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. Only use this for smallish
47 * positive ints (0 <= i < 2^30).
50 (* "RInt64" is the same as RInt, but is guaranteed to be able
51 * to return a full 64 bit value, _except_ that -1 means error
52 * (so -1 cannot be a valid, non-error return value).
55 (* "RBool" is a bool return value which can be true/false or
59 (* "RConstString" is a string that refers to a constant value.
60 * Try to avoid using this. In particular you cannot use this
61 * for values returned from the daemon, because there is no
62 * thread-safe way to return them in the C API.
64 | RConstString of string
65 (* "RString" and "RStringList" are caller-frees. *)
67 | RStringList of string
68 (* Some limited tuples are possible: *)
69 | RIntBool of string * string
70 (* LVM PVs, VGs and LVs. *)
77 (* Key-value pairs of untyped strings. Turns into a hashtable or
78 * dictionary in languages which support it. DON'T use this as a
79 * general "bucket" for results. Prefer a stronger typed return
80 * value if one is available, or write a custom struct. Don't use
81 * this if the list could potentially be very long, since it is
82 * inefficient. Keys should be unique. NULLs are not permitted.
84 | RHashtable of string
86 and args = argt list (* Function parameters, guestfs handle is implicit. *)
88 (* Note in future we should allow a "variable args" parameter as
89 * the final parameter, to allow commands like
90 * chmod mode file [file(s)...]
91 * This is not implemented yet, but many commands (such as chmod)
92 * are currently defined with the argument order keeping this future
93 * possibility in mind.
96 | String of string (* const char *name, cannot be NULL *)
97 | OptString of string (* const char *name, may be NULL *)
98 | StringList of string(* list of strings (each string cannot be NULL) *)
99 | Bool of string (* boolean *)
100 | Int of string (* int (smallish ints, signed, <= 31 bits) *)
103 | ProtocolLimitWarning (* display warning about protocol size limits *)
104 | DangerWillRobinson (* flags particularly dangerous commands *)
105 | FishAlias of string (* provide an alias for this cmd in guestfish *)
106 | FishAction of string (* call this function in guestfish *)
107 | NotInFish (* do not export via guestfish *)
109 let protocol_limit_warning =
110 "Because of the message protocol, there is a transfer limit
111 of somewhere between 2MB and 4MB. To transfer large files you should use
114 let danger_will_robinson =
115 "B<This command is dangerous. Without careful use you
116 can easily destroy all your data>."
118 (* You can supply zero or as many tests as you want per API call.
120 * Note that the test environment has 3 block devices, of size 500MB,
121 * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc).
122 * Note for partitioning purposes, the 500MB device has 63 cylinders.
124 * To be able to run the tests in a reasonable amount of time,
125 * the virtual machine and block devices are reused between tests.
126 * So don't try testing kill_subprocess :-x
128 * Between each test we umount-all and lvm-remove-all (except InitNone).
130 * Don't assume anything about the previous contents of the block
131 * devices. Use 'Init*' to create some initial scenarios.
133 type tests = (test_init * test) list
135 (* Run the command sequence and just expect nothing to fail. *)
137 (* Run the command sequence and expect the output of the final
138 * command to be the string.
140 | TestOutput of seq * string
141 (* Run the command sequence and expect the output of the final
142 * command to be the list of strings.
144 | TestOutputList of seq * string list
145 (* Run the command sequence and expect the output of the final
146 * command to be the integer.
148 | TestOutputInt of seq * int
149 (* Run the command sequence and expect the output of the final
150 * command to be a true value (!= 0 or != NULL).
152 | TestOutputTrue of seq
153 (* Run the command sequence and expect the output of the final
154 * command to be a false value (== 0 or == NULL, but not an error).
156 | TestOutputFalse of seq
157 (* Run the command sequence and expect the output of the final
158 * command to be a list of the given length (but don't care about
161 | TestOutputLength of seq * int
162 (* Run the command sequence and expect the output of the final
163 * command to be a structure.
165 | TestOutputStruct of seq * test_field_compare list
166 (* Run the command sequence and expect the final command (only)
169 | TestLastFail of seq
171 and test_field_compare =
172 | CompareWithInt of string * int
173 | CompareWithString of string * string
174 | CompareFieldsIntEq of string * string
175 | CompareFieldsStrEq of string * string
177 (* Some initial scenarios for testing. *)
179 (* Do nothing, block devices could contain random stuff including
180 * LVM PVs, and some filesystems might be mounted. This is usually
184 (* Block devices are empty and no filesystems are mounted. *)
186 (* /dev/sda contains a single partition /dev/sda1, which is formatted
187 * as ext2, empty [except for lost+found] and mounted on /.
188 * /dev/sdb and /dev/sdc may have random content.
193 * /dev/sda1 (is a PV):
194 * /dev/VG/LV (size 8MB):
195 * formatted as ext2, empty [except for lost+found], mounted on /
196 * /dev/sdb and /dev/sdc may have random content.
200 (* Sequence of commands for testing. *)
202 and cmd = string list
204 (* Note about long descriptions: When referring to another
205 * action, use the format C<guestfs_other> (ie. the full name of
206 * the C function). This will be replaced as appropriate in other
209 * Apart from that, long descriptions are just perldoc paragraphs.
212 let non_daemon_functions = [
213 ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
215 "launch the qemu subprocess",
217 Internally libguestfs is implemented by running a virtual machine
220 You should call this after configuring the handle
221 (eg. adding drives) but before performing any actions.");
223 ("wait_ready", (RErr, []), -1, [NotInFish],
225 "wait until the qemu subprocess launches",
227 Internally libguestfs is implemented by running a virtual machine
230 You should call this after C<guestfs_launch> to wait for the launch
233 ("kill_subprocess", (RErr, []), -1, [],
235 "kill the qemu subprocess",
237 This kills the qemu subprocess. You should never need to call this.");
239 ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
241 "add an image to examine or modify",
243 This function adds a virtual machine disk image C<filename> to the
244 guest. The first time you call this function, the disk appears as IDE
245 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
248 You don't necessarily need to be root when using libguestfs. However
249 you obviously do need sufficient permissions to access the filename
250 for whatever operations you want to perform (ie. read access if you
251 just want to read the image or write access if you want to modify the
254 This is equivalent to the qemu parameter C<-drive file=filename>.");
256 ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
258 "add a CD-ROM disk image to examine",
260 This function adds a virtual CD-ROM disk image to the guest.
262 This is equivalent to the qemu parameter C<-cdrom filename>.");
264 ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
266 "add qemu parameters",
268 This can be used to add arbitrary qemu command line parameters
269 of the form C<-param value>. Actually it's not quite arbitrary - we
270 prevent you from setting some parameters which would interfere with
271 parameters that we use.
273 The first character of C<param> string must be a C<-> (dash).
275 C<value> can be NULL.");
277 ("set_path", (RErr, [String "path"]), -1, [FishAlias "path"],
279 "set the search path",
281 Set the path that libguestfs searches for kernel and initrd.img.
283 The default is C<$libdir/guestfs> unless overridden by setting
284 C<LIBGUESTFS_PATH> environment variable.
286 The string C<path> is stashed in the libguestfs handle, so the caller
287 must make sure it remains valid for the lifetime of the handle.
289 Setting C<path> to C<NULL> restores the default path.");
291 ("get_path", (RConstString "path", []), -1, [],
293 "get the search path",
295 Return the current search path.
297 This is always non-NULL. If it wasn't set already, then this will
298 return the default path.");
300 ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
304 If C<autosync> is true, this enables autosync. Libguestfs will make a
305 best effort attempt to run C<guestfs_sync> when the handle is closed
306 (also if the program exits without closing handles).");
308 ("get_autosync", (RBool "autosync", []), -1, [],
312 Get the autosync flag.");
314 ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
318 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
320 Verbose messages are disabled unless the environment variable
321 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
323 ("get_verbose", (RBool "verbose", []), -1, [],
327 This returns the verbose messages flag.")
330 let daemon_functions = [
331 ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
332 [InitEmpty, TestOutput (
333 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
334 ["mkfs"; "ext2"; "/dev/sda1"];
335 ["mount"; "/dev/sda1"; "/"];
336 ["write_file"; "/new"; "new file contents"; "0"];
337 ["cat"; "/new"]], "new file contents")],
338 "mount a guest disk at a position in the filesystem",
340 Mount a guest disk at a position in the filesystem. Block devices
341 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
342 the guest. If those block devices contain partitions, they will have
343 the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
346 The rules are the same as for L<mount(2)>: A filesystem must
347 first be mounted on C</> before others can be mounted. Other
348 filesystems can only be mounted on directories which already
351 The mounted filesystem is writable, if we have sufficient permissions
352 on the underlying device.
354 The filesystem options C<sync> and C<noatime> are set with this
355 call, in order to improve reliability.");
357 ("sync", (RErr, []), 2, [],
358 [ InitEmpty, TestRun [["sync"]]],
359 "sync disks, writes are flushed through to the disk image",
361 This syncs the disk, so that any writes are flushed through to the
362 underlying disk image.
364 You should always call this if you have modified a disk image, before
365 closing the handle.");
367 ("touch", (RErr, [String "path"]), 3, [],
368 [InitBasicFS, TestOutputTrue (
370 ["exists"; "/new"]])],
371 "update file timestamps or create a new file",
373 Touch acts like the L<touch(1)> command. It can be used to
374 update the timestamps on a file, or, if the file does not exist,
375 to create a new zero-length file.");
377 ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
378 [InitBasicFS, TestOutput (
379 [["write_file"; "/new"; "new file contents"; "0"];
380 ["cat"; "/new"]], "new file contents")],
381 "list the contents of a file",
383 Return the contents of the file named C<path>.
385 Note that this function cannot correctly handle binary files
386 (specifically, files containing C<\\0> character which is treated
387 as end of string). For those you need to use the C<guestfs_read_file>
388 function which has a more complex interface.");
390 ("ll", (RString "listing", [String "directory"]), 5, [],
391 [], (* XXX Tricky to test because it depends on the exact format
392 * of the 'ls -l' command, which changes between F10 and F11.
394 "list the files in a directory (long format)",
396 List the files in C<directory> (relative to the root directory,
397 there is no cwd) in the format of 'ls -la'.
399 This command is mostly useful for interactive sessions. It
400 is I<not> intended that you try to parse the output string.");
402 ("ls", (RStringList "listing", [String "directory"]), 6, [],
403 [InitBasicFS, TestOutputList (
406 ["touch"; "/newest"];
407 ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
408 "list the files in a directory",
410 List the files in C<directory> (relative to the root directory,
411 there is no cwd). The '.' and '..' entries are not returned, but
412 hidden files are shown.
414 This command is mostly useful for interactive sessions. Programs
415 should probably use C<guestfs_readdir> instead.");
417 ("list_devices", (RStringList "devices", []), 7, [],
418 [InitEmpty, TestOutputList (
419 [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"])],
420 "list the block devices",
422 List all the block devices.
424 The full block device names are returned, eg. C</dev/sda>");
426 ("list_partitions", (RStringList "partitions", []), 8, [],
427 [InitBasicFS, TestOutputList (
428 [["list_partitions"]], ["/dev/sda1"]);
429 InitEmpty, TestOutputList (
430 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
431 ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
432 "list the partitions",
434 List all the partitions detected on all block devices.
436 The full partition device names are returned, eg. C</dev/sda1>
438 This does not return logical volumes. For that you will need to
439 call C<guestfs_lvs>.");
441 ("pvs", (RStringList "physvols", []), 9, [],
442 [InitBasicFSonLVM, TestOutputList (
443 [["pvs"]], ["/dev/sda1"]);
444 InitEmpty, TestOutputList (
445 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
446 ["pvcreate"; "/dev/sda1"];
447 ["pvcreate"; "/dev/sda2"];
448 ["pvcreate"; "/dev/sda3"];
449 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
450 "list the LVM physical volumes (PVs)",
452 List all the physical volumes detected. This is the equivalent
453 of the L<pvs(8)> command.
455 This returns a list of just the device names that contain
456 PVs (eg. C</dev/sda2>).
458 See also C<guestfs_pvs_full>.");
460 ("vgs", (RStringList "volgroups", []), 10, [],
461 [InitBasicFSonLVM, TestOutputList (
463 InitEmpty, TestOutputList (
464 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
465 ["pvcreate"; "/dev/sda1"];
466 ["pvcreate"; "/dev/sda2"];
467 ["pvcreate"; "/dev/sda3"];
468 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
469 ["vgcreate"; "VG2"; "/dev/sda3"];
470 ["vgs"]], ["VG1"; "VG2"])],
471 "list the LVM volume groups (VGs)",
473 List all the volumes groups detected. This is the equivalent
474 of the L<vgs(8)> command.
476 This returns a list of just the volume group names that were
477 detected (eg. C<VolGroup00>).
479 See also C<guestfs_vgs_full>.");
481 ("lvs", (RStringList "logvols", []), 11, [],
482 [InitBasicFSonLVM, TestOutputList (
483 [["lvs"]], ["/dev/VG/LV"]);
484 InitEmpty, TestOutputList (
485 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
486 ["pvcreate"; "/dev/sda1"];
487 ["pvcreate"; "/dev/sda2"];
488 ["pvcreate"; "/dev/sda3"];
489 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
490 ["vgcreate"; "VG2"; "/dev/sda3"];
491 ["lvcreate"; "LV1"; "VG1"; "50"];
492 ["lvcreate"; "LV2"; "VG1"; "50"];
493 ["lvcreate"; "LV3"; "VG2"; "50"];
494 ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
495 "list the LVM logical volumes (LVs)",
497 List all the logical volumes detected. This is the equivalent
498 of the L<lvs(8)> command.
500 This returns a list of the logical volume device names
501 (eg. C</dev/VolGroup00/LogVol00>).
503 See also C<guestfs_lvs_full>.");
505 ("pvs_full", (RPVList "physvols", []), 12, [],
506 [], (* XXX how to test? *)
507 "list the LVM physical volumes (PVs)",
509 List all the physical volumes detected. This is the equivalent
510 of the L<pvs(8)> command. The \"full\" version includes all fields.");
512 ("vgs_full", (RVGList "volgroups", []), 13, [],
513 [], (* XXX how to test? *)
514 "list the LVM volume groups (VGs)",
516 List all the volumes groups detected. This is the equivalent
517 of the L<vgs(8)> command. The \"full\" version includes all fields.");
519 ("lvs_full", (RLVList "logvols", []), 14, [],
520 [], (* XXX how to test? *)
521 "list the LVM logical volumes (LVs)",
523 List all the logical volumes detected. This is the equivalent
524 of the L<lvs(8)> command. The \"full\" version includes all fields.");
526 ("read_lines", (RStringList "lines", [String "path"]), 15, [],
527 [InitBasicFS, TestOutputList (
528 [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
529 ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);
530 InitBasicFS, TestOutputList (
531 [["write_file"; "/new"; ""; "0"];
532 ["read_lines"; "/new"]], [])],
533 "read file as lines",
535 Return the contents of the file named C<path>.
537 The file contents are returned as a list of lines. Trailing
538 C<LF> and C<CRLF> character sequences are I<not> returned.
540 Note that this function cannot correctly handle binary files
541 (specifically, files containing C<\\0> character which is treated
542 as end of line). For those you need to use the C<guestfs_read_file>
543 function which has a more complex interface.");
545 ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [],
546 [], (* XXX Augeas code needs tests. *)
547 "create a new Augeas handle",
549 Create a new Augeas handle for editing configuration files.
550 If there was any previous Augeas handle associated with this
551 guestfs session, then it is closed.
553 You must call this before using any other C<guestfs_aug_*>
556 C<root> is the filesystem root. C<root> must not be NULL,
559 The flags are the same as the flags defined in
560 E<lt>augeas.hE<gt>, the logical I<or> of the following
565 =item C<AUG_SAVE_BACKUP> = 1
567 Keep the original file with a C<.augsave> extension.
569 =item C<AUG_SAVE_NEWFILE> = 2
571 Save changes into a file with extension C<.augnew>, and
572 do not overwrite original. Overrides C<AUG_SAVE_BACKUP>.
574 =item C<AUG_TYPE_CHECK> = 4
576 Typecheck lenses (can be expensive).
578 =item C<AUG_NO_STDINC> = 8
580 Do not use standard load path for modules.
582 =item C<AUG_SAVE_NOOP> = 16
584 Make save a no-op, just record what would have been changed.
586 =item C<AUG_NO_LOAD> = 32
588 Do not load the tree in C<guestfs_aug_init>.
592 To close the handle, you can call C<guestfs_aug_close>.
594 To find out more about Augeas, see L<http://augeas.net/>.");
596 ("aug_close", (RErr, []), 26, [],
597 [], (* XXX Augeas code needs tests. *)
598 "close the current Augeas handle",
600 Close the current Augeas handle and free up any resources
601 used by it. After calling this, you have to call
602 C<guestfs_aug_init> again before you can use any other
605 ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
606 [], (* XXX Augeas code needs tests. *)
607 "define an Augeas variable",
609 Defines an Augeas variable C<name> whose value is the result
610 of evaluating C<expr>. If C<expr> is NULL, then C<name> is
613 On success this returns the number of nodes in C<expr>, or
614 C<0> if C<expr> evaluates to something which is not a nodeset.");
616 ("aug_defnode", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [],
617 [], (* XXX Augeas code needs tests. *)
618 "define an Augeas node",
620 Defines a variable C<name> whose value is the result of
623 If C<expr> evaluates to an empty nodeset, a node is created,
624 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
625 C<name> will be the nodeset containing that single node.
627 On success this returns a pair containing the
628 number of nodes in the nodeset, and a boolean flag
629 if a node was created.");
631 ("aug_get", (RString "val", [String "path"]), 19, [],
632 [], (* XXX Augeas code needs tests. *)
633 "look up the value of an Augeas path",
635 Look up the value associated with C<path>. If C<path>
636 matches exactly one node, the C<value> is returned.");
638 ("aug_set", (RErr, [String "path"; String "val"]), 20, [],
639 [], (* XXX Augeas code needs tests. *)
640 "set Augeas path to value",
642 Set the value associated with C<path> to C<value>.");
644 ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [],
645 [], (* XXX Augeas code needs tests. *)
646 "insert a sibling Augeas node",
648 Create a new sibling C<label> for C<path>, inserting it into
649 the tree before or after C<path> (depending on the boolean
652 C<path> must match exactly one existing node in the tree, and
653 C<label> must be a label, ie. not contain C</>, C<*> or end
654 with a bracketed index C<[N]>.");
656 ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
657 [], (* XXX Augeas code needs tests. *)
658 "remove an Augeas path",
660 Remove C<path> and all of its children.
662 On success this returns the number of entries which were removed.");
664 ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [],
665 [], (* XXX Augeas code needs tests. *)
668 Move the node C<src> to C<dest>. C<src> must match exactly
669 one node. C<dest> is overwritten if it exists.");
671 ("aug_match", (RStringList "matches", [String "path"]), 24, [],
672 [], (* XXX Augeas code needs tests. *)
673 "return Augeas nodes which match path",
675 Returns a list of paths which match the path expression C<path>.
676 The returned paths are sufficiently qualified so that they match
677 exactly one node in the current tree.");
679 ("aug_save", (RErr, []), 25, [],
680 [], (* XXX Augeas code needs tests. *)
681 "write all pending Augeas changes to disk",
683 This writes all pending changes to disk.
685 The flags which were passed to C<guestfs_aug_init> affect exactly
686 how files are saved.");
688 ("aug_load", (RErr, []), 27, [],
689 [], (* XXX Augeas code needs tests. *)
690 "load files into the tree",
692 Load files into the tree.
694 See C<aug_load> in the Augeas documentation for the full gory
697 ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
698 [], (* XXX Augeas code needs tests. *)
699 "list Augeas nodes under a path",
701 This is just a shortcut for listing C<guestfs_aug_match>
702 C<path/*> and sorting the resulting nodes into alphabetical order.");
704 ("rm", (RErr, [String "path"]), 29, [],
705 [InitBasicFS, TestRun
708 InitBasicFS, TestLastFail
710 InitBasicFS, TestLastFail
715 Remove the single file C<path>.");
717 ("rmdir", (RErr, [String "path"]), 30, [],
718 [InitBasicFS, TestRun
721 InitBasicFS, TestLastFail
723 InitBasicFS, TestLastFail
726 "remove a directory",
728 Remove the single directory C<path>.");
730 ("rm_rf", (RErr, [String "path"]), 31, [],
731 [InitBasicFS, TestOutputFalse
733 ["mkdir"; "/new/foo"];
734 ["touch"; "/new/foo/bar"];
736 ["exists"; "/new"]]],
737 "remove a file or directory recursively",
739 Remove the file or directory C<path>, recursively removing the
740 contents if its a directory. This is like the C<rm -rf> shell
743 ("mkdir", (RErr, [String "path"]), 32, [],
744 [InitBasicFS, TestOutputTrue
747 InitBasicFS, TestLastFail
748 [["mkdir"; "/new/foo/bar"]]],
749 "create a directory",
751 Create a directory named C<path>.");
753 ("mkdir_p", (RErr, [String "path"]), 33, [],
754 [InitBasicFS, TestOutputTrue
755 [["mkdir_p"; "/new/foo/bar"];
756 ["is_dir"; "/new/foo/bar"]];
757 InitBasicFS, TestOutputTrue
758 [["mkdir_p"; "/new/foo/bar"];
759 ["is_dir"; "/new/foo"]];
760 InitBasicFS, TestOutputTrue
761 [["mkdir_p"; "/new/foo/bar"];
762 ["is_dir"; "/new"]]],
763 "create a directory and parents",
765 Create a directory named C<path>, creating any parent directories
766 as necessary. This is like the C<mkdir -p> shell command.");
768 ("chmod", (RErr, [Int "mode"; String "path"]), 34, [],
769 [], (* XXX Need stat command to test *)
772 Change the mode (permissions) of C<path> to C<mode>. Only
773 numeric modes are supported.");
775 ("chown", (RErr, [Int "owner"; Int "group"; String "path"]), 35, [],
776 [], (* XXX Need stat command to test *)
777 "change file owner and group",
779 Change the file owner to C<owner> and group to C<group>.
781 Only numeric uid and gid are supported. If you want to use
782 names, you will need to locate and parse the password file
783 yourself (Augeas support makes this relatively easy).");
785 ("exists", (RBool "existsflag", [String "path"]), 36, [],
786 [InitBasicFS, TestOutputTrue (
788 ["exists"; "/new"]]);
789 InitBasicFS, TestOutputTrue (
791 ["exists"; "/new"]])],
792 "test if file or directory exists",
794 This returns C<true> if and only if there is a file, directory
795 (or anything) with the given C<path> name.
797 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
799 ("is_file", (RBool "fileflag", [String "path"]), 37, [],
800 [InitBasicFS, TestOutputTrue (
802 ["is_file"; "/new"]]);
803 InitBasicFS, TestOutputFalse (
805 ["is_file"; "/new"]])],
806 "test if file exists",
808 This returns C<true> if and only if there is a file
809 with the given C<path> name. Note that it returns false for
810 other objects like directories.
812 See also C<guestfs_stat>.");
814 ("is_dir", (RBool "dirflag", [String "path"]), 38, [],
815 [InitBasicFS, TestOutputFalse (
817 ["is_dir"; "/new"]]);
818 InitBasicFS, TestOutputTrue (
820 ["is_dir"; "/new"]])],
821 "test if file exists",
823 This returns C<true> if and only if there is a directory
824 with the given C<path> name. Note that it returns false for
825 other objects like files.
827 See also C<guestfs_stat>.");
829 ("pvcreate", (RErr, [String "device"]), 39, [],
830 [InitEmpty, TestOutputList (
831 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
832 ["pvcreate"; "/dev/sda1"];
833 ["pvcreate"; "/dev/sda2"];
834 ["pvcreate"; "/dev/sda3"];
835 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
836 "create an LVM physical volume",
838 This creates an LVM physical volume on the named C<device>,
839 where C<device> should usually be a partition name such
842 ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
843 [InitEmpty, TestOutputList (
844 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
845 ["pvcreate"; "/dev/sda1"];
846 ["pvcreate"; "/dev/sda2"];
847 ["pvcreate"; "/dev/sda3"];
848 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
849 ["vgcreate"; "VG2"; "/dev/sda3"];
850 ["vgs"]], ["VG1"; "VG2"])],
851 "create an LVM volume group",
853 This creates an LVM volume group called C<volgroup>
854 from the non-empty list of physical volumes C<physvols>.");
856 ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [],
857 [InitEmpty, TestOutputList (
858 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
859 ["pvcreate"; "/dev/sda1"];
860 ["pvcreate"; "/dev/sda2"];
861 ["pvcreate"; "/dev/sda3"];
862 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
863 ["vgcreate"; "VG2"; "/dev/sda3"];
864 ["lvcreate"; "LV1"; "VG1"; "50"];
865 ["lvcreate"; "LV2"; "VG1"; "50"];
866 ["lvcreate"; "LV3"; "VG2"; "50"];
867 ["lvcreate"; "LV4"; "VG2"; "50"];
868 ["lvcreate"; "LV5"; "VG2"; "50"];
870 ["/dev/VG1/LV1"; "/dev/VG1/LV2";
871 "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
872 "create an LVM volume group",
874 This creates an LVM volume group called C<logvol>
875 on the volume group C<volgroup>, with C<size> megabytes.");
877 ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [],
878 [InitEmpty, TestOutput (
879 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
880 ["mkfs"; "ext2"; "/dev/sda1"];
881 ["mount"; "/dev/sda1"; "/"];
882 ["write_file"; "/new"; "new file contents"; "0"];
883 ["cat"; "/new"]], "new file contents")],
886 This creates a filesystem on C<device> (usually a partition
887 of LVM logical volume). The filesystem type is C<fstype>, for
890 ("sfdisk", (RErr, [String "device";
891 Int "cyls"; Int "heads"; Int "sectors";
892 StringList "lines"]), 43, [DangerWillRobinson],
894 "create partitions on a block device",
896 This is a direct interface to the L<sfdisk(8)> program for creating
897 partitions on block devices.
899 C<device> should be a block device, for example C</dev/sda>.
901 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
902 and sectors on the device, which are passed directly to sfdisk as
903 the I<-C>, I<-H> and I<-S> parameters. If you pass C<0> for any
904 of these, then the corresponding parameter is omitted. Usually for
905 'large' disks, you can just pass C<0> for these, but for small
906 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
907 out the right geometry and you will need to tell it.
909 C<lines> is a list of lines that we feed to C<sfdisk>. For more
910 information refer to the L<sfdisk(8)> manpage.
912 To create a single partition occupying the whole disk, you would
913 pass C<lines> as a single element list, when the single element being
914 the string C<,> (comma).");
916 ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
917 [InitBasicFS, TestOutput (
918 [["write_file"; "/new"; "new file contents"; "0"];
919 ["cat"; "/new"]], "new file contents");
920 InitBasicFS, TestOutput (
921 [["write_file"; "/new"; "\nnew file contents\n"; "0"];
922 ["cat"; "/new"]], "\nnew file contents\n");
923 InitBasicFS, TestOutput (
924 [["write_file"; "/new"; "\n\n"; "0"];
925 ["cat"; "/new"]], "\n\n");
926 InitBasicFS, TestOutput (
927 [["write_file"; "/new"; ""; "0"];
928 ["cat"; "/new"]], "");
929 InitBasicFS, TestOutput (
930 [["write_file"; "/new"; "\n\n\n"; "0"];
931 ["cat"; "/new"]], "\n\n\n");
932 InitBasicFS, TestOutput (
933 [["write_file"; "/new"; "\n"; "0"];
934 ["cat"; "/new"]], "\n")],
937 This call creates a file called C<path>. The contents of the
938 file is the string C<content> (which can contain any 8 bit data),
941 As a special case, if C<size> is C<0>
942 then the length is calculated using C<strlen> (so in this case
943 the content cannot contain embedded ASCII NULs).");
945 ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
946 [InitEmpty, TestOutputList (
947 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
948 ["mkfs"; "ext2"; "/dev/sda1"];
949 ["mount"; "/dev/sda1"; "/"];
950 ["mounts"]], ["/dev/sda1"]);
951 InitEmpty, TestOutputList (
952 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
953 ["mkfs"; "ext2"; "/dev/sda1"];
954 ["mount"; "/dev/sda1"; "/"];
957 "unmount a filesystem",
959 This unmounts the given filesystem. The filesystem may be
960 specified either by its mountpoint (path) or the device which
961 contains the filesystem.");
963 ("mounts", (RStringList "devices", []), 46, [],
964 [InitBasicFS, TestOutputList (
965 [["mounts"]], ["/dev/sda1"])],
966 "show mounted filesystems",
968 This returns the list of currently mounted filesystems. It returns
969 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
971 Some internal mounts are not shown.");
973 ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
974 [InitBasicFS, TestOutputList (
977 "unmount all filesystems",
979 This unmounts all mounted filesystems.
981 Some internal mounts are not unmounted by this call.");
983 ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson],
985 "remove all LVM LVs, VGs and PVs",
987 This command removes all LVM logical volumes, volume groups
988 and physical volumes.");
990 ("file", (RString "description", [String "path"]), 49, [],
991 [InitBasicFS, TestOutput (
993 ["file"; "/new"]], "empty");
994 InitBasicFS, TestOutput (
995 [["write_file"; "/new"; "some content\n"; "0"];
996 ["file"; "/new"]], "ASCII text");
997 InitBasicFS, TestLastFail (
998 [["file"; "/nofile"]])],
999 "determine file type",
1001 This call uses the standard L<file(1)> command to determine
1002 the type or contents of the file. This also works on devices,
1003 for example to find out whether a partition contains a filesystem.
1005 The exact command which runs is C<file -bsL path>. Note in
1006 particular that the filename is not prepended to the output
1007 (the C<-b> option).");
1009 ("command", (RString "output", [StringList "arguments"]), 50, [],
1010 [], (* XXX how to test? *)
1011 "run a command from the guest filesystem",
1013 This call runs a command from the guest filesystem. The
1014 filesystem must be mounted, and must contain a compatible
1015 operating system (ie. something Linux, with the same
1016 or compatible processor architecture).
1018 The single parameter is an argv-style list of arguments.
1019 The first element is the name of the program to run.
1020 Subsequent elements are parameters. The list must be
1021 non-empty (ie. must contain a program name).
1023 The C<$PATH> environment variable will contain at least
1024 C</usr/bin> and C</bin>. If you require a program from
1025 another location, you should provide the full path in the
1028 Shared libraries and data files required by the program
1029 must be available on filesystems which are mounted in the
1030 correct places. It is the caller's responsibility to ensure
1031 all filesystems that are needed are mounted at the right
1034 ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [],
1035 [], (* XXX how to test? *)
1036 "run a command, returning lines",
1038 This is the same as C<guestfs_command>, but splits the
1039 result into a list of lines.");
1041 ("stat", (RStat "statbuf", [String "path"]), 52, [],
1042 [InitBasicFS, TestOutputStruct (
1044 ["stat"; "/new"]], [CompareWithInt ("size", 0)])],
1045 "get file information",
1047 Returns file information for the given C<path>.
1049 This is the same as the C<stat(2)> system call.");
1051 ("lstat", (RStat "statbuf", [String "path"]), 53, [],
1052 [InitBasicFS, TestOutputStruct (
1054 ["lstat"; "/new"]], [CompareWithInt ("size", 0)])],
1055 "get file information for a symbolic link",
1057 Returns file information for the given C<path>.
1059 This is the same as C<guestfs_stat> except that if C<path>
1060 is a symbolic link, then the link is stat-ed, not the file it
1063 This is the same as the C<lstat(2)> system call.");
1065 ("statvfs", (RStatVFS "statbuf", [String "path"]), 54, [],
1066 [InitBasicFS, TestOutputStruct (
1067 [["statvfs"; "/"]], [CompareWithInt ("bfree", 487702);
1068 CompareWithInt ("blocks", 490020);
1069 CompareWithInt ("bsize", 1024)])],
1070 "get file system statistics",
1072 Returns file system statistics for any mounted file system.
1073 C<path> should be a file or directory in the mounted file system
1074 (typically it is the mount point itself, but it doesn't need to be).
1076 This is the same as the C<statvfs(2)> system call.");
1078 ("tune2fs_l", (RHashtable "superblock", [String "device"]), 55, [],
1080 "get ext2/ext3 superblock details",
1082 This returns the contents of the ext2 or ext3 filesystem superblock
1085 It is the same as running C<tune2fs -l device>. See L<tune2fs(8)>
1086 manpage for more details. The list of fields returned isn't
1087 clearly defined, and depends on both the version of C<tune2fs>
1088 that libguestfs was built against, and the filesystem itself.");
1090 ("blockdev_setro", (RErr, [String "device"]), 56, [],
1091 [InitEmpty, TestOutputTrue (
1092 [["blockdev_setro"; "/dev/sda"];
1093 ["blockdev_getro"; "/dev/sda"]])],
1094 "set block device to read-only",
1096 Sets the block device named C<device> to read-only.
1098 This uses the L<blockdev(8)> command.");
1100 ("blockdev_setrw", (RErr, [String "device"]), 57, [],
1101 [InitEmpty, TestOutputFalse (
1102 [["blockdev_setrw"; "/dev/sda"];
1103 ["blockdev_getro"; "/dev/sda"]])],
1104 "set block device to read-write",
1106 Sets the block device named C<device> to read-write.
1108 This uses the L<blockdev(8)> command.");
1110 ("blockdev_getro", (RBool "ro", [String "device"]), 58, [],
1111 [InitEmpty, TestOutputTrue (
1112 [["blockdev_setro"; "/dev/sda"];
1113 ["blockdev_getro"; "/dev/sda"]])],
1114 "is block device set to read-only",
1116 Returns a boolean indicating if the block device is read-only
1117 (true if read-only, false if not).
1119 This uses the L<blockdev(8)> command.");
1121 ("blockdev_getss", (RInt "sectorsize", [String "device"]), 59, [],
1122 [InitEmpty, TestOutputInt (
1123 [["blockdev_getss"; "/dev/sda"]], 512)],
1124 "get sectorsize of block device",
1126 This returns the size of sectors on a block device.
1127 Usually 512, but can be larger for modern devices.
1129 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
1132 This uses the L<blockdev(8)> command.");
1134 ("blockdev_getbsz", (RInt "blocksize", [String "device"]), 60, [],
1135 [InitEmpty, TestOutputInt (
1136 [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1137 "get blocksize of block device",
1139 This returns the block size of a device.
1141 (Note this is different from both I<size in blocks> and
1142 I<filesystem block size>).
1144 This uses the L<blockdev(8)> command.");
1146 ("blockdev_setbsz", (RErr, [String "device"; Int "blocksize"]), 61, [],
1148 "set blocksize of block device",
1150 This sets the block size of a device.
1152 (Note this is different from both I<size in blocks> and
1153 I<filesystem block size>).
1155 This uses the L<blockdev(8)> command.");
1157 ("blockdev_getsz", (RInt64 "sizeinsectors", [String "device"]), 62, [],
1158 [InitEmpty, TestOutputInt (
1159 [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1160 "get total size of device in 512-byte sectors",
1162 This returns the size of the device in units of 512-byte sectors
1163 (even if the sectorsize isn't 512 bytes ... weird).
1165 See also C<guestfs_blockdev_getss> for the real sector size of
1166 the device, and C<guestfs_blockdev_getsize64> for the more
1167 useful I<size in bytes>.
1169 This uses the L<blockdev(8)> command.");
1171 ("blockdev_getsize64", (RInt64 "sizeinbytes", [String "device"]), 63, [],
1172 [InitEmpty, TestOutputInt (
1173 [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1174 "get total size of device in bytes",
1176 This returns the size of the device in bytes.
1178 See also C<guestfs_blockdev_getsz>.
1180 This uses the L<blockdev(8)> command.");
1182 ("blockdev_flushbufs", (RErr, [String "device"]), 64, [],
1184 [["blockdev_flushbufs"; "/dev/sda"]]],
1185 "flush device buffers",
1187 This tells the kernel to flush internal buffers associated
1190 This uses the L<blockdev(8)> command.");
1192 ("blockdev_rereadpt", (RErr, [String "device"]), 65, [],
1194 [["blockdev_rereadpt"; "/dev/sda"]]],
1195 "reread partition table",
1197 Reread the partition table on C<device>.
1199 This uses the L<blockdev(8)> command.");
1203 let all_functions = non_daemon_functions @ daemon_functions
1205 (* In some places we want the functions to be displayed sorted
1206 * alphabetically, so this is useful:
1208 let all_functions_sorted =
1209 List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
1210 compare n1 n2) all_functions
1212 (* Column names and types from LVM PVs/VGs/LVs. *)
1221 "pv_attr", `String (* XXX *);
1222 "pv_pe_count", `Int;
1223 "pv_pe_alloc_count", `Int;
1226 "pv_mda_count", `Int;
1227 "pv_mda_free", `Bytes;
1228 (* Not in Fedora 10:
1229 "pv_mda_size", `Bytes;
1236 "vg_attr", `String (* XXX *);
1239 "vg_sysid", `String;
1240 "vg_extent_size", `Bytes;
1241 "vg_extent_count", `Int;
1242 "vg_free_count", `Int;
1250 "vg_mda_count", `Int;
1251 "vg_mda_free", `Bytes;
1252 (* Not in Fedora 10:
1253 "vg_mda_size", `Bytes;
1259 "lv_attr", `String (* XXX *);
1262 "lv_kernel_major", `Int;
1263 "lv_kernel_minor", `Int;
1267 "snap_percent", `OptPercent;
1268 "copy_percent", `OptPercent;
1271 "mirror_log", `String;
1275 (* Column names and types from stat structures.
1276 * NB. Can't use things like 'st_atime' because glibc header files
1277 * define some of these as macros. Ugh.
1294 let statvfs_cols = [
1308 (* Useful functions.
1309 * Note we don't want to use any external OCaml libraries which
1310 * makes this a bit harder than it should be.
1312 let failwithf fs = ksprintf failwith fs
1314 let replace_char s c1 c2 =
1315 let s2 = String.copy s in
1316 let r = ref false in
1317 for i = 0 to String.length s2 - 1 do
1318 if String.unsafe_get s2 i = c1 then (
1319 String.unsafe_set s2 i c2;
1323 if not !r then s else s2
1325 let rec find s sub =
1326 let len = String.length s in
1327 let sublen = String.length sub in
1329 if i <= len-sublen then (
1331 if j < sublen then (
1332 if s.[i+j] = sub.[j] then loop2 (j+1)
1338 if r = -1 then loop (i+1) else r
1344 let rec replace_str s s1 s2 =
1345 let len = String.length s in
1346 let sublen = String.length s1 in
1347 let i = find s s1 in
1350 let s' = String.sub s 0 i in
1351 let s'' = String.sub s (i+sublen) (len-i-sublen) in
1352 s' ^ s2 ^ replace_str s'' s1 s2
1355 let rec string_split sep str =
1356 let len = String.length str in
1357 let seplen = String.length sep in
1358 let i = find str sep in
1359 if i = -1 then [str]
1361 let s' = String.sub str 0 i in
1362 let s'' = String.sub str (i+seplen) (len-i-seplen) in
1363 s' :: string_split sep s''
1366 let rec find_map f = function
1367 | [] -> raise Not_found
1371 | None -> find_map f xs
1374 let rec loop i = function
1376 | x :: xs -> f i x; loop (i+1) xs
1381 let rec loop i = function
1383 | x :: xs -> let r = f i x in r :: loop (i+1) xs
1387 let name_of_argt = function
1388 | String n | OptString n | StringList n | Bool n | Int n -> n
1390 let seq_of_test = function
1391 | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
1392 | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s
1393 | TestOutputLength (s, _) | TestOutputStruct (s, _)
1394 | TestLastFail s -> s
1396 (* Check function names etc. for consistency. *)
1397 let check_functions () =
1398 let contains_uppercase str =
1399 let len = String.length str in
1401 if i >= len then false
1404 if c >= 'A' && c <= 'Z' then true
1411 (* Check function names. *)
1413 fun (name, _, _, _, _, _, _) ->
1414 if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
1415 failwithf "function name %s does not need 'guestfs' prefix" name;
1416 if contains_uppercase name then
1417 failwithf "function name %s should not contain uppercase chars" name;
1418 if String.contains name '-' then
1419 failwithf "function name %s should not contain '-', use '_' instead."
1423 (* Check function parameter/return names. *)
1425 fun (name, style, _, _, _, _, _) ->
1426 let check_arg_ret_name n =
1427 if contains_uppercase n then
1428 failwithf "%s param/ret %s should not contain uppercase chars"
1430 if String.contains n '-' || String.contains n '_' then
1431 failwithf "%s param/ret %s should not contain '-' or '_'"
1434 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;
1435 if n = "argv" || n = "args" then
1436 failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" n
1439 (match fst style with
1441 | RInt n | RInt64 n | RBool n | RConstString n | RString n
1442 | RStringList n | RPVList n | RVGList n | RLVList n
1443 | RStat n | RStatVFS n
1445 check_arg_ret_name n
1447 check_arg_ret_name n;
1448 check_arg_ret_name m
1450 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
1453 (* Check short descriptions. *)
1455 fun (name, _, _, _, _, shortdesc, _) ->
1456 if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
1457 failwithf "short description of %s should begin with lowercase." name;
1458 let c = shortdesc.[String.length shortdesc-1] in
1459 if c = '\n' || c = '.' then
1460 failwithf "short description of %s should not end with . or \\n." name
1463 (* Check long dscriptions. *)
1465 fun (name, _, _, _, _, _, longdesc) ->
1466 if longdesc.[String.length longdesc-1] = '\n' then
1467 failwithf "long description of %s should not end with \\n." name
1470 (* Check proc_nrs. *)
1472 fun (name, _, proc_nr, _, _, _, _) ->
1473 if proc_nr <= 0 then
1474 failwithf "daemon function %s should have proc_nr > 0" name
1478 fun (name, _, proc_nr, _, _, _, _) ->
1479 if proc_nr <> -1 then
1480 failwithf "non-daemon function %s should have proc_nr -1" name
1481 ) non_daemon_functions;
1484 List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
1487 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
1488 let rec loop = function
1491 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
1493 | (name1,nr1) :: (name2,nr2) :: _ ->
1494 failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
1502 (* Ignore functions that have no tests. We generate a
1503 * warning when the user does 'make check' instead.
1505 | name, _, _, _, [], _, _ -> ()
1506 | name, _, _, _, tests, _, _ ->
1510 match seq_of_test test with
1512 failwithf "%s has a test containing an empty sequence" name
1513 | cmds -> List.map List.hd cmds
1515 let funcs = List.flatten funcs in
1517 let tested = List.mem name funcs in
1520 failwithf "function %s has tests but does not test itself" name
1523 (* 'pr' prints to the current output file. *)
1524 let chan = ref stdout
1525 let pr fs = ksprintf (output_string !chan) fs
1527 (* Generate a header block in a number of standard styles. *)
1528 type comment_style = CStyle | HashStyle | OCamlStyle
1529 type license = GPLv2 | LGPLv2
1531 let generate_header comment license =
1532 let c = match comment with
1533 | CStyle -> pr "/* "; " *"
1534 | HashStyle -> pr "# "; "#"
1535 | OCamlStyle -> pr "(* "; " *" in
1536 pr "libguestfs generated file\n";
1537 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
1538 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
1540 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
1544 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
1545 pr "%s it under the terms of the GNU General Public License as published by\n" c;
1546 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
1547 pr "%s (at your option) any later version.\n" c;
1549 pr "%s This program is distributed in the hope that it will be useful,\n" c;
1550 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1551 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
1552 pr "%s GNU General Public License for more details.\n" c;
1554 pr "%s You should have received a copy of the GNU General Public License along\n" c;
1555 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
1556 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
1559 pr "%s This library is free software; you can redistribute it and/or\n" c;
1560 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
1561 pr "%s License as published by the Free Software Foundation; either\n" c;
1562 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
1564 pr "%s This library is distributed in the hope that it will be useful,\n" c;
1565 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1566 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
1567 pr "%s Lesser General Public License for more details.\n" c;
1569 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
1570 pr "%s License along with this library; if not, write to the Free Software\n" c;
1571 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
1574 | CStyle -> pr " */\n"
1576 | OCamlStyle -> pr " *)\n"
1580 (* Start of main code generation functions below this line. *)
1582 (* Generate the pod documentation for the C API. *)
1583 let rec generate_actions_pod () =
1585 fun (shortname, style, _, flags, _, _, longdesc) ->
1586 let name = "guestfs_" ^ shortname in
1587 pr "=head2 %s\n\n" name;
1589 generate_prototype ~extern:false ~handle:"handle" name style;
1591 pr "%s\n\n" longdesc;
1592 (match fst style with
1594 pr "This function returns 0 on success or -1 on error.\n\n"
1596 pr "On error this function returns -1.\n\n"
1598 pr "On error this function returns -1.\n\n"
1600 pr "This function returns a C truth value on success or -1 on error.\n\n"
1602 pr "This function returns a string, or NULL on error.
1603 The string is owned by the guest handle and must I<not> be freed.\n\n"
1605 pr "This function returns a string, or NULL on error.
1606 I<The caller must free the returned string after use>.\n\n"
1608 pr "This function returns a NULL-terminated array of strings
1609 (like L<environ(3)>), or NULL if there was an error.
1610 I<The caller must free the strings and the array after use>.\n\n"
1612 pr "This function returns a C<struct guestfs_int_bool *>,
1613 or NULL if there was an error.
1614 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
1616 pr "This function returns a C<struct guestfs_lvm_pv_list *>
1617 (see E<lt>guestfs-structs.hE<gt>),
1618 or NULL if there was an error.
1619 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
1621 pr "This function returns a C<struct guestfs_lvm_vg_list *>
1622 (see E<lt>guestfs-structs.hE<gt>),
1623 or NULL if there was an error.
1624 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
1626 pr "This function returns a C<struct guestfs_lvm_lv_list *>
1627 (see E<lt>guestfs-structs.hE<gt>),
1628 or NULL if there was an error.
1629 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
1631 pr "This function returns a C<struct guestfs_stat *>
1632 (see L<stat(2)> and E<lt>guestfs-structs.hE<gt>),
1633 or NULL if there was an error.
1634 I<The caller must call C<free> after use>.\n\n"
1636 pr "This function returns a C<struct guestfs_statvfs *>
1637 (see L<statvfs(2)> and E<lt>guestfs-structs.hE<gt>),
1638 or NULL if there was an error.
1639 I<The caller must call C<free> after use>.\n\n"
1641 pr "This function returns a NULL-terminated array of
1642 strings, or NULL if there was an error.
1643 The array of strings will always have length C<2n+1>, where
1644 C<n> keys and values alternate, followed by the trailing NULL entry.
1645 I<The caller must free the strings and the array after use>.\n\n"
1647 if List.mem ProtocolLimitWarning flags then
1648 pr "%s\n\n" protocol_limit_warning;
1649 if List.mem DangerWillRobinson flags then
1650 pr "%s\n\n" danger_will_robinson;
1651 ) all_functions_sorted
1653 and generate_structs_pod () =
1654 (* LVM structs documentation. *)
1657 pr "=head2 guestfs_lvm_%s\n" typ;
1659 pr " struct guestfs_lvm_%s {\n" typ;
1662 | name, `String -> pr " char *%s;\n" name
1664 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
1665 pr " char %s[32];\n" name
1666 | name, `Bytes -> pr " uint64_t %s;\n" name
1667 | name, `Int -> pr " int64_t %s;\n" name
1668 | name, `OptPercent ->
1669 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
1670 pr " float %s;\n" name
1673 pr " struct guestfs_lvm_%s_list {\n" typ;
1674 pr " uint32_t len; /* Number of elements in list. */\n";
1675 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
1678 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
1681 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1683 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
1684 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
1686 * We have to use an underscore instead of a dash because otherwise
1687 * rpcgen generates incorrect code.
1689 * This header is NOT exported to clients, but see also generate_structs_h.
1691 and generate_xdr () =
1692 generate_header CStyle LGPLv2;
1694 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
1695 pr "typedef string str<>;\n";
1698 (* LVM internal structures. *)
1702 pr "struct guestfs_lvm_int_%s {\n" typ;
1704 | name, `String -> pr " string %s<>;\n" name
1705 | name, `UUID -> pr " opaque %s[32];\n" name
1706 | name, `Bytes -> pr " hyper %s;\n" name
1707 | name, `Int -> pr " hyper %s;\n" name
1708 | name, `OptPercent -> pr " float %s;\n" name
1712 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
1714 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1716 (* Stat internal structures. *)
1720 pr "struct guestfs_int_%s {\n" typ;
1722 | name, `Int -> pr " hyper %s;\n" name
1726 ) ["stat", stat_cols; "statvfs", statvfs_cols];
1729 fun (shortname, style, _, _, _, _, _) ->
1730 let name = "guestfs_" ^ shortname in
1732 (match snd style with
1735 pr "struct %s_args {\n" name;
1738 | String n -> pr " string %s<>;\n" n
1739 | OptString n -> pr " str *%s;\n" n
1740 | StringList n -> pr " str %s<>;\n" n
1741 | Bool n -> pr " bool %s;\n" n
1742 | Int n -> pr " int %s;\n" n
1746 (match fst style with
1749 pr "struct %s_ret {\n" name;
1753 pr "struct %s_ret {\n" name;
1754 pr " hyper %s;\n" n;
1757 pr "struct %s_ret {\n" name;
1761 failwithf "RConstString cannot be returned from a daemon function"
1763 pr "struct %s_ret {\n" name;
1764 pr " string %s<>;\n" n;
1767 pr "struct %s_ret {\n" name;
1768 pr " str %s<>;\n" n;
1771 pr "struct %s_ret {\n" name;
1776 pr "struct %s_ret {\n" name;
1777 pr " guestfs_lvm_int_pv_list %s;\n" n;
1780 pr "struct %s_ret {\n" name;
1781 pr " guestfs_lvm_int_vg_list %s;\n" n;
1784 pr "struct %s_ret {\n" name;
1785 pr " guestfs_lvm_int_lv_list %s;\n" n;
1788 pr "struct %s_ret {\n" name;
1789 pr " guestfs_int_stat %s;\n" n;
1792 pr "struct %s_ret {\n" name;
1793 pr " guestfs_int_statvfs %s;\n" n;
1796 pr "struct %s_ret {\n" name;
1797 pr " str %s<>;\n" n;
1802 (* Table of procedure numbers. *)
1803 pr "enum guestfs_procedure {\n";
1805 fun (shortname, _, proc_nr, _, _, _, _) ->
1806 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
1808 pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
1812 (* Having to choose a maximum message size is annoying for several
1813 * reasons (it limits what we can do in the API), but it (a) makes
1814 * the protocol a lot simpler, and (b) provides a bound on the size
1815 * of the daemon which operates in limited memory space. For large
1816 * file transfers you should use FTP.
1818 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
1821 (* Message header, etc. *)
1823 const GUESTFS_PROGRAM = 0x2000F5F5;
1824 const GUESTFS_PROTOCOL_VERSION = 1;
1826 enum guestfs_message_direction {
1827 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
1828 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
1831 enum guestfs_message_status {
1832 GUESTFS_STATUS_OK = 0,
1833 GUESTFS_STATUS_ERROR = 1
1836 const GUESTFS_ERROR_LEN = 256;
1838 struct guestfs_message_error {
1839 string error<GUESTFS_ERROR_LEN>; /* error message */
1842 struct guestfs_message_header {
1843 unsigned prog; /* GUESTFS_PROGRAM */
1844 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
1845 guestfs_procedure proc; /* GUESTFS_PROC_x */
1846 guestfs_message_direction direction;
1847 unsigned serial; /* message serial number */
1848 guestfs_message_status status;
1852 (* Generate the guestfs-structs.h file. *)
1853 and generate_structs_h () =
1854 generate_header CStyle LGPLv2;
1856 (* This is a public exported header file containing various
1857 * structures. The structures are carefully written to have
1858 * exactly the same in-memory format as the XDR structures that
1859 * we use on the wire to the daemon. The reason for creating
1860 * copies of these structures here is just so we don't have to
1861 * export the whole of guestfs_protocol.h (which includes much
1862 * unrelated and XDR-dependent stuff that we don't want to be
1863 * public, or required by clients).
1865 * To reiterate, we will pass these structures to and from the
1866 * client with a simple assignment or memcpy, so the format
1867 * must be identical to what rpcgen / the RFC defines.
1870 (* guestfs_int_bool structure. *)
1871 pr "struct guestfs_int_bool {\n";
1877 (* LVM public structures. *)
1881 pr "struct guestfs_lvm_%s {\n" typ;
1884 | name, `String -> pr " char *%s;\n" name
1885 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
1886 | name, `Bytes -> pr " uint64_t %s;\n" name
1887 | name, `Int -> pr " int64_t %s;\n" name
1888 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
1892 pr "struct guestfs_lvm_%s_list {\n" typ;
1893 pr " uint32_t len;\n";
1894 pr " struct guestfs_lvm_%s *val;\n" typ;
1897 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1899 (* Stat structures. *)
1903 pr "struct guestfs_%s {\n" typ;
1906 | name, `Int -> pr " int64_t %s;\n" name
1910 ) ["stat", stat_cols; "statvfs", statvfs_cols]
1912 (* Generate the guestfs-actions.h file. *)
1913 and generate_actions_h () =
1914 generate_header CStyle LGPLv2;
1916 fun (shortname, style, _, _, _, _, _) ->
1917 let name = "guestfs_" ^ shortname in
1918 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
1922 (* Generate the client-side dispatch stubs. *)
1923 and generate_client_actions () =
1924 generate_header CStyle LGPLv2;
1926 (* Client-side stubs for each function. *)
1928 fun (shortname, style, _, _, _, _, _) ->
1929 let name = "guestfs_" ^ shortname in
1931 (* Generate the return value struct. *)
1932 pr "struct %s_rv {\n" shortname;
1933 pr " int cb_done; /* flag to indicate callback was called */\n";
1934 pr " struct guestfs_message_header hdr;\n";
1935 pr " struct guestfs_message_error err;\n";
1936 (match fst style with
1939 failwithf "RConstString cannot be returned from a daemon function"
1941 | RBool _ | RString _ | RStringList _
1943 | RPVList _ | RVGList _ | RLVList _
1944 | RStat _ | RStatVFS _
1946 pr " struct %s_ret ret;\n" name
1950 (* Generate the callback function. *)
1951 pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
1953 pr " struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
1955 pr " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
1956 pr " error (g, \"%s: failed to parse reply header\");\n" name;
1959 pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
1960 pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
1961 pr " error (g, \"%s: failed to parse reply error\");\n" name;
1967 (match fst style with
1970 failwithf "RConstString cannot be returned from a daemon function"
1972 | RBool _ | RString _ | RStringList _
1974 | RPVList _ | RVGList _ | RLVList _
1975 | RStat _ | RStatVFS _
1977 pr " if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
1978 pr " error (g, \"%s: failed to parse reply\");\n" name;
1984 pr " rv->cb_done = 1;\n";
1985 pr " main_loop.main_loop_quit (g);\n";
1988 (* Generate the action stub. *)
1989 generate_prototype ~extern:false ~semicolon:false ~newline:true
1990 ~handle:"g" name style;
1993 match fst style with
1994 | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
1996 failwithf "RConstString cannot be returned from a daemon function"
1997 | RString _ | RStringList _ | RIntBool _
1998 | RPVList _ | RVGList _ | RLVList _
1999 | RStat _ | RStatVFS _
2005 (match snd style with
2007 | _ -> pr " struct %s_args args;\n" name
2010 pr " struct %s_rv rv;\n" shortname;
2011 pr " int serial;\n";
2013 pr " if (g->state != READY) {\n";
2014 pr " error (g, \"%s called from the wrong state, %%d != READY\",\n"
2017 pr " return %s;\n" error_code;
2020 pr " memset (&rv, 0, sizeof rv);\n";
2023 (match snd style with
2025 pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
2026 (String.uppercase shortname)
2031 pr " args.%s = (char *) %s;\n" n n
2033 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
2035 pr " args.%s.%s_val = (char **) %s;\n" n n n;
2036 pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
2038 pr " args.%s = %s;\n" n n
2040 pr " args.%s = %s;\n" n n
2042 pr " serial = dispatch (g, GUESTFS_PROC_%s,\n"
2043 (String.uppercase shortname);
2044 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
2047 pr " if (serial == -1)\n";
2048 pr " return %s;\n" error_code;
2051 pr " rv.cb_done = 0;\n";
2052 pr " g->reply_cb_internal = %s_cb;\n" shortname;
2053 pr " g->reply_cb_internal_data = &rv;\n";
2054 pr " main_loop.main_loop_run (g);\n";
2055 pr " g->reply_cb_internal = NULL;\n";
2056 pr " g->reply_cb_internal_data = NULL;\n";
2057 pr " if (!rv.cb_done) {\n";
2058 pr " error (g, \"%s failed, see earlier error messages\");\n" name;
2059 pr " return %s;\n" error_code;
2063 pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
2064 (String.uppercase shortname);
2065 pr " return %s;\n" error_code;
2068 pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
2069 pr " error (g, \"%%s\", rv.err.error);\n";
2070 pr " return %s;\n" error_code;
2074 (match fst style with
2075 | RErr -> pr " return 0;\n"
2076 | RInt n | RInt64 n | RBool n ->
2077 pr " return rv.ret.%s;\n" n
2079 failwithf "RConstString cannot be returned from a daemon function"
2081 pr " return rv.ret.%s; /* caller will free */\n" n
2082 | RStringList n | RHashtable n ->
2083 pr " /* caller will free this, but we need to add a NULL entry */\n";
2084 pr " rv.ret.%s.%s_val =" n n;
2085 pr " safe_realloc (g, rv.ret.%s.%s_val,\n" n n;
2086 pr " sizeof (char *) * (rv.ret.%s.%s_len + 1));\n"
2088 pr " rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
2089 pr " return rv.ret.%s.%s_val;\n" n n
2091 pr " /* caller with free this */\n";
2092 pr " return safe_memdup (g, &rv.ret, sizeof (rv.ret));\n"
2093 | RPVList n | RVGList n | RLVList n
2094 | RStat n | RStatVFS n ->
2095 pr " /* caller will free this */\n";
2096 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
2102 (* Generate daemon/actions.h. *)
2103 and generate_daemon_actions_h () =
2104 generate_header CStyle GPLv2;
2106 pr "#include \"../src/guestfs_protocol.h\"\n";
2110 fun (name, style, _, _, _, _, _) ->
2112 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
2116 (* Generate the server-side stubs. *)
2117 and generate_daemon_actions () =
2118 generate_header CStyle GPLv2;
2120 pr "#define _GNU_SOURCE // for strchrnul\n";
2122 pr "#include <stdio.h>\n";
2123 pr "#include <stdlib.h>\n";
2124 pr "#include <string.h>\n";
2125 pr "#include <inttypes.h>\n";
2126 pr "#include <ctype.h>\n";
2127 pr "#include <rpc/types.h>\n";
2128 pr "#include <rpc/xdr.h>\n";
2130 pr "#include \"daemon.h\"\n";
2131 pr "#include \"../src/guestfs_protocol.h\"\n";
2132 pr "#include \"actions.h\"\n";
2136 fun (name, style, _, _, _, _, _) ->
2137 (* Generate server-side stubs. *)
2138 pr "static void %s_stub (XDR *xdr_in)\n" name;
2141 match fst style with
2142 | RErr | RInt _ -> pr " int r;\n"; "-1"
2143 | RInt64 _ -> pr " int64_t r;\n"; "-1"
2144 | RBool _ -> pr " int r;\n"; "-1"
2146 failwithf "RConstString cannot be returned from a daemon function"
2147 | RString _ -> pr " char *r;\n"; "NULL"
2148 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
2149 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
2150 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
2151 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
2152 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL"
2153 | RStat _ -> pr " guestfs_int_stat *r;\n"; "NULL"
2154 | RStatVFS _ -> pr " guestfs_int_statvfs *r;\n"; "NULL" in
2156 (match snd style with
2159 pr " struct guestfs_%s_args args;\n" name;
2163 | OptString n -> pr " const char *%s;\n" n
2164 | StringList n -> pr " char **%s;\n" n
2165 | Bool n -> pr " int %s;\n" n
2166 | Int n -> pr " int %s;\n" n
2171 (match snd style with
2174 pr " memset (&args, 0, sizeof args);\n";
2176 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
2177 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
2182 | String n -> pr " %s = args.%s;\n" n n
2183 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
2185 pr " args.%s.%s_val = realloc (args.%s.%s_val, sizeof (char *) * (args.%s.%s_len+1));\n" n n n n n n;
2186 pr " args.%s.%s_val[args.%s.%s_len] = NULL;\n" n n n n;
2187 pr " %s = args.%s.%s_val;\n" n n n
2188 | Bool n -> pr " %s = args.%s;\n" n n
2189 | Int n -> pr " %s = args.%s;\n" n n
2194 pr " r = do_%s " name;
2195 generate_call_args style;
2198 pr " if (r == %s)\n" error_code;
2199 pr " /* do_%s has already called reply_with_error */\n" name;
2203 (match fst style with
2204 | RErr -> pr " reply (NULL, NULL);\n"
2205 | RInt n | RInt64 n | RBool n ->
2206 pr " struct guestfs_%s_ret ret;\n" name;
2207 pr " ret.%s = r;\n" n;
2208 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
2210 failwithf "RConstString cannot be returned from a daemon function"
2212 pr " struct guestfs_%s_ret ret;\n" name;
2213 pr " ret.%s = r;\n" n;
2214 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
2216 | RStringList n | RHashtable n ->
2217 pr " struct guestfs_%s_ret ret;\n" name;
2218 pr " ret.%s.%s_len = count_strings (r);\n" n n;
2219 pr " ret.%s.%s_val = r;\n" n n;
2220 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
2221 pr " free_strings (r);\n"
2223 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name;
2224 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
2225 | RPVList n | RVGList n | RLVList n
2226 | RStat n | RStatVFS n ->
2227 pr " struct guestfs_%s_ret ret;\n" name;
2228 pr " ret.%s = *r;\n" n;
2229 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
2230 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
2233 (* Free the args. *)
2234 (match snd style with
2239 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
2246 (* Dispatch function. *)
2247 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
2249 pr " switch (proc_nr) {\n";
2252 fun (name, style, _, _, _, _, _) ->
2253 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
2254 pr " %s_stub (xdr_in);\n" name;
2259 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
2264 (* LVM columns and tokenization functions. *)
2265 (* XXX This generates crap code. We should rethink how we
2271 pr "static const char *lvm_%s_cols = \"%s\";\n"
2272 typ (String.concat "," (List.map fst cols));
2275 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
2277 pr " char *tok, *p, *next;\n";
2281 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
2284 pr " if (!str) {\n";
2285 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
2288 pr " if (!*str || isspace (*str)) {\n";
2289 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
2294 fun (name, coltype) ->
2295 pr " if (!tok) {\n";
2296 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
2299 pr " p = strchrnul (tok, ',');\n";
2300 pr " if (*p) next = p+1; else next = NULL;\n";
2301 pr " *p = '\\0';\n";
2304 pr " r->%s = strdup (tok);\n" name;
2305 pr " if (r->%s == NULL) {\n" name;
2306 pr " perror (\"strdup\");\n";
2310 pr " for (i = j = 0; i < 32; ++j) {\n";
2311 pr " if (tok[j] == '\\0') {\n";
2312 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
2314 pr " } else if (tok[j] != '-')\n";
2315 pr " r->%s[i++] = tok[j];\n" name;
2318 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
2319 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2323 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
2324 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2328 pr " if (tok[0] == '\\0')\n";
2329 pr " r->%s = -1;\n" name;
2330 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
2331 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2335 pr " tok = next;\n";
2338 pr " if (tok != NULL) {\n";
2339 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
2346 pr "guestfs_lvm_int_%s_list *\n" typ;
2347 pr "parse_command_line_%ss (void)\n" typ;
2349 pr " char *out, *err;\n";
2350 pr " char *p, *pend;\n";
2352 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
2353 pr " void *newp;\n";
2355 pr " ret = malloc (sizeof *ret);\n";
2356 pr " if (!ret) {\n";
2357 pr " reply_with_perror (\"malloc\");\n";
2358 pr " return NULL;\n";
2361 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
2362 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
2364 pr " r = command (&out, &err,\n";
2365 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
2366 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
2367 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
2368 pr " if (r == -1) {\n";
2369 pr " reply_with_error (\"%%s\", err);\n";
2370 pr " free (out);\n";
2371 pr " free (err);\n";
2372 pr " return NULL;\n";
2375 pr " free (err);\n";
2377 pr " /* Tokenize each line of the output. */\n";
2380 pr " while (p) {\n";
2381 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
2382 pr " if (pend) {\n";
2383 pr " *pend = '\\0';\n";
2387 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
2390 pr " if (!*p) { /* Empty line? Skip it. */\n";
2395 pr " /* Allocate some space to store this next entry. */\n";
2396 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
2397 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
2398 pr " if (newp == NULL) {\n";
2399 pr " reply_with_perror (\"realloc\");\n";
2400 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2401 pr " free (ret);\n";
2402 pr " free (out);\n";
2403 pr " return NULL;\n";
2405 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
2407 pr " /* Tokenize the next entry. */\n";
2408 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
2409 pr " if (r == -1) {\n";
2410 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
2411 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2412 pr " free (ret);\n";
2413 pr " free (out);\n";
2414 pr " return NULL;\n";
2421 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
2423 pr " free (out);\n";
2424 pr " return ret;\n";
2427 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2429 (* Generate the tests. *)
2430 and generate_tests () =
2431 generate_header CStyle GPLv2;
2438 #include <sys/types.h>
2441 #include \"guestfs.h\"
2443 static guestfs_h *g;
2444 static int suppress_error = 0;
2446 static void print_error (guestfs_h *g, void *data, const char *msg)
2448 if (!suppress_error)
2449 fprintf (stderr, \"%%s\\n\", msg);
2452 static void print_strings (char * const * const argv)
2456 for (argc = 0; argv[argc] != NULL; ++argc)
2457 printf (\"\\t%%s\\n\", argv[argc]);
2461 static void print_table (char * const * const argv)
2465 for (i = 0; argv[i] != NULL; i += 2)
2466 printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
2470 static void no_test_warnings (void)
2476 | name, _, _, _, [], _, _ ->
2477 pr " fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
2478 | name, _, _, _, tests, _, _ -> ()
2484 (* Generate the actual tests. Note that we generate the tests
2485 * in reverse order, deliberately, so that (in general) the
2486 * newest tests run first. This makes it quicker and easier to
2491 fun (name, _, _, _, tests, _, _) ->
2492 mapi (generate_one_test name) tests
2493 ) (List.rev all_functions) in
2494 let test_names = List.concat test_names in
2495 let nr_tests = List.length test_names in
2498 int main (int argc, char *argv[])
2505 int nr_tests, test_num = 0;
2507 no_test_warnings ();
2509 g = guestfs_create ();
2511 printf (\"guestfs_create FAILED\\n\");
2515 guestfs_set_error_handler (g, print_error, NULL);
2517 srcdir = getenv (\"srcdir\");
2518 if (!srcdir) srcdir = \".\";
2519 guestfs_set_path (g, srcdir);
2521 snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);
2522 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2527 if (lseek (fd, %d, SEEK_SET) == -1) {
2533 if (write (fd, &c, 1) == -1) {
2539 if (close (fd) == -1) {
2544 if (guestfs_add_drive (g, buf) == -1) {
2545 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2549 snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);
2550 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2555 if (lseek (fd, %d, SEEK_SET) == -1) {
2561 if (write (fd, &c, 1) == -1) {
2567 if (close (fd) == -1) {
2572 if (guestfs_add_drive (g, buf) == -1) {
2573 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2577 snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);
2578 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2583 if (lseek (fd, %d, SEEK_SET) == -1) {
2589 if (write (fd, &c, 1) == -1) {
2595 if (close (fd) == -1) {
2600 if (guestfs_add_drive (g, buf) == -1) {
2601 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2605 if (guestfs_launch (g) == -1) {
2606 printf (\"guestfs_launch FAILED\\n\");
2609 if (guestfs_wait_ready (g) == -1) {
2610 printf (\"guestfs_wait_ready FAILED\\n\");
2616 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
2620 pr " test_num++;\n";
2621 pr " printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
2622 pr " if (%s () == -1) {\n" test_name;
2623 pr " printf (\"%s FAILED\\n\");\n" test_name;
2629 pr " guestfs_close (g);\n";
2630 pr " snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);\n";
2631 pr " unlink (buf);\n";
2632 pr " snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);\n";
2633 pr " unlink (buf);\n";
2634 pr " snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);\n";
2635 pr " unlink (buf);\n";
2638 pr " if (failed > 0) {\n";
2639 pr " printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n";
2647 and generate_one_test name i (init, test) =
2648 let test_name = sprintf "test_%s_%d" name i in
2650 pr "static int %s (void)\n" test_name;
2656 pr " /* InitEmpty for %s (%d) */\n" name i;
2657 List.iter (generate_test_command_call test_name)
2661 pr " /* InitBasicFS for %s (%d): create ext2 on /dev/sda1 */\n" name i;
2662 List.iter (generate_test_command_call test_name)
2665 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2666 ["mkfs"; "ext2"; "/dev/sda1"];
2667 ["mount"; "/dev/sda1"; "/"]]
2668 | InitBasicFSonLVM ->
2669 pr " /* InitBasicFSonLVM for %s (%d): create ext2 on /dev/VG/LV */\n"
2671 List.iter (generate_test_command_call test_name)
2674 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2675 ["pvcreate"; "/dev/sda1"];
2676 ["vgcreate"; "VG"; "/dev/sda1"];
2677 ["lvcreate"; "LV"; "VG"; "8"];
2678 ["mkfs"; "ext2"; "/dev/VG/LV"];
2679 ["mount"; "/dev/VG/LV"; "/"]]
2682 let get_seq_last = function
2684 failwithf "%s: you cannot use [] (empty list) when expecting a command"
2687 let seq = List.rev seq in
2688 List.rev (List.tl seq), List.hd seq
2693 pr " /* TestRun for %s (%d) */\n" name i;
2694 List.iter (generate_test_command_call test_name) seq
2695 | TestOutput (seq, expected) ->
2696 pr " /* TestOutput for %s (%d) */\n" name i;
2697 let seq, last = get_seq_last seq in
2699 pr " if (strcmp (r, \"%s\") != 0) {\n" (c_quote expected);
2700 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r);\n" test_name (c_quote expected);
2704 List.iter (generate_test_command_call test_name) seq;
2705 generate_test_command_call ~test test_name last
2706 | TestOutputList (seq, expected) ->
2707 pr " /* TestOutputList for %s (%d) */\n" name i;
2708 let seq, last = get_seq_last seq in
2712 pr " if (!r[%d]) {\n" i;
2713 pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
2714 pr " print_strings (r);\n";
2717 pr " if (strcmp (r[%d], \"%s\") != 0) {\n" i (c_quote str);
2718 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r[%d]);\n" test_name (c_quote str) i;
2722 pr " if (r[%d] != NULL) {\n" (List.length expected);
2723 pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
2725 pr " print_strings (r);\n";
2729 List.iter (generate_test_command_call test_name) seq;
2730 generate_test_command_call ~test test_name last
2731 | TestOutputInt (seq, expected) ->
2732 pr " /* TestOutputInt for %s (%d) */\n" name i;
2733 let seq, last = get_seq_last seq in
2735 pr " if (r != %d) {\n" expected;
2736 pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\","
2742 List.iter (generate_test_command_call test_name) seq;
2743 generate_test_command_call ~test test_name last
2744 | TestOutputTrue seq ->
2745 pr " /* TestOutputTrue for %s (%d) */\n" name i;
2746 let seq, last = get_seq_last seq in
2749 pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n"
2754 List.iter (generate_test_command_call test_name) seq;
2755 generate_test_command_call ~test test_name last
2756 | TestOutputFalse seq ->
2757 pr " /* TestOutputFalse for %s (%d) */\n" name i;
2758 let seq, last = get_seq_last seq in
2761 pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n"
2766 List.iter (generate_test_command_call test_name) seq;
2767 generate_test_command_call ~test test_name last
2768 | TestOutputLength (seq, expected) ->
2769 pr " /* TestOutputLength for %s (%d) */\n" name i;
2770 let seq, last = get_seq_last seq in
2773 pr " for (j = 0; j < %d; ++j)\n" expected;
2774 pr " if (r[j] == NULL) {\n";
2775 pr " fprintf (stderr, \"%s: short list returned\\n\");\n"
2777 pr " print_strings (r);\n";
2780 pr " if (r[j] != NULL) {\n";
2781 pr " fprintf (stderr, \"%s: long list returned\\n\");\n"
2783 pr " print_strings (r);\n";
2787 List.iter (generate_test_command_call test_name) seq;
2788 generate_test_command_call ~test test_name last
2789 | TestOutputStruct (seq, checks) ->
2790 pr " /* TestOutputStruct for %s (%d) */\n" name i;
2791 let seq, last = get_seq_last seq in
2795 | CompareWithInt (field, expected) ->
2796 pr " if (r->%s != %d) {\n" field expected;
2797 pr " fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
2798 test_name field expected;
2799 pr " (int) r->%s);\n" field;
2802 | CompareWithString (field, expected) ->
2803 pr " if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
2804 pr " fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
2805 test_name field expected;
2806 pr " r->%s);\n" field;
2809 | CompareFieldsIntEq (field1, field2) ->
2810 pr " if (r->%s != r->%s) {\n" field1 field2;
2811 pr " fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
2812 test_name field1 field2;
2813 pr " (int) r->%s, (int) r->%s);\n" field1 field2;
2816 | CompareFieldsStrEq (field1, field2) ->
2817 pr " if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
2818 pr " fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
2819 test_name field1 field2;
2820 pr " r->%s, r->%s);\n" field1 field2;
2825 List.iter (generate_test_command_call test_name) seq;
2826 generate_test_command_call ~test test_name last
2827 | TestLastFail seq ->
2828 pr " /* TestLastFail for %s (%d) */\n" name i;
2829 let seq, last = get_seq_last seq in
2830 List.iter (generate_test_command_call test_name) seq;
2831 generate_test_command_call test_name ~expect_error:true last
2839 (* Generate the code to run a command, leaving the result in 'r'.
2840 * If you expect to get an error then you should set expect_error:true.
2842 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
2844 | [] -> assert false
2846 (* Look up the command to find out what args/ret it has. *)
2849 let _, style, _, _, _, _, _ =
2850 List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
2853 failwithf "%s: in test, command %s was not found" test_name name in
2855 if List.length (snd style) <> List.length args then
2856 failwithf "%s: in test, wrong number of args given to %s"
2867 | StringList n, arg ->
2868 pr " char *%s[] = {\n" n;
2869 let strs = string_split " " arg in
2871 fun str -> pr " \"%s\",\n" (c_quote str)
2875 ) (List.combine (snd style) args);
2878 match fst style with
2879 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
2880 | RInt64 _ -> pr " int64_t r;\n"; "-1"
2881 | RConstString _ -> pr " const char *r;\n"; "NULL"
2882 | RString _ -> pr " char *r;\n"; "NULL"
2883 | RStringList _ | RHashtable _ ->
2888 pr " struct guestfs_int_bool *r;\n"; "NULL"
2890 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
2892 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
2894 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
2896 pr " struct guestfs_stat *r;\n"; "NULL"
2898 pr " struct guestfs_statvfs *r;\n"; "NULL" in
2900 pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
2901 pr " r = guestfs_%s (g" name;
2903 (* Generate the parameters. *)
2906 | String _, arg -> pr ", \"%s\"" (c_quote arg)
2907 | OptString _, arg ->
2908 if arg = "NULL" then pr ", NULL" else pr ", \"%s\"" (c_quote arg)
2909 | StringList n, _ ->
2913 try int_of_string arg
2914 with Failure "int_of_string" ->
2915 failwithf "%s: expecting an int, but got '%s'" test_name arg in
2918 let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
2919 ) (List.combine (snd style) args);
2922 if not expect_error then
2923 pr " if (r == %s)\n" error_code
2925 pr " if (r != %s)\n" error_code;
2928 (* Insert the test code. *)
2934 (match fst style with
2935 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ -> ()
2936 | RString _ -> pr " free (r);\n"
2937 | RStringList _ | RHashtable _ ->
2938 pr " for (i = 0; r[i] != NULL; ++i)\n";
2939 pr " free (r[i]);\n";
2942 pr " guestfs_free_int_bool (r);\n"
2944 pr " guestfs_free_lvm_pv_list (r);\n"
2946 pr " guestfs_free_lvm_vg_list (r);\n"
2948 pr " guestfs_free_lvm_lv_list (r);\n"
2949 | RStat _ | RStatVFS _ ->
2956 let str = replace_str str "\r" "\\r" in
2957 let str = replace_str str "\n" "\\n" in
2958 let str = replace_str str "\t" "\\t" in
2961 (* Generate a lot of different functions for guestfish. *)
2962 and generate_fish_cmds () =
2963 generate_header CStyle GPLv2;
2967 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
2969 let all_functions_sorted =
2971 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
2972 ) all_functions_sorted in
2974 pr "#include <stdio.h>\n";
2975 pr "#include <stdlib.h>\n";
2976 pr "#include <string.h>\n";
2977 pr "#include <inttypes.h>\n";
2979 pr "#include <guestfs.h>\n";
2980 pr "#include \"fish.h\"\n";
2983 (* list_commands function, which implements guestfish -h *)
2984 pr "void list_commands (void)\n";
2986 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
2987 pr " list_builtin_commands ();\n";
2989 fun (name, _, _, flags, _, shortdesc, _) ->
2990 let name = replace_char name '_' '-' in
2991 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
2993 ) all_functions_sorted;
2994 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
2998 (* display_command function, which implements guestfish -h cmd *)
2999 pr "void display_command (const char *cmd)\n";
3002 fun (name, style, _, flags, _, shortdesc, longdesc) ->
3003 let name2 = replace_char name '_' '-' in
3005 try find_map (function FishAlias n -> Some n | _ -> None) flags
3006 with Not_found -> name in
3007 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
3009 match snd style with
3013 name2 (String.concat "> <" (List.map name_of_argt args)) in
3016 if List.mem ProtocolLimitWarning flags then
3017 ("\n\n" ^ protocol_limit_warning)
3020 (* For DangerWillRobinson commands, we should probably have
3021 * guestfish prompt before allowing you to use them (especially
3022 * in interactive mode). XXX
3026 if List.mem DangerWillRobinson flags then
3027 ("\n\n" ^ danger_will_robinson)
3030 let describe_alias =
3031 if name <> alias then
3032 sprintf "\n\nYou can use '%s' as an alias for this command." alias
3036 pr "strcasecmp (cmd, \"%s\") == 0" name;
3037 if name <> name2 then
3038 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
3039 if name <> alias then
3040 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
3042 pr " pod2text (\"%s - %s\", %S);\n"
3044 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
3047 pr " display_builtin_command (cmd);\n";
3051 (* print_{pv,vg,lv}_list functions *)
3055 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
3062 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
3064 pr " printf (\"%s: \");\n" name;
3065 pr " for (i = 0; i < 32; ++i)\n";
3066 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
3067 pr " printf (\"\\n\");\n"
3069 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
3071 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
3072 | name, `OptPercent ->
3073 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
3074 typ name name typ name;
3075 pr " else printf (\"%s: \\n\");\n" name
3079 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
3084 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
3085 pr " print_%s (&%ss->val[i]);\n" typ typ;
3088 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3090 (* print_{stat,statvfs} functions *)
3094 pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
3099 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
3103 ) ["stat", stat_cols; "statvfs", statvfs_cols];
3105 (* run_<action> actions *)
3107 fun (name, style, _, flags, _, _, _) ->
3108 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
3110 (match fst style with
3113 | RBool _ -> pr " int r;\n"
3114 | RInt64 _ -> pr " int64_t r;\n"
3115 | RConstString _ -> pr " const char *r;\n"
3116 | RString _ -> pr " char *r;\n"
3117 | RStringList _ | RHashtable _ -> pr " char **r;\n"
3118 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
3119 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
3120 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
3121 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
3122 | RStat _ -> pr " struct guestfs_stat *r;\n"
3123 | RStatVFS _ -> pr " struct guestfs_statvfs *r;\n"
3128 | OptString n -> pr " const char *%s;\n" n
3129 | StringList n -> pr " char **%s;\n" n
3130 | Bool n -> pr " int %s;\n" n
3131 | Int n -> pr " int %s;\n" n
3134 (* Check and convert parameters. *)
3135 let argc_expected = List.length (snd style) in
3136 pr " if (argc != %d) {\n" argc_expected;
3137 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
3139 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
3145 | String name -> pr " %s = argv[%d];\n" name i
3147 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
3149 | StringList name ->
3150 pr " %s = parse_string_list (argv[%d]);\n" name i
3152 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
3154 pr " %s = atoi (argv[%d]);\n" name i
3157 (* Call C API function. *)
3159 try find_map (function FishAction n -> Some n | _ -> None) flags
3160 with Not_found -> sprintf "guestfs_%s" name in
3162 generate_call_args ~handle:"g" style;
3165 (* Check return value for errors and display command results. *)
3166 (match fst style with
3167 | RErr -> pr " return r;\n"
3169 pr " if (r == -1) return -1;\n";
3170 pr " printf (\"%%d\\n\", r);\n";
3173 pr " if (r == -1) return -1;\n";
3174 pr " printf (\"%%\" PRIi64 \"\\n\", r);\n";
3177 pr " if (r == -1) return -1;\n";
3178 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
3181 pr " if (r == NULL) return -1;\n";
3182 pr " printf (\"%%s\\n\", r);\n";
3185 pr " if (r == NULL) return -1;\n";
3186 pr " printf (\"%%s\\n\", r);\n";
3190 pr " if (r == NULL) return -1;\n";
3191 pr " print_strings (r);\n";
3192 pr " free_strings (r);\n";
3195 pr " if (r == NULL) return -1;\n";
3196 pr " printf (\"%%d, %%s\\n\", r->i,\n";
3197 pr " r->b ? \"true\" : \"false\");\n";
3198 pr " guestfs_free_int_bool (r);\n";
3201 pr " if (r == NULL) return -1;\n";
3202 pr " print_pv_list (r);\n";
3203 pr " guestfs_free_lvm_pv_list (r);\n";
3206 pr " if (r == NULL) return -1;\n";
3207 pr " print_vg_list (r);\n";
3208 pr " guestfs_free_lvm_vg_list (r);\n";
3211 pr " if (r == NULL) return -1;\n";
3212 pr " print_lv_list (r);\n";
3213 pr " guestfs_free_lvm_lv_list (r);\n";
3216 pr " if (r == NULL) return -1;\n";
3217 pr " print_stat (r);\n";
3221 pr " if (r == NULL) return -1;\n";
3222 pr " print_statvfs (r);\n";
3226 pr " if (r == NULL) return -1;\n";
3227 pr " print_table (r);\n";
3228 pr " free_strings (r);\n";
3235 (* run_action function *)
3236 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
3239 fun (name, _, _, flags, _, _, _) ->
3240 let name2 = replace_char name '_' '-' in
3242 try find_map (function FishAlias n -> Some n | _ -> None) flags
3243 with Not_found -> name in
3245 pr "strcasecmp (cmd, \"%s\") == 0" name;
3246 if name <> name2 then
3247 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
3248 if name <> alias then
3249 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
3251 pr " return run_%s (cmd, argc, argv);\n" name;
3255 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
3262 (* Readline completion for guestfish. *)
3263 and generate_fish_completion () =
3264 generate_header CStyle GPLv2;
3268 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3278 #ifdef HAVE_LIBREADLINE
3279 #include <readline/readline.h>
3284 #ifdef HAVE_LIBREADLINE
3286 static const char *commands[] = {
3289 (* Get the commands and sort them, including the aliases. *)
3292 fun (name, _, _, flags, _, _, _) ->
3293 let name2 = replace_char name '_' '-' in
3295 try find_map (function FishAlias n -> Some n | _ -> None) flags
3296 with Not_found -> name in
3298 if name <> alias then [name2; alias] else [name2]
3300 let commands = List.flatten commands in
3301 let commands = List.sort compare commands in
3303 List.iter (pr " \"%s\",\n") commands;
3309 generator (const char *text, int state)
3311 static int index, len;
3316 len = strlen (text);
3319 while ((name = commands[index]) != NULL) {
3321 if (strncasecmp (name, text, len) == 0)
3322 return strdup (name);
3328 #endif /* HAVE_LIBREADLINE */
3330 char **do_completion (const char *text, int start, int end)
3332 char **matches = NULL;
3334 #ifdef HAVE_LIBREADLINE
3336 matches = rl_completion_matches (text, generator);
3343 (* Generate the POD documentation for guestfish. *)
3344 and generate_fish_actions_pod () =
3345 let all_functions_sorted =
3347 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3348 ) all_functions_sorted in
3351 fun (name, style, _, flags, _, _, longdesc) ->
3352 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
3353 let name = replace_char name '_' '-' in
3355 try find_map (function FishAlias n -> Some n | _ -> None) flags
3356 with Not_found -> name in
3358 pr "=head2 %s" name;
3359 if name <> alias then
3366 | String n -> pr " %s" n
3367 | OptString n -> pr " %s" n
3368 | StringList n -> pr " %s,..." n
3369 | Bool _ -> pr " true|false"
3370 | Int n -> pr " %s" n
3374 pr "%s\n\n" longdesc;
3376 if List.mem ProtocolLimitWarning flags then
3377 pr "%s\n\n" protocol_limit_warning;
3379 if List.mem DangerWillRobinson flags then
3380 pr "%s\n\n" danger_will_robinson
3381 ) all_functions_sorted
3383 (* Generate a C function prototype. *)
3384 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
3385 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
3387 ?handle name style =
3388 if extern then pr "extern ";
3389 if static then pr "static ";
3390 (match fst style with
3392 | RInt _ -> pr "int "
3393 | RInt64 _ -> pr "int64_t "
3394 | RBool _ -> pr "int "
3395 | RConstString _ -> pr "const char *"
3396 | RString _ -> pr "char *"
3397 | RStringList _ | RHashtable _ -> pr "char **"
3399 if not in_daemon then pr "struct guestfs_int_bool *"
3400 else pr "guestfs_%s_ret *" name
3402 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
3403 else pr "guestfs_lvm_int_pv_list *"
3405 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
3406 else pr "guestfs_lvm_int_vg_list *"
3408 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
3409 else pr "guestfs_lvm_int_lv_list *"
3411 if not in_daemon then pr "struct guestfs_stat *"
3412 else pr "guestfs_int_stat *"
3414 if not in_daemon then pr "struct guestfs_statvfs *"
3415 else pr "guestfs_int_statvfs *"
3417 pr "%s%s (" prefix name;
3418 if handle = None && List.length (snd style) = 0 then
3421 let comma = ref false in
3424 | Some handle -> pr "guestfs_h *%s" handle; comma := true
3428 if single_line then pr ", " else pr ",\n\t\t"
3434 | String n -> next (); pr "const char *%s" n
3435 | OptString n -> next (); pr "const char *%s" n
3436 | StringList n -> next (); pr "char * const* const %s" n
3437 | Bool n -> next (); pr "int %s" n
3438 | Int n -> next (); pr "int %s" n
3442 if semicolon then pr ";";
3443 if newline then pr "\n"
3445 (* Generate C call arguments, eg "(handle, foo, bar)" *)
3446 and generate_call_args ?handle style =
3448 let comma = ref false in
3451 | Some handle -> pr "%s" handle; comma := true
3455 if !comma then pr ", ";
3462 | Int n -> pr "%s" n
3466 (* Generate the OCaml bindings interface. *)
3467 and generate_ocaml_mli () =
3468 generate_header OCamlStyle LGPLv2;
3471 (** For API documentation you should refer to the C API
3472 in the guestfs(3) manual page. The OCaml API uses almost
3473 exactly the same calls. *)
3476 (** A [guestfs_h] handle. *)
3478 exception Error of string
3479 (** This exception is raised when there is an error. *)
3481 val create : unit -> t
3483 val close : t -> unit
3484 (** Handles are closed by the garbage collector when they become
3485 unreferenced, but callers can also call this in order to
3486 provide predictable cleanup. *)
3489 generate_ocaml_lvm_structure_decls ();
3491 generate_ocaml_stat_structure_decls ();
3495 fun (name, style, _, _, _, shortdesc, _) ->
3496 generate_ocaml_prototype name style;
3497 pr "(** %s *)\n" shortdesc;
3501 (* Generate the OCaml bindings implementation. *)
3502 and generate_ocaml_ml () =
3503 generate_header OCamlStyle LGPLv2;
3507 exception Error of string
3508 external create : unit -> t = \"ocaml_guestfs_create\"
3509 external close : t -> unit = \"ocaml_guestfs_close\"
3512 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
3516 generate_ocaml_lvm_structure_decls ();
3518 generate_ocaml_stat_structure_decls ();
3522 fun (name, style, _, _, _, shortdesc, _) ->
3523 generate_ocaml_prototype ~is_external:true name style;
3526 (* Generate the OCaml bindings C implementation. *)
3527 and generate_ocaml_c () =
3528 generate_header CStyle LGPLv2;
3535 #include <caml/config.h>
3536 #include <caml/alloc.h>
3537 #include <caml/callback.h>
3538 #include <caml/fail.h>
3539 #include <caml/memory.h>
3540 #include <caml/mlvalues.h>
3541 #include <caml/signals.h>
3543 #include <guestfs.h>
3545 #include \"guestfs_c.h\"
3547 /* Copy a hashtable of string pairs into an assoc-list. We return
3548 * the list in reverse order, but hashtables aren't supposed to be
3551 static CAMLprim value
3552 copy_table (char * const * argv)
3555 CAMLlocal5 (rv, pairv, kv, vv, cons);
3559 for (i = 0; argv[i] != NULL; i += 2) {
3560 kv = caml_copy_string (argv[i]);
3561 vv = caml_copy_string (argv[i+1]);
3562 pairv = caml_alloc (2, 0);
3563 Store_field (pairv, 0, kv);
3564 Store_field (pairv, 1, vv);
3565 cons = caml_alloc (2, 0);
3566 Store_field (cons, 1, rv);
3568 Store_field (cons, 0, pairv);
3576 (* LVM struct copy functions. *)
3579 let has_optpercent_col =
3580 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
3582 pr "static CAMLprim value\n";
3583 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
3585 pr " CAMLparam0 ();\n";
3586 if has_optpercent_col then
3587 pr " CAMLlocal3 (rv, v, v2);\n"
3589 pr " CAMLlocal2 (rv, v);\n";
3591 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
3596 pr " v = caml_copy_string (%s->%s);\n" typ name
3598 pr " v = caml_alloc_string (32);\n";
3599 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
3602 pr " v = caml_copy_int64 (%s->%s);\n" typ name
3603 | name, `OptPercent ->
3604 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
3605 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
3606 pr " v = caml_alloc (1, 0);\n";
3607 pr " Store_field (v, 0, v2);\n";
3608 pr " } else /* None */\n";
3609 pr " v = Val_int (0);\n";
3611 pr " Store_field (rv, %d, v);\n" i
3613 pr " CAMLreturn (rv);\n";
3617 pr "static CAMLprim value\n";
3618 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
3621 pr " CAMLparam0 ();\n";
3622 pr " CAMLlocal2 (rv, v);\n";
3625 pr " if (%ss->len == 0)\n" typ;
3626 pr " CAMLreturn (Atom (0));\n";
3628 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
3629 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
3630 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
3631 pr " caml_modify (&Field (rv, i), v);\n";
3633 pr " CAMLreturn (rv);\n";
3637 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3639 (* Stat copy functions. *)
3642 pr "static CAMLprim value\n";
3643 pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
3645 pr " CAMLparam0 ();\n";
3646 pr " CAMLlocal2 (rv, v);\n";
3648 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
3653 pr " v = caml_copy_int64 (%s->%s);\n" typ name
3655 pr " Store_field (rv, %d, v);\n" i
3657 pr " CAMLreturn (rv);\n";
3660 ) ["stat", stat_cols; "statvfs", statvfs_cols];
3664 fun (name, style, _, _, _, _, _) ->
3666 "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
3668 pr "CAMLprim value\n";
3669 pr "ocaml_guestfs_%s (value %s" name (List.hd params);
3670 List.iter (pr ", value %s") (List.tl params);
3675 | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
3676 pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
3677 pr " CAMLxparam%d (%s);\n"
3678 (List.length rest) (String.concat ", " rest)
3680 pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
3682 pr " CAMLlocal1 (rv);\n";
3685 pr " guestfs_h *g = Guestfs_val (gv);\n";
3686 pr " if (g == NULL)\n";
3687 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
3693 pr " const char *%s = String_val (%sv);\n" n n
3695 pr " const char *%s =\n" n;
3696 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
3699 pr " char **%s = ocaml_guestfs_strings_val (%sv);\n" n n
3701 pr " int %s = Bool_val (%sv);\n" n n
3703 pr " int %s = Int_val (%sv);\n" n n
3706 match fst style with
3707 | RErr -> pr " int r;\n"; "-1"
3708 | RInt _ -> pr " int r;\n"; "-1"
3709 | RInt64 _ -> pr " int64_t r;\n"; "-1"
3710 | RBool _ -> pr " int r;\n"; "-1"
3711 | RConstString _ -> pr " const char *r;\n"; "NULL"
3712 | RString _ -> pr " char *r;\n"; "NULL"
3718 pr " struct guestfs_int_bool *r;\n"; "NULL"
3720 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
3722 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
3724 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
3726 pr " struct guestfs_stat *r;\n"; "NULL"
3728 pr " struct guestfs_statvfs *r;\n"; "NULL"
3735 pr " caml_enter_blocking_section ();\n";
3736 pr " r = guestfs_%s " name;
3737 generate_call_args ~handle:"g" style;
3739 pr " caml_leave_blocking_section ();\n";
3744 pr " ocaml_guestfs_free_strings (%s);\n" n;
3745 | String _ | OptString _ | Bool _ | Int _ -> ()
3748 pr " if (r == %s)\n" error_code;
3749 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
3752 (match fst style with
3753 | RErr -> pr " rv = Val_unit;\n"
3754 | RInt _ -> pr " rv = Val_int (r);\n"
3756 pr " rv = caml_copy_int64 (r);\n"
3757 | RBool _ -> pr " rv = Val_bool (r);\n"
3758 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
3760 pr " rv = caml_copy_string (r);\n";
3763 pr " rv = caml_copy_string_array ((const char **) r);\n";
3764 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
3767 pr " rv = caml_alloc (2, 0);\n";
3768 pr " Store_field (rv, 0, Val_int (r->i));\n";
3769 pr " Store_field (rv, 1, Val_bool (r->b));\n";
3770 pr " guestfs_free_int_bool (r);\n";
3772 pr " rv = copy_lvm_pv_list (r);\n";
3773 pr " guestfs_free_lvm_pv_list (r);\n";
3775 pr " rv = copy_lvm_vg_list (r);\n";
3776 pr " guestfs_free_lvm_vg_list (r);\n";
3778 pr " rv = copy_lvm_lv_list (r);\n";
3779 pr " guestfs_free_lvm_lv_list (r);\n";
3781 pr " rv = copy_stat (r);\n";
3784 pr " rv = copy_statvfs (r);\n";
3787 pr " rv = copy_table (r);\n";
3788 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
3792 pr " CAMLreturn (rv);\n";
3796 if List.length params > 5 then (
3797 pr "CAMLprim value\n";
3798 pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
3800 pr " return ocaml_guestfs_%s (argv[0]" name;
3801 iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
3808 and generate_ocaml_lvm_structure_decls () =
3811 pr "type lvm_%s = {\n" typ;
3814 | name, `String -> pr " %s : string;\n" name
3815 | name, `UUID -> pr " %s : string;\n" name
3816 | name, `Bytes -> pr " %s : int64;\n" name
3817 | name, `Int -> pr " %s : int64;\n" name
3818 | name, `OptPercent -> pr " %s : float option;\n" name
3822 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
3824 and generate_ocaml_stat_structure_decls () =
3827 pr "type %s = {\n" typ;
3830 | name, `Int -> pr " %s : int64;\n" name
3834 ) ["stat", stat_cols; "statvfs", statvfs_cols]
3836 and generate_ocaml_prototype ?(is_external = false) name style =
3837 if is_external then pr "external " else pr "val ";
3838 pr "%s : t -> " name;
3841 | String _ -> pr "string -> "
3842 | OptString _ -> pr "string option -> "
3843 | StringList _ -> pr "string array -> "
3844 | Bool _ -> pr "bool -> "
3845 | Int _ -> pr "int -> "
3847 (match fst style with
3848 | RErr -> pr "unit" (* all errors are turned into exceptions *)
3849 | RInt _ -> pr "int"
3850 | RInt64 _ -> pr "int64"
3851 | RBool _ -> pr "bool"
3852 | RConstString _ -> pr "string"
3853 | RString _ -> pr "string"
3854 | RStringList _ -> pr "string array"
3855 | RIntBool _ -> pr "int * bool"
3856 | RPVList _ -> pr "lvm_pv array"
3857 | RVGList _ -> pr "lvm_vg array"
3858 | RLVList _ -> pr "lvm_lv array"
3859 | RStat _ -> pr "stat"
3860 | RStatVFS _ -> pr "statvfs"
3861 | RHashtable _ -> pr "(string * string) list"
3863 if is_external then (
3865 if List.length (snd style) + 1 > 5 then
3866 pr "\"ocaml_guestfs_%s_byte\" " name;
3867 pr "\"ocaml_guestfs_%s\"" name
3871 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
3872 and generate_perl_xs () =
3873 generate_header CStyle LGPLv2;
3876 #include \"EXTERN.h\"
3880 #include <guestfs.h>
3883 #define PRId64 \"lld\"
3887 my_newSVll(long long val) {
3888 #ifdef USE_64_BIT_ALL
3889 return newSViv(val);
3893 len = snprintf(buf, 100, \"%%\" PRId64, val);
3894 return newSVpv(buf, len);
3899 #define PRIu64 \"llu\"
3903 my_newSVull(unsigned long long val) {
3904 #ifdef USE_64_BIT_ALL
3905 return newSVuv(val);
3909 len = snprintf(buf, 100, \"%%\" PRIu64, val);
3910 return newSVpv(buf, len);
3914 /* http://www.perlmonks.org/?node_id=680842 */
3916 XS_unpack_charPtrPtr (SV *arg) {
3921 if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV) {
3922 croak (\"array reference expected\");
3925 av = (AV *)SvRV (arg);
3926 ret = (char **)malloc (av_len (av) + 1 + 1);
3928 for (i = 0; i <= av_len (av); i++) {
3929 SV **elem = av_fetch (av, i, 0);
3931 if (!elem || !*elem)
3932 croak (\"missing element in list\");
3934 ret[i] = SvPV_nolen (*elem);
3942 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
3947 RETVAL = guestfs_create ();
3949 croak (\"could not create guestfs handle\");
3950 guestfs_set_error_handler (RETVAL, NULL, NULL);
3963 fun (name, style, _, _, _, _, _) ->
3964 (match fst style with
3965 | RErr -> pr "void\n"
3966 | RInt _ -> pr "SV *\n"
3967 | RInt64 _ -> pr "SV *\n"
3968 | RBool _ -> pr "SV *\n"
3969 | RConstString _ -> pr "SV *\n"
3970 | RString _ -> pr "SV *\n"
3973 | RPVList _ | RVGList _ | RLVList _
3974 | RStat _ | RStatVFS _
3976 pr "void\n" (* all lists returned implictly on the stack *)
3978 (* Call and arguments. *)
3980 generate_call_args ~handle:"g" style;
3982 pr " guestfs_h *g;\n";
3985 | String n -> pr " char *%s;\n" n
3986 | OptString n -> pr " char *%s;\n" n
3987 | StringList n -> pr " char **%s;\n" n
3988 | Bool n -> pr " int %s;\n" n
3989 | Int n -> pr " int %s;\n" n
3992 let do_cleanups () =
3999 | StringList n -> pr " free (%s);\n" n
4004 (match fst style with
4009 pr " r = guestfs_%s " name;
4010 generate_call_args ~handle:"g" style;
4013 pr " if (r == -1)\n";
4014 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4020 pr " %s = guestfs_%s " n name;
4021 generate_call_args ~handle:"g" style;
4024 pr " if (%s == -1)\n" n;
4025 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4026 pr " RETVAL = newSViv (%s);\n" n;
4031 pr " int64_t %s;\n" n;
4033 pr " %s = guestfs_%s " n name;
4034 generate_call_args ~handle:"g" style;
4037 pr " if (%s == -1)\n" n;
4038 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4039 pr " RETVAL = my_newSVll (%s);\n" n;
4044 pr " const char *%s;\n" n;
4046 pr " %s = guestfs_%s " n name;
4047 generate_call_args ~handle:"g" style;
4050 pr " if (%s == NULL)\n" n;
4051 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4052 pr " RETVAL = newSVpv (%s, 0);\n" n;
4057 pr " char *%s;\n" n;
4059 pr " %s = guestfs_%s " n name;
4060 generate_call_args ~handle:"g" style;
4063 pr " if (%s == NULL)\n" n;
4064 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4065 pr " RETVAL = newSVpv (%s, 0);\n" n;
4066 pr " free (%s);\n" n;
4069 | RStringList n | RHashtable n ->
4071 pr " char **%s;\n" n;
4074 pr " %s = guestfs_%s " n name;
4075 generate_call_args ~handle:"g" style;
4078 pr " if (%s == NULL)\n" n;
4079 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4080 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
4081 pr " EXTEND (SP, n);\n";
4082 pr " for (i = 0; i < n; ++i) {\n";
4083 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
4084 pr " free (%s[i]);\n" n;
4086 pr " free (%s);\n" n;
4089 pr " struct guestfs_int_bool *r;\n";
4091 pr " r = guestfs_%s " name;
4092 generate_call_args ~handle:"g" style;
4095 pr " if (r == NULL)\n";
4096 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4097 pr " EXTEND (SP, 2);\n";
4098 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
4099 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
4100 pr " guestfs_free_int_bool (r);\n";
4102 generate_perl_lvm_code "pv" pv_cols name style n do_cleanups
4104 generate_perl_lvm_code "vg" vg_cols name style n do_cleanups
4106 generate_perl_lvm_code "lv" lv_cols name style n do_cleanups
4108 generate_perl_stat_code "stat" stat_cols name style n do_cleanups
4110 generate_perl_stat_code
4111 "statvfs" statvfs_cols name style n do_cleanups
4117 and generate_perl_lvm_code typ cols name style n do_cleanups =
4119 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
4123 pr " %s = guestfs_%s " n name;
4124 generate_call_args ~handle:"g" style;
4127 pr " if (%s == NULL)\n" n;
4128 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4129 pr " EXTEND (SP, %s->len);\n" n;
4130 pr " for (i = 0; i < %s->len; ++i) {\n" n;
4131 pr " hv = newHV ();\n";
4135 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
4136 name (String.length name) n name
4138 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
4139 name (String.length name) n name
4141 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
4142 name (String.length name) n name
4144 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
4145 name (String.length name) n name
4146 | name, `OptPercent ->
4147 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
4148 name (String.length name) n name
4150 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
4152 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
4154 and generate_perl_stat_code typ cols name style n do_cleanups =
4156 pr " struct guestfs_%s *%s;\n" typ n;
4158 pr " %s = guestfs_%s " n name;
4159 generate_call_args ~handle:"g" style;
4162 pr " if (%s == NULL)\n" n;
4163 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4164 pr " EXTEND (SP, %d);\n" (List.length cols);
4168 pr " PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n" n name
4170 pr " free (%s);\n" n
4172 (* Generate Sys/Guestfs.pm. *)
4173 and generate_perl_pm () =
4174 generate_header HashStyle LGPLv2;
4181 Sys::Guestfs - Perl bindings for libguestfs
4187 my $h = Sys::Guestfs->new ();
4188 $h->add_drive ('guest.img');
4191 $h->mount ('/dev/sda1', '/');
4192 $h->touch ('/hello');
4197 The C<Sys::Guestfs> module provides a Perl XS binding to the
4198 libguestfs API for examining and modifying virtual machine
4201 Amongst the things this is good for: making batch configuration
4202 changes to guests, getting disk used/free statistics (see also:
4203 virt-df), migrating between virtualization systems (see also:
4204 virt-p2v), performing partial backups, performing partial guest
4205 clones, cloning guests and changing registry/UUID/hostname info, and
4208 Libguestfs uses Linux kernel and qemu code, and can access any type of
4209 guest filesystem that Linux and qemu can, including but not limited
4210 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
4211 schemes, qcow, qcow2, vmdk.
4213 Libguestfs provides ways to enumerate guest storage (eg. partitions,
4214 LVs, what filesystem is in each LV, etc.). It can also run commands
4215 in the context of the guest. Also you can access filesystems over FTP.
4219 All errors turn into calls to C<croak> (see L<Carp(3)>).
4227 package Sys::Guestfs;
4233 XSLoader::load ('Sys::Guestfs');
4235 =item $h = Sys::Guestfs->new ();
4237 Create a new guestfs handle.
4243 my $class = ref ($proto) || $proto;
4245 my $self = Sys::Guestfs::_create ();
4246 bless $self, $class;
4252 (* Actions. We only need to print documentation for these as
4253 * they are pulled in from the XS code automatically.
4256 fun (name, style, _, flags, _, _, longdesc) ->
4257 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
4259 generate_perl_prototype name style;
4261 pr "%s\n\n" longdesc;
4262 if List.mem ProtocolLimitWarning flags then
4263 pr "%s\n\n" protocol_limit_warning;
4264 if List.mem DangerWillRobinson flags then
4265 pr "%s\n\n" danger_will_robinson
4266 ) all_functions_sorted;
4278 Copyright (C) 2009 Red Hat Inc.
4282 Please see the file COPYING.LIB for the full license.
4286 L<guestfs(3)>, L<guestfish(1)>.
4291 and generate_perl_prototype name style =
4292 (match fst style with
4298 | RString n -> pr "$%s = " n
4299 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
4303 | RLVList n -> pr "@%s = " n
4306 | RHashtable n -> pr "%%%s = " n
4309 let comma = ref false in
4312 if !comma then pr ", ";
4315 | String n | OptString n | Bool n | Int n ->
4322 (* Generate Python C module. *)
4323 and generate_python_c () =
4324 generate_header CStyle LGPLv2;
4333 #include \"guestfs.h\"
4341 get_handle (PyObject *obj)
4344 assert (obj != Py_None);
4345 return ((Pyguestfs_Object *) obj)->g;
4349 put_handle (guestfs_h *g)
4353 PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
4356 /* This list should be freed (but not the strings) after use. */
4357 static const char **
4358 get_string_list (PyObject *obj)
4365 if (!PyList_Check (obj)) {
4366 PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
4370 len = PyList_Size (obj);
4371 r = malloc (sizeof (char *) * (len+1));
4373 PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
4377 for (i = 0; i < len; ++i)
4378 r[i] = PyString_AsString (PyList_GetItem (obj, i));
4385 put_string_list (char * const * const argv)
4390 for (argc = 0; argv[argc] != NULL; ++argc)
4393 list = PyList_New (argc);
4394 for (i = 0; i < argc; ++i)
4395 PyList_SetItem (list, i, PyString_FromString (argv[i]));
4401 put_table (char * const * const argv)
4403 PyObject *list, *item;
4406 for (argc = 0; argv[argc] != NULL; ++argc)
4409 list = PyList_New (argc >> 1);
4410 for (i = 0; i < argc; i += 2) {
4412 item = PyTuple_New (2);
4413 PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
4414 PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
4415 PyList_SetItem (list, i >> 1, item);
4422 free_strings (char **argv)
4426 for (argc = 0; argv[argc] != NULL; ++argc)
4432 py_guestfs_create (PyObject *self, PyObject *args)
4436 g = guestfs_create ();
4438 PyErr_SetString (PyExc_RuntimeError,
4439 \"guestfs.create: failed to allocate handle\");
4442 guestfs_set_error_handler (g, NULL, NULL);
4443 return put_handle (g);
4447 py_guestfs_close (PyObject *self, PyObject *args)
4452 if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
4454 g = get_handle (py_g);
4458 Py_INCREF (Py_None);
4464 (* LVM structures, turned into Python dictionaries. *)
4467 pr "static PyObject *\n";
4468 pr "put_lvm_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
4470 pr " PyObject *dict;\n";
4472 pr " dict = PyDict_New ();\n";
4476 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4477 pr " PyString_FromString (%s->%s));\n"
4480 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4481 pr " PyString_FromStringAndSize (%s->%s, 32));\n"
4484 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4485 pr " PyLong_FromUnsignedLongLong (%s->%s));\n"
4488 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4489 pr " PyLong_FromLongLong (%s->%s));\n"
4491 | name, `OptPercent ->
4492 pr " if (%s->%s >= 0)\n" typ name;
4493 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4494 pr " PyFloat_FromDouble ((double) %s->%s));\n"
4497 pr " Py_INCREF (Py_None);\n";
4498 pr " PyDict_SetItemString (dict, \"%s\", Py_None);" name;
4501 pr " return dict;\n";
4505 pr "static PyObject *\n";
4506 pr "put_lvm_%s_list (struct guestfs_lvm_%s_list *%ss)\n" typ typ typ;
4508 pr " PyObject *list;\n";
4511 pr " list = PyList_New (%ss->len);\n" typ;
4512 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
4513 pr " PyList_SetItem (list, i, put_lvm_%s (&%ss->val[i]));\n" typ typ;
4514 pr " return list;\n";
4517 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
4519 (* Stat structures, turned into Python dictionaries. *)
4522 pr "static PyObject *\n";
4523 pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
4525 pr " PyObject *dict;\n";
4527 pr " dict = PyDict_New ();\n";
4531 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4532 pr " PyLong_FromLongLong (%s->%s));\n"
4535 pr " return dict;\n";
4538 ) ["stat", stat_cols; "statvfs", statvfs_cols];
4540 (* Python wrapper functions. *)
4542 fun (name, style, _, _, _, _, _) ->
4543 pr "static PyObject *\n";
4544 pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
4547 pr " PyObject *py_g;\n";
4548 pr " guestfs_h *g;\n";
4549 pr " PyObject *py_r;\n";
4552 match fst style with
4553 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
4554 | RInt64 _ -> pr " int64_t r;\n"; "-1"
4555 | RConstString _ -> pr " const char *r;\n"; "NULL"
4556 | RString _ -> pr " char *r;\n"; "NULL"
4557 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
4558 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
4559 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
4560 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
4561 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
4562 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
4563 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
4567 | String n -> pr " const char *%s;\n" n
4568 | OptString n -> pr " const char *%s;\n" n
4570 pr " PyObject *py_%s;\n" n;
4571 pr " const char **%s;\n" n
4572 | Bool n -> pr " int %s;\n" n
4573 | Int n -> pr " int %s;\n" n
4578 (* Convert the parameters. *)
4579 pr " if (!PyArg_ParseTuple (args, (char *) \"O";
4582 | String _ -> pr "s"
4583 | OptString _ -> pr "z"
4584 | StringList _ -> pr "O"
4585 | Bool _ -> pr "i" (* XXX Python has booleans? *)
4588 pr ":guestfs_%s\",\n" name;
4592 | String n -> pr ", &%s" n
4593 | OptString n -> pr ", &%s" n
4594 | StringList n -> pr ", &py_%s" n
4595 | Bool n -> pr ", &%s" n
4596 | Int n -> pr ", &%s" n
4600 pr " return NULL;\n";
4602 pr " g = get_handle (py_g);\n";
4605 | String _ | OptString _ | Bool _ | Int _ -> ()
4607 pr " %s = get_string_list (py_%s);\n" n n;
4608 pr " if (!%s) return NULL;\n" n
4613 pr " r = guestfs_%s " name;
4614 generate_call_args ~handle:"g" style;
4619 | String _ | OptString _ | Bool _ | Int _ -> ()
4621 pr " free (%s);\n" n
4624 pr " if (r == %s) {\n" error_code;
4625 pr " PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
4626 pr " return NULL;\n";
4630 (match fst style with
4632 pr " Py_INCREF (Py_None);\n";
4633 pr " py_r = Py_None;\n"
4635 | RBool _ -> pr " py_r = PyInt_FromLong ((long) r);\n"
4636 | RInt64 _ -> pr " py_r = PyLong_FromLongLong (r);\n"
4637 | RConstString _ -> pr " py_r = PyString_FromString (r);\n"
4639 pr " py_r = PyString_FromString (r);\n";
4642 pr " py_r = put_string_list (r);\n";
4643 pr " free_strings (r);\n"
4645 pr " py_r = PyTuple_New (2);\n";
4646 pr " PyTuple_SetItem (py_r, 0, PyInt_FromLong ((long) r->i));\n";
4647 pr " PyTuple_SetItem (py_r, 1, PyInt_FromLong ((long) r->b));\n";
4648 pr " guestfs_free_int_bool (r);\n"
4650 pr " py_r = put_lvm_pv_list (r);\n";
4651 pr " guestfs_free_lvm_pv_list (r);\n"
4653 pr " py_r = put_lvm_vg_list (r);\n";
4654 pr " guestfs_free_lvm_vg_list (r);\n"
4656 pr " py_r = put_lvm_lv_list (r);\n";
4657 pr " guestfs_free_lvm_lv_list (r);\n"
4659 pr " py_r = put_stat (r);\n";
4662 pr " py_r = put_statvfs (r);\n";
4665 pr " py_r = put_table (r);\n";
4666 pr " free_strings (r);\n"
4669 pr " return py_r;\n";
4674 (* Table of functions. *)
4675 pr "static PyMethodDef methods[] = {\n";
4676 pr " { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
4677 pr " { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
4679 fun (name, _, _, _, _, _, _) ->
4680 pr " { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
4683 pr " { NULL, NULL, 0, NULL }\n";
4687 (* Init function. *)
4690 initlibguestfsmod (void)
4692 static int initialized = 0;
4694 if (initialized) return;
4695 Py_InitModule ((char *) \"libguestfsmod\", methods);
4700 (* Generate Python module. *)
4701 and generate_python_py () =
4702 generate_header HashStyle LGPLv2;
4704 pr "import libguestfsmod\n";
4706 pr "class GuestFS:\n";
4707 pr " def __init__ (self):\n";
4708 pr " self._o = libguestfsmod.create ()\n";
4710 pr " def __del__ (self):\n";
4711 pr " libguestfsmod.close (self._o)\n";
4715 fun (name, style, _, _, _, _, _) ->
4717 generate_call_args ~handle:"self" style;
4719 pr " return libguestfsmod.%s " name;
4720 generate_call_args ~handle:"self._o" style;
4725 let output_to filename =
4726 let filename_new = filename ^ ".new" in
4727 chan := open_out filename_new;
4731 Unix.rename filename_new filename;
4732 printf "written %s\n%!" filename;
4740 if not (Sys.file_exists "configure.ac") then (
4742 You are probably running this from the wrong directory.
4743 Run it from the top source directory using the command
4749 let close = output_to "src/guestfs_protocol.x" in
4753 let close = output_to "src/guestfs-structs.h" in
4754 generate_structs_h ();
4757 let close = output_to "src/guestfs-actions.h" in
4758 generate_actions_h ();
4761 let close = output_to "src/guestfs-actions.c" in
4762 generate_client_actions ();
4765 let close = output_to "daemon/actions.h" in
4766 generate_daemon_actions_h ();
4769 let close = output_to "daemon/stubs.c" in
4770 generate_daemon_actions ();
4773 let close = output_to "tests.c" in
4777 let close = output_to "fish/cmds.c" in
4778 generate_fish_cmds ();
4781 let close = output_to "fish/completion.c" in
4782 generate_fish_completion ();
4785 let close = output_to "guestfs-structs.pod" in
4786 generate_structs_pod ();
4789 let close = output_to "guestfs-actions.pod" in
4790 generate_actions_pod ();
4793 let close = output_to "guestfish-actions.pod" in
4794 generate_fish_actions_pod ();
4797 let close = output_to "ocaml/guestfs.mli" in
4798 generate_ocaml_mli ();
4801 let close = output_to "ocaml/guestfs.ml" in
4802 generate_ocaml_ml ();
4805 let close = output_to "ocaml/guestfs_c_actions.c" in
4806 generate_ocaml_c ();
4809 let close = output_to "perl/Guestfs.xs" in
4810 generate_perl_xs ();
4813 let close = output_to "perl/lib/Sys/Guestfs.pm" in
4814 generate_perl_pm ();
4817 let close = output_to "python/guestfs-py.c" in
4818 generate_python_c ();
4821 let close = output_to "python/guestfs.py" in
4822 generate_python_py ();