3 * Copyright (C) 2009 Red Hat Inc.
5 * This program is free software; you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation; either version 2 of the License, or
8 * (at your option) any later version.
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
15 * You should have received a copy of the GNU General Public License
16 * along with this program; if not, write to the Free Software
17 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
20 (* This script generates a large amount of code and documentation for
21 * all the daemon actions.
23 * To add a new action there are only two files you need to change,
24 * this one to describe the interface (see the big table below), and
25 * daemon/<somefile>.c to write the implementation.
27 * After editing this file, run it (./src/generator.ml) to regenerate
28 * all the output files.
30 * IMPORTANT: This script should NOT print any warnings. If it prints
31 * warnings, you should treat them as errors.
32 * [Need to add -warn-error to ocaml command line]
39 type style = ret * args
41 (* "RErr" as a return value means an int used as a simple error
42 * indication, ie. 0 or -1.
45 (* "RInt" as a return value means an int which is -1 for error
46 * or any value >= 0 on success.
49 (* "RBool" is a bool return value which can be true/false or
53 (* "RConstString" is a string that refers to a constant value.
54 * Try to avoid using this. In particular you cannot use this
55 * for values returned from the daemon, because there is no
56 * thread-safe way to return them in the C API.
58 | RConstString of string
59 (* "RString" and "RStringList" are caller-frees. *)
61 | RStringList of string
62 (* Some limited tuples are possible: *)
63 | RIntBool of string * string
64 (* LVM PVs, VGs and LVs. *)
68 and args = argt list (* Function parameters, guestfs handle is implicit. *)
70 (* Note in future we should allow a "variable args" parameter as
71 * the final parameter, to allow commands like
72 * chmod mode file [file(s)...]
73 * This is not implemented yet, but many commands (such as chmod)
74 * are currently defined with the argument order keeping this future
75 * possibility in mind.
78 | String of string (* const char *name, cannot be NULL *)
79 | OptString of string (* const char *name, may be NULL *)
80 | StringList of string(* list of strings (each string cannot be NULL) *)
81 | Bool of string (* boolean *)
82 | Int of string (* int (smallish ints, signed, <= 31 bits) *)
85 | ProtocolLimitWarning (* display warning about protocol size limits *)
86 | DangerWillRobinson (* flags particularly dangerous commands *)
87 | FishAlias of string (* provide an alias for this cmd in guestfish *)
88 | FishAction of string (* call this function in guestfish *)
89 | NotInFish (* do not export via guestfish *)
91 let protocol_limit_warning =
92 "Because of the message protocol, there is a transfer limit
93 of somewhere between 2MB and 4MB. To transfer large files you should use
96 let danger_will_robinson =
97 "B<This command is dangerous. Without careful use you
98 can easily destroy all your data>."
100 (* You can supply zero or as many tests as you want per API call.
102 * Note that the test environment has 3 block devices, of size 500MB,
103 * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc).
104 * Note for partitioning purposes, the 500MB device has 63 cylinders.
106 * To be able to run the tests in a reasonable amount of time,
107 * the virtual machine and block devices are reused between tests.
108 * So don't try testing kill_subprocess :-x
110 * Between each test we umount-all and lvm-remove-all.
112 * Don't assume anything about the previous contents of the block
113 * devices. Use 'Init*' to create some initial scenarios.
115 type tests = (test_init * test) list
117 (* Run the command sequence and just expect nothing to fail. *)
119 (* Run the command sequence and expect the output of the final
120 * command to be the string.
122 | TestOutput of seq * string
123 (* Run the command sequence and expect the output of the final
124 * command to be the list of strings.
126 | TestOutputList of seq * string list
127 (* Run the command sequence and expect the output of the final
128 * command to be the integer.
130 | TestOutputInt of seq * int
131 (* Run the command sequence and expect the output of the final
132 * command to be a true value (!= 0 or != NULL).
134 | TestOutputTrue of seq
135 (* Run the command sequence and expect the output of the final
136 * command to be a false value (== 0 or == NULL, but not an error).
138 | TestOutputFalse of seq
139 (* Run the command sequence and expect the output of the final
140 * command to be a list of the given length (but don't care about
143 | TestOutputLength of seq * int
144 (* Run the command sequence and expect the final command (only)
147 | TestLastFail of seq
149 (* Some initial scenarios for testing. *)
151 (* Do nothing, block devices could contain random stuff. *)
153 (* /dev/sda contains a single partition /dev/sda1, which is formatted
154 * as ext2, empty [except for lost+found] and mounted on /.
155 * /dev/sdb and /dev/sdc may have random content.
160 * /dev/sda1 (is a PV):
161 * /dev/VG/LV (size 8MB):
162 * formatted as ext2, empty [except for lost+found], mounted on /
163 * /dev/sdb and /dev/sdc may have random content.
167 (* Sequence of commands for testing. *)
169 and cmd = string list
171 (* Note about long descriptions: When referring to another
172 * action, use the format C<guestfs_other> (ie. the full name of
173 * the C function). This will be replaced as appropriate in other
176 * Apart from that, long descriptions are just perldoc paragraphs.
179 let non_daemon_functions = [
180 ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
182 "launch the qemu subprocess",
184 Internally libguestfs is implemented by running a virtual machine
187 You should call this after configuring the handle
188 (eg. adding drives) but before performing any actions.");
190 ("wait_ready", (RErr, []), -1, [NotInFish],
192 "wait until the qemu subprocess launches",
194 Internally libguestfs is implemented by running a virtual machine
197 You should call this after C<guestfs_launch> to wait for the launch
200 ("kill_subprocess", (RErr, []), -1, [],
202 "kill the qemu subprocess",
204 This kills the qemu subprocess. You should never need to call this.");
206 ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
208 "add an image to examine or modify",
210 This function adds a virtual machine disk image C<filename> to the
211 guest. The first time you call this function, the disk appears as IDE
212 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
215 You don't necessarily need to be root when using libguestfs. However
216 you obviously do need sufficient permissions to access the filename
217 for whatever operations you want to perform (ie. read access if you
218 just want to read the image or write access if you want to modify the
221 This is equivalent to the qemu parameter C<-drive file=filename>.");
223 ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
225 "add a CD-ROM disk image to examine",
227 This function adds a virtual CD-ROM disk image to the guest.
229 This is equivalent to the qemu parameter C<-cdrom filename>.");
231 ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
233 "add qemu parameters",
235 This can be used to add arbitrary qemu command line parameters
236 of the form C<-param value>. Actually it's not quite arbitrary - we
237 prevent you from setting some parameters which would interfere with
238 parameters that we use.
240 The first character of C<param> string must be a C<-> (dash).
242 C<value> can be NULL.");
244 ("set_path", (RErr, [String "path"]), -1, [FishAlias "path"],
246 "set the search path",
248 Set the path that libguestfs searches for kernel and initrd.img.
250 The default is C<$libdir/guestfs> unless overridden by setting
251 C<LIBGUESTFS_PATH> environment variable.
253 The string C<path> is stashed in the libguestfs handle, so the caller
254 must make sure it remains valid for the lifetime of the handle.
256 Setting C<path> to C<NULL> restores the default path.");
258 ("get_path", (RConstString "path", []), -1, [],
260 "get the search path",
262 Return the current search path.
264 This is always non-NULL. If it wasn't set already, then this will
265 return the default path.");
267 ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
271 If C<autosync> is true, this enables autosync. Libguestfs will make a
272 best effort attempt to run C<guestfs_sync> when the handle is closed
273 (also if the program exits without closing handles).");
275 ("get_autosync", (RBool "autosync", []), -1, [],
279 Get the autosync flag.");
281 ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
285 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
287 Verbose messages are disabled unless the environment variable
288 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
290 ("get_verbose", (RBool "verbose", []), -1, [],
294 This returns the verbose messages flag.")
297 let daemon_functions = [
298 ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
299 [InitNone, TestOutput (
300 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
301 ["mkfs"; "ext2"; "/dev/sda1"];
302 ["mount"; "/dev/sda1"; "/"];
303 ["write_file"; "/new"; "new file contents"; "0"];
304 ["cat"; "/new"]], "new file contents")],
305 "mount a guest disk at a position in the filesystem",
307 Mount a guest disk at a position in the filesystem. Block devices
308 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
309 the guest. If those block devices contain partitions, they will have
310 the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
313 The rules are the same as for L<mount(2)>: A filesystem must
314 first be mounted on C</> before others can be mounted. Other
315 filesystems can only be mounted on directories which already
318 The mounted filesystem is writable, if we have sufficient permissions
319 on the underlying device.
321 The filesystem options C<sync> and C<noatime> are set with this
322 call, in order to improve reliability.");
324 ("sync", (RErr, []), 2, [],
325 [ InitNone, TestRun [["sync"]]],
326 "sync disks, writes are flushed through to the disk image",
328 This syncs the disk, so that any writes are flushed through to the
329 underlying disk image.
331 You should always call this if you have modified a disk image, before
332 closing the handle.");
334 ("touch", (RErr, [String "path"]), 3, [],
335 [InitEmpty, TestOutputTrue (
337 ["exists"; "/new"]])],
338 "update file timestamps or create a new file",
340 Touch acts like the L<touch(1)> command. It can be used to
341 update the timestamps on a file, or, if the file does not exist,
342 to create a new zero-length file.");
344 ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
345 [InitEmpty, TestOutput (
346 [["write_file"; "/new"; "new file contents"; "0"];
347 ["cat"; "/new"]], "new file contents")],
348 "list the contents of a file",
350 Return the contents of the file named C<path>.
352 Note that this function cannot correctly handle binary files
353 (specifically, files containing C<\\0> character which is treated
354 as end of string). For those you need to use the C<guestfs_read_file>
355 function which has a more complex interface.");
357 ("ll", (RString "listing", [String "directory"]), 5, [],
358 [], (* XXX Tricky to test because it depends on the exact format
359 * of the 'ls -l' command, which changes between F10 and F11.
361 "list the files in a directory (long format)",
363 List the files in C<directory> (relative to the root directory,
364 there is no cwd) in the format of 'ls -la'.
366 This command is mostly useful for interactive sessions. It
367 is I<not> intended that you try to parse the output string.");
369 ("ls", (RStringList "listing", [String "directory"]), 6, [],
370 [InitEmpty, TestOutputList (
373 ["touch"; "/newest"];
374 ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
375 "list the files in a directory",
377 List the files in C<directory> (relative to the root directory,
378 there is no cwd). The '.' and '..' entries are not returned, but
379 hidden files are shown.
381 This command is mostly useful for interactive sessions. Programs
382 should probably use C<guestfs_readdir> instead.");
384 ("list_devices", (RStringList "devices", []), 7, [],
385 [InitNone, TestOutputList (
386 [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"])],
387 "list the block devices",
389 List all the block devices.
391 The full block device names are returned, eg. C</dev/sda>");
393 ("list_partitions", (RStringList "partitions", []), 8, [],
394 [InitEmpty, TestOutputList (
395 [["list_partitions"]], ["/dev/sda1"]);
396 InitNone, TestOutputList (
397 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
398 ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
399 "list the partitions",
401 List all the partitions detected on all block devices.
403 The full partition device names are returned, eg. C</dev/sda1>
405 This does not return logical volumes. For that you will need to
406 call C<guestfs_lvs>.");
408 ("pvs", (RStringList "physvols", []), 9, [],
409 [InitEmptyLVM, TestOutputList (
410 [["pvs"]], ["/dev/sda1"]);
411 InitNone, TestOutputList (
412 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
413 ["pvcreate"; "/dev/sda1"];
414 ["pvcreate"; "/dev/sda2"];
415 ["pvcreate"; "/dev/sda3"];
416 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
417 "list the LVM physical volumes (PVs)",
419 List all the physical volumes detected. This is the equivalent
420 of the L<pvs(8)> command.
422 This returns a list of just the device names that contain
423 PVs (eg. C</dev/sda2>).
425 See also C<guestfs_pvs_full>.");
427 ("vgs", (RStringList "volgroups", []), 10, [],
428 [InitEmptyLVM, TestOutputList (
430 InitNone, TestOutputList (
431 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
432 ["pvcreate"; "/dev/sda1"];
433 ["pvcreate"; "/dev/sda2"];
434 ["pvcreate"; "/dev/sda3"];
435 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
436 ["vgcreate"; "VG2"; "/dev/sda3"];
437 ["vgs"]], ["VG1"; "VG2"])],
438 "list the LVM volume groups (VGs)",
440 List all the volumes groups detected. This is the equivalent
441 of the L<vgs(8)> command.
443 This returns a list of just the volume group names that were
444 detected (eg. C<VolGroup00>).
446 See also C<guestfs_vgs_full>.");
448 ("lvs", (RStringList "logvols", []), 11, [],
449 [InitEmptyLVM, TestOutputList (
450 [["lvs"]], ["/dev/VG/LV"]);
451 InitNone, TestOutputList (
452 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
453 ["pvcreate"; "/dev/sda1"];
454 ["pvcreate"; "/dev/sda2"];
455 ["pvcreate"; "/dev/sda3"];
456 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
457 ["vgcreate"; "VG2"; "/dev/sda3"];
458 ["lvcreate"; "LV1"; "VG1"; "50"];
459 ["lvcreate"; "LV2"; "VG1"; "50"];
460 ["lvcreate"; "LV3"; "VG2"; "50"];
461 ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
462 "list the LVM logical volumes (LVs)",
464 List all the logical volumes detected. This is the equivalent
465 of the L<lvs(8)> command.
467 This returns a list of the logical volume device names
468 (eg. C</dev/VolGroup00/LogVol00>).
470 See also C<guestfs_lvs_full>.");
472 ("pvs_full", (RPVList "physvols", []), 12, [],
473 [InitEmptyLVM, TestOutputLength (
475 "list the LVM physical volumes (PVs)",
477 List all the physical volumes detected. This is the equivalent
478 of the L<pvs(8)> command. The \"full\" version includes all fields.");
480 ("vgs_full", (RVGList "volgroups", []), 13, [],
481 [InitEmptyLVM, TestOutputLength (
483 "list the LVM volume groups (VGs)",
485 List all the volumes groups detected. This is the equivalent
486 of the L<vgs(8)> command. The \"full\" version includes all fields.");
488 ("lvs_full", (RLVList "logvols", []), 14, [],
489 [InitEmptyLVM, TestOutputLength (
491 "list the LVM logical volumes (LVs)",
493 List all the logical volumes detected. This is the equivalent
494 of the L<lvs(8)> command. The \"full\" version includes all fields.");
496 ("read_lines", (RStringList "lines", [String "path"]), 15, [],
497 [InitEmpty, TestOutputList (
498 [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
499 ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);
500 InitEmpty, TestOutputList (
501 [["write_file"; "/new"; ""; "0"];
502 ["read_lines"; "/new"]], [])],
503 "read file as lines",
505 Return the contents of the file named C<path>.
507 The file contents are returned as a list of lines. Trailing
508 C<LF> and C<CRLF> character sequences are I<not> returned.
510 Note that this function cannot correctly handle binary files
511 (specifically, files containing C<\\0> character which is treated
512 as end of line). For those you need to use the C<guestfs_read_file>
513 function which has a more complex interface.");
515 ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [],
516 [], (* XXX Augeas code needs tests. *)
517 "create a new Augeas handle",
519 Create a new Augeas handle for editing configuration files.
520 If there was any previous Augeas handle associated with this
521 guestfs session, then it is closed.
523 You must call this before using any other C<guestfs_aug_*>
526 C<root> is the filesystem root. C<root> must not be NULL,
529 The flags are the same as the flags defined in
530 E<lt>augeas.hE<gt>, the logical I<or> of the following
535 =item C<AUG_SAVE_BACKUP> = 1
537 Keep the original file with a C<.augsave> extension.
539 =item C<AUG_SAVE_NEWFILE> = 2
541 Save changes into a file with extension C<.augnew>, and
542 do not overwrite original. Overrides C<AUG_SAVE_BACKUP>.
544 =item C<AUG_TYPE_CHECK> = 4
546 Typecheck lenses (can be expensive).
548 =item C<AUG_NO_STDINC> = 8
550 Do not use standard load path for modules.
552 =item C<AUG_SAVE_NOOP> = 16
554 Make save a no-op, just record what would have been changed.
556 =item C<AUG_NO_LOAD> = 32
558 Do not load the tree in C<guestfs_aug_init>.
562 To close the handle, you can call C<guestfs_aug_close>.
564 To find out more about Augeas, see L<http://augeas.net/>.");
566 ("aug_close", (RErr, []), 26, [],
567 [], (* XXX Augeas code needs tests. *)
568 "close the current Augeas handle",
570 Close the current Augeas handle and free up any resources
571 used by it. After calling this, you have to call
572 C<guestfs_aug_init> again before you can use any other
575 ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
576 [], (* XXX Augeas code needs tests. *)
577 "define an Augeas variable",
579 Defines an Augeas variable C<name> whose value is the result
580 of evaluating C<expr>. If C<expr> is NULL, then C<name> is
583 On success this returns the number of nodes in C<expr>, or
584 C<0> if C<expr> evaluates to something which is not a nodeset.");
586 ("aug_defnode", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [],
587 [], (* XXX Augeas code needs tests. *)
588 "define an Augeas node",
590 Defines a variable C<name> whose value is the result of
593 If C<expr> evaluates to an empty nodeset, a node is created,
594 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
595 C<name> will be the nodeset containing that single node.
597 On success this returns a pair containing the
598 number of nodes in the nodeset, and a boolean flag
599 if a node was created.");
601 ("aug_get", (RString "val", [String "path"]), 19, [],
602 [], (* XXX Augeas code needs tests. *)
603 "look up the value of an Augeas path",
605 Look up the value associated with C<path>. If C<path>
606 matches exactly one node, the C<value> is returned.");
608 ("aug_set", (RErr, [String "path"; String "val"]), 20, [],
609 [], (* XXX Augeas code needs tests. *)
610 "set Augeas path to value",
612 Set the value associated with C<path> to C<value>.");
614 ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [],
615 [], (* XXX Augeas code needs tests. *)
616 "insert a sibling Augeas node",
618 Create a new sibling C<label> for C<path>, inserting it into
619 the tree before or after C<path> (depending on the boolean
622 C<path> must match exactly one existing node in the tree, and
623 C<label> must be a label, ie. not contain C</>, C<*> or end
624 with a bracketed index C<[N]>.");
626 ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
627 [], (* XXX Augeas code needs tests. *)
628 "remove an Augeas path",
630 Remove C<path> and all of its children.
632 On success this returns the number of entries which were removed.");
634 ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [],
635 [], (* XXX Augeas code needs tests. *)
638 Move the node C<src> to C<dest>. C<src> must match exactly
639 one node. C<dest> is overwritten if it exists.");
641 ("aug_match", (RStringList "matches", [String "path"]), 24, [],
642 [], (* XXX Augeas code needs tests. *)
643 "return Augeas nodes which match path",
645 Returns a list of paths which match the path expression C<path>.
646 The returned paths are sufficiently qualified so that they match
647 exactly one node in the current tree.");
649 ("aug_save", (RErr, []), 25, [],
650 [], (* XXX Augeas code needs tests. *)
651 "write all pending Augeas changes to disk",
653 This writes all pending changes to disk.
655 The flags which were passed to C<guestfs_aug_init> affect exactly
656 how files are saved.");
658 ("aug_load", (RErr, []), 27, [],
659 [], (* XXX Augeas code needs tests. *)
660 "load files into the tree",
662 Load files into the tree.
664 See C<aug_load> in the Augeas documentation for the full gory
667 ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
668 [], (* XXX Augeas code needs tests. *)
669 "list Augeas nodes under a path",
671 This is just a shortcut for listing C<guestfs_aug_match>
672 C<path/*> and sorting the resulting nodes into alphabetical order.");
674 ("rm", (RErr, [String "path"]), 29, [],
678 InitEmpty, TestLastFail
680 InitEmpty, TestLastFail
685 Remove the single file C<path>.");
687 ("rmdir", (RErr, [String "path"]), 30, [],
691 InitEmpty, TestLastFail
693 InitEmpty, TestLastFail
696 "remove a directory",
698 Remove the single directory C<path>.");
700 ("rm_rf", (RErr, [String "path"]), 31, [],
701 [InitEmpty, TestOutputFalse
703 ["mkdir"; "/new/foo"];
704 ["touch"; "/new/foo/bar"];
706 ["exists"; "/new"]]],
707 "remove a file or directory recursively",
709 Remove the file or directory C<path>, recursively removing the
710 contents if its a directory. This is like the C<rm -rf> shell
713 ("mkdir", (RErr, [String "path"]), 32, [],
714 [InitEmpty, TestOutputTrue
717 InitEmpty, TestLastFail
718 [["mkdir"; "/new/foo/bar"]]],
719 "create a directory",
721 Create a directory named C<path>.");
723 ("mkdir_p", (RErr, [String "path"]), 33, [],
724 [InitEmpty, TestOutputTrue
725 [["mkdir_p"; "/new/foo/bar"];
726 ["is_dir"; "/new/foo/bar"]];
727 InitEmpty, TestOutputTrue
728 [["mkdir_p"; "/new/foo/bar"];
729 ["is_dir"; "/new/foo"]];
730 InitEmpty, TestOutputTrue
731 [["mkdir_p"; "/new/foo/bar"];
732 ["is_dir"; "/new"]]],
733 "create a directory and parents",
735 Create a directory named C<path>, creating any parent directories
736 as necessary. This is like the C<mkdir -p> shell command.");
738 ("chmod", (RErr, [Int "mode"; String "path"]), 34, [],
739 [], (* XXX Need stat command to test *)
742 Change the mode (permissions) of C<path> to C<mode>. Only
743 numeric modes are supported.");
745 ("chown", (RErr, [Int "owner"; Int "group"; String "path"]), 35, [],
746 [], (* XXX Need stat command to test *)
747 "change file owner and group",
749 Change the file owner to C<owner> and group to C<group>.
751 Only numeric uid and gid are supported. If you want to use
752 names, you will need to locate and parse the password file
753 yourself (Augeas support makes this relatively easy).");
755 ("exists", (RBool "existsflag", [String "path"]), 36, [],
756 [InitEmpty, TestOutputTrue (
758 ["exists"; "/new"]]);
759 InitEmpty, TestOutputTrue (
761 ["exists"; "/new"]])],
762 "test if file or directory exists",
764 This returns C<true> if and only if there is a file, directory
765 (or anything) with the given C<path> name.
767 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
769 ("is_file", (RBool "fileflag", [String "path"]), 37, [],
770 [InitEmpty, TestOutputTrue (
772 ["is_file"; "/new"]]);
773 InitEmpty, TestOutputFalse (
775 ["is_file"; "/new"]])],
776 "test if file exists",
778 This returns C<true> if and only if there is a file
779 with the given C<path> name. Note that it returns false for
780 other objects like directories.
782 See also C<guestfs_stat>.");
784 ("is_dir", (RBool "dirflag", [String "path"]), 38, [],
785 [InitEmpty, TestOutputFalse (
787 ["is_dir"; "/new"]]);
788 InitEmpty, TestOutputTrue (
790 ["is_dir"; "/new"]])],
791 "test if file exists",
793 This returns C<true> if and only if there is a directory
794 with the given C<path> name. Note that it returns false for
795 other objects like files.
797 See also C<guestfs_stat>.");
799 ("pvcreate", (RErr, [String "device"]), 39, [],
800 [InitNone, TestOutputList (
801 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
802 ["pvcreate"; "/dev/sda1"];
803 ["pvcreate"; "/dev/sda2"];
804 ["pvcreate"; "/dev/sda3"];
805 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
806 "create an LVM physical volume",
808 This creates an LVM physical volume on the named C<device>,
809 where C<device> should usually be a partition name such
812 ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
813 [InitNone, TestOutputList (
814 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
815 ["pvcreate"; "/dev/sda1"];
816 ["pvcreate"; "/dev/sda2"];
817 ["pvcreate"; "/dev/sda3"];
818 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
819 ["vgcreate"; "VG2"; "/dev/sda3"];
820 ["vgs"]], ["VG1"; "VG2"])],
821 "create an LVM volume group",
823 This creates an LVM volume group called C<volgroup>
824 from the non-empty list of physical volumes C<physvols>.");
826 ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [],
827 [InitNone, TestOutputList (
828 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
829 ["pvcreate"; "/dev/sda1"];
830 ["pvcreate"; "/dev/sda2"];
831 ["pvcreate"; "/dev/sda3"];
832 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
833 ["vgcreate"; "VG2"; "/dev/sda3"];
834 ["lvcreate"; "LV1"; "VG1"; "50"];
835 ["lvcreate"; "LV2"; "VG1"; "50"];
836 ["lvcreate"; "LV3"; "VG2"; "50"];
837 ["lvcreate"; "LV4"; "VG2"; "50"];
838 ["lvcreate"; "LV5"; "VG2"; "50"];
840 ["/dev/VG1/LV1"; "/dev/VG1/LV2";
841 "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
842 "create an LVM volume group",
844 This creates an LVM volume group called C<logvol>
845 on the volume group C<volgroup>, with C<size> megabytes.");
847 ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [],
848 [InitNone, TestOutput (
849 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
850 ["mkfs"; "ext2"; "/dev/sda1"];
851 ["mount"; "/dev/sda1"; "/"];
852 ["write_file"; "/new"; "new file contents"; "0"];
853 ["cat"; "/new"]], "new file contents")],
856 This creates a filesystem on C<device> (usually a partition
857 of LVM logical volume). The filesystem type is C<fstype>, for
860 ("sfdisk", (RErr, [String "device";
861 Int "cyls"; Int "heads"; Int "sectors";
862 StringList "lines"]), 43, [DangerWillRobinson],
864 "create partitions on a block device",
866 This is a direct interface to the L<sfdisk(8)> program for creating
867 partitions on block devices.
869 C<device> should be a block device, for example C</dev/sda>.
871 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
872 and sectors on the device, which are passed directly to sfdisk as
873 the I<-C>, I<-H> and I<-S> parameters. If you pass C<0> for any
874 of these, then the corresponding parameter is omitted. Usually for
875 'large' disks, you can just pass C<0> for these, but for small
876 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
877 out the right geometry and you will need to tell it.
879 C<lines> is a list of lines that we feed to C<sfdisk>. For more
880 information refer to the L<sfdisk(8)> manpage.
882 To create a single partition occupying the whole disk, you would
883 pass C<lines> as a single element list, when the single element being
884 the string C<,> (comma).");
886 ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
887 [InitNone, TestOutput (
888 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
889 ["mkfs"; "ext2"; "/dev/sda1"];
890 ["mount"; "/dev/sda1"; "/"];
891 ["write_file"; "/new"; "new file contents"; "0"];
892 ["cat"; "/new"]], "new file contents")],
895 This call creates a file called C<path>. The contents of the
896 file is the string C<content> (which can contain any 8 bit data),
899 As a special case, if C<size> is C<0>
900 then the length is calculated using C<strlen> (so in this case
901 the content cannot contain embedded ASCII NULs).");
903 ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
904 [InitNone, TestOutputList (
905 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
906 ["mkfs"; "ext2"; "/dev/sda1"];
907 ["mount"; "/dev/sda1"; "/"];
908 ["mounts"]], ["/dev/sda1"]);
909 InitNone, TestOutputList (
910 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
911 ["mkfs"; "ext2"; "/dev/sda1"];
912 ["mount"; "/dev/sda1"; "/"];
915 "unmount a filesystem",
917 This unmounts the given filesystem. The filesystem may be
918 specified either by its mountpoint (path) or the device which
919 contains the filesystem.");
921 ("mounts", (RStringList "devices", []), 46, [],
922 [InitEmpty, TestOutputList (
923 [["mounts"]], ["/dev/sda1"])],
924 "show mounted filesystems",
926 This returns the list of currently mounted filesystems. It returns
927 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
929 Some internal mounts are not shown.");
931 ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
932 [InitEmpty, TestOutputList (
935 "unmount all filesystems",
937 This unmounts all mounted filesystems.
939 Some internal mounts are not unmounted by this call.");
941 ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson],
943 "remove all LVM LVs, VGs and PVs",
945 This command removes all LVM logical volumes, volume groups
946 and physical volumes.");
950 let all_functions = non_daemon_functions @ daemon_functions
952 (* In some places we want the functions to be displayed sorted
953 * alphabetically, so this is useful:
955 let all_functions_sorted =
956 List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
957 compare n1 n2) all_functions
959 (* Column names and types from LVM PVs/VGs/LVs. *)
968 "pv_attr", `String (* XXX *);
970 "pv_pe_alloc_count", `Int;
973 "pv_mda_count", `Int;
974 "pv_mda_free", `Bytes;
976 "pv_mda_size", `Bytes;
983 "vg_attr", `String (* XXX *);
987 "vg_extent_size", `Bytes;
988 "vg_extent_count", `Int;
989 "vg_free_count", `Int;
997 "vg_mda_count", `Int;
998 "vg_mda_free", `Bytes;
1000 "vg_mda_size", `Bytes;
1006 "lv_attr", `String (* XXX *);
1009 "lv_kernel_major", `Int;
1010 "lv_kernel_minor", `Int;
1014 "snap_percent", `OptPercent;
1015 "copy_percent", `OptPercent;
1018 "mirror_log", `String;
1022 (* Useful functions.
1023 * Note we don't want to use any external OCaml libraries which
1024 * makes this a bit harder than it should be.
1026 let failwithf fs = ksprintf failwith fs
1028 let replace_char s c1 c2 =
1029 let s2 = String.copy s in
1030 let r = ref false in
1031 for i = 0 to String.length s2 - 1 do
1032 if String.unsafe_get s2 i = c1 then (
1033 String.unsafe_set s2 i c2;
1037 if not !r then s else s2
1039 let rec find s sub =
1040 let len = String.length s in
1041 let sublen = String.length sub in
1043 if i <= len-sublen then (
1045 if j < sublen then (
1046 if s.[i+j] = sub.[j] then loop2 (j+1)
1052 if r = -1 then loop (i+1) else r
1058 let rec replace_str s s1 s2 =
1059 let len = String.length s in
1060 let sublen = String.length s1 in
1061 let i = find s s1 in
1064 let s' = String.sub s 0 i in
1065 let s'' = String.sub s (i+sublen) (len-i-sublen) in
1066 s' ^ s2 ^ replace_str s'' s1 s2
1069 let rec string_split sep str =
1070 let len = String.length str in
1071 let seplen = String.length sep in
1072 let i = find str sep in
1073 if i = -1 then [str]
1075 let s' = String.sub str 0 i in
1076 let s'' = String.sub str (i+seplen) (len-i-seplen) in
1077 s' :: string_split sep s''
1080 let rec find_map f = function
1081 | [] -> raise Not_found
1085 | None -> find_map f xs
1088 let rec loop i = function
1090 | x :: xs -> f i x; loop (i+1) xs
1095 let rec loop i = function
1097 | x :: xs -> let r = f i x in r :: loop (i+1) xs
1101 let name_of_argt = function
1102 | String n | OptString n | StringList n | Bool n | Int n -> n
1104 (* Check function names etc. for consistency. *)
1105 let check_functions () =
1106 let contains_uppercase str =
1107 let len = String.length str in
1109 if i >= len then false
1112 if c >= 'A' && c <= 'Z' then true
1119 (* Check function names. *)
1121 fun (name, _, _, _, _, _, _) ->
1122 if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
1123 failwithf "function name %s does not need 'guestfs' prefix" name;
1124 if contains_uppercase name then
1125 failwithf "function name %s should not contain uppercase chars" name;
1126 if String.contains name '-' then
1127 failwithf "function name %s should not contain '-', use '_' instead."
1131 (* Check function parameter/return names. *)
1133 fun (name, style, _, _, _, _, _) ->
1134 let check_arg_ret_name n =
1135 if contains_uppercase n then
1136 failwithf "%s param/ret %s should not contain uppercase chars"
1138 if String.contains n '-' || String.contains n '_' then
1139 failwithf "%s param/ret %s should not contain '-' or '_'"
1142 failwithf "%s has a param/ret called 'value', which causes conflicts in the OCaml bindings, use something like 'val' or a more descriptive name" n
1145 (match fst style with
1147 | RInt n | RBool n | RConstString n | RString n
1148 | RStringList n | RPVList n | RVGList n | RLVList n ->
1149 check_arg_ret_name n
1151 check_arg_ret_name n;
1152 check_arg_ret_name m
1154 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
1157 (* Check long dscriptions. *)
1159 fun (name, _, _, _, _, _, longdesc) ->
1160 if longdesc.[String.length longdesc-1] = '\n' then
1161 failwithf "long description of %s should not end with \\n." name
1164 (* Check proc_nrs. *)
1166 fun (name, _, proc_nr, _, _, _, _) ->
1167 if proc_nr <= 0 then
1168 failwithf "daemon function %s should have proc_nr > 0" name
1172 fun (name, _, proc_nr, _, _, _, _) ->
1173 if proc_nr <> -1 then
1174 failwithf "non-daemon function %s should have proc_nr -1" name
1175 ) non_daemon_functions;
1178 List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
1181 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
1182 let rec loop = function
1185 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
1187 | (name1,nr1) :: (name2,nr2) :: _ ->
1188 failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
1193 (* 'pr' prints to the current output file. *)
1194 let chan = ref stdout
1195 let pr fs = ksprintf (output_string !chan) fs
1197 (* Generate a header block in a number of standard styles. *)
1198 type comment_style = CStyle | HashStyle | OCamlStyle
1199 type license = GPLv2 | LGPLv2
1201 let generate_header comment license =
1202 let c = match comment with
1203 | CStyle -> pr "/* "; " *"
1204 | HashStyle -> pr "# "; "#"
1205 | OCamlStyle -> pr "(* "; " *" in
1206 pr "libguestfs generated file\n";
1207 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
1208 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
1210 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
1214 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
1215 pr "%s it under the terms of the GNU General Public License as published by\n" c;
1216 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
1217 pr "%s (at your option) any later version.\n" c;
1219 pr "%s This program is distributed in the hope that it will be useful,\n" c;
1220 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1221 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
1222 pr "%s GNU General Public License for more details.\n" c;
1224 pr "%s You should have received a copy of the GNU General Public License along\n" c;
1225 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
1226 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
1229 pr "%s This library is free software; you can redistribute it and/or\n" c;
1230 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
1231 pr "%s License as published by the Free Software Foundation; either\n" c;
1232 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
1234 pr "%s This library is distributed in the hope that it will be useful,\n" c;
1235 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1236 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
1237 pr "%s Lesser General Public License for more details.\n" c;
1239 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
1240 pr "%s License along with this library; if not, write to the Free Software\n" c;
1241 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
1244 | CStyle -> pr " */\n"
1246 | OCamlStyle -> pr " *)\n"
1250 (* Start of main code generation functions below this line. *)
1252 (* Generate the pod documentation for the C API. *)
1253 let rec generate_actions_pod () =
1255 fun (shortname, style, _, flags, _, _, longdesc) ->
1256 let name = "guestfs_" ^ shortname in
1257 pr "=head2 %s\n\n" name;
1259 generate_prototype ~extern:false ~handle:"handle" name style;
1261 pr "%s\n\n" longdesc;
1262 (match fst style with
1264 pr "This function returns 0 on success or -1 on error.\n\n"
1266 pr "On error this function returns -1.\n\n"
1268 pr "This function returns a C truth value on success or -1 on error.\n\n"
1270 pr "This function returns a string or NULL on error.
1271 The string is owned by the guest handle and must I<not> be freed.\n\n"
1273 pr "This function returns a string or NULL on error.
1274 I<The caller must free the returned string after use>.\n\n"
1276 pr "This function returns a NULL-terminated array of strings
1277 (like L<environ(3)>), or NULL if there was an error.
1278 I<The caller must free the strings and the array after use>.\n\n"
1280 pr "This function returns a C<struct guestfs_int_bool *>.
1281 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
1283 pr "This function returns a C<struct guestfs_lvm_pv_list *>.
1284 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
1286 pr "This function returns a C<struct guestfs_lvm_vg_list *>.
1287 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
1289 pr "This function returns a C<struct guestfs_lvm_lv_list *>.
1290 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
1292 if List.mem ProtocolLimitWarning flags then
1293 pr "%s\n\n" protocol_limit_warning;
1294 if List.mem DangerWillRobinson flags then
1295 pr "%s\n\n" danger_will_robinson;
1296 ) all_functions_sorted
1298 and generate_structs_pod () =
1299 (* LVM structs documentation. *)
1302 pr "=head2 guestfs_lvm_%s\n" typ;
1304 pr " struct guestfs_lvm_%s {\n" typ;
1307 | name, `String -> pr " char *%s;\n" name
1309 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
1310 pr " char %s[32];\n" name
1311 | name, `Bytes -> pr " uint64_t %s;\n" name
1312 | name, `Int -> pr " int64_t %s;\n" name
1313 | name, `OptPercent ->
1314 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
1315 pr " float %s;\n" name
1318 pr " struct guestfs_lvm_%s_list {\n" typ;
1319 pr " uint32_t len; /* Number of elements in list. */\n";
1320 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
1323 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
1326 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1328 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
1329 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
1331 * We have to use an underscore instead of a dash because otherwise
1332 * rpcgen generates incorrect code.
1334 * This header is NOT exported to clients, but see also generate_structs_h.
1336 and generate_xdr () =
1337 generate_header CStyle LGPLv2;
1339 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
1340 pr "typedef string str<>;\n";
1343 (* LVM internal structures. *)
1347 pr "struct guestfs_lvm_int_%s {\n" typ;
1349 | name, `String -> pr " string %s<>;\n" name
1350 | name, `UUID -> pr " opaque %s[32];\n" name
1351 | name, `Bytes -> pr " hyper %s;\n" name
1352 | name, `Int -> pr " hyper %s;\n" name
1353 | name, `OptPercent -> pr " float %s;\n" name
1357 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
1359 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1362 fun (shortname, style, _, _, _, _, _) ->
1363 let name = "guestfs_" ^ shortname in
1365 (match snd style with
1368 pr "struct %s_args {\n" name;
1371 | String n -> pr " string %s<>;\n" n
1372 | OptString n -> pr " str *%s;\n" n
1373 | StringList n -> pr " str %s<>;\n" n
1374 | Bool n -> pr " bool %s;\n" n
1375 | Int n -> pr " int %s;\n" n
1379 (match fst style with
1382 pr "struct %s_ret {\n" name;
1386 pr "struct %s_ret {\n" name;
1390 failwithf "RConstString cannot be returned from a daemon function"
1392 pr "struct %s_ret {\n" name;
1393 pr " string %s<>;\n" n;
1396 pr "struct %s_ret {\n" name;
1397 pr " str %s<>;\n" n;
1400 pr "struct %s_ret {\n" name;
1405 pr "struct %s_ret {\n" name;
1406 pr " guestfs_lvm_int_pv_list %s;\n" n;
1409 pr "struct %s_ret {\n" name;
1410 pr " guestfs_lvm_int_vg_list %s;\n" n;
1413 pr "struct %s_ret {\n" name;
1414 pr " guestfs_lvm_int_lv_list %s;\n" n;
1419 (* Table of procedure numbers. *)
1420 pr "enum guestfs_procedure {\n";
1422 fun (shortname, _, proc_nr, _, _, _, _) ->
1423 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
1425 pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
1429 (* Having to choose a maximum message size is annoying for several
1430 * reasons (it limits what we can do in the API), but it (a) makes
1431 * the protocol a lot simpler, and (b) provides a bound on the size
1432 * of the daemon which operates in limited memory space. For large
1433 * file transfers you should use FTP.
1435 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
1438 (* Message header, etc. *)
1440 const GUESTFS_PROGRAM = 0x2000F5F5;
1441 const GUESTFS_PROTOCOL_VERSION = 1;
1443 enum guestfs_message_direction {
1444 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
1445 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
1448 enum guestfs_message_status {
1449 GUESTFS_STATUS_OK = 0,
1450 GUESTFS_STATUS_ERROR = 1
1453 const GUESTFS_ERROR_LEN = 256;
1455 struct guestfs_message_error {
1456 string error<GUESTFS_ERROR_LEN>; /* error message */
1459 struct guestfs_message_header {
1460 unsigned prog; /* GUESTFS_PROGRAM */
1461 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
1462 guestfs_procedure proc; /* GUESTFS_PROC_x */
1463 guestfs_message_direction direction;
1464 unsigned serial; /* message serial number */
1465 guestfs_message_status status;
1469 (* Generate the guestfs-structs.h file. *)
1470 and generate_structs_h () =
1471 generate_header CStyle LGPLv2;
1473 (* This is a public exported header file containing various
1474 * structures. The structures are carefully written to have
1475 * exactly the same in-memory format as the XDR structures that
1476 * we use on the wire to the daemon. The reason for creating
1477 * copies of these structures here is just so we don't have to
1478 * export the whole of guestfs_protocol.h (which includes much
1479 * unrelated and XDR-dependent stuff that we don't want to be
1480 * public, or required by clients).
1482 * To reiterate, we will pass these structures to and from the
1483 * client with a simple assignment or memcpy, so the format
1484 * must be identical to what rpcgen / the RFC defines.
1487 (* guestfs_int_bool structure. *)
1488 pr "struct guestfs_int_bool {\n";
1494 (* LVM public structures. *)
1498 pr "struct guestfs_lvm_%s {\n" typ;
1501 | name, `String -> pr " char *%s;\n" name
1502 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
1503 | name, `Bytes -> pr " uint64_t %s;\n" name
1504 | name, `Int -> pr " int64_t %s;\n" name
1505 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
1509 pr "struct guestfs_lvm_%s_list {\n" typ;
1510 pr " uint32_t len;\n";
1511 pr " struct guestfs_lvm_%s *val;\n" typ;
1514 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1516 (* Generate the guestfs-actions.h file. *)
1517 and generate_actions_h () =
1518 generate_header CStyle LGPLv2;
1520 fun (shortname, style, _, _, _, _, _) ->
1521 let name = "guestfs_" ^ shortname in
1522 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
1526 (* Generate the client-side dispatch stubs. *)
1527 and generate_client_actions () =
1528 generate_header CStyle LGPLv2;
1530 (* Client-side stubs for each function. *)
1532 fun (shortname, style, _, _, _, _, _) ->
1533 let name = "guestfs_" ^ shortname in
1535 (* Generate the return value struct. *)
1536 pr "struct %s_rv {\n" shortname;
1537 pr " int cb_done; /* flag to indicate callback was called */\n";
1538 pr " struct guestfs_message_header hdr;\n";
1539 pr " struct guestfs_message_error err;\n";
1540 (match fst style with
1543 failwithf "RConstString cannot be returned from a daemon function"
1545 | RBool _ | RString _ | RStringList _
1547 | RPVList _ | RVGList _ | RLVList _ ->
1548 pr " struct %s_ret ret;\n" name
1552 (* Generate the callback function. *)
1553 pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
1555 pr " struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
1557 pr " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
1558 pr " error (g, \"%s: failed to parse reply header\");\n" name;
1561 pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
1562 pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
1563 pr " error (g, \"%s: failed to parse reply error\");\n" name;
1569 (match fst style with
1572 failwithf "RConstString cannot be returned from a daemon function"
1574 | RBool _ | RString _ | RStringList _
1576 | RPVList _ | RVGList _ | RLVList _ ->
1577 pr " if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
1578 pr " error (g, \"%s: failed to parse reply\");\n" name;
1584 pr " rv->cb_done = 1;\n";
1585 pr " main_loop.main_loop_quit (g);\n";
1588 (* Generate the action stub. *)
1589 generate_prototype ~extern:false ~semicolon:false ~newline:true
1590 ~handle:"g" name style;
1593 match fst style with
1594 | RErr | RInt _ | RBool _ -> "-1"
1596 failwithf "RConstString cannot be returned from a daemon function"
1597 | RString _ | RStringList _ | RIntBool _
1598 | RPVList _ | RVGList _ | RLVList _ ->
1603 (match snd style with
1605 | _ -> pr " struct %s_args args;\n" name
1608 pr " struct %s_rv rv;\n" shortname;
1609 pr " int serial;\n";
1611 pr " if (g->state != READY) {\n";
1612 pr " error (g, \"%s called from the wrong state, %%d != READY\",\n"
1615 pr " return %s;\n" error_code;
1618 pr " memset (&rv, 0, sizeof rv);\n";
1621 (match snd style with
1623 pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
1624 (String.uppercase shortname)
1629 pr " args.%s = (char *) %s;\n" n n
1631 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
1633 pr " args.%s.%s_val = (char **) %s;\n" n n n;
1634 pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
1636 pr " args.%s = %s;\n" n n
1638 pr " args.%s = %s;\n" n n
1640 pr " serial = dispatch (g, GUESTFS_PROC_%s,\n"
1641 (String.uppercase shortname);
1642 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
1645 pr " if (serial == -1)\n";
1646 pr " return %s;\n" error_code;
1649 pr " rv.cb_done = 0;\n";
1650 pr " g->reply_cb_internal = %s_cb;\n" shortname;
1651 pr " g->reply_cb_internal_data = &rv;\n";
1652 pr " main_loop.main_loop_run (g);\n";
1653 pr " g->reply_cb_internal = NULL;\n";
1654 pr " g->reply_cb_internal_data = NULL;\n";
1655 pr " if (!rv.cb_done) {\n";
1656 pr " error (g, \"%s failed, see earlier error messages\");\n" name;
1657 pr " return %s;\n" error_code;
1661 pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
1662 (String.uppercase shortname);
1663 pr " return %s;\n" error_code;
1666 pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
1667 pr " error (g, \"%%s\", rv.err.error);\n";
1668 pr " return %s;\n" error_code;
1672 (match fst style with
1673 | RErr -> pr " return 0;\n"
1675 | RBool n -> pr " return rv.ret.%s;\n" n
1677 failwithf "RConstString cannot be returned from a daemon function"
1679 pr " return rv.ret.%s; /* caller will free */\n" n
1681 pr " /* caller will free this, but we need to add a NULL entry */\n";
1682 pr " rv.ret.%s.%s_val =" n n;
1683 pr " safe_realloc (g, rv.ret.%s.%s_val,\n" n n;
1684 pr " sizeof (char *) * (rv.ret.%s.%s_len + 1));\n"
1686 pr " rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
1687 pr " return rv.ret.%s.%s_val;\n" n n
1689 pr " /* caller with free this */\n";
1690 pr " return safe_memdup (g, &rv.ret, sizeof (rv.ret));\n"
1692 pr " /* caller will free this */\n";
1693 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1695 pr " /* caller will free this */\n";
1696 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1698 pr " /* caller will free this */\n";
1699 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1705 (* Generate daemon/actions.h. *)
1706 and generate_daemon_actions_h () =
1707 generate_header CStyle GPLv2;
1709 pr "#include \"../src/guestfs_protocol.h\"\n";
1713 fun (name, style, _, _, _, _, _) ->
1715 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
1719 (* Generate the server-side stubs. *)
1720 and generate_daemon_actions () =
1721 generate_header CStyle GPLv2;
1723 pr "#define _GNU_SOURCE // for strchrnul\n";
1725 pr "#include <stdio.h>\n";
1726 pr "#include <stdlib.h>\n";
1727 pr "#include <string.h>\n";
1728 pr "#include <inttypes.h>\n";
1729 pr "#include <ctype.h>\n";
1730 pr "#include <rpc/types.h>\n";
1731 pr "#include <rpc/xdr.h>\n";
1733 pr "#include \"daemon.h\"\n";
1734 pr "#include \"../src/guestfs_protocol.h\"\n";
1735 pr "#include \"actions.h\"\n";
1739 fun (name, style, _, _, _, _, _) ->
1740 (* Generate server-side stubs. *)
1741 pr "static void %s_stub (XDR *xdr_in)\n" name;
1744 match fst style with
1745 | RErr | RInt _ -> pr " int r;\n"; "-1"
1746 | RBool _ -> pr " int r;\n"; "-1"
1748 failwithf "RConstString cannot be returned from a daemon function"
1749 | RString _ -> pr " char *r;\n"; "NULL"
1750 | RStringList _ -> pr " char **r;\n"; "NULL"
1751 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
1752 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
1753 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
1754 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL" in
1756 (match snd style with
1759 pr " struct guestfs_%s_args args;\n" name;
1763 | OptString n -> pr " const char *%s;\n" n
1764 | StringList n -> pr " char **%s;\n" n
1765 | Bool n -> pr " int %s;\n" n
1766 | Int n -> pr " int %s;\n" n
1771 (match snd style with
1774 pr " memset (&args, 0, sizeof args);\n";
1776 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
1777 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
1782 | String n -> pr " %s = args.%s;\n" n n
1783 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
1785 pr " args.%s.%s_val = realloc (args.%s.%s_val, sizeof (char *) * (args.%s.%s_len+1));\n" n n n n n n;
1786 pr " args.%s.%s_val[args.%s.%s_len] = NULL;\n" n n n n;
1787 pr " %s = args.%s.%s_val;\n" n n n
1788 | Bool n -> pr " %s = args.%s;\n" n n
1789 | Int n -> pr " %s = args.%s;\n" n n
1794 pr " r = do_%s " name;
1795 generate_call_args style;
1798 pr " if (r == %s)\n" error_code;
1799 pr " /* do_%s has already called reply_with_error */\n" name;
1803 (match fst style with
1804 | RErr -> pr " reply (NULL, NULL);\n"
1806 pr " struct guestfs_%s_ret ret;\n" name;
1807 pr " ret.%s = r;\n" n;
1808 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1810 pr " struct guestfs_%s_ret ret;\n" name;
1811 pr " ret.%s = r;\n" n;
1812 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1814 failwithf "RConstString cannot be returned from a daemon function"
1816 pr " struct guestfs_%s_ret ret;\n" name;
1817 pr " ret.%s = r;\n" n;
1818 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1821 pr " struct guestfs_%s_ret ret;\n" name;
1822 pr " ret.%s.%s_len = count_strings (r);\n" n n;
1823 pr " ret.%s.%s_val = r;\n" n n;
1824 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1825 pr " free_strings (r);\n"
1827 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name;
1828 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
1830 pr " struct guestfs_%s_ret ret;\n" name;
1831 pr " ret.%s = *r;\n" n;
1832 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1833 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1835 pr " struct guestfs_%s_ret ret;\n" name;
1836 pr " ret.%s = *r;\n" n;
1837 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1838 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1840 pr " struct guestfs_%s_ret ret;\n" name;
1841 pr " ret.%s = *r;\n" n;
1842 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1843 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1846 (* Free the args. *)
1847 (match snd style with
1852 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
1859 (* Dispatch function. *)
1860 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
1862 pr " switch (proc_nr) {\n";
1865 fun (name, style, _, _, _, _, _) ->
1866 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
1867 pr " %s_stub (xdr_in);\n" name;
1872 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
1877 (* LVM columns and tokenization functions. *)
1878 (* XXX This generates crap code. We should rethink how we
1884 pr "static const char *lvm_%s_cols = \"%s\";\n"
1885 typ (String.concat "," (List.map fst cols));
1888 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
1890 pr " char *tok, *p, *next;\n";
1894 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
1897 pr " if (!str) {\n";
1898 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
1901 pr " if (!*str || isspace (*str)) {\n";
1902 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
1907 fun (name, coltype) ->
1908 pr " if (!tok) {\n";
1909 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
1912 pr " p = strchrnul (tok, ',');\n";
1913 pr " if (*p) next = p+1; else next = NULL;\n";
1914 pr " *p = '\\0';\n";
1917 pr " r->%s = strdup (tok);\n" name;
1918 pr " if (r->%s == NULL) {\n" name;
1919 pr " perror (\"strdup\");\n";
1923 pr " for (i = j = 0; i < 32; ++j) {\n";
1924 pr " if (tok[j] == '\\0') {\n";
1925 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
1927 pr " } else if (tok[j] != '-')\n";
1928 pr " r->%s[i++] = tok[j];\n" name;
1931 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
1932 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1936 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
1937 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1941 pr " if (tok[0] == '\\0')\n";
1942 pr " r->%s = -1;\n" name;
1943 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
1944 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1948 pr " tok = next;\n";
1951 pr " if (tok != NULL) {\n";
1952 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
1959 pr "guestfs_lvm_int_%s_list *\n" typ;
1960 pr "parse_command_line_%ss (void)\n" typ;
1962 pr " char *out, *err;\n";
1963 pr " char *p, *pend;\n";
1965 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
1966 pr " void *newp;\n";
1968 pr " ret = malloc (sizeof *ret);\n";
1969 pr " if (!ret) {\n";
1970 pr " reply_with_perror (\"malloc\");\n";
1971 pr " return NULL;\n";
1974 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
1975 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
1977 pr " r = command (&out, &err,\n";
1978 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
1979 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
1980 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
1981 pr " if (r == -1) {\n";
1982 pr " reply_with_error (\"%%s\", err);\n";
1983 pr " free (out);\n";
1984 pr " free (err);\n";
1985 pr " return NULL;\n";
1988 pr " free (err);\n";
1990 pr " /* Tokenize each line of the output. */\n";
1993 pr " while (p) {\n";
1994 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
1995 pr " if (pend) {\n";
1996 pr " *pend = '\\0';\n";
2000 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
2003 pr " if (!*p) { /* Empty line? Skip it. */\n";
2008 pr " /* Allocate some space to store this next entry. */\n";
2009 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
2010 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
2011 pr " if (newp == NULL) {\n";
2012 pr " reply_with_perror (\"realloc\");\n";
2013 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2014 pr " free (ret);\n";
2015 pr " free (out);\n";
2016 pr " return NULL;\n";
2018 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
2020 pr " /* Tokenize the next entry. */\n";
2021 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
2022 pr " if (r == -1) {\n";
2023 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
2024 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2025 pr " free (ret);\n";
2026 pr " free (out);\n";
2027 pr " return NULL;\n";
2034 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
2036 pr " free (out);\n";
2037 pr " return ret;\n";
2040 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2042 (* Generate the tests. *)
2043 and generate_tests () =
2044 generate_header CStyle GPLv2;
2051 #include <sys/types.h>
2054 #include \"guestfs.h\"
2056 static guestfs_h *g;
2057 static int suppress_error = 0;
2059 static void print_error (guestfs_h *g, void *data, const char *msg)
2061 if (!suppress_error)
2062 fprintf (stderr, \"%%s\\n\", msg);
2065 static void print_strings (char * const * const argv)
2069 for (argc = 0; argv[argc] != NULL; ++argc)
2070 printf (\"\\t%%s\\n\", argv[argc]);
2077 fun (name, _, _, _, tests, _, _) ->
2078 mapi (generate_one_test name) tests
2080 let test_names = List.concat test_names in
2081 let nr_tests = List.length test_names in
2084 int main (int argc, char *argv[])
2092 g = guestfs_create ();
2094 printf (\"guestfs_create FAILED\\n\");
2098 guestfs_set_error_handler (g, print_error, NULL);
2100 srcdir = getenv (\"srcdir\");
2101 if (!srcdir) srcdir = \".\";
2102 guestfs_set_path (g, srcdir);
2104 snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);
2105 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2110 if (lseek (fd, %d, SEEK_SET) == -1) {
2116 if (write (fd, &c, 1) == -1) {
2122 if (close (fd) == -1) {
2127 if (guestfs_add_drive (g, buf) == -1) {
2128 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2132 snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);
2133 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2138 if (lseek (fd, %d, SEEK_SET) == -1) {
2144 if (write (fd, &c, 1) == -1) {
2150 if (close (fd) == -1) {
2155 if (guestfs_add_drive (g, buf) == -1) {
2156 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2160 snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);
2161 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2166 if (lseek (fd, %d, SEEK_SET) == -1) {
2172 if (write (fd, &c, 1) == -1) {
2178 if (close (fd) == -1) {
2183 if (guestfs_add_drive (g, buf) == -1) {
2184 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2188 if (guestfs_launch (g) == -1) {
2189 printf (\"guestfs_launch FAILED\\n\");
2192 if (guestfs_wait_ready (g) == -1) {
2193 printf (\"guestfs_wait_ready FAILED\\n\");
2197 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024);
2201 pr " printf (\"%3d/%3d %s\\n\");\n" (i+1) nr_tests test_name;
2202 pr " if (%s () == -1) {\n" test_name;
2203 pr " printf (\"%s FAILED\\n\");\n" test_name;
2209 pr " guestfs_close (g);\n";
2210 pr " snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);\n";
2211 pr " unlink (buf);\n";
2212 pr " snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);\n";
2213 pr " unlink (buf);\n";
2214 pr " snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);\n";
2215 pr " unlink (buf);\n";
2218 pr " if (failed > 0) {\n";
2219 pr " printf (\"***** %%d / %d tests FAILED *****\\n\", failed);\n"
2228 and generate_one_test name i (init, test) =
2229 let test_name = sprintf "test_%s_%d" name i in
2231 pr "static int %s (void)\n" test_name;
2236 pr " /* InitNone for %s (%d) */\n" name i;
2237 List.iter (generate_test_command_call test_name)
2241 pr " /* InitEmpty for %s (%d): create ext2 on /dev/sda1 */\n" name i;
2242 List.iter (generate_test_command_call test_name)
2245 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2246 ["mkfs"; "ext2"; "/dev/sda1"];
2247 ["mount"; "/dev/sda1"; "/"]]
2249 pr " /* InitEmptyLVM for %s (%d): create ext2 on /dev/VG/LV */\n"
2251 List.iter (generate_test_command_call test_name)
2254 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2255 ["pvcreate"; "/dev/sda1"];
2256 ["vgcreate"; "VG"; "/dev/sda1"];
2257 ["lvcreate"; "LV"; "VG"; "8"];
2258 ["mkfs"; "ext2"; "/dev/VG/LV"];
2259 ["mount"; "/dev/VG/LV"; "/"]]
2262 let get_seq_last = function
2264 failwithf "%s: you cannot use [] (empty list) when expecting a command"
2267 let seq = List.rev seq in
2268 List.rev (List.tl seq), List.hd seq
2273 pr " /* TestRun for %s (%d) */\n" name i;
2274 List.iter (generate_test_command_call test_name) seq
2275 | TestOutput (seq, expected) ->
2276 pr " /* TestOutput for %s (%d) */\n" name i;
2277 let seq, last = get_seq_last seq in
2279 pr " if (strcmp (r, \"%s\") != 0) {\n" (c_quote expected);
2280 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r);\n" test_name (c_quote expected);
2284 List.iter (generate_test_command_call test_name) seq;
2285 generate_test_command_call ~test test_name last
2286 | TestOutputList (seq, expected) ->
2287 pr " /* TestOutputList for %s (%d) */\n" name i;
2288 let seq, last = get_seq_last seq in
2292 pr " if (!r[%d]) {\n" i;
2293 pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
2294 pr " print_strings (r);\n";
2297 pr " if (strcmp (r[%d], \"%s\") != 0) {\n" i (c_quote str);
2298 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r[%d]);\n" test_name (c_quote str) i;
2302 pr " if (r[%d] != NULL) {\n" (List.length expected);
2303 pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
2305 pr " print_strings (r);\n";
2309 List.iter (generate_test_command_call test_name) seq;
2310 generate_test_command_call ~test test_name last
2311 | TestOutputInt (seq, expected) ->
2312 pr " /* TestOutputInt for %s (%d) */\n" name i;
2313 let seq, last = get_seq_last seq in
2315 pr " if (r != %d) {\n" expected;
2316 pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\", r);\n"
2321 List.iter (generate_test_command_call test_name) seq;
2322 generate_test_command_call ~test test_name last
2323 | TestOutputTrue seq ->
2324 pr " /* TestOutputTrue for %s (%d) */\n" name i;
2325 let seq, last = get_seq_last seq in
2328 pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n"
2333 List.iter (generate_test_command_call test_name) seq;
2334 generate_test_command_call ~test test_name last
2335 | TestOutputFalse seq ->
2336 pr " /* TestOutputFalse for %s (%d) */\n" name i;
2337 let seq, last = get_seq_last seq in
2340 pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n"
2345 List.iter (generate_test_command_call test_name) seq;
2346 generate_test_command_call ~test test_name last
2347 | TestOutputLength (seq, expected) ->
2348 pr " /* TestOutputLength for %s (%d) */\n" name i;
2349 let seq, last = get_seq_last seq in
2352 pr " for (j = 0; j < %d; ++j)\n" expected;
2353 pr " if (r[j] == NULL) {\n";
2354 pr " fprintf (stderr, \"%s: short list returned\\n\");\n"
2356 pr " print_strings (r);\n";
2359 pr " if (r[j] != NULL) {\n";
2360 pr " fprintf (stderr, \"%s: long list returned\\n\");\n"
2362 pr " print_strings (r);\n";
2366 List.iter (generate_test_command_call test_name) seq;
2367 generate_test_command_call ~test test_name last
2368 | TestLastFail seq ->
2369 pr " /* TestLastFail for %s (%d) */\n" name i;
2370 let seq, last = get_seq_last seq in
2371 List.iter (generate_test_command_call test_name) seq;
2372 generate_test_command_call test_name ~expect_error:true last
2380 (* Generate the code to run a command, leaving the result in 'r'.
2381 * If you expect to get an error then you should set expect_error:true.
2383 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
2385 | [] -> assert false
2387 (* Look up the command to find out what args/ret it has. *)
2390 let _, style, _, _, _, _, _ =
2391 List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
2394 failwithf "%s: in test, command %s was not found" test_name name in
2396 if List.length (snd style) <> List.length args then
2397 failwithf "%s: in test, wrong number of args given to %s"
2408 | StringList n, arg ->
2409 pr " char *%s[] = {\n" n;
2410 let strs = string_split " " arg in
2412 fun str -> pr " \"%s\",\n" (c_quote str)
2416 ) (List.combine (snd style) args);
2419 match fst style with
2420 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
2421 | RConstString _ -> pr " const char *r;\n"; "NULL"
2422 | RString _ -> pr " char *r;\n"; "NULL"
2428 pr " struct guestfs_int_bool *r;\n";
2431 pr " struct guestfs_lvm_pv_list *r;\n";
2434 pr " struct guestfs_lvm_vg_list *r;\n";
2437 pr " struct guestfs_lvm_lv_list *r;\n";
2440 pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
2441 pr " r = guestfs_%s (g" name;
2443 (* Generate the parameters. *)
2446 | String _, arg -> pr ", \"%s\"" (c_quote arg)
2447 | OptString _, arg ->
2448 if arg = "NULL" then pr ", NULL" else pr ", \"%s\"" (c_quote arg)
2449 | StringList n, _ ->
2453 try int_of_string arg
2454 with Failure "int_of_string" ->
2455 failwithf "%s: expecting an int, but got '%s'" test_name arg in
2458 let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
2459 ) (List.combine (snd style) args);
2462 if not expect_error then
2463 pr " if (r == %s)\n" error_code
2465 pr " if (r != %s)\n" error_code;
2468 (* Insert the test code. *)
2474 (match fst style with
2475 | RErr | RInt _ | RBool _ | RConstString _ -> ()
2476 | RString _ -> pr " free (r);\n"
2478 pr " for (i = 0; r[i] != NULL; ++i)\n";
2479 pr " free (r[i]);\n";
2482 pr " guestfs_free_int_bool (r);\n"
2484 pr " guestfs_free_lvm_pv_list (r);\n"
2486 pr " guestfs_free_lvm_vg_list (r);\n"
2488 pr " guestfs_free_lvm_lv_list (r);\n"
2494 let str = replace_str str "\r" "\\r" in
2495 let str = replace_str str "\n" "\\n" in
2496 let str = replace_str str "\t" "\\t" in
2499 (* Generate a lot of different functions for guestfish. *)
2500 and generate_fish_cmds () =
2501 generate_header CStyle GPLv2;
2505 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
2507 let all_functions_sorted =
2509 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
2510 ) all_functions_sorted in
2512 pr "#include <stdio.h>\n";
2513 pr "#include <stdlib.h>\n";
2514 pr "#include <string.h>\n";
2515 pr "#include <inttypes.h>\n";
2517 pr "#include <guestfs.h>\n";
2518 pr "#include \"fish.h\"\n";
2521 (* list_commands function, which implements guestfish -h *)
2522 pr "void list_commands (void)\n";
2524 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
2525 pr " list_builtin_commands ();\n";
2527 fun (name, _, _, flags, _, shortdesc, _) ->
2528 let name = replace_char name '_' '-' in
2529 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
2531 ) all_functions_sorted;
2532 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
2536 (* display_command function, which implements guestfish -h cmd *)
2537 pr "void display_command (const char *cmd)\n";
2540 fun (name, style, _, flags, _, shortdesc, longdesc) ->
2541 let name2 = replace_char name '_' '-' in
2543 try find_map (function FishAlias n -> Some n | _ -> None) flags
2544 with Not_found -> name in
2545 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
2547 match snd style with
2551 name2 (String.concat "> <" (List.map name_of_argt args)) in
2554 if List.mem ProtocolLimitWarning flags then
2555 ("\n\n" ^ protocol_limit_warning)
2558 (* For DangerWillRobinson commands, we should probably have
2559 * guestfish prompt before allowing you to use them (especially
2560 * in interactive mode). XXX
2564 if List.mem DangerWillRobinson flags then
2565 ("\n\n" ^ danger_will_robinson)
2568 let describe_alias =
2569 if name <> alias then
2570 sprintf "\n\nYou can use '%s' as an alias for this command." alias
2574 pr "strcasecmp (cmd, \"%s\") == 0" name;
2575 if name <> name2 then
2576 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
2577 if name <> alias then
2578 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
2580 pr " pod2text (\"%s - %s\", %S);\n"
2582 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
2585 pr " display_builtin_command (cmd);\n";
2589 (* print_{pv,vg,lv}_list functions *)
2593 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
2600 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
2602 pr " printf (\"%s: \");\n" name;
2603 pr " for (i = 0; i < 32; ++i)\n";
2604 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
2605 pr " printf (\"\\n\");\n"
2607 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
2609 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
2610 | name, `OptPercent ->
2611 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
2612 typ name name typ name;
2613 pr " else printf (\"%s: \\n\");\n" name
2617 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
2622 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
2623 pr " print_%s (&%ss->val[i]);\n" typ typ;
2626 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2628 (* run_<action> actions *)
2630 fun (name, style, _, flags, _, _, _) ->
2631 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
2633 (match fst style with
2636 | RBool _ -> pr " int r;\n"
2637 | RConstString _ -> pr " const char *r;\n"
2638 | RString _ -> pr " char *r;\n"
2639 | RStringList _ -> pr " char **r;\n"
2640 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
2641 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
2642 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
2643 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
2648 | OptString n -> pr " const char *%s;\n" n
2649 | StringList n -> pr " char **%s;\n" n
2650 | Bool n -> pr " int %s;\n" n
2651 | Int n -> pr " int %s;\n" n
2654 (* Check and convert parameters. *)
2655 let argc_expected = List.length (snd style) in
2656 pr " if (argc != %d) {\n" argc_expected;
2657 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
2659 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
2665 | String name -> pr " %s = argv[%d];\n" name i
2667 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
2669 | StringList name ->
2670 pr " %s = parse_string_list (argv[%d]);\n" name i
2672 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
2674 pr " %s = atoi (argv[%d]);\n" name i
2677 (* Call C API function. *)
2679 try find_map (function FishAction n -> Some n | _ -> None) flags
2680 with Not_found -> sprintf "guestfs_%s" name in
2682 generate_call_args ~handle:"g" style;
2685 (* Check return value for errors and display command results. *)
2686 (match fst style with
2687 | RErr -> pr " return r;\n"
2689 pr " if (r == -1) return -1;\n";
2690 pr " if (r) printf (\"%%d\\n\", r);\n";
2693 pr " if (r == -1) return -1;\n";
2694 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
2697 pr " if (r == NULL) return -1;\n";
2698 pr " printf (\"%%s\\n\", r);\n";
2701 pr " if (r == NULL) return -1;\n";
2702 pr " printf (\"%%s\\n\", r);\n";
2706 pr " if (r == NULL) return -1;\n";
2707 pr " print_strings (r);\n";
2708 pr " free_strings (r);\n";
2711 pr " if (r == NULL) return -1;\n";
2712 pr " printf (\"%%d, %%s\\n\", r->i,\n";
2713 pr " r->b ? \"true\" : \"false\");\n";
2714 pr " guestfs_free_int_bool (r);\n";
2717 pr " if (r == NULL) return -1;\n";
2718 pr " print_pv_list (r);\n";
2719 pr " guestfs_free_lvm_pv_list (r);\n";
2722 pr " if (r == NULL) return -1;\n";
2723 pr " print_vg_list (r);\n";
2724 pr " guestfs_free_lvm_vg_list (r);\n";
2727 pr " if (r == NULL) return -1;\n";
2728 pr " print_lv_list (r);\n";
2729 pr " guestfs_free_lvm_lv_list (r);\n";
2736 (* run_action function *)
2737 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
2740 fun (name, _, _, flags, _, _, _) ->
2741 let name2 = replace_char name '_' '-' in
2743 try find_map (function FishAlias n -> Some n | _ -> None) flags
2744 with Not_found -> name in
2746 pr "strcasecmp (cmd, \"%s\") == 0" name;
2747 if name <> name2 then
2748 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
2749 if name <> alias then
2750 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
2752 pr " return run_%s (cmd, argc, argv);\n" name;
2756 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
2763 (* Generate the POD documentation for guestfish. *)
2764 and generate_fish_actions_pod () =
2765 let all_functions_sorted =
2767 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
2768 ) all_functions_sorted in
2771 fun (name, style, _, flags, _, _, longdesc) ->
2772 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
2773 let name = replace_char name '_' '-' in
2775 try find_map (function FishAlias n -> Some n | _ -> None) flags
2776 with Not_found -> name in
2778 pr "=head2 %s" name;
2779 if name <> alias then
2786 | String n -> pr " %s" n
2787 | OptString n -> pr " %s" n
2788 | StringList n -> pr " %s,..." n
2789 | Bool _ -> pr " true|false"
2790 | Int n -> pr " %s" n
2794 pr "%s\n\n" longdesc;
2796 if List.mem ProtocolLimitWarning flags then
2797 pr "%s\n\n" protocol_limit_warning;
2799 if List.mem DangerWillRobinson flags then
2800 pr "%s\n\n" danger_will_robinson
2801 ) all_functions_sorted
2803 (* Generate a C function prototype. *)
2804 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
2805 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
2807 ?handle name style =
2808 if extern then pr "extern ";
2809 if static then pr "static ";
2810 (match fst style with
2812 | RInt _ -> pr "int "
2813 | RBool _ -> pr "int "
2814 | RConstString _ -> pr "const char *"
2815 | RString _ -> pr "char *"
2816 | RStringList _ -> pr "char **"
2818 if not in_daemon then pr "struct guestfs_int_bool *"
2819 else pr "guestfs_%s_ret *" name
2821 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
2822 else pr "guestfs_lvm_int_pv_list *"
2824 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
2825 else pr "guestfs_lvm_int_vg_list *"
2827 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
2828 else pr "guestfs_lvm_int_lv_list *"
2830 pr "%s%s (" prefix name;
2831 if handle = None && List.length (snd style) = 0 then
2834 let comma = ref false in
2837 | Some handle -> pr "guestfs_h *%s" handle; comma := true
2841 if single_line then pr ", " else pr ",\n\t\t"
2847 | String n -> next (); pr "const char *%s" n
2848 | OptString n -> next (); pr "const char *%s" n
2849 | StringList n -> next (); pr "char * const* const %s" n
2850 | Bool n -> next (); pr "int %s" n
2851 | Int n -> next (); pr "int %s" n
2855 if semicolon then pr ";";
2856 if newline then pr "\n"
2858 (* Generate C call arguments, eg "(handle, foo, bar)" *)
2859 and generate_call_args ?handle style =
2861 let comma = ref false in
2864 | Some handle -> pr "%s" handle; comma := true
2868 if !comma then pr ", ";
2875 | Int n -> pr "%s" n
2879 (* Generate the OCaml bindings interface. *)
2880 and generate_ocaml_mli () =
2881 generate_header OCamlStyle LGPLv2;
2884 (** For API documentation you should refer to the C API
2885 in the guestfs(3) manual page. The OCaml API uses almost
2886 exactly the same calls. *)
2889 (** A [guestfs_h] handle. *)
2891 exception Error of string
2892 (** This exception is raised when there is an error. *)
2894 val create : unit -> t
2896 val close : t -> unit
2897 (** Handles are closed by the garbage collector when they become
2898 unreferenced, but callers can also call this in order to
2899 provide predictable cleanup. *)
2902 generate_ocaml_lvm_structure_decls ();
2906 fun (name, style, _, _, _, shortdesc, _) ->
2907 generate_ocaml_prototype name style;
2908 pr "(** %s *)\n" shortdesc;
2912 (* Generate the OCaml bindings implementation. *)
2913 and generate_ocaml_ml () =
2914 generate_header OCamlStyle LGPLv2;
2918 exception Error of string
2919 external create : unit -> t = \"ocaml_guestfs_create\"
2920 external close : t -> unit = \"ocaml_guestfs_close\"
2923 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
2927 generate_ocaml_lvm_structure_decls ();
2931 fun (name, style, _, _, _, shortdesc, _) ->
2932 generate_ocaml_prototype ~is_external:true name style;
2935 (* Generate the OCaml bindings C implementation. *)
2936 and generate_ocaml_c () =
2937 generate_header CStyle LGPLv2;
2939 pr "#include <stdio.h>\n";
2940 pr "#include <stdlib.h>\n";
2941 pr "#include <string.h>\n";
2943 pr "#include <caml/config.h>\n";
2944 pr "#include <caml/alloc.h>\n";
2945 pr "#include <caml/callback.h>\n";
2946 pr "#include <caml/fail.h>\n";
2947 pr "#include <caml/memory.h>\n";
2948 pr "#include <caml/mlvalues.h>\n";
2949 pr "#include <caml/signals.h>\n";
2951 pr "#include <guestfs.h>\n";
2953 pr "#include \"guestfs_c.h\"\n";
2956 (* LVM struct copy functions. *)
2959 let has_optpercent_col =
2960 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
2962 pr "static CAMLprim value\n";
2963 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
2965 pr " CAMLparam0 ();\n";
2966 if has_optpercent_col then
2967 pr " CAMLlocal3 (rv, v, v2);\n"
2969 pr " CAMLlocal2 (rv, v);\n";
2971 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
2976 pr " v = caml_copy_string (%s->%s);\n" typ name
2978 pr " v = caml_alloc_string (32);\n";
2979 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
2982 pr " v = caml_copy_int64 (%s->%s);\n" typ name
2983 | name, `OptPercent ->
2984 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
2985 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
2986 pr " v = caml_alloc (1, 0);\n";
2987 pr " Store_field (v, 0, v2);\n";
2988 pr " } else /* None */\n";
2989 pr " v = Val_int (0);\n";
2991 pr " Store_field (rv, %d, v);\n" i
2993 pr " CAMLreturn (rv);\n";
2997 pr "static CAMLprim value\n";
2998 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
3001 pr " CAMLparam0 ();\n";
3002 pr " CAMLlocal2 (rv, v);\n";
3005 pr " if (%ss->len == 0)\n" typ;
3006 pr " CAMLreturn (Atom (0));\n";
3008 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
3009 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
3010 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
3011 pr " caml_modify (&Field (rv, i), v);\n";
3013 pr " CAMLreturn (rv);\n";
3017 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3020 fun (name, style, _, _, _, _, _) ->
3022 "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
3024 pr "CAMLprim value\n";
3025 pr "ocaml_guestfs_%s (value %s" name (List.hd params);
3026 List.iter (pr ", value %s") (List.tl params);
3031 | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
3032 pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
3033 pr " CAMLxparam%d (%s);\n"
3034 (List.length rest) (String.concat ", " rest)
3036 pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
3038 pr " CAMLlocal1 (rv);\n";
3041 pr " guestfs_h *g = Guestfs_val (gv);\n";
3042 pr " if (g == NULL)\n";
3043 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
3049 pr " const char *%s = String_val (%sv);\n" n n
3051 pr " const char *%s =\n" n;
3052 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
3055 pr " char **%s = ocaml_guestfs_strings_val (%sv);\n" n n
3057 pr " int %s = Bool_val (%sv);\n" n n
3059 pr " int %s = Int_val (%sv);\n" n n
3062 match fst style with
3063 | RErr -> pr " int r;\n"; "-1"
3064 | RInt _ -> pr " int r;\n"; "-1"
3065 | RBool _ -> pr " int r;\n"; "-1"
3066 | RConstString _ -> pr " const char *r;\n"; "NULL"
3067 | RString _ -> pr " char *r;\n"; "NULL"
3073 pr " struct guestfs_int_bool *r;\n";
3076 pr " struct guestfs_lvm_pv_list *r;\n";
3079 pr " struct guestfs_lvm_vg_list *r;\n";
3082 pr " struct guestfs_lvm_lv_list *r;\n";
3086 pr " caml_enter_blocking_section ();\n";
3087 pr " r = guestfs_%s " name;
3088 generate_call_args ~handle:"g" style;
3090 pr " caml_leave_blocking_section ();\n";
3095 pr " ocaml_guestfs_free_strings (%s);\n" n;
3096 | String _ | OptString _ | Bool _ | Int _ -> ()
3099 pr " if (r == %s)\n" error_code;
3100 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
3103 (match fst style with
3104 | RErr -> pr " rv = Val_unit;\n"
3105 | RInt _ -> pr " rv = Val_int (r);\n"
3106 | RBool _ -> pr " rv = Val_bool (r);\n"
3107 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
3109 pr " rv = caml_copy_string (r);\n";
3112 pr " rv = caml_copy_string_array ((const char **) r);\n";
3113 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
3116 pr " rv = caml_alloc (2, 0);\n";
3117 pr " Store_field (rv, 0, Val_int (r->i));\n";
3118 pr " Store_field (rv, 1, Val_bool (r->b));\n";
3119 pr " guestfs_free_int_bool (r);\n";
3121 pr " rv = copy_lvm_pv_list (r);\n";
3122 pr " guestfs_free_lvm_pv_list (r);\n";
3124 pr " rv = copy_lvm_vg_list (r);\n";
3125 pr " guestfs_free_lvm_vg_list (r);\n";
3127 pr " rv = copy_lvm_lv_list (r);\n";
3128 pr " guestfs_free_lvm_lv_list (r);\n";
3131 pr " CAMLreturn (rv);\n";
3135 if List.length params > 5 then (
3136 pr "CAMLprim value\n";
3137 pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
3139 pr " return ocaml_guestfs_%s (argv[0]" name;
3140 iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
3147 and generate_ocaml_lvm_structure_decls () =
3150 pr "type lvm_%s = {\n" typ;
3153 | name, `String -> pr " %s : string;\n" name
3154 | name, `UUID -> pr " %s : string;\n" name
3155 | name, `Bytes -> pr " %s : int64;\n" name
3156 | name, `Int -> pr " %s : int64;\n" name
3157 | name, `OptPercent -> pr " %s : float option;\n" name
3161 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
3163 and generate_ocaml_prototype ?(is_external = false) name style =
3164 if is_external then pr "external " else pr "val ";
3165 pr "%s : t -> " name;
3168 | String _ -> pr "string -> "
3169 | OptString _ -> pr "string option -> "
3170 | StringList _ -> pr "string array -> "
3171 | Bool _ -> pr "bool -> "
3172 | Int _ -> pr "int -> "
3174 (match fst style with
3175 | RErr -> pr "unit" (* all errors are turned into exceptions *)
3176 | RInt _ -> pr "int"
3177 | RBool _ -> pr "bool"
3178 | RConstString _ -> pr "string"
3179 | RString _ -> pr "string"
3180 | RStringList _ -> pr "string array"
3181 | RIntBool _ -> pr "int * bool"
3182 | RPVList _ -> pr "lvm_pv array"
3183 | RVGList _ -> pr "lvm_vg array"
3184 | RLVList _ -> pr "lvm_lv array"
3186 if is_external then (
3188 if List.length (snd style) + 1 > 5 then
3189 pr "\"ocaml_guestfs_%s_byte\" " name;
3190 pr "\"ocaml_guestfs_%s\"" name
3194 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
3195 and generate_perl_xs () =
3196 generate_header CStyle LGPLv2;
3199 #include \"EXTERN.h\"
3203 #include <guestfs.h>
3206 #define PRId64 \"lld\"
3210 my_newSVll(long long val) {
3211 #ifdef USE_64_BIT_ALL
3212 return newSViv(val);
3216 len = snprintf(buf, 100, \"%%\" PRId64, val);
3217 return newSVpv(buf, len);
3222 #define PRIu64 \"llu\"
3226 my_newSVull(unsigned long long val) {
3227 #ifdef USE_64_BIT_ALL
3228 return newSVuv(val);
3232 len = snprintf(buf, 100, \"%%\" PRIu64, val);
3233 return newSVpv(buf, len);
3237 /* XXX Not thread-safe, and in general not safe if the caller is
3238 * issuing multiple requests in parallel (on different guestfs
3239 * handles). We should use the guestfs_h handle passed to the
3240 * error handle to distinguish these cases.
3242 static char *last_error = NULL;
3245 error_handler (guestfs_h *g,
3249 if (last_error != NULL) free (last_error);
3250 last_error = strdup (msg);
3253 /* http://www.perlmonks.org/?node_id=680842 */
3255 XS_unpack_charPtrPtr (SV *arg) {
3260 if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV) {
3261 croak (\"array reference expected\");
3264 av = (AV *)SvRV (arg);
3265 ret = (char **)malloc (av_len (av) + 1 + 1);
3267 for (i = 0; i <= av_len (av); i++) {
3268 SV **elem = av_fetch (av, i, 0);
3270 if (!elem || !*elem) {
3271 croak (\"missing element in list\");
3274 ret[i] = SvPV_nolen (*elem);
3282 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
3287 RETVAL = guestfs_create ();
3289 croak (\"could not create guestfs handle\");
3290 guestfs_set_error_handler (RETVAL, error_handler, NULL);
3303 fun (name, style, _, _, _, _, _) ->
3304 (match fst style with
3305 | RErr -> pr "void\n"
3306 | RInt _ -> pr "SV *\n"
3307 | RBool _ -> pr "SV *\n"
3308 | RConstString _ -> pr "SV *\n"
3309 | RString _ -> pr "SV *\n"
3312 | RPVList _ | RVGList _ | RLVList _ ->
3313 pr "void\n" (* all lists returned implictly on the stack *)
3315 (* Call and arguments. *)
3317 generate_call_args ~handle:"g" style;
3319 pr " guestfs_h *g;\n";
3322 | String n -> pr " char *%s;\n" n
3323 | OptString n -> pr " char *%s;\n" n
3324 | StringList n -> pr " char **%s;\n" n
3325 | Bool n -> pr " int %s;\n" n
3326 | Int n -> pr " int %s;\n" n
3329 let do_cleanups () =
3336 | StringList n -> pr " free (%s);\n" n
3341 (match fst style with
3344 pr " if (guestfs_%s " name;
3345 generate_call_args ~handle:"g" style;
3348 pr " croak (\"%s: %%s\", last_error);\n" name;
3355 pr " %s = guestfs_%s " n name;
3356 generate_call_args ~handle:"g" style;
3358 pr " if (%s == -1) {\n" n;
3360 pr " croak (\"%s: %%s\", last_error);\n" name;
3362 pr " RETVAL = newSViv (%s);\n" n;
3367 pr " const char *%s;\n" n;
3369 pr " %s = guestfs_%s " n name;
3370 generate_call_args ~handle:"g" style;
3372 pr " if (%s == NULL) {\n" n;
3374 pr " croak (\"%s: %%s\", last_error);\n" name;
3376 pr " RETVAL = newSVpv (%s, 0);\n" n;
3381 pr " char *%s;\n" n;
3383 pr " %s = guestfs_%s " n name;
3384 generate_call_args ~handle:"g" style;
3386 pr " if (%s == NULL) {\n" n;
3388 pr " croak (\"%s: %%s\", last_error);\n" name;
3390 pr " RETVAL = newSVpv (%s, 0);\n" n;
3391 pr " free (%s);\n" n;
3396 pr " char **%s;\n" n;
3399 pr " %s = guestfs_%s " n name;
3400 generate_call_args ~handle:"g" style;
3402 pr " if (%s == NULL) {\n" n;
3404 pr " croak (\"%s: %%s\", last_error);\n" name;
3406 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
3407 pr " EXTEND (SP, n);\n";
3408 pr " for (i = 0; i < n; ++i) {\n";
3409 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
3410 pr " free (%s[i]);\n" n;
3412 pr " free (%s);\n" n;
3415 pr " struct guestfs_int_bool *r;\n";
3417 pr " r = guestfs_%s " name;
3418 generate_call_args ~handle:"g" style;
3420 pr " if (r == NULL) {\n";
3422 pr " croak (\"%s: %%s\", last_error);\n" name;
3424 pr " EXTEND (SP, 2);\n";
3425 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
3426 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
3427 pr " guestfs_free_int_bool (r);\n";
3429 generate_perl_lvm_code "pv" pv_cols name style n;
3431 generate_perl_lvm_code "vg" vg_cols name style n;
3433 generate_perl_lvm_code "lv" lv_cols name style n;
3441 and generate_perl_lvm_code typ cols name style n =
3443 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
3447 pr " %s = guestfs_%s " n name;
3448 generate_call_args ~handle:"g" style;
3450 pr " if (%s == NULL)\n" n;
3451 pr " croak (\"%s: %%s\", last_error);\n" name;
3452 pr " EXTEND (SP, %s->len);\n" n;
3453 pr " for (i = 0; i < %s->len; ++i) {\n" n;
3454 pr " hv = newHV ();\n";
3458 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
3459 name (String.length name) n name
3461 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
3462 name (String.length name) n name
3464 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
3465 name (String.length name) n name
3467 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
3468 name (String.length name) n name
3469 | name, `OptPercent ->
3470 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
3471 name (String.length name) n name
3473 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
3475 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
3477 (* Generate Sys/Guestfs.pm. *)
3478 and generate_perl_pm () =
3479 generate_header HashStyle LGPLv2;
3486 Sys::Guestfs - Perl bindings for libguestfs
3492 my $h = Sys::Guestfs->new ();
3493 $h->add_drive ('guest.img');
3496 $h->mount ('/dev/sda1', '/');
3497 $h->touch ('/hello');
3502 The C<Sys::Guestfs> module provides a Perl XS binding to the
3503 libguestfs API for examining and modifying virtual machine
3506 Amongst the things this is good for: making batch configuration
3507 changes to guests, getting disk used/free statistics (see also:
3508 virt-df), migrating between virtualization systems (see also:
3509 virt-p2v), performing partial backups, performing partial guest
3510 clones, cloning guests and changing registry/UUID/hostname info, and
3513 Libguestfs uses Linux kernel and qemu code, and can access any type of
3514 guest filesystem that Linux and qemu can, including but not limited
3515 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
3516 schemes, qcow, qcow2, vmdk.
3518 Libguestfs provides ways to enumerate guest storage (eg. partitions,
3519 LVs, what filesystem is in each LV, etc.). It can also run commands
3520 in the context of the guest. Also you can access filesystems over FTP.
3524 All errors turn into calls to C<croak> (see L<Carp(3)>).
3532 package Sys::Guestfs;
3538 XSLoader::load ('Sys::Guestfs');
3540 =item $h = Sys::Guestfs->new ();
3542 Create a new guestfs handle.
3548 my $class = ref ($proto) || $proto;
3550 my $self = Sys::Guestfs::_create ();
3551 bless $self, $class;
3557 (* Actions. We only need to print documentation for these as
3558 * they are pulled in from the XS code automatically.
3561 fun (name, style, _, flags, _, _, longdesc) ->
3562 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
3564 generate_perl_prototype name style;
3566 pr "%s\n\n" longdesc;
3567 if List.mem ProtocolLimitWarning flags then
3568 pr "%s\n\n" protocol_limit_warning;
3569 if List.mem DangerWillRobinson flags then
3570 pr "%s\n\n" danger_will_robinson
3571 ) all_functions_sorted;
3583 Copyright (C) 2009 Red Hat Inc.
3587 Please see the file COPYING.LIB for the full license.
3591 L<guestfs(3)>, L<guestfish(1)>.
3596 and generate_perl_prototype name style =
3597 (match fst style with
3602 | RString n -> pr "$%s = " n
3603 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
3607 | RLVList n -> pr "@%s = " n
3610 let comma = ref false in
3613 if !comma then pr ", ";
3616 | String n | OptString n | Bool n | Int n ->
3623 let output_to filename =
3624 let filename_new = filename ^ ".new" in
3625 chan := open_out filename_new;
3629 Unix.rename filename_new filename;
3630 printf "written %s\n%!" filename;
3638 if not (Sys.file_exists "configure.ac") then (
3640 You are probably running this from the wrong directory.
3641 Run it from the top source directory using the command
3647 let close = output_to "src/guestfs_protocol.x" in
3651 let close = output_to "src/guestfs-structs.h" in
3652 generate_structs_h ();
3655 let close = output_to "src/guestfs-actions.h" in
3656 generate_actions_h ();
3659 let close = output_to "src/guestfs-actions.c" in
3660 generate_client_actions ();
3663 let close = output_to "daemon/actions.h" in
3664 generate_daemon_actions_h ();
3667 let close = output_to "daemon/stubs.c" in
3668 generate_daemon_actions ();
3671 let close = output_to "tests.c" in
3675 let close = output_to "fish/cmds.c" in
3676 generate_fish_cmds ();
3679 let close = output_to "guestfs-structs.pod" in
3680 generate_structs_pod ();
3683 let close = output_to "guestfs-actions.pod" in
3684 generate_actions_pod ();
3687 let close = output_to "guestfish-actions.pod" in
3688 generate_fish_actions_pod ();
3691 let close = output_to "ocaml/guestfs.mli" in
3692 generate_ocaml_mli ();
3695 let close = output_to "ocaml/guestfs.ml" in
3696 generate_ocaml_ml ();
3699 let close = output_to "ocaml/guestfs_c_actions.c" in
3700 generate_ocaml_c ();
3703 let close = output_to "perl/Guestfs.xs" in
3704 generate_perl_xs ();
3707 let close = output_to "perl/lib/Sys/Guestfs.pm" in
3708 generate_perl_pm ();