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) *)
101 (* These are treated as filenames (simple string parameters) in
102 * the C API and bindings. But in the RPC protocol, we transfer
103 * the actual file content up to or down from the daemon.
104 * FileIn: local machine -> daemon (in request)
105 * FileOut: daemon -> local machine (in reply)
106 * In guestfish (only), the special name "-" means read from
107 * stdin or write to stdout.
113 | ProtocolLimitWarning (* display warning about protocol size limits *)
114 | DangerWillRobinson (* flags particularly dangerous commands *)
115 | FishAlias of string (* provide an alias for this cmd in guestfish *)
116 | FishAction of string (* call this function in guestfish *)
117 | NotInFish (* do not export via guestfish *)
119 let protocol_limit_warning =
120 "Because of the message protocol, there is a transfer limit
121 of somewhere between 2MB and 4MB. To transfer large files you should use
124 let danger_will_robinson =
125 "B<This command is dangerous. Without careful use you
126 can easily destroy all your data>."
128 (* You can supply zero or as many tests as you want per API call.
130 * Note that the test environment has 3 block devices, of size 500MB,
131 * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc).
132 * Note for partitioning purposes, the 500MB device has 63 cylinders.
134 * To be able to run the tests in a reasonable amount of time,
135 * the virtual machine and block devices are reused between tests.
136 * So don't try testing kill_subprocess :-x
138 * Between each test we umount-all and lvm-remove-all (except InitNone).
140 * Don't assume anything about the previous contents of the block
141 * devices. Use 'Init*' to create some initial scenarios.
143 type tests = (test_init * test) list
145 (* Run the command sequence and just expect nothing to fail. *)
147 (* Run the command sequence and expect the output of the final
148 * command to be the string.
150 | TestOutput of seq * string
151 (* Run the command sequence and expect the output of the final
152 * command to be the list of strings.
154 | TestOutputList of seq * string list
155 (* Run the command sequence and expect the output of the final
156 * command to be the integer.
158 | TestOutputInt of seq * int
159 (* Run the command sequence and expect the output of the final
160 * command to be a true value (!= 0 or != NULL).
162 | TestOutputTrue of seq
163 (* Run the command sequence and expect the output of the final
164 * command to be a false value (== 0 or == NULL, but not an error).
166 | TestOutputFalse of seq
167 (* Run the command sequence and expect the output of the final
168 * command to be a list of the given length (but don't care about
171 | TestOutputLength of seq * int
172 (* Run the command sequence and expect the output of the final
173 * command to be a structure.
175 | TestOutputStruct of seq * test_field_compare list
176 (* Run the command sequence and expect the final command (only)
179 | TestLastFail of seq
181 and test_field_compare =
182 | CompareWithInt of string * int
183 | CompareWithString of string * string
184 | CompareFieldsIntEq of string * string
185 | CompareFieldsStrEq of string * string
187 (* Some initial scenarios for testing. *)
189 (* Do nothing, block devices could contain random stuff including
190 * LVM PVs, and some filesystems might be mounted. This is usually
194 (* Block devices are empty and no filesystems are mounted. *)
196 (* /dev/sda contains a single partition /dev/sda1, which is formatted
197 * as ext2, empty [except for lost+found] and mounted on /.
198 * /dev/sdb and /dev/sdc may have random content.
203 * /dev/sda1 (is a PV):
204 * /dev/VG/LV (size 8MB):
205 * formatted as ext2, empty [except for lost+found], mounted on /
206 * /dev/sdb and /dev/sdc may have random content.
210 (* Sequence of commands for testing. *)
212 and cmd = string list
214 (* Note about long descriptions: When referring to another
215 * action, use the format C<guestfs_other> (ie. the full name of
216 * the C function). This will be replaced as appropriate in other
219 * Apart from that, long descriptions are just perldoc paragraphs.
222 let non_daemon_functions = [
223 ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
225 "launch the qemu subprocess",
227 Internally libguestfs is implemented by running a virtual machine
230 You should call this after configuring the handle
231 (eg. adding drives) but before performing any actions.");
233 ("wait_ready", (RErr, []), -1, [NotInFish],
235 "wait until the qemu subprocess launches",
237 Internally libguestfs is implemented by running a virtual machine
240 You should call this after C<guestfs_launch> to wait for the launch
243 ("kill_subprocess", (RErr, []), -1, [],
245 "kill the qemu subprocess",
247 This kills the qemu subprocess. You should never need to call this.");
249 ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
251 "add an image to examine or modify",
253 This function adds a virtual machine disk image C<filename> to the
254 guest. The first time you call this function, the disk appears as IDE
255 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
258 You don't necessarily need to be root when using libguestfs. However
259 you obviously do need sufficient permissions to access the filename
260 for whatever operations you want to perform (ie. read access if you
261 just want to read the image or write access if you want to modify the
264 This is equivalent to the qemu parameter C<-drive file=filename>.");
266 ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
268 "add a CD-ROM disk image to examine",
270 This function adds a virtual CD-ROM disk image to the guest.
272 This is equivalent to the qemu parameter C<-cdrom filename>.");
274 ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
276 "add qemu parameters",
278 This can be used to add arbitrary qemu command line parameters
279 of the form C<-param value>. Actually it's not quite arbitrary - we
280 prevent you from setting some parameters which would interfere with
281 parameters that we use.
283 The first character of C<param> string must be a C<-> (dash).
285 C<value> can be NULL.");
287 ("set_path", (RErr, [String "path"]), -1, [FishAlias "path"],
289 "set the search path",
291 Set the path that libguestfs searches for kernel and initrd.img.
293 The default is C<$libdir/guestfs> unless overridden by setting
294 C<LIBGUESTFS_PATH> environment variable.
296 The string C<path> is stashed in the libguestfs handle, so the caller
297 must make sure it remains valid for the lifetime of the handle.
299 Setting C<path> to C<NULL> restores the default path.");
301 ("get_path", (RConstString "path", []), -1, [],
303 "get the search path",
305 Return the current search path.
307 This is always non-NULL. If it wasn't set already, then this will
308 return the default path.");
310 ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
314 If C<autosync> is true, this enables autosync. Libguestfs will make a
315 best effort attempt to run C<guestfs_sync> when the handle is closed
316 (also if the program exits without closing handles).");
318 ("get_autosync", (RBool "autosync", []), -1, [],
322 Get the autosync flag.");
324 ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
328 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
330 Verbose messages are disabled unless the environment variable
331 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
333 ("get_verbose", (RBool "verbose", []), -1, [],
337 This returns the verbose messages flag.");
339 ("is_ready", (RBool "ready", []), -1, [],
341 "is ready to accept commands",
343 This returns true iff this handle is ready to accept commands
344 (in the C<READY> state).
346 For more information on states, see L<guestfs(3)>.");
348 ("is_config", (RBool "config", []), -1, [],
350 "is in configuration state",
352 This returns true iff this handle is being configured
353 (in the C<CONFIG> state).
355 For more information on states, see L<guestfs(3)>.");
357 ("is_launching", (RBool "launching", []), -1, [],
359 "is launching subprocess",
361 This returns true iff this handle is launching the subprocess
362 (in the C<LAUNCHING> state).
364 For more information on states, see L<guestfs(3)>.");
366 ("is_busy", (RBool "busy", []), -1, [],
368 "is busy processing a command",
370 This returns true iff this handle is busy processing a command
371 (in the C<BUSY> state).
373 For more information on states, see L<guestfs(3)>.");
375 ("get_state", (RInt "state", []), -1, [],
377 "get the current state",
379 This returns the current state as an opaque integer. This is
380 only useful for printing debug and internal error messages.
382 For more information on states, see L<guestfs(3)>.");
385 let daemon_functions = [
386 ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
387 [InitEmpty, TestOutput (
388 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
389 ["mkfs"; "ext2"; "/dev/sda1"];
390 ["mount"; "/dev/sda1"; "/"];
391 ["write_file"; "/new"; "new file contents"; "0"];
392 ["cat"; "/new"]], "new file contents")],
393 "mount a guest disk at a position in the filesystem",
395 Mount a guest disk at a position in the filesystem. Block devices
396 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
397 the guest. If those block devices contain partitions, they will have
398 the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
401 The rules are the same as for L<mount(2)>: A filesystem must
402 first be mounted on C</> before others can be mounted. Other
403 filesystems can only be mounted on directories which already
406 The mounted filesystem is writable, if we have sufficient permissions
407 on the underlying device.
409 The filesystem options C<sync> and C<noatime> are set with this
410 call, in order to improve reliability.");
412 ("sync", (RErr, []), 2, [],
413 [ InitEmpty, TestRun [["sync"]]],
414 "sync disks, writes are flushed through to the disk image",
416 This syncs the disk, so that any writes are flushed through to the
417 underlying disk image.
419 You should always call this if you have modified a disk image, before
420 closing the handle.");
422 ("touch", (RErr, [String "path"]), 3, [],
423 [InitBasicFS, TestOutputTrue (
425 ["exists"; "/new"]])],
426 "update file timestamps or create a new file",
428 Touch acts like the L<touch(1)> command. It can be used to
429 update the timestamps on a file, or, if the file does not exist,
430 to create a new zero-length file.");
432 ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
433 [InitBasicFS, TestOutput (
434 [["write_file"; "/new"; "new file contents"; "0"];
435 ["cat"; "/new"]], "new file contents")],
436 "list the contents of a file",
438 Return the contents of the file named C<path>.
440 Note that this function cannot correctly handle binary files
441 (specifically, files containing C<\\0> character which is treated
442 as end of string). For those you need to use the C<guestfs_download>
443 function which has a more complex interface.");
445 ("ll", (RString "listing", [String "directory"]), 5, [],
446 [], (* XXX Tricky to test because it depends on the exact format
447 * of the 'ls -l' command, which changes between F10 and F11.
449 "list the files in a directory (long format)",
451 List the files in C<directory> (relative to the root directory,
452 there is no cwd) in the format of 'ls -la'.
454 This command is mostly useful for interactive sessions. It
455 is I<not> intended that you try to parse the output string.");
457 ("ls", (RStringList "listing", [String "directory"]), 6, [],
458 [InitBasicFS, TestOutputList (
461 ["touch"; "/newest"];
462 ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
463 "list the files in a directory",
465 List the files in C<directory> (relative to the root directory,
466 there is no cwd). The '.' and '..' entries are not returned, but
467 hidden files are shown.
469 This command is mostly useful for interactive sessions. Programs
470 should probably use C<guestfs_readdir> instead.");
472 ("list_devices", (RStringList "devices", []), 7, [],
473 [InitEmpty, TestOutputList (
474 [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"])],
475 "list the block devices",
477 List all the block devices.
479 The full block device names are returned, eg. C</dev/sda>");
481 ("list_partitions", (RStringList "partitions", []), 8, [],
482 [InitBasicFS, TestOutputList (
483 [["list_partitions"]], ["/dev/sda1"]);
484 InitEmpty, TestOutputList (
485 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
486 ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
487 "list the partitions",
489 List all the partitions detected on all block devices.
491 The full partition device names are returned, eg. C</dev/sda1>
493 This does not return logical volumes. For that you will need to
494 call C<guestfs_lvs>.");
496 ("pvs", (RStringList "physvols", []), 9, [],
497 [InitBasicFSonLVM, TestOutputList (
498 [["pvs"]], ["/dev/sda1"]);
499 InitEmpty, TestOutputList (
500 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
501 ["pvcreate"; "/dev/sda1"];
502 ["pvcreate"; "/dev/sda2"];
503 ["pvcreate"; "/dev/sda3"];
504 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
505 "list the LVM physical volumes (PVs)",
507 List all the physical volumes detected. This is the equivalent
508 of the L<pvs(8)> command.
510 This returns a list of just the device names that contain
511 PVs (eg. C</dev/sda2>).
513 See also C<guestfs_pvs_full>.");
515 ("vgs", (RStringList "volgroups", []), 10, [],
516 [InitBasicFSonLVM, TestOutputList (
518 InitEmpty, TestOutputList (
519 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
520 ["pvcreate"; "/dev/sda1"];
521 ["pvcreate"; "/dev/sda2"];
522 ["pvcreate"; "/dev/sda3"];
523 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
524 ["vgcreate"; "VG2"; "/dev/sda3"];
525 ["vgs"]], ["VG1"; "VG2"])],
526 "list the LVM volume groups (VGs)",
528 List all the volumes groups detected. This is the equivalent
529 of the L<vgs(8)> command.
531 This returns a list of just the volume group names that were
532 detected (eg. C<VolGroup00>).
534 See also C<guestfs_vgs_full>.");
536 ("lvs", (RStringList "logvols", []), 11, [],
537 [InitBasicFSonLVM, TestOutputList (
538 [["lvs"]], ["/dev/VG/LV"]);
539 InitEmpty, TestOutputList (
540 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
541 ["pvcreate"; "/dev/sda1"];
542 ["pvcreate"; "/dev/sda2"];
543 ["pvcreate"; "/dev/sda3"];
544 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
545 ["vgcreate"; "VG2"; "/dev/sda3"];
546 ["lvcreate"; "LV1"; "VG1"; "50"];
547 ["lvcreate"; "LV2"; "VG1"; "50"];
548 ["lvcreate"; "LV3"; "VG2"; "50"];
549 ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
550 "list the LVM logical volumes (LVs)",
552 List all the logical volumes detected. This is the equivalent
553 of the L<lvs(8)> command.
555 This returns a list of the logical volume device names
556 (eg. C</dev/VolGroup00/LogVol00>).
558 See also C<guestfs_lvs_full>.");
560 ("pvs_full", (RPVList "physvols", []), 12, [],
561 [], (* XXX how to test? *)
562 "list the LVM physical volumes (PVs)",
564 List all the physical volumes detected. This is the equivalent
565 of the L<pvs(8)> command. The \"full\" version includes all fields.");
567 ("vgs_full", (RVGList "volgroups", []), 13, [],
568 [], (* XXX how to test? *)
569 "list the LVM volume groups (VGs)",
571 List all the volumes groups detected. This is the equivalent
572 of the L<vgs(8)> command. The \"full\" version includes all fields.");
574 ("lvs_full", (RLVList "logvols", []), 14, [],
575 [], (* XXX how to test? *)
576 "list the LVM logical volumes (LVs)",
578 List all the logical volumes detected. This is the equivalent
579 of the L<lvs(8)> command. The \"full\" version includes all fields.");
581 ("read_lines", (RStringList "lines", [String "path"]), 15, [],
582 [InitBasicFS, TestOutputList (
583 [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
584 ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);
585 InitBasicFS, TestOutputList (
586 [["write_file"; "/new"; ""; "0"];
587 ["read_lines"; "/new"]], [])],
588 "read file as lines",
590 Return the contents of the file named C<path>.
592 The file contents are returned as a list of lines. Trailing
593 C<LF> and C<CRLF> character sequences are I<not> returned.
595 Note that this function cannot correctly handle binary files
596 (specifically, files containing C<\\0> character which is treated
597 as end of line). For those you need to use the C<guestfs_read_file>
598 function which has a more complex interface.");
600 ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [],
601 [], (* XXX Augeas code needs tests. *)
602 "create a new Augeas handle",
604 Create a new Augeas handle for editing configuration files.
605 If there was any previous Augeas handle associated with this
606 guestfs session, then it is closed.
608 You must call this before using any other C<guestfs_aug_*>
611 C<root> is the filesystem root. C<root> must not be NULL,
614 The flags are the same as the flags defined in
615 E<lt>augeas.hE<gt>, the logical I<or> of the following
620 =item C<AUG_SAVE_BACKUP> = 1
622 Keep the original file with a C<.augsave> extension.
624 =item C<AUG_SAVE_NEWFILE> = 2
626 Save changes into a file with extension C<.augnew>, and
627 do not overwrite original. Overrides C<AUG_SAVE_BACKUP>.
629 =item C<AUG_TYPE_CHECK> = 4
631 Typecheck lenses (can be expensive).
633 =item C<AUG_NO_STDINC> = 8
635 Do not use standard load path for modules.
637 =item C<AUG_SAVE_NOOP> = 16
639 Make save a no-op, just record what would have been changed.
641 =item C<AUG_NO_LOAD> = 32
643 Do not load the tree in C<guestfs_aug_init>.
647 To close the handle, you can call C<guestfs_aug_close>.
649 To find out more about Augeas, see L<http://augeas.net/>.");
651 ("aug_close", (RErr, []), 26, [],
652 [], (* XXX Augeas code needs tests. *)
653 "close the current Augeas handle",
655 Close the current Augeas handle and free up any resources
656 used by it. After calling this, you have to call
657 C<guestfs_aug_init> again before you can use any other
660 ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
661 [], (* XXX Augeas code needs tests. *)
662 "define an Augeas variable",
664 Defines an Augeas variable C<name> whose value is the result
665 of evaluating C<expr>. If C<expr> is NULL, then C<name> is
668 On success this returns the number of nodes in C<expr>, or
669 C<0> if C<expr> evaluates to something which is not a nodeset.");
671 ("aug_defnode", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [],
672 [], (* XXX Augeas code needs tests. *)
673 "define an Augeas node",
675 Defines a variable C<name> whose value is the result of
678 If C<expr> evaluates to an empty nodeset, a node is created,
679 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
680 C<name> will be the nodeset containing that single node.
682 On success this returns a pair containing the
683 number of nodes in the nodeset, and a boolean flag
684 if a node was created.");
686 ("aug_get", (RString "val", [String "path"]), 19, [],
687 [], (* XXX Augeas code needs tests. *)
688 "look up the value of an Augeas path",
690 Look up the value associated with C<path>. If C<path>
691 matches exactly one node, the C<value> is returned.");
693 ("aug_set", (RErr, [String "path"; String "val"]), 20, [],
694 [], (* XXX Augeas code needs tests. *)
695 "set Augeas path to value",
697 Set the value associated with C<path> to C<value>.");
699 ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [],
700 [], (* XXX Augeas code needs tests. *)
701 "insert a sibling Augeas node",
703 Create a new sibling C<label> for C<path>, inserting it into
704 the tree before or after C<path> (depending on the boolean
707 C<path> must match exactly one existing node in the tree, and
708 C<label> must be a label, ie. not contain C</>, C<*> or end
709 with a bracketed index C<[N]>.");
711 ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
712 [], (* XXX Augeas code needs tests. *)
713 "remove an Augeas path",
715 Remove C<path> and all of its children.
717 On success this returns the number of entries which were removed.");
719 ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [],
720 [], (* XXX Augeas code needs tests. *)
723 Move the node C<src> to C<dest>. C<src> must match exactly
724 one node. C<dest> is overwritten if it exists.");
726 ("aug_match", (RStringList "matches", [String "path"]), 24, [],
727 [], (* XXX Augeas code needs tests. *)
728 "return Augeas nodes which match path",
730 Returns a list of paths which match the path expression C<path>.
731 The returned paths are sufficiently qualified so that they match
732 exactly one node in the current tree.");
734 ("aug_save", (RErr, []), 25, [],
735 [], (* XXX Augeas code needs tests. *)
736 "write all pending Augeas changes to disk",
738 This writes all pending changes to disk.
740 The flags which were passed to C<guestfs_aug_init> affect exactly
741 how files are saved.");
743 ("aug_load", (RErr, []), 27, [],
744 [], (* XXX Augeas code needs tests. *)
745 "load files into the tree",
747 Load files into the tree.
749 See C<aug_load> in the Augeas documentation for the full gory
752 ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
753 [], (* XXX Augeas code needs tests. *)
754 "list Augeas nodes under a path",
756 This is just a shortcut for listing C<guestfs_aug_match>
757 C<path/*> and sorting the resulting nodes into alphabetical order.");
759 ("rm", (RErr, [String "path"]), 29, [],
760 [InitBasicFS, TestRun
763 InitBasicFS, TestLastFail
765 InitBasicFS, TestLastFail
770 Remove the single file C<path>.");
772 ("rmdir", (RErr, [String "path"]), 30, [],
773 [InitBasicFS, TestRun
776 InitBasicFS, TestLastFail
778 InitBasicFS, TestLastFail
781 "remove a directory",
783 Remove the single directory C<path>.");
785 ("rm_rf", (RErr, [String "path"]), 31, [],
786 [InitBasicFS, TestOutputFalse
788 ["mkdir"; "/new/foo"];
789 ["touch"; "/new/foo/bar"];
791 ["exists"; "/new"]]],
792 "remove a file or directory recursively",
794 Remove the file or directory C<path>, recursively removing the
795 contents if its a directory. This is like the C<rm -rf> shell
798 ("mkdir", (RErr, [String "path"]), 32, [],
799 [InitBasicFS, TestOutputTrue
802 InitBasicFS, TestLastFail
803 [["mkdir"; "/new/foo/bar"]]],
804 "create a directory",
806 Create a directory named C<path>.");
808 ("mkdir_p", (RErr, [String "path"]), 33, [],
809 [InitBasicFS, TestOutputTrue
810 [["mkdir_p"; "/new/foo/bar"];
811 ["is_dir"; "/new/foo/bar"]];
812 InitBasicFS, TestOutputTrue
813 [["mkdir_p"; "/new/foo/bar"];
814 ["is_dir"; "/new/foo"]];
815 InitBasicFS, TestOutputTrue
816 [["mkdir_p"; "/new/foo/bar"];
817 ["is_dir"; "/new"]]],
818 "create a directory and parents",
820 Create a directory named C<path>, creating any parent directories
821 as necessary. This is like the C<mkdir -p> shell command.");
823 ("chmod", (RErr, [Int "mode"; String "path"]), 34, [],
824 [], (* XXX Need stat command to test *)
827 Change the mode (permissions) of C<path> to C<mode>. Only
828 numeric modes are supported.");
830 ("chown", (RErr, [Int "owner"; Int "group"; String "path"]), 35, [],
831 [], (* XXX Need stat command to test *)
832 "change file owner and group",
834 Change the file owner to C<owner> and group to C<group>.
836 Only numeric uid and gid are supported. If you want to use
837 names, you will need to locate and parse the password file
838 yourself (Augeas support makes this relatively easy).");
840 ("exists", (RBool "existsflag", [String "path"]), 36, [],
841 [InitBasicFS, TestOutputTrue (
843 ["exists"; "/new"]]);
844 InitBasicFS, TestOutputTrue (
846 ["exists"; "/new"]])],
847 "test if file or directory exists",
849 This returns C<true> if and only if there is a file, directory
850 (or anything) with the given C<path> name.
852 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
854 ("is_file", (RBool "fileflag", [String "path"]), 37, [],
855 [InitBasicFS, TestOutputTrue (
857 ["is_file"; "/new"]]);
858 InitBasicFS, TestOutputFalse (
860 ["is_file"; "/new"]])],
861 "test if file exists",
863 This returns C<true> if and only if there is a file
864 with the given C<path> name. Note that it returns false for
865 other objects like directories.
867 See also C<guestfs_stat>.");
869 ("is_dir", (RBool "dirflag", [String "path"]), 38, [],
870 [InitBasicFS, TestOutputFalse (
872 ["is_dir"; "/new"]]);
873 InitBasicFS, TestOutputTrue (
875 ["is_dir"; "/new"]])],
876 "test if file exists",
878 This returns C<true> if and only if there is a directory
879 with the given C<path> name. Note that it returns false for
880 other objects like files.
882 See also C<guestfs_stat>.");
884 ("pvcreate", (RErr, [String "device"]), 39, [],
885 [InitEmpty, TestOutputList (
886 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
887 ["pvcreate"; "/dev/sda1"];
888 ["pvcreate"; "/dev/sda2"];
889 ["pvcreate"; "/dev/sda3"];
890 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
891 "create an LVM physical volume",
893 This creates an LVM physical volume on the named C<device>,
894 where C<device> should usually be a partition name such
897 ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
898 [InitEmpty, TestOutputList (
899 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
900 ["pvcreate"; "/dev/sda1"];
901 ["pvcreate"; "/dev/sda2"];
902 ["pvcreate"; "/dev/sda3"];
903 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
904 ["vgcreate"; "VG2"; "/dev/sda3"];
905 ["vgs"]], ["VG1"; "VG2"])],
906 "create an LVM volume group",
908 This creates an LVM volume group called C<volgroup>
909 from the non-empty list of physical volumes C<physvols>.");
911 ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [],
912 [InitEmpty, TestOutputList (
913 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
914 ["pvcreate"; "/dev/sda1"];
915 ["pvcreate"; "/dev/sda2"];
916 ["pvcreate"; "/dev/sda3"];
917 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
918 ["vgcreate"; "VG2"; "/dev/sda3"];
919 ["lvcreate"; "LV1"; "VG1"; "50"];
920 ["lvcreate"; "LV2"; "VG1"; "50"];
921 ["lvcreate"; "LV3"; "VG2"; "50"];
922 ["lvcreate"; "LV4"; "VG2"; "50"];
923 ["lvcreate"; "LV5"; "VG2"; "50"];
925 ["/dev/VG1/LV1"; "/dev/VG1/LV2";
926 "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
927 "create an LVM volume group",
929 This creates an LVM volume group called C<logvol>
930 on the volume group C<volgroup>, with C<size> megabytes.");
932 ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [],
933 [InitEmpty, TestOutput (
934 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
935 ["mkfs"; "ext2"; "/dev/sda1"];
936 ["mount"; "/dev/sda1"; "/"];
937 ["write_file"; "/new"; "new file contents"; "0"];
938 ["cat"; "/new"]], "new file contents")],
941 This creates a filesystem on C<device> (usually a partition
942 of LVM logical volume). The filesystem type is C<fstype>, for
945 ("sfdisk", (RErr, [String "device";
946 Int "cyls"; Int "heads"; Int "sectors";
947 StringList "lines"]), 43, [DangerWillRobinson],
949 "create partitions on a block device",
951 This is a direct interface to the L<sfdisk(8)> program for creating
952 partitions on block devices.
954 C<device> should be a block device, for example C</dev/sda>.
956 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
957 and sectors on the device, which are passed directly to sfdisk as
958 the I<-C>, I<-H> and I<-S> parameters. If you pass C<0> for any
959 of these, then the corresponding parameter is omitted. Usually for
960 'large' disks, you can just pass C<0> for these, but for small
961 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
962 out the right geometry and you will need to tell it.
964 C<lines> is a list of lines that we feed to C<sfdisk>. For more
965 information refer to the L<sfdisk(8)> manpage.
967 To create a single partition occupying the whole disk, you would
968 pass C<lines> as a single element list, when the single element being
969 the string C<,> (comma).");
971 ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
972 [InitBasicFS, TestOutput (
973 [["write_file"; "/new"; "new file contents"; "0"];
974 ["cat"; "/new"]], "new file contents");
975 InitBasicFS, TestOutput (
976 [["write_file"; "/new"; "\nnew file contents\n"; "0"];
977 ["cat"; "/new"]], "\nnew file contents\n");
978 InitBasicFS, TestOutput (
979 [["write_file"; "/new"; "\n\n"; "0"];
980 ["cat"; "/new"]], "\n\n");
981 InitBasicFS, TestOutput (
982 [["write_file"; "/new"; ""; "0"];
983 ["cat"; "/new"]], "");
984 InitBasicFS, TestOutput (
985 [["write_file"; "/new"; "\n\n\n"; "0"];
986 ["cat"; "/new"]], "\n\n\n");
987 InitBasicFS, TestOutput (
988 [["write_file"; "/new"; "\n"; "0"];
989 ["cat"; "/new"]], "\n")],
992 This call creates a file called C<path>. The contents of the
993 file is the string C<content> (which can contain any 8 bit data),
996 As a special case, if C<size> is C<0>
997 then the length is calculated using C<strlen> (so in this case
998 the content cannot contain embedded ASCII NULs).");
1000 ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
1001 [InitEmpty, TestOutputList (
1002 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1003 ["mkfs"; "ext2"; "/dev/sda1"];
1004 ["mount"; "/dev/sda1"; "/"];
1005 ["mounts"]], ["/dev/sda1"]);
1006 InitEmpty, TestOutputList (
1007 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1008 ["mkfs"; "ext2"; "/dev/sda1"];
1009 ["mount"; "/dev/sda1"; "/"];
1012 "unmount a filesystem",
1014 This unmounts the given filesystem. The filesystem may be
1015 specified either by its mountpoint (path) or the device which
1016 contains the filesystem.");
1018 ("mounts", (RStringList "devices", []), 46, [],
1019 [InitBasicFS, TestOutputList (
1020 [["mounts"]], ["/dev/sda1"])],
1021 "show mounted filesystems",
1023 This returns the list of currently mounted filesystems. It returns
1024 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
1026 Some internal mounts are not shown.");
1028 ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
1029 [InitBasicFS, TestOutputList (
1032 "unmount all filesystems",
1034 This unmounts all mounted filesystems.
1036 Some internal mounts are not unmounted by this call.");
1038 ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson],
1040 "remove all LVM LVs, VGs and PVs",
1042 This command removes all LVM logical volumes, volume groups
1043 and physical volumes.");
1045 ("file", (RString "description", [String "path"]), 49, [],
1046 [InitBasicFS, TestOutput (
1048 ["file"; "/new"]], "empty");
1049 InitBasicFS, TestOutput (
1050 [["write_file"; "/new"; "some content\n"; "0"];
1051 ["file"; "/new"]], "ASCII text");
1052 InitBasicFS, TestLastFail (
1053 [["file"; "/nofile"]])],
1054 "determine file type",
1056 This call uses the standard L<file(1)> command to determine
1057 the type or contents of the file. This also works on devices,
1058 for example to find out whether a partition contains a filesystem.
1060 The exact command which runs is C<file -bsL path>. Note in
1061 particular that the filename is not prepended to the output
1062 (the C<-b> option).");
1064 ("command", (RString "output", [StringList "arguments"]), 50, [],
1065 [], (* XXX how to test? *)
1066 "run a command from the guest filesystem",
1068 This call runs a command from the guest filesystem. The
1069 filesystem must be mounted, and must contain a compatible
1070 operating system (ie. something Linux, with the same
1071 or compatible processor architecture).
1073 The single parameter is an argv-style list of arguments.
1074 The first element is the name of the program to run.
1075 Subsequent elements are parameters. The list must be
1076 non-empty (ie. must contain a program name).
1078 The C<$PATH> environment variable will contain at least
1079 C</usr/bin> and C</bin>. If you require a program from
1080 another location, you should provide the full path in the
1083 Shared libraries and data files required by the program
1084 must be available on filesystems which are mounted in the
1085 correct places. It is the caller's responsibility to ensure
1086 all filesystems that are needed are mounted at the right
1089 ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [],
1090 [], (* XXX how to test? *)
1091 "run a command, returning lines",
1093 This is the same as C<guestfs_command>, but splits the
1094 result into a list of lines.");
1096 ("stat", (RStat "statbuf", [String "path"]), 52, [],
1097 [InitBasicFS, TestOutputStruct (
1099 ["stat"; "/new"]], [CompareWithInt ("size", 0)])],
1100 "get file information",
1102 Returns file information for the given C<path>.
1104 This is the same as the C<stat(2)> system call.");
1106 ("lstat", (RStat "statbuf", [String "path"]), 53, [],
1107 [InitBasicFS, TestOutputStruct (
1109 ["lstat"; "/new"]], [CompareWithInt ("size", 0)])],
1110 "get file information for a symbolic link",
1112 Returns file information for the given C<path>.
1114 This is the same as C<guestfs_stat> except that if C<path>
1115 is a symbolic link, then the link is stat-ed, not the file it
1118 This is the same as the C<lstat(2)> system call.");
1120 ("statvfs", (RStatVFS "statbuf", [String "path"]), 54, [],
1121 [InitBasicFS, TestOutputStruct (
1122 [["statvfs"; "/"]], [CompareWithInt ("bfree", 487702);
1123 CompareWithInt ("blocks", 490020);
1124 CompareWithInt ("bsize", 1024)])],
1125 "get file system statistics",
1127 Returns file system statistics for any mounted file system.
1128 C<path> should be a file or directory in the mounted file system
1129 (typically it is the mount point itself, but it doesn't need to be).
1131 This is the same as the C<statvfs(2)> system call.");
1133 ("tune2fs_l", (RHashtable "superblock", [String "device"]), 55, [],
1135 "get ext2/ext3 superblock details",
1137 This returns the contents of the ext2 or ext3 filesystem superblock
1140 It is the same as running C<tune2fs -l device>. See L<tune2fs(8)>
1141 manpage for more details. The list of fields returned isn't
1142 clearly defined, and depends on both the version of C<tune2fs>
1143 that libguestfs was built against, and the filesystem itself.");
1145 ("blockdev_setro", (RErr, [String "device"]), 56, [],
1146 [InitEmpty, TestOutputTrue (
1147 [["blockdev_setro"; "/dev/sda"];
1148 ["blockdev_getro"; "/dev/sda"]])],
1149 "set block device to read-only",
1151 Sets the block device named C<device> to read-only.
1153 This uses the L<blockdev(8)> command.");
1155 ("blockdev_setrw", (RErr, [String "device"]), 57, [],
1156 [InitEmpty, TestOutputFalse (
1157 [["blockdev_setrw"; "/dev/sda"];
1158 ["blockdev_getro"; "/dev/sda"]])],
1159 "set block device to read-write",
1161 Sets the block device named C<device> to read-write.
1163 This uses the L<blockdev(8)> command.");
1165 ("blockdev_getro", (RBool "ro", [String "device"]), 58, [],
1166 [InitEmpty, TestOutputTrue (
1167 [["blockdev_setro"; "/dev/sda"];
1168 ["blockdev_getro"; "/dev/sda"]])],
1169 "is block device set to read-only",
1171 Returns a boolean indicating if the block device is read-only
1172 (true if read-only, false if not).
1174 This uses the L<blockdev(8)> command.");
1176 ("blockdev_getss", (RInt "sectorsize", [String "device"]), 59, [],
1177 [InitEmpty, TestOutputInt (
1178 [["blockdev_getss"; "/dev/sda"]], 512)],
1179 "get sectorsize of block device",
1181 This returns the size of sectors on a block device.
1182 Usually 512, but can be larger for modern devices.
1184 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
1187 This uses the L<blockdev(8)> command.");
1189 ("blockdev_getbsz", (RInt "blocksize", [String "device"]), 60, [],
1190 [InitEmpty, TestOutputInt (
1191 [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1192 "get blocksize of block device",
1194 This returns the block size of a device.
1196 (Note this is different from both I<size in blocks> and
1197 I<filesystem block size>).
1199 This uses the L<blockdev(8)> command.");
1201 ("blockdev_setbsz", (RErr, [String "device"; Int "blocksize"]), 61, [],
1203 "set blocksize of block device",
1205 This sets the block size of a device.
1207 (Note this is different from both I<size in blocks> and
1208 I<filesystem block size>).
1210 This uses the L<blockdev(8)> command.");
1212 ("blockdev_getsz", (RInt64 "sizeinsectors", [String "device"]), 62, [],
1213 [InitEmpty, TestOutputInt (
1214 [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1215 "get total size of device in 512-byte sectors",
1217 This returns the size of the device in units of 512-byte sectors
1218 (even if the sectorsize isn't 512 bytes ... weird).
1220 See also C<guestfs_blockdev_getss> for the real sector size of
1221 the device, and C<guestfs_blockdev_getsize64> for the more
1222 useful I<size in bytes>.
1224 This uses the L<blockdev(8)> command.");
1226 ("blockdev_getsize64", (RInt64 "sizeinbytes", [String "device"]), 63, [],
1227 [InitEmpty, TestOutputInt (
1228 [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1229 "get total size of device in bytes",
1231 This returns the size of the device in bytes.
1233 See also C<guestfs_blockdev_getsz>.
1235 This uses the L<blockdev(8)> command.");
1237 ("blockdev_flushbufs", (RErr, [String "device"]), 64, [],
1239 [["blockdev_flushbufs"; "/dev/sda"]]],
1240 "flush device buffers",
1242 This tells the kernel to flush internal buffers associated
1245 This uses the L<blockdev(8)> command.");
1247 ("blockdev_rereadpt", (RErr, [String "device"]), 65, [],
1249 [["blockdev_rereadpt"; "/dev/sda"]]],
1250 "reread partition table",
1252 Reread the partition table on C<device>.
1254 This uses the L<blockdev(8)> command.");
1257 ("upload", (RErr, [FileIn "filename"; String "remotefilename"]), 66, [],
1259 "upload a file from the local machine",
1261 Upload local file C<filename> to C<remotefilename> on the
1264 C<filename> can also be a named pipe.
1266 See also C<guestfs_download>.");
1268 ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [],
1270 "download a file to the local machine",
1272 Download file C<remotefilename> and save it as C<filename>
1273 on the local machine.
1275 C<filename> can also be a named pipe.
1277 See also C<guestfs_upload>, C<guestfs_cat>.");
1282 let all_functions = non_daemon_functions @ daemon_functions
1284 (* In some places we want the functions to be displayed sorted
1285 * alphabetically, so this is useful:
1287 let all_functions_sorted =
1288 List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
1289 compare n1 n2) all_functions
1291 (* Column names and types from LVM PVs/VGs/LVs. *)
1300 "pv_attr", `String (* XXX *);
1301 "pv_pe_count", `Int;
1302 "pv_pe_alloc_count", `Int;
1305 "pv_mda_count", `Int;
1306 "pv_mda_free", `Bytes;
1307 (* Not in Fedora 10:
1308 "pv_mda_size", `Bytes;
1315 "vg_attr", `String (* XXX *);
1318 "vg_sysid", `String;
1319 "vg_extent_size", `Bytes;
1320 "vg_extent_count", `Int;
1321 "vg_free_count", `Int;
1329 "vg_mda_count", `Int;
1330 "vg_mda_free", `Bytes;
1331 (* Not in Fedora 10:
1332 "vg_mda_size", `Bytes;
1338 "lv_attr", `String (* XXX *);
1341 "lv_kernel_major", `Int;
1342 "lv_kernel_minor", `Int;
1346 "snap_percent", `OptPercent;
1347 "copy_percent", `OptPercent;
1350 "mirror_log", `String;
1354 (* Column names and types from stat structures.
1355 * NB. Can't use things like 'st_atime' because glibc header files
1356 * define some of these as macros. Ugh.
1373 let statvfs_cols = [
1387 (* Useful functions.
1388 * Note we don't want to use any external OCaml libraries which
1389 * makes this a bit harder than it should be.
1391 let failwithf fs = ksprintf failwith fs
1393 let replace_char s c1 c2 =
1394 let s2 = String.copy s in
1395 let r = ref false in
1396 for i = 0 to String.length s2 - 1 do
1397 if String.unsafe_get s2 i = c1 then (
1398 String.unsafe_set s2 i c2;
1402 if not !r then s else s2
1406 (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
1408 let triml ?(test = isspace) str =
1410 let n = ref (String.length str) in
1411 while !n > 0 && test str.[!i]; do
1416 else String.sub str !i !n
1418 let trimr ?(test = isspace) str =
1419 let n = ref (String.length str) in
1420 while !n > 0 && test str.[!n-1]; do
1423 if !n = String.length str then str
1424 else String.sub str 0 !n
1426 let trim ?(test = isspace) str =
1427 trimr ~test (triml ~test str)
1429 let rec find s sub =
1430 let len = String.length s in
1431 let sublen = String.length sub in
1433 if i <= len-sublen then (
1435 if j < sublen then (
1436 if s.[i+j] = sub.[j] then loop2 (j+1)
1442 if r = -1 then loop (i+1) else r
1448 let rec replace_str s s1 s2 =
1449 let len = String.length s in
1450 let sublen = String.length s1 in
1451 let i = find s s1 in
1454 let s' = String.sub s 0 i in
1455 let s'' = String.sub s (i+sublen) (len-i-sublen) in
1456 s' ^ s2 ^ replace_str s'' s1 s2
1459 let rec string_split sep str =
1460 let len = String.length str in
1461 let seplen = String.length sep in
1462 let i = find str sep in
1463 if i = -1 then [str]
1465 let s' = String.sub str 0 i in
1466 let s'' = String.sub str (i+seplen) (len-i-seplen) in
1467 s' :: string_split sep s''
1470 let rec find_map f = function
1471 | [] -> raise Not_found
1475 | None -> find_map f xs
1478 let rec loop i = function
1480 | x :: xs -> f i x; loop (i+1) xs
1485 let rec loop i = function
1487 | x :: xs -> let r = f i x in r :: loop (i+1) xs
1491 let name_of_argt = function
1492 | String n | OptString n | StringList n | Bool n | Int n
1493 | FileIn n | FileOut n -> n
1495 let seq_of_test = function
1496 | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
1497 | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s
1498 | TestOutputLength (s, _) | TestOutputStruct (s, _)
1499 | TestLastFail s -> s
1501 (* Check function names etc. for consistency. *)
1502 let check_functions () =
1503 let contains_uppercase str =
1504 let len = String.length str in
1506 if i >= len then false
1509 if c >= 'A' && c <= 'Z' then true
1516 (* Check function names. *)
1518 fun (name, _, _, _, _, _, _) ->
1519 if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
1520 failwithf "function name %s does not need 'guestfs' prefix" name;
1521 if contains_uppercase name then
1522 failwithf "function name %s should not contain uppercase chars" name;
1523 if String.contains name '-' then
1524 failwithf "function name %s should not contain '-', use '_' instead."
1528 (* Check function parameter/return names. *)
1530 fun (name, style, _, _, _, _, _) ->
1531 let check_arg_ret_name n =
1532 if contains_uppercase n then
1533 failwithf "%s param/ret %s should not contain uppercase chars"
1535 if String.contains n '-' || String.contains n '_' then
1536 failwithf "%s param/ret %s should not contain '-' or '_'"
1539 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;
1540 if n = "argv" || n = "args" then
1541 failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" n
1544 (match fst style with
1546 | RInt n | RInt64 n | RBool n | RConstString n | RString n
1547 | RStringList n | RPVList n | RVGList n | RLVList n
1548 | RStat n | RStatVFS n
1550 check_arg_ret_name n
1552 check_arg_ret_name n;
1553 check_arg_ret_name m
1555 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
1558 (* Check short descriptions. *)
1560 fun (name, _, _, _, _, shortdesc, _) ->
1561 if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
1562 failwithf "short description of %s should begin with lowercase." name;
1563 let c = shortdesc.[String.length shortdesc-1] in
1564 if c = '\n' || c = '.' then
1565 failwithf "short description of %s should not end with . or \\n." name
1568 (* Check long dscriptions. *)
1570 fun (name, _, _, _, _, _, longdesc) ->
1571 if longdesc.[String.length longdesc-1] = '\n' then
1572 failwithf "long description of %s should not end with \\n." name
1575 (* Check proc_nrs. *)
1577 fun (name, _, proc_nr, _, _, _, _) ->
1578 if proc_nr <= 0 then
1579 failwithf "daemon function %s should have proc_nr > 0" name
1583 fun (name, _, proc_nr, _, _, _, _) ->
1584 if proc_nr <> -1 then
1585 failwithf "non-daemon function %s should have proc_nr -1" name
1586 ) non_daemon_functions;
1589 List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
1592 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
1593 let rec loop = function
1596 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
1598 | (name1,nr1) :: (name2,nr2) :: _ ->
1599 failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
1607 (* Ignore functions that have no tests. We generate a
1608 * warning when the user does 'make check' instead.
1610 | name, _, _, _, [], _, _ -> ()
1611 | name, _, _, _, tests, _, _ ->
1615 match seq_of_test test with
1617 failwithf "%s has a test containing an empty sequence" name
1618 | cmds -> List.map List.hd cmds
1620 let funcs = List.flatten funcs in
1622 let tested = List.mem name funcs in
1625 failwithf "function %s has tests but does not test itself" name
1628 (* 'pr' prints to the current output file. *)
1629 let chan = ref stdout
1630 let pr fs = ksprintf (output_string !chan) fs
1632 (* Generate a header block in a number of standard styles. *)
1633 type comment_style = CStyle | HashStyle | OCamlStyle
1634 type license = GPLv2 | LGPLv2
1636 let generate_header comment license =
1637 let c = match comment with
1638 | CStyle -> pr "/* "; " *"
1639 | HashStyle -> pr "# "; "#"
1640 | OCamlStyle -> pr "(* "; " *" in
1641 pr "libguestfs generated file\n";
1642 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
1643 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
1645 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
1649 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
1650 pr "%s it under the terms of the GNU General Public License as published by\n" c;
1651 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
1652 pr "%s (at your option) any later version.\n" c;
1654 pr "%s This program is distributed in the hope that it will be useful,\n" c;
1655 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1656 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
1657 pr "%s GNU General Public License for more details.\n" c;
1659 pr "%s You should have received a copy of the GNU General Public License along\n" c;
1660 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
1661 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
1664 pr "%s This library is free software; you can redistribute it and/or\n" c;
1665 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
1666 pr "%s License as published by the Free Software Foundation; either\n" c;
1667 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
1669 pr "%s This library is distributed in the hope that it will be useful,\n" c;
1670 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1671 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
1672 pr "%s Lesser General Public License for more details.\n" c;
1674 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
1675 pr "%s License along with this library; if not, write to the Free Software\n" c;
1676 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
1679 | CStyle -> pr " */\n"
1681 | OCamlStyle -> pr " *)\n"
1685 (* Start of main code generation functions below this line. *)
1687 (* Generate the pod documentation for the C API. *)
1688 let rec generate_actions_pod () =
1690 fun (shortname, style, _, flags, _, _, longdesc) ->
1691 let name = "guestfs_" ^ shortname in
1692 pr "=head2 %s\n\n" name;
1694 generate_prototype ~extern:false ~handle:"handle" name style;
1696 pr "%s\n\n" longdesc;
1697 (match fst style with
1699 pr "This function returns 0 on success or -1 on error.\n\n"
1701 pr "On error this function returns -1.\n\n"
1703 pr "On error this function returns -1.\n\n"
1705 pr "This function returns a C truth value on success or -1 on error.\n\n"
1707 pr "This function returns a string, or NULL on error.
1708 The string is owned by the guest handle and must I<not> be freed.\n\n"
1710 pr "This function returns a string, or NULL on error.
1711 I<The caller must free the returned string after use>.\n\n"
1713 pr "This function returns a NULL-terminated array of strings
1714 (like L<environ(3)>), or NULL if there was an error.
1715 I<The caller must free the strings and the array after use>.\n\n"
1717 pr "This function returns a C<struct guestfs_int_bool *>,
1718 or NULL if there was an error.
1719 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
1721 pr "This function returns a C<struct guestfs_lvm_pv_list *>
1722 (see E<lt>guestfs-structs.hE<gt>),
1723 or NULL if there was an error.
1724 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
1726 pr "This function returns a C<struct guestfs_lvm_vg_list *>
1727 (see E<lt>guestfs-structs.hE<gt>),
1728 or NULL if there was an error.
1729 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
1731 pr "This function returns a C<struct guestfs_lvm_lv_list *>
1732 (see E<lt>guestfs-structs.hE<gt>),
1733 or NULL if there was an error.
1734 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
1736 pr "This function returns a C<struct guestfs_stat *>
1737 (see L<stat(2)> and E<lt>guestfs-structs.hE<gt>),
1738 or NULL if there was an error.
1739 I<The caller must call C<free> after use>.\n\n"
1741 pr "This function returns a C<struct guestfs_statvfs *>
1742 (see L<statvfs(2)> and E<lt>guestfs-structs.hE<gt>),
1743 or NULL if there was an error.
1744 I<The caller must call C<free> after use>.\n\n"
1746 pr "This function returns a NULL-terminated array of
1747 strings, or NULL if there was an error.
1748 The array of strings will always have length C<2n+1>, where
1749 C<n> keys and values alternate, followed by the trailing NULL entry.
1750 I<The caller must free the strings and the array after use>.\n\n"
1752 if List.mem ProtocolLimitWarning flags then
1753 pr "%s\n\n" protocol_limit_warning;
1754 if List.mem DangerWillRobinson flags then
1755 pr "%s\n\n" danger_will_robinson;
1756 ) all_functions_sorted
1758 and generate_structs_pod () =
1759 (* LVM structs documentation. *)
1762 pr "=head2 guestfs_lvm_%s\n" typ;
1764 pr " struct guestfs_lvm_%s {\n" typ;
1767 | name, `String -> pr " char *%s;\n" name
1769 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
1770 pr " char %s[32];\n" name
1771 | name, `Bytes -> pr " uint64_t %s;\n" name
1772 | name, `Int -> pr " int64_t %s;\n" name
1773 | name, `OptPercent ->
1774 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
1775 pr " float %s;\n" name
1778 pr " struct guestfs_lvm_%s_list {\n" typ;
1779 pr " uint32_t len; /* Number of elements in list. */\n";
1780 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
1783 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
1786 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1788 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
1789 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
1791 * We have to use an underscore instead of a dash because otherwise
1792 * rpcgen generates incorrect code.
1794 * This header is NOT exported to clients, but see also generate_structs_h.
1796 and generate_xdr () =
1797 generate_header CStyle LGPLv2;
1799 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
1800 pr "typedef string str<>;\n";
1803 (* LVM internal structures. *)
1807 pr "struct guestfs_lvm_int_%s {\n" typ;
1809 | name, `String -> pr " string %s<>;\n" name
1810 | name, `UUID -> pr " opaque %s[32];\n" name
1811 | name, `Bytes -> pr " hyper %s;\n" name
1812 | name, `Int -> pr " hyper %s;\n" name
1813 | name, `OptPercent -> pr " float %s;\n" name
1817 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
1819 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1821 (* Stat internal structures. *)
1825 pr "struct guestfs_int_%s {\n" typ;
1827 | name, `Int -> pr " hyper %s;\n" name
1831 ) ["stat", stat_cols; "statvfs", statvfs_cols];
1834 fun (shortname, style, _, _, _, _, _) ->
1835 let name = "guestfs_" ^ shortname in
1837 (match snd style with
1840 pr "struct %s_args {\n" name;
1843 | String n -> pr " string %s<>;\n" n
1844 | OptString n -> pr " str *%s;\n" n
1845 | StringList n -> pr " str %s<>;\n" n
1846 | Bool n -> pr " bool %s;\n" n
1847 | Int n -> pr " int %s;\n" n
1848 | FileIn _ | FileOut _ -> ()
1852 (match fst style with
1855 pr "struct %s_ret {\n" name;
1859 pr "struct %s_ret {\n" name;
1860 pr " hyper %s;\n" n;
1863 pr "struct %s_ret {\n" name;
1867 failwithf "RConstString cannot be returned from a daemon function"
1869 pr "struct %s_ret {\n" name;
1870 pr " string %s<>;\n" n;
1873 pr "struct %s_ret {\n" name;
1874 pr " str %s<>;\n" n;
1877 pr "struct %s_ret {\n" name;
1882 pr "struct %s_ret {\n" name;
1883 pr " guestfs_lvm_int_pv_list %s;\n" n;
1886 pr "struct %s_ret {\n" name;
1887 pr " guestfs_lvm_int_vg_list %s;\n" n;
1890 pr "struct %s_ret {\n" name;
1891 pr " guestfs_lvm_int_lv_list %s;\n" n;
1894 pr "struct %s_ret {\n" name;
1895 pr " guestfs_int_stat %s;\n" n;
1898 pr "struct %s_ret {\n" name;
1899 pr " guestfs_int_statvfs %s;\n" n;
1902 pr "struct %s_ret {\n" name;
1903 pr " str %s<>;\n" n;
1908 (* Table of procedure numbers. *)
1909 pr "enum guestfs_procedure {\n";
1911 fun (shortname, _, proc_nr, _, _, _, _) ->
1912 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
1914 pr " GUESTFS_PROC_NR_PROCS\n";
1918 (* Having to choose a maximum message size is annoying for several
1919 * reasons (it limits what we can do in the API), but it (a) makes
1920 * the protocol a lot simpler, and (b) provides a bound on the size
1921 * of the daemon which operates in limited memory space. For large
1922 * file transfers you should use FTP.
1924 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
1927 (* Message header, etc. *)
1929 const GUESTFS_PROGRAM = 0x2000F5F5;
1930 const GUESTFS_PROTOCOL_VERSION = 1;
1932 enum guestfs_message_direction {
1933 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
1934 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
1937 enum guestfs_message_status {
1938 GUESTFS_STATUS_OK = 0,
1939 GUESTFS_STATUS_ERROR = 1
1942 const GUESTFS_ERROR_LEN = 256;
1944 struct guestfs_message_error {
1945 string error_message<GUESTFS_ERROR_LEN>;
1948 /* For normal requests and replies (not involving any FileIn or
1949 * FileOut parameters), the protocol is:
1952 * total length (header + args, but not including length word itself)
1954 * guestfs_foo_args struct
1956 * total length (as above)
1958 * guestfs_foo_ret struct
1961 struct guestfs_message_header {
1962 unsigned prog; /* GUESTFS_PROGRAM */
1963 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
1964 guestfs_procedure proc; /* GUESTFS_PROC_x */
1965 guestfs_message_direction direction;
1966 unsigned serial; /* message serial number */
1967 guestfs_message_status status;
1970 /* Chunked encoding used to transfer files, for FileIn and FileOut
1973 * For requests which have >= 1 FileIn parameter:
1974 * length of header + args (but not length word itself, and not chunks)
1976 * guestfs_foo_args struct
1977 * sequence of chunks for FileIn param #0
1978 * sequence of chunks for FileIn param #1 etc
1980 * For replies which have >= 1 FileOut parameter:
1981 * length of header + ret (but not length word itself, and not chunks)
1983 * guestfs_foo_ret struct
1984 * sequence of chunks for FileOut param #0
1985 * sequence of chunks for FileOut param #1 etc
1987 const GUESTFS_MAX_CHUNK_SIZE = 8192;
1989 struct guestfs_chunk {
1990 int cancel; /* if non-zero, transfer is cancelled */
1991 /* data size is 0 bytes if the transfer has finished successfully */
1992 opaque data<GUESTFS_MAX_CHUNK_SIZE>;
1996 (* Generate the guestfs-structs.h file. *)
1997 and generate_structs_h () =
1998 generate_header CStyle LGPLv2;
2000 (* This is a public exported header file containing various
2001 * structures. The structures are carefully written to have
2002 * exactly the same in-memory format as the XDR structures that
2003 * we use on the wire to the daemon. The reason for creating
2004 * copies of these structures here is just so we don't have to
2005 * export the whole of guestfs_protocol.h (which includes much
2006 * unrelated and XDR-dependent stuff that we don't want to be
2007 * public, or required by clients).
2009 * To reiterate, we will pass these structures to and from the
2010 * client with a simple assignment or memcpy, so the format
2011 * must be identical to what rpcgen / the RFC defines.
2014 (* guestfs_int_bool structure. *)
2015 pr "struct guestfs_int_bool {\n";
2021 (* LVM public structures. *)
2025 pr "struct guestfs_lvm_%s {\n" typ;
2028 | name, `String -> pr " char *%s;\n" name
2029 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
2030 | name, `Bytes -> pr " uint64_t %s;\n" name
2031 | name, `Int -> pr " int64_t %s;\n" name
2032 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
2036 pr "struct guestfs_lvm_%s_list {\n" typ;
2037 pr " uint32_t len;\n";
2038 pr " struct guestfs_lvm_%s *val;\n" typ;
2041 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2043 (* Stat structures. *)
2047 pr "struct guestfs_%s {\n" typ;
2050 | name, `Int -> pr " int64_t %s;\n" name
2054 ) ["stat", stat_cols; "statvfs", statvfs_cols]
2056 (* Generate the guestfs-actions.h file. *)
2057 and generate_actions_h () =
2058 generate_header CStyle LGPLv2;
2060 fun (shortname, style, _, _, _, _, _) ->
2061 let name = "guestfs_" ^ shortname in
2062 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
2066 (* Generate the client-side dispatch stubs. *)
2067 and generate_client_actions () =
2068 generate_header CStyle LGPLv2;
2074 #include \"guestfs.h\"
2075 #include \"guestfs_protocol.h\"
2077 #define error guestfs_error
2078 #define perrorf guestfs_perrorf
2079 #define safe_malloc guestfs_safe_malloc
2080 #define safe_realloc guestfs_safe_realloc
2081 #define safe_strdup guestfs_safe_strdup
2082 #define safe_memdup guestfs_safe_memdup
2084 /* Check the return message from a call for validity. */
2086 check_reply_header (guestfs_h *g,
2087 const struct guestfs_message_header *hdr,
2088 int proc_nr, int serial)
2090 if (hdr->prog != GUESTFS_PROGRAM) {
2091 error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
2094 if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
2095 error (g, \"wrong protocol version (%%d/%%d)\",
2096 hdr->vers, GUESTFS_PROTOCOL_VERSION);
2099 if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
2100 error (g, \"unexpected message direction (%%d/%%d)\",
2101 hdr->direction, GUESTFS_DIRECTION_REPLY);
2104 if (hdr->proc != proc_nr) {
2105 error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
2108 if (hdr->serial != serial) {
2109 error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
2116 /* Check we are in the right state to run a high-level action. */
2118 check_state (guestfs_h *g, const char *caller)
2120 if (!guestfs_is_ready (g)) {
2121 if (guestfs_is_config (g))
2122 error (g, \"%%s: call launch() before using this function\",
2124 else if (guestfs_is_launching (g))
2125 error (g, \"%%s: call wait_ready() before using this function\",
2128 error (g, \"%%s called from the wrong state, %%d != READY\",
2129 caller, guestfs_get_state (g));
2137 (* Client-side stubs for each function. *)
2139 fun (shortname, style, _, _, _, _, _) ->
2140 let name = "guestfs_" ^ shortname in
2142 (* Generate the state struct which stores the high-level
2143 * state between callback functions.
2145 pr "struct %s_state {\n" shortname;
2146 pr " int cb_state;\n";
2147 pr " struct guestfs_message_header hdr;\n";
2148 pr " struct guestfs_message_error err;\n";
2149 (match fst style with
2152 failwithf "RConstString cannot be returned from a daemon function"
2154 | RBool _ | RString _ | RStringList _
2156 | RPVList _ | RVGList _ | RLVList _
2157 | RStat _ | RStatVFS _
2159 pr " struct %s_ret ret;\n" name
2164 (* Generate the callback function. *)
2165 pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
2167 pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
2168 pr " struct %s_state *state = (struct %s_state *) data;\n" shortname shortname;
2170 pr " if (!xdr_guestfs_message_header (xdr, &state->hdr)) {\n";
2171 pr " error (g, \"%s: failed to parse reply header\");\n" name;
2174 pr " if (state->hdr.status == GUESTFS_STATUS_ERROR) {\n";
2175 pr " if (!xdr_guestfs_message_error (xdr, &state->err)) {\n";
2176 pr " error (g, \"%s: failed to parse reply error\");\n" name;
2182 (match fst style with
2185 failwithf "RConstString cannot be returned from a daemon function"
2187 | RBool _ | RString _ | RStringList _
2189 | RPVList _ | RVGList _ | RLVList _
2190 | RStat _ | RStatVFS _
2192 pr " if (!xdr_%s_ret (xdr, &state->ret)) {\n" name;
2193 pr " error (g, \"%s: failed to parse reply\");\n" name;
2199 pr " state->cb_state = 1;\n";
2200 pr " ml->main_loop_quit (ml, g);\n";
2203 (* Generate the action stub. *)
2204 generate_prototype ~extern:false ~semicolon:false ~newline:true
2205 ~handle:"g" name style;
2208 match fst style with
2209 | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
2211 failwithf "RConstString cannot be returned from a daemon function"
2212 | RString _ | RStringList _ | RIntBool _
2213 | RPVList _ | RVGList _ | RLVList _
2214 | RStat _ | RStatVFS _
2220 (match snd style with
2222 | _ -> pr " struct %s_args args;\n" name
2225 pr " struct %s_state state;\n" shortname;
2226 pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
2227 pr " int serial;\n";
2229 pr " if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
2231 pr " memset (&state, 0, sizeof state);\n";
2234 (* Dispatch the main header and arguments. *)
2235 (match snd style with
2237 pr " serial = guestfs__send (g, GUESTFS_PROC_%s, NULL, NULL);\n"
2238 (String.uppercase shortname)
2243 pr " args.%s = (char *) %s;\n" n n
2245 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
2247 pr " args.%s.%s_val = (char **) %s;\n" n n n;
2248 pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
2250 pr " args.%s = %s;\n" n n
2252 pr " args.%s = %s;\n" n n
2253 | FileIn _ | FileOut _ -> ()
2255 pr " serial = guestfs__send (g, GUESTFS_PROC_%s,\n"
2256 (String.uppercase shortname);
2257 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
2260 pr " if (serial == -1)\n";
2261 pr " return %s;\n" error_code;
2264 (* Send any additional files requested. *)
2268 pr " if (send_file (g, %s) == -1)\n" n;
2269 pr " return %s;\n" error_code;
2274 (* Wait for the reply from the remote end. *)
2275 pr " state.cb_state = 0;\n";
2276 pr " guestfs_set_reply_callback (g, %s_cb, &state);\n" shortname;
2277 pr " (void) ml->main_loop_run (ml, g);\n";
2278 pr " guestfs_set_reply_callback (g, NULL, NULL);\n";
2279 pr " if (!state.cb_state) {\n";
2280 pr " error (g, \"%s failed, see earlier error messages\");\n" name;
2281 pr " return %s;\n" error_code;
2285 pr " if (check_reply_header (g, &state.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
2286 (String.uppercase shortname);
2287 pr " return %s;\n" error_code;
2290 pr " if (state.hdr.status == GUESTFS_STATUS_ERROR) {\n";
2291 pr " error (g, \"%%s\", state.err.error_message);\n";
2292 pr " return %s;\n" error_code;
2296 (* Expecting to receive further files (FileOut)? *)
2300 pr " if (receive_file (g, %s) == -1)\n" n;
2301 pr " return %s;\n" error_code;
2306 (match fst style with
2307 | RErr -> pr " return 0;\n"
2308 | RInt n | RInt64 n | RBool n ->
2309 pr " return state.ret.%s;\n" n
2311 failwithf "RConstString cannot be returned from a daemon function"
2313 pr " return state.ret.%s; /* caller will free */\n" n
2314 | RStringList n | RHashtable n ->
2315 pr " /* caller will free this, but we need to add a NULL entry */\n";
2316 pr " state.ret.%s.%s_val =\n" n n;
2317 pr " safe_realloc (g, state.ret.%s.%s_val,\n" n n;
2318 pr " sizeof (char *) * (state.ret.%s.%s_len + 1));\n"
2320 pr " state.ret.%s.%s_val[state.ret.%s.%s_len] = NULL;\n" n n n n;
2321 pr " return state.ret.%s.%s_val;\n" n n
2323 pr " /* caller with free this */\n";
2324 pr " return safe_memdup (g, &state.ret, sizeof (state.ret));\n"
2325 | RPVList n | RVGList n | RLVList n
2326 | RStat n | RStatVFS n ->
2327 pr " /* caller will free this */\n";
2328 pr " return safe_memdup (g, &state.ret.%s, sizeof (state.ret.%s));\n" n n
2334 (* Generate daemon/actions.h. *)
2335 and generate_daemon_actions_h () =
2336 generate_header CStyle GPLv2;
2338 pr "#include \"../src/guestfs_protocol.h\"\n";
2342 fun (name, style, _, _, _, _, _) ->
2344 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
2348 (* Generate the server-side stubs. *)
2349 and generate_daemon_actions () =
2350 generate_header CStyle GPLv2;
2352 pr "#define _GNU_SOURCE // for strchrnul\n";
2354 pr "#include <stdio.h>\n";
2355 pr "#include <stdlib.h>\n";
2356 pr "#include <string.h>\n";
2357 pr "#include <inttypes.h>\n";
2358 pr "#include <ctype.h>\n";
2359 pr "#include <rpc/types.h>\n";
2360 pr "#include <rpc/xdr.h>\n";
2362 pr "#include \"daemon.h\"\n";
2363 pr "#include \"../src/guestfs_protocol.h\"\n";
2364 pr "#include \"actions.h\"\n";
2368 fun (name, style, _, _, _, _, _) ->
2369 (* Generate server-side stubs. *)
2370 pr "static void %s_stub (XDR *xdr_in)\n" name;
2373 match fst style with
2374 | RErr | RInt _ -> pr " int r;\n"; "-1"
2375 | RInt64 _ -> pr " int64_t r;\n"; "-1"
2376 | RBool _ -> pr " int r;\n"; "-1"
2378 failwithf "RConstString cannot be returned from a daemon function"
2379 | RString _ -> pr " char *r;\n"; "NULL"
2380 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
2381 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
2382 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
2383 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
2384 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL"
2385 | RStat _ -> pr " guestfs_int_stat *r;\n"; "NULL"
2386 | RStatVFS _ -> pr " guestfs_int_statvfs *r;\n"; "NULL" in
2388 (match snd style with
2391 pr " struct guestfs_%s_args args;\n" name;
2395 | OptString n -> pr " const char *%s;\n" n
2396 | StringList n -> pr " char **%s;\n" n
2397 | Bool n -> pr " int %s;\n" n
2398 | Int n -> pr " int %s;\n" n
2399 | FileIn _ | FileOut _ -> ()
2404 (match snd style with
2407 pr " memset (&args, 0, sizeof args);\n";
2409 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
2410 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
2415 | String n -> pr " %s = args.%s;\n" n n
2416 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
2418 pr " args.%s.%s_val = realloc (args.%s.%s_val, sizeof (char *) * (args.%s.%s_len+1));\n" n n n n n n;
2419 pr " args.%s.%s_val[args.%s.%s_len] = NULL;\n" n n n n;
2420 pr " %s = args.%s.%s_val;\n" n n n
2421 | Bool n -> pr " %s = args.%s;\n" n n
2422 | Int n -> pr " %s = args.%s;\n" n n
2423 | FileIn _ | FileOut _ -> ()
2428 (* Don't want to call the impl with any FileIn or FileOut
2429 * parameters, since these go "outside" the RPC protocol.
2432 List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
2434 pr " r = do_%s " name;
2435 generate_call_args argsnofile;
2438 pr " if (r == %s)\n" error_code;
2439 pr " /* do_%s has already called reply_with_error */\n" name;
2443 (* If there are any FileOut parameters, then the impl must
2444 * send its own reply.
2447 List.exists (function FileOut _ -> true | _ -> false) (snd style) in
2449 pr " /* do_%s has already sent a reply */\n" name
2451 match fst style with
2452 | RErr -> pr " reply (NULL, NULL);\n"
2453 | RInt n | RInt64 n | RBool n ->
2454 pr " struct guestfs_%s_ret ret;\n" name;
2455 pr " ret.%s = r;\n" n;
2456 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2459 failwithf "RConstString cannot be returned from a daemon function"
2461 pr " struct guestfs_%s_ret ret;\n" name;
2462 pr " ret.%s = r;\n" n;
2463 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2466 | RStringList n | RHashtable n ->
2467 pr " struct guestfs_%s_ret ret;\n" name;
2468 pr " ret.%s.%s_len = count_strings (r);\n" n n;
2469 pr " ret.%s.%s_val = r;\n" n n;
2470 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2472 pr " free_strings (r);\n"
2474 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n"
2476 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
2477 | RPVList n | RVGList n | RLVList n
2478 | RStat n | RStatVFS n ->
2479 pr " struct guestfs_%s_ret ret;\n" name;
2480 pr " ret.%s = *r;\n" n;
2481 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
2483 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
2487 (* Free the args. *)
2488 (match snd style with
2493 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
2500 (* Dispatch function. *)
2501 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
2503 pr " switch (proc_nr) {\n";
2506 fun (name, style, _, _, _, _, _) ->
2507 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
2508 pr " %s_stub (xdr_in);\n" name;
2513 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
2518 (* LVM columns and tokenization functions. *)
2519 (* XXX This generates crap code. We should rethink how we
2525 pr "static const char *lvm_%s_cols = \"%s\";\n"
2526 typ (String.concat "," (List.map fst cols));
2529 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
2531 pr " char *tok, *p, *next;\n";
2535 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
2538 pr " if (!str) {\n";
2539 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
2542 pr " if (!*str || isspace (*str)) {\n";
2543 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
2548 fun (name, coltype) ->
2549 pr " if (!tok) {\n";
2550 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
2553 pr " p = strchrnul (tok, ',');\n";
2554 pr " if (*p) next = p+1; else next = NULL;\n";
2555 pr " *p = '\\0';\n";
2558 pr " r->%s = strdup (tok);\n" name;
2559 pr " if (r->%s == NULL) {\n" name;
2560 pr " perror (\"strdup\");\n";
2564 pr " for (i = j = 0; i < 32; ++j) {\n";
2565 pr " if (tok[j] == '\\0') {\n";
2566 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
2568 pr " } else if (tok[j] != '-')\n";
2569 pr " r->%s[i++] = tok[j];\n" name;
2572 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
2573 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2577 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
2578 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2582 pr " if (tok[0] == '\\0')\n";
2583 pr " r->%s = -1;\n" name;
2584 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
2585 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2589 pr " tok = next;\n";
2592 pr " if (tok != NULL) {\n";
2593 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
2600 pr "guestfs_lvm_int_%s_list *\n" typ;
2601 pr "parse_command_line_%ss (void)\n" typ;
2603 pr " char *out, *err;\n";
2604 pr " char *p, *pend;\n";
2606 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
2607 pr " void *newp;\n";
2609 pr " ret = malloc (sizeof *ret);\n";
2610 pr " if (!ret) {\n";
2611 pr " reply_with_perror (\"malloc\");\n";
2612 pr " return NULL;\n";
2615 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
2616 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
2618 pr " r = command (&out, &err,\n";
2619 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
2620 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
2621 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
2622 pr " if (r == -1) {\n";
2623 pr " reply_with_error (\"%%s\", err);\n";
2624 pr " free (out);\n";
2625 pr " free (err);\n";
2626 pr " free (ret);\n";
2627 pr " return NULL;\n";
2630 pr " free (err);\n";
2632 pr " /* Tokenize each line of the output. */\n";
2635 pr " while (p) {\n";
2636 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
2637 pr " if (pend) {\n";
2638 pr " *pend = '\\0';\n";
2642 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
2645 pr " if (!*p) { /* Empty line? Skip it. */\n";
2650 pr " /* Allocate some space to store this next entry. */\n";
2651 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
2652 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
2653 pr " if (newp == NULL) {\n";
2654 pr " reply_with_perror (\"realloc\");\n";
2655 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2656 pr " free (ret);\n";
2657 pr " free (out);\n";
2658 pr " return NULL;\n";
2660 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
2662 pr " /* Tokenize the next entry. */\n";
2663 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
2664 pr " if (r == -1) {\n";
2665 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
2666 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2667 pr " free (ret);\n";
2668 pr " free (out);\n";
2669 pr " return NULL;\n";
2676 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
2678 pr " free (out);\n";
2679 pr " return ret;\n";
2682 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2684 (* Generate the tests. *)
2685 and generate_tests () =
2686 generate_header CStyle GPLv2;
2693 #include <sys/types.h>
2696 #include \"guestfs.h\"
2698 static guestfs_h *g;
2699 static int suppress_error = 0;
2701 static void print_error (guestfs_h *g, void *data, const char *msg)
2703 if (!suppress_error)
2704 fprintf (stderr, \"%%s\\n\", msg);
2707 static void print_strings (char * const * const argv)
2711 for (argc = 0; argv[argc] != NULL; ++argc)
2712 printf (\"\\t%%s\\n\", argv[argc]);
2716 static void print_table (char * const * const argv)
2720 for (i = 0; argv[i] != NULL; i += 2)
2721 printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
2725 static void no_test_warnings (void)
2731 | name, _, _, _, [], _, _ ->
2732 pr " fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
2733 | name, _, _, _, tests, _, _ -> ()
2739 (* Generate the actual tests. Note that we generate the tests
2740 * in reverse order, deliberately, so that (in general) the
2741 * newest tests run first. This makes it quicker and easier to
2746 fun (name, _, _, _, tests, _, _) ->
2747 mapi (generate_one_test name) tests
2748 ) (List.rev all_functions) in
2749 let test_names = List.concat test_names in
2750 let nr_tests = List.length test_names in
2753 int main (int argc, char *argv[])
2760 int nr_tests, test_num = 0;
2762 no_test_warnings ();
2764 g = guestfs_create ();
2766 printf (\"guestfs_create FAILED\\n\");
2770 guestfs_set_error_handler (g, print_error, NULL);
2772 srcdir = getenv (\"srcdir\");
2773 if (!srcdir) srcdir = \".\";
2774 guestfs_set_path (g, srcdir);
2776 snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);
2777 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2782 if (lseek (fd, %d, SEEK_SET) == -1) {
2788 if (write (fd, &c, 1) == -1) {
2794 if (close (fd) == -1) {
2799 if (guestfs_add_drive (g, buf) == -1) {
2800 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2804 snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);
2805 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2810 if (lseek (fd, %d, SEEK_SET) == -1) {
2816 if (write (fd, &c, 1) == -1) {
2822 if (close (fd) == -1) {
2827 if (guestfs_add_drive (g, buf) == -1) {
2828 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2832 snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);
2833 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2838 if (lseek (fd, %d, SEEK_SET) == -1) {
2844 if (write (fd, &c, 1) == -1) {
2850 if (close (fd) == -1) {
2855 if (guestfs_add_drive (g, buf) == -1) {
2856 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2860 if (guestfs_launch (g) == -1) {
2861 printf (\"guestfs_launch FAILED\\n\");
2864 if (guestfs_wait_ready (g) == -1) {
2865 printf (\"guestfs_wait_ready FAILED\\n\");
2871 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
2875 pr " test_num++;\n";
2876 pr " printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
2877 pr " if (%s () == -1) {\n" test_name;
2878 pr " printf (\"%s FAILED\\n\");\n" test_name;
2884 pr " guestfs_close (g);\n";
2885 pr " snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);\n";
2886 pr " unlink (buf);\n";
2887 pr " snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);\n";
2888 pr " unlink (buf);\n";
2889 pr " snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);\n";
2890 pr " unlink (buf);\n";
2893 pr " if (failed > 0) {\n";
2894 pr " printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n";
2902 and generate_one_test name i (init, test) =
2903 let test_name = sprintf "test_%s_%d" name i in
2905 pr "static int %s (void)\n" test_name;
2911 pr " /* InitEmpty for %s (%d) */\n" name i;
2912 List.iter (generate_test_command_call test_name)
2916 pr " /* InitBasicFS for %s (%d): create ext2 on /dev/sda1 */\n" name i;
2917 List.iter (generate_test_command_call test_name)
2920 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2921 ["mkfs"; "ext2"; "/dev/sda1"];
2922 ["mount"; "/dev/sda1"; "/"]]
2923 | InitBasicFSonLVM ->
2924 pr " /* InitBasicFSonLVM for %s (%d): create ext2 on /dev/VG/LV */\n"
2926 List.iter (generate_test_command_call test_name)
2929 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2930 ["pvcreate"; "/dev/sda1"];
2931 ["vgcreate"; "VG"; "/dev/sda1"];
2932 ["lvcreate"; "LV"; "VG"; "8"];
2933 ["mkfs"; "ext2"; "/dev/VG/LV"];
2934 ["mount"; "/dev/VG/LV"; "/"]]
2937 let get_seq_last = function
2939 failwithf "%s: you cannot use [] (empty list) when expecting a command"
2942 let seq = List.rev seq in
2943 List.rev (List.tl seq), List.hd seq
2948 pr " /* TestRun for %s (%d) */\n" name i;
2949 List.iter (generate_test_command_call test_name) seq
2950 | TestOutput (seq, expected) ->
2951 pr " /* TestOutput for %s (%d) */\n" name i;
2952 let seq, last = get_seq_last seq in
2954 pr " if (strcmp (r, \"%s\") != 0) {\n" (c_quote expected);
2955 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r);\n" test_name (c_quote expected);
2959 List.iter (generate_test_command_call test_name) seq;
2960 generate_test_command_call ~test test_name last
2961 | TestOutputList (seq, expected) ->
2962 pr " /* TestOutputList for %s (%d) */\n" name i;
2963 let seq, last = get_seq_last seq in
2967 pr " if (!r[%d]) {\n" i;
2968 pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
2969 pr " print_strings (r);\n";
2972 pr " if (strcmp (r[%d], \"%s\") != 0) {\n" i (c_quote str);
2973 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r[%d]);\n" test_name (c_quote str) i;
2977 pr " if (r[%d] != NULL) {\n" (List.length expected);
2978 pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
2980 pr " print_strings (r);\n";
2984 List.iter (generate_test_command_call test_name) seq;
2985 generate_test_command_call ~test test_name last
2986 | TestOutputInt (seq, expected) ->
2987 pr " /* TestOutputInt for %s (%d) */\n" name i;
2988 let seq, last = get_seq_last seq in
2990 pr " if (r != %d) {\n" expected;
2991 pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\","
2997 List.iter (generate_test_command_call test_name) seq;
2998 generate_test_command_call ~test test_name last
2999 | TestOutputTrue seq ->
3000 pr " /* TestOutputTrue for %s (%d) */\n" name i;
3001 let seq, last = get_seq_last seq in
3004 pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n"
3009 List.iter (generate_test_command_call test_name) seq;
3010 generate_test_command_call ~test test_name last
3011 | TestOutputFalse seq ->
3012 pr " /* TestOutputFalse for %s (%d) */\n" name i;
3013 let seq, last = get_seq_last seq in
3016 pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n"
3021 List.iter (generate_test_command_call test_name) seq;
3022 generate_test_command_call ~test test_name last
3023 | TestOutputLength (seq, expected) ->
3024 pr " /* TestOutputLength for %s (%d) */\n" name i;
3025 let seq, last = get_seq_last seq in
3028 pr " for (j = 0; j < %d; ++j)\n" expected;
3029 pr " if (r[j] == NULL) {\n";
3030 pr " fprintf (stderr, \"%s: short list returned\\n\");\n"
3032 pr " print_strings (r);\n";
3035 pr " if (r[j] != NULL) {\n";
3036 pr " fprintf (stderr, \"%s: long list returned\\n\");\n"
3038 pr " print_strings (r);\n";
3042 List.iter (generate_test_command_call test_name) seq;
3043 generate_test_command_call ~test test_name last
3044 | TestOutputStruct (seq, checks) ->
3045 pr " /* TestOutputStruct for %s (%d) */\n" name i;
3046 let seq, last = get_seq_last seq in
3050 | CompareWithInt (field, expected) ->
3051 pr " if (r->%s != %d) {\n" field expected;
3052 pr " fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
3053 test_name field expected;
3054 pr " (int) r->%s);\n" field;
3057 | CompareWithString (field, expected) ->
3058 pr " if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
3059 pr " fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
3060 test_name field expected;
3061 pr " r->%s);\n" field;
3064 | CompareFieldsIntEq (field1, field2) ->
3065 pr " if (r->%s != r->%s) {\n" field1 field2;
3066 pr " fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
3067 test_name field1 field2;
3068 pr " (int) r->%s, (int) r->%s);\n" field1 field2;
3071 | CompareFieldsStrEq (field1, field2) ->
3072 pr " if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
3073 pr " fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
3074 test_name field1 field2;
3075 pr " r->%s, r->%s);\n" field1 field2;
3080 List.iter (generate_test_command_call test_name) seq;
3081 generate_test_command_call ~test test_name last
3082 | TestLastFail seq ->
3083 pr " /* TestLastFail for %s (%d) */\n" name i;
3084 let seq, last = get_seq_last seq in
3085 List.iter (generate_test_command_call test_name) seq;
3086 generate_test_command_call test_name ~expect_error:true last
3094 (* Generate the code to run a command, leaving the result in 'r'.
3095 * If you expect to get an error then you should set expect_error:true.
3097 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
3099 | [] -> assert false
3101 (* Look up the command to find out what args/ret it has. *)
3104 let _, style, _, _, _, _, _ =
3105 List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
3108 failwithf "%s: in test, command %s was not found" test_name name in
3110 if List.length (snd style) <> List.length args then
3111 failwithf "%s: in test, wrong number of args given to %s"
3122 | FileIn _, _ | FileOut _, _ -> ()
3123 | StringList n, arg ->
3124 pr " char *%s[] = {\n" n;
3125 let strs = string_split " " arg in
3127 fun str -> pr " \"%s\",\n" (c_quote str)
3131 ) (List.combine (snd style) args);
3134 match fst style with
3135 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
3136 | RInt64 _ -> pr " int64_t r;\n"; "-1"
3137 | RConstString _ -> pr " const char *r;\n"; "NULL"
3138 | RString _ -> pr " char *r;\n"; "NULL"
3139 | RStringList _ | RHashtable _ ->
3144 pr " struct guestfs_int_bool *r;\n"; "NULL"
3146 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
3148 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
3150 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
3152 pr " struct guestfs_stat *r;\n"; "NULL"
3154 pr " struct guestfs_statvfs *r;\n"; "NULL" in
3156 pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
3157 pr " r = guestfs_%s (g" name;
3159 (* Generate the parameters. *)
3163 | FileIn _, arg | FileOut _, arg ->
3164 pr ", \"%s\"" (c_quote arg)
3165 | OptString _, arg ->
3166 if arg = "NULL" then pr ", NULL" else pr ", \"%s\"" (c_quote arg)
3167 | StringList n, _ ->
3171 try int_of_string arg
3172 with Failure "int_of_string" ->
3173 failwithf "%s: expecting an int, but got '%s'" test_name arg in
3176 let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
3177 ) (List.combine (snd style) args);
3180 if not expect_error then
3181 pr " if (r == %s)\n" error_code
3183 pr " if (r != %s)\n" error_code;
3186 (* Insert the test code. *)
3192 (match fst style with
3193 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ -> ()
3194 | RString _ -> pr " free (r);\n"
3195 | RStringList _ | RHashtable _ ->
3196 pr " for (i = 0; r[i] != NULL; ++i)\n";
3197 pr " free (r[i]);\n";
3200 pr " guestfs_free_int_bool (r);\n"
3202 pr " guestfs_free_lvm_pv_list (r);\n"
3204 pr " guestfs_free_lvm_vg_list (r);\n"
3206 pr " guestfs_free_lvm_lv_list (r);\n"
3207 | RStat _ | RStatVFS _ ->
3214 let str = replace_str str "\r" "\\r" in
3215 let str = replace_str str "\n" "\\n" in
3216 let str = replace_str str "\t" "\\t" in
3219 (* Generate a lot of different functions for guestfish. *)
3220 and generate_fish_cmds () =
3221 generate_header CStyle GPLv2;
3225 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3227 let all_functions_sorted =
3229 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3230 ) all_functions_sorted in
3232 pr "#include <stdio.h>\n";
3233 pr "#include <stdlib.h>\n";
3234 pr "#include <string.h>\n";
3235 pr "#include <inttypes.h>\n";
3237 pr "#include <guestfs.h>\n";
3238 pr "#include \"fish.h\"\n";
3241 (* list_commands function, which implements guestfish -h *)
3242 pr "void list_commands (void)\n";
3244 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
3245 pr " list_builtin_commands ();\n";
3247 fun (name, _, _, flags, _, shortdesc, _) ->
3248 let name = replace_char name '_' '-' in
3249 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
3251 ) all_functions_sorted;
3252 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
3256 (* display_command function, which implements guestfish -h cmd *)
3257 pr "void display_command (const char *cmd)\n";
3260 fun (name, style, _, flags, _, shortdesc, longdesc) ->
3261 let name2 = replace_char name '_' '-' in
3263 try find_map (function FishAlias n -> Some n | _ -> None) flags
3264 with Not_found -> name in
3265 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
3267 match snd style with
3271 name2 (String.concat "> <" (List.map name_of_argt args)) in
3274 if List.mem ProtocolLimitWarning flags then
3275 ("\n\n" ^ protocol_limit_warning)
3278 (* For DangerWillRobinson commands, we should probably have
3279 * guestfish prompt before allowing you to use them (especially
3280 * in interactive mode). XXX
3284 if List.mem DangerWillRobinson flags then
3285 ("\n\n" ^ danger_will_robinson)
3288 let describe_alias =
3289 if name <> alias then
3290 sprintf "\n\nYou can use '%s' as an alias for this command." alias
3294 pr "strcasecmp (cmd, \"%s\") == 0" name;
3295 if name <> name2 then
3296 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
3297 if name <> alias then
3298 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
3300 pr " pod2text (\"%s - %s\", %S);\n"
3302 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
3305 pr " display_builtin_command (cmd);\n";
3309 (* print_{pv,vg,lv}_list functions *)
3313 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
3320 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
3322 pr " printf (\"%s: \");\n" name;
3323 pr " for (i = 0; i < 32; ++i)\n";
3324 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
3325 pr " printf (\"\\n\");\n"
3327 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
3329 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
3330 | name, `OptPercent ->
3331 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
3332 typ name name typ name;
3333 pr " else printf (\"%s: \\n\");\n" name
3337 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
3342 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
3343 pr " print_%s (&%ss->val[i]);\n" typ typ;
3346 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3348 (* print_{stat,statvfs} functions *)
3352 pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
3357 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
3361 ) ["stat", stat_cols; "statvfs", statvfs_cols];
3363 (* run_<action> actions *)
3365 fun (name, style, _, flags, _, _, _) ->
3366 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
3368 (match fst style with
3371 | RBool _ -> pr " int r;\n"
3372 | RInt64 _ -> pr " int64_t r;\n"
3373 | RConstString _ -> pr " const char *r;\n"
3374 | RString _ -> pr " char *r;\n"
3375 | RStringList _ | RHashtable _ -> pr " char **r;\n"
3376 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
3377 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
3378 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
3379 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
3380 | RStat _ -> pr " struct guestfs_stat *r;\n"
3381 | RStatVFS _ -> pr " struct guestfs_statvfs *r;\n"
3388 | FileOut n -> pr " const char *%s;\n" n
3389 | StringList n -> pr " char **%s;\n" n
3390 | Bool n -> pr " int %s;\n" n
3391 | Int n -> pr " int %s;\n" n
3394 (* Check and convert parameters. *)
3395 let argc_expected = List.length (snd style) in
3396 pr " if (argc != %d) {\n" argc_expected;
3397 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
3399 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
3405 | String name -> pr " %s = argv[%d];\n" name i
3407 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
3410 pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdin\";\n"
3413 pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n"
3415 | StringList name ->
3416 pr " %s = parse_string_list (argv[%d]);\n" name i
3418 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
3420 pr " %s = atoi (argv[%d]);\n" name i
3423 (* Call C API function. *)
3425 try find_map (function FishAction n -> Some n | _ -> None) flags
3426 with Not_found -> sprintf "guestfs_%s" name in
3428 generate_call_args ~handle:"g" (snd style);
3431 (* Check return value for errors and display command results. *)
3432 (match fst style with
3433 | RErr -> pr " return r;\n"
3435 pr " if (r == -1) return -1;\n";
3436 pr " printf (\"%%d\\n\", r);\n";
3439 pr " if (r == -1) return -1;\n";
3440 pr " printf (\"%%\" PRIi64 \"\\n\", r);\n";
3443 pr " if (r == -1) return -1;\n";
3444 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
3447 pr " if (r == NULL) return -1;\n";
3448 pr " printf (\"%%s\\n\", r);\n";
3451 pr " if (r == NULL) return -1;\n";
3452 pr " printf (\"%%s\\n\", r);\n";
3456 pr " if (r == NULL) return -1;\n";
3457 pr " print_strings (r);\n";
3458 pr " free_strings (r);\n";
3461 pr " if (r == NULL) return -1;\n";
3462 pr " printf (\"%%d, %%s\\n\", r->i,\n";
3463 pr " r->b ? \"true\" : \"false\");\n";
3464 pr " guestfs_free_int_bool (r);\n";
3467 pr " if (r == NULL) return -1;\n";
3468 pr " print_pv_list (r);\n";
3469 pr " guestfs_free_lvm_pv_list (r);\n";
3472 pr " if (r == NULL) return -1;\n";
3473 pr " print_vg_list (r);\n";
3474 pr " guestfs_free_lvm_vg_list (r);\n";
3477 pr " if (r == NULL) return -1;\n";
3478 pr " print_lv_list (r);\n";
3479 pr " guestfs_free_lvm_lv_list (r);\n";
3482 pr " if (r == NULL) return -1;\n";
3483 pr " print_stat (r);\n";
3487 pr " if (r == NULL) return -1;\n";
3488 pr " print_statvfs (r);\n";
3492 pr " if (r == NULL) return -1;\n";
3493 pr " print_table (r);\n";
3494 pr " free_strings (r);\n";
3501 (* run_action function *)
3502 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
3505 fun (name, _, _, flags, _, _, _) ->
3506 let name2 = replace_char name '_' '-' in
3508 try find_map (function FishAlias n -> Some n | _ -> None) flags
3509 with Not_found -> name in
3511 pr "strcasecmp (cmd, \"%s\") == 0" name;
3512 if name <> name2 then
3513 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
3514 if name <> alias then
3515 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
3517 pr " return run_%s (cmd, argc, argv);\n" name;
3521 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
3528 (* Readline completion for guestfish. *)
3529 and generate_fish_completion () =
3530 generate_header CStyle GPLv2;
3534 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3544 #ifdef HAVE_LIBREADLINE
3545 #include <readline/readline.h>
3550 #ifdef HAVE_LIBREADLINE
3552 static const char *commands[] = {
3555 (* Get the commands and sort them, including the aliases. *)
3558 fun (name, _, _, flags, _, _, _) ->
3559 let name2 = replace_char name '_' '-' in
3561 try find_map (function FishAlias n -> Some n | _ -> None) flags
3562 with Not_found -> name in
3564 if name <> alias then [name2; alias] else [name2]
3566 let commands = List.flatten commands in
3567 let commands = List.sort compare commands in
3569 List.iter (pr " \"%s\",\n") commands;
3575 generator (const char *text, int state)
3577 static int index, len;
3582 len = strlen (text);
3585 while ((name = commands[index]) != NULL) {
3587 if (strncasecmp (name, text, len) == 0)
3588 return strdup (name);
3594 #endif /* HAVE_LIBREADLINE */
3596 char **do_completion (const char *text, int start, int end)
3598 char **matches = NULL;
3600 #ifdef HAVE_LIBREADLINE
3602 matches = rl_completion_matches (text, generator);
3609 (* Generate the POD documentation for guestfish. *)
3610 and generate_fish_actions_pod () =
3611 let all_functions_sorted =
3613 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3614 ) all_functions_sorted in
3617 fun (name, style, _, flags, _, _, longdesc) ->
3618 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
3619 let name = replace_char name '_' '-' in
3621 try find_map (function FishAlias n -> Some n | _ -> None) flags
3622 with Not_found -> name in
3624 pr "=head2 %s" name;
3625 if name <> alias then
3632 | String n -> pr " %s" n
3633 | OptString n -> pr " %s" n
3634 | StringList n -> pr " %s,..." n
3635 | Bool _ -> pr " true|false"
3636 | Int n -> pr " %s" n
3637 | FileIn n | FileOut n -> pr " (%s|-)" n
3641 pr "%s\n\n" longdesc;
3643 if List.exists (function FileIn _ | FileOut _ -> true
3644 | _ -> false) (snd style) then
3645 pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
3647 if List.mem ProtocolLimitWarning flags then
3648 pr "%s\n\n" protocol_limit_warning;
3650 if List.mem DangerWillRobinson flags then
3651 pr "%s\n\n" danger_will_robinson
3652 ) all_functions_sorted
3654 (* Generate a C function prototype. *)
3655 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
3656 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
3658 ?handle name style =
3659 if extern then pr "extern ";
3660 if static then pr "static ";
3661 (match fst style with
3663 | RInt _ -> pr "int "
3664 | RInt64 _ -> pr "int64_t "
3665 | RBool _ -> pr "int "
3666 | RConstString _ -> pr "const char *"
3667 | RString _ -> pr "char *"
3668 | RStringList _ | RHashtable _ -> pr "char **"
3670 if not in_daemon then pr "struct guestfs_int_bool *"
3671 else pr "guestfs_%s_ret *" name
3673 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
3674 else pr "guestfs_lvm_int_pv_list *"
3676 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
3677 else pr "guestfs_lvm_int_vg_list *"
3679 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
3680 else pr "guestfs_lvm_int_lv_list *"
3682 if not in_daemon then pr "struct guestfs_stat *"
3683 else pr "guestfs_int_stat *"
3685 if not in_daemon then pr "struct guestfs_statvfs *"
3686 else pr "guestfs_int_statvfs *"
3688 pr "%s%s (" prefix name;
3689 if handle = None && List.length (snd style) = 0 then
3692 let comma = ref false in
3695 | Some handle -> pr "guestfs_h *%s" handle; comma := true
3699 if single_line then pr ", " else pr ",\n\t\t"
3706 | OptString n -> next (); pr "const char *%s" n
3707 | StringList n -> next (); pr "char * const* const %s" n
3708 | Bool n -> next (); pr "int %s" n
3709 | Int n -> next (); pr "int %s" n
3712 if not in_daemon then (next (); pr "const char *%s" n)
3716 if semicolon then pr ";";
3717 if newline then pr "\n"
3719 (* Generate C call arguments, eg "(handle, foo, bar)" *)
3720 and generate_call_args ?handle args =
3722 let comma = ref false in
3725 | Some handle -> pr "%s" handle; comma := true
3729 if !comma then pr ", ";
3731 pr "%s" (name_of_argt arg)
3735 (* Generate the OCaml bindings interface. *)
3736 and generate_ocaml_mli () =
3737 generate_header OCamlStyle LGPLv2;
3740 (** For API documentation you should refer to the C API
3741 in the guestfs(3) manual page. The OCaml API uses almost
3742 exactly the same calls. *)
3745 (** A [guestfs_h] handle. *)
3747 exception Error of string
3748 (** This exception is raised when there is an error. *)
3750 val create : unit -> t
3752 val close : t -> unit
3753 (** Handles are closed by the garbage collector when they become
3754 unreferenced, but callers can also call this in order to
3755 provide predictable cleanup. *)
3758 generate_ocaml_lvm_structure_decls ();
3760 generate_ocaml_stat_structure_decls ();
3764 fun (name, style, _, _, _, shortdesc, _) ->
3765 generate_ocaml_prototype name style;
3766 pr "(** %s *)\n" shortdesc;
3770 (* Generate the OCaml bindings implementation. *)
3771 and generate_ocaml_ml () =
3772 generate_header OCamlStyle LGPLv2;
3776 exception Error of string
3777 external create : unit -> t = \"ocaml_guestfs_create\"
3778 external close : t -> unit = \"ocaml_guestfs_close\"
3781 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
3785 generate_ocaml_lvm_structure_decls ();
3787 generate_ocaml_stat_structure_decls ();
3791 fun (name, style, _, _, _, shortdesc, _) ->
3792 generate_ocaml_prototype ~is_external:true name style;
3795 (* Generate the OCaml bindings C implementation. *)
3796 and generate_ocaml_c () =
3797 generate_header CStyle LGPLv2;
3804 #include <caml/config.h>
3805 #include <caml/alloc.h>
3806 #include <caml/callback.h>
3807 #include <caml/fail.h>
3808 #include <caml/memory.h>
3809 #include <caml/mlvalues.h>
3810 #include <caml/signals.h>
3812 #include <guestfs.h>
3814 #include \"guestfs_c.h\"
3816 /* Copy a hashtable of string pairs into an assoc-list. We return
3817 * the list in reverse order, but hashtables aren't supposed to be
3820 static CAMLprim value
3821 copy_table (char * const * argv)
3824 CAMLlocal5 (rv, pairv, kv, vv, cons);
3828 for (i = 0; argv[i] != NULL; i += 2) {
3829 kv = caml_copy_string (argv[i]);
3830 vv = caml_copy_string (argv[i+1]);
3831 pairv = caml_alloc (2, 0);
3832 Store_field (pairv, 0, kv);
3833 Store_field (pairv, 1, vv);
3834 cons = caml_alloc (2, 0);
3835 Store_field (cons, 1, rv);
3837 Store_field (cons, 0, pairv);
3845 (* LVM struct copy functions. *)
3848 let has_optpercent_col =
3849 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
3851 pr "static CAMLprim value\n";
3852 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
3854 pr " CAMLparam0 ();\n";
3855 if has_optpercent_col then
3856 pr " CAMLlocal3 (rv, v, v2);\n"
3858 pr " CAMLlocal2 (rv, v);\n";
3860 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
3865 pr " v = caml_copy_string (%s->%s);\n" typ name
3867 pr " v = caml_alloc_string (32);\n";
3868 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
3871 pr " v = caml_copy_int64 (%s->%s);\n" typ name
3872 | name, `OptPercent ->
3873 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
3874 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
3875 pr " v = caml_alloc (1, 0);\n";
3876 pr " Store_field (v, 0, v2);\n";
3877 pr " } else /* None */\n";
3878 pr " v = Val_int (0);\n";
3880 pr " Store_field (rv, %d, v);\n" i
3882 pr " CAMLreturn (rv);\n";
3886 pr "static CAMLprim value\n";
3887 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
3890 pr " CAMLparam0 ();\n";
3891 pr " CAMLlocal2 (rv, v);\n";
3894 pr " if (%ss->len == 0)\n" typ;
3895 pr " CAMLreturn (Atom (0));\n";
3897 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
3898 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
3899 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
3900 pr " caml_modify (&Field (rv, i), v);\n";
3902 pr " CAMLreturn (rv);\n";
3906 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3908 (* Stat copy functions. *)
3911 pr "static CAMLprim value\n";
3912 pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
3914 pr " CAMLparam0 ();\n";
3915 pr " CAMLlocal2 (rv, v);\n";
3917 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
3922 pr " v = caml_copy_int64 (%s->%s);\n" typ name
3924 pr " Store_field (rv, %d, v);\n" i
3926 pr " CAMLreturn (rv);\n";
3929 ) ["stat", stat_cols; "statvfs", statvfs_cols];
3933 fun (name, style, _, _, _, _, _) ->
3935 "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
3937 pr "CAMLprim value\n";
3938 pr "ocaml_guestfs_%s (value %s" name (List.hd params);
3939 List.iter (pr ", value %s") (List.tl params);
3944 | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
3945 pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
3946 pr " CAMLxparam%d (%s);\n"
3947 (List.length rest) (String.concat ", " rest)
3949 pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
3951 pr " CAMLlocal1 (rv);\n";
3954 pr " guestfs_h *g = Guestfs_val (gv);\n";
3955 pr " if (g == NULL)\n";
3956 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
3964 pr " const char *%s = String_val (%sv);\n" n n
3966 pr " const char *%s =\n" n;
3967 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
3970 pr " char **%s = ocaml_guestfs_strings_val (%sv);\n" n n
3972 pr " int %s = Bool_val (%sv);\n" n n
3974 pr " int %s = Int_val (%sv);\n" n n
3977 match fst style with
3978 | RErr -> pr " int r;\n"; "-1"
3979 | RInt _ -> pr " int r;\n"; "-1"
3980 | RInt64 _ -> pr " int64_t r;\n"; "-1"
3981 | RBool _ -> pr " int r;\n"; "-1"
3982 | RConstString _ -> pr " const char *r;\n"; "NULL"
3983 | RString _ -> pr " char *r;\n"; "NULL"
3989 pr " struct guestfs_int_bool *r;\n"; "NULL"
3991 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
3993 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
3995 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
3997 pr " struct guestfs_stat *r;\n"; "NULL"
3999 pr " struct guestfs_statvfs *r;\n"; "NULL"
4006 pr " caml_enter_blocking_section ();\n";
4007 pr " r = guestfs_%s " name;
4008 generate_call_args ~handle:"g" (snd style);
4010 pr " caml_leave_blocking_section ();\n";
4015 pr " ocaml_guestfs_free_strings (%s);\n" n;
4016 | String _ | OptString _ | Bool _ | Int _ | FileIn _ | FileOut _ -> ()
4019 pr " if (r == %s)\n" error_code;
4020 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
4023 (match fst style with
4024 | RErr -> pr " rv = Val_unit;\n"
4025 | RInt _ -> pr " rv = Val_int (r);\n"
4027 pr " rv = caml_copy_int64 (r);\n"
4028 | RBool _ -> pr " rv = Val_bool (r);\n"
4029 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
4031 pr " rv = caml_copy_string (r);\n";
4034 pr " rv = caml_copy_string_array ((const char **) r);\n";
4035 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
4038 pr " rv = caml_alloc (2, 0);\n";
4039 pr " Store_field (rv, 0, Val_int (r->i));\n";
4040 pr " Store_field (rv, 1, Val_bool (r->b));\n";
4041 pr " guestfs_free_int_bool (r);\n";
4043 pr " rv = copy_lvm_pv_list (r);\n";
4044 pr " guestfs_free_lvm_pv_list (r);\n";
4046 pr " rv = copy_lvm_vg_list (r);\n";
4047 pr " guestfs_free_lvm_vg_list (r);\n";
4049 pr " rv = copy_lvm_lv_list (r);\n";
4050 pr " guestfs_free_lvm_lv_list (r);\n";
4052 pr " rv = copy_stat (r);\n";
4055 pr " rv = copy_statvfs (r);\n";
4058 pr " rv = copy_table (r);\n";
4059 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
4063 pr " CAMLreturn (rv);\n";
4067 if List.length params > 5 then (
4068 pr "CAMLprim value\n";
4069 pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
4071 pr " return ocaml_guestfs_%s (argv[0]" name;
4072 iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
4079 and generate_ocaml_lvm_structure_decls () =
4082 pr "type lvm_%s = {\n" typ;
4085 | name, `String -> pr " %s : string;\n" name
4086 | name, `UUID -> pr " %s : string;\n" name
4087 | name, `Bytes -> pr " %s : int64;\n" name
4088 | name, `Int -> pr " %s : int64;\n" name
4089 | name, `OptPercent -> pr " %s : float option;\n" name
4093 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
4095 and generate_ocaml_stat_structure_decls () =
4098 pr "type %s = {\n" typ;
4101 | name, `Int -> pr " %s : int64;\n" name
4105 ) ["stat", stat_cols; "statvfs", statvfs_cols]
4107 and generate_ocaml_prototype ?(is_external = false) name style =
4108 if is_external then pr "external " else pr "val ";
4109 pr "%s : t -> " name;
4112 | String _ | FileIn _ | FileOut _ -> pr "string -> "
4113 | OptString _ -> pr "string option -> "
4114 | StringList _ -> pr "string array -> "
4115 | Bool _ -> pr "bool -> "
4116 | Int _ -> pr "int -> "
4118 (match fst style with
4119 | RErr -> pr "unit" (* all errors are turned into exceptions *)
4120 | RInt _ -> pr "int"
4121 | RInt64 _ -> pr "int64"
4122 | RBool _ -> pr "bool"
4123 | RConstString _ -> pr "string"
4124 | RString _ -> pr "string"
4125 | RStringList _ -> pr "string array"
4126 | RIntBool _ -> pr "int * bool"
4127 | RPVList _ -> pr "lvm_pv array"
4128 | RVGList _ -> pr "lvm_vg array"
4129 | RLVList _ -> pr "lvm_lv array"
4130 | RStat _ -> pr "stat"
4131 | RStatVFS _ -> pr "statvfs"
4132 | RHashtable _ -> pr "(string * string) list"
4134 if is_external then (
4136 if List.length (snd style) + 1 > 5 then
4137 pr "\"ocaml_guestfs_%s_byte\" " name;
4138 pr "\"ocaml_guestfs_%s\"" name
4142 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
4143 and generate_perl_xs () =
4144 generate_header CStyle LGPLv2;
4147 #include \"EXTERN.h\"
4151 #include <guestfs.h>
4154 #define PRId64 \"lld\"
4158 my_newSVll(long long val) {
4159 #ifdef USE_64_BIT_ALL
4160 return newSViv(val);
4164 len = snprintf(buf, 100, \"%%\" PRId64, val);
4165 return newSVpv(buf, len);
4170 #define PRIu64 \"llu\"
4174 my_newSVull(unsigned long long val) {
4175 #ifdef USE_64_BIT_ALL
4176 return newSVuv(val);
4180 len = snprintf(buf, 100, \"%%\" PRIu64, val);
4181 return newSVpv(buf, len);
4185 /* http://www.perlmonks.org/?node_id=680842 */
4187 XS_unpack_charPtrPtr (SV *arg) {
4192 if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV) {
4193 croak (\"array reference expected\");
4196 av = (AV *)SvRV (arg);
4197 ret = (char **)malloc (av_len (av) + 1 + 1);
4199 for (i = 0; i <= av_len (av); i++) {
4200 SV **elem = av_fetch (av, i, 0);
4202 if (!elem || !*elem)
4203 croak (\"missing element in list\");
4205 ret[i] = SvPV_nolen (*elem);
4213 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
4218 RETVAL = guestfs_create ();
4220 croak (\"could not create guestfs handle\");
4221 guestfs_set_error_handler (RETVAL, NULL, NULL);
4234 fun (name, style, _, _, _, _, _) ->
4235 (match fst style with
4236 | RErr -> pr "void\n"
4237 | RInt _ -> pr "SV *\n"
4238 | RInt64 _ -> pr "SV *\n"
4239 | RBool _ -> pr "SV *\n"
4240 | RConstString _ -> pr "SV *\n"
4241 | RString _ -> pr "SV *\n"
4244 | RPVList _ | RVGList _ | RLVList _
4245 | RStat _ | RStatVFS _
4247 pr "void\n" (* all lists returned implictly on the stack *)
4249 (* Call and arguments. *)
4251 generate_call_args ~handle:"g" (snd style);
4253 pr " guestfs_h *g;\n";
4256 | String n | FileIn n | FileOut n -> pr " char *%s;\n" n
4257 | OptString n -> pr " char *%s;\n" n
4258 | StringList n -> pr " char **%s;\n" n
4259 | Bool n -> pr " int %s;\n" n
4260 | Int n -> pr " int %s;\n" n
4263 let do_cleanups () =
4266 | String _ | OptString _ | Bool _ | Int _
4267 | FileIn _ | FileOut _ -> ()
4268 | StringList n -> pr " free (%s);\n" n
4273 (match fst style with
4278 pr " r = guestfs_%s " name;
4279 generate_call_args ~handle:"g" (snd style);
4282 pr " if (r == -1)\n";
4283 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4289 pr " %s = guestfs_%s " n name;
4290 generate_call_args ~handle:"g" (snd style);
4293 pr " if (%s == -1)\n" n;
4294 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4295 pr " RETVAL = newSViv (%s);\n" n;
4300 pr " int64_t %s;\n" n;
4302 pr " %s = guestfs_%s " n name;
4303 generate_call_args ~handle:"g" (snd style);
4306 pr " if (%s == -1)\n" n;
4307 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4308 pr " RETVAL = my_newSVll (%s);\n" n;
4313 pr " const char *%s;\n" n;
4315 pr " %s = guestfs_%s " n name;
4316 generate_call_args ~handle:"g" (snd style);
4319 pr " if (%s == NULL)\n" n;
4320 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4321 pr " RETVAL = newSVpv (%s, 0);\n" n;
4326 pr " char *%s;\n" n;
4328 pr " %s = guestfs_%s " n name;
4329 generate_call_args ~handle:"g" (snd style);
4332 pr " if (%s == NULL)\n" n;
4333 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4334 pr " RETVAL = newSVpv (%s, 0);\n" n;
4335 pr " free (%s);\n" n;
4338 | RStringList n | RHashtable n ->
4340 pr " char **%s;\n" n;
4343 pr " %s = guestfs_%s " n name;
4344 generate_call_args ~handle:"g" (snd style);
4347 pr " if (%s == NULL)\n" n;
4348 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4349 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
4350 pr " EXTEND (SP, n);\n";
4351 pr " for (i = 0; i < n; ++i) {\n";
4352 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
4353 pr " free (%s[i]);\n" n;
4355 pr " free (%s);\n" n;
4358 pr " struct guestfs_int_bool *r;\n";
4360 pr " r = guestfs_%s " name;
4361 generate_call_args ~handle:"g" (snd style);
4364 pr " if (r == NULL)\n";
4365 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4366 pr " EXTEND (SP, 2);\n";
4367 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
4368 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
4369 pr " guestfs_free_int_bool (r);\n";
4371 generate_perl_lvm_code "pv" pv_cols name style n do_cleanups
4373 generate_perl_lvm_code "vg" vg_cols name style n do_cleanups
4375 generate_perl_lvm_code "lv" lv_cols name style n do_cleanups
4377 generate_perl_stat_code "stat" stat_cols name style n do_cleanups
4379 generate_perl_stat_code
4380 "statvfs" statvfs_cols name style n do_cleanups
4386 and generate_perl_lvm_code typ cols name style n do_cleanups =
4388 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
4392 pr " %s = guestfs_%s " n name;
4393 generate_call_args ~handle:"g" (snd style);
4396 pr " if (%s == NULL)\n" n;
4397 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4398 pr " EXTEND (SP, %s->len);\n" n;
4399 pr " for (i = 0; i < %s->len; ++i) {\n" n;
4400 pr " hv = newHV ();\n";
4404 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
4405 name (String.length name) n name
4407 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
4408 name (String.length name) n name
4410 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
4411 name (String.length name) n name
4413 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
4414 name (String.length name) n name
4415 | name, `OptPercent ->
4416 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
4417 name (String.length name) n name
4419 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
4421 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
4423 and generate_perl_stat_code typ cols name style n do_cleanups =
4425 pr " struct guestfs_%s *%s;\n" typ n;
4427 pr " %s = guestfs_%s " n name;
4428 generate_call_args ~handle:"g" (snd style);
4431 pr " if (%s == NULL)\n" n;
4432 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4433 pr " EXTEND (SP, %d);\n" (List.length cols);
4437 pr " PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n" n name
4439 pr " free (%s);\n" n
4441 (* Generate Sys/Guestfs.pm. *)
4442 and generate_perl_pm () =
4443 generate_header HashStyle LGPLv2;
4450 Sys::Guestfs - Perl bindings for libguestfs
4456 my $h = Sys::Guestfs->new ();
4457 $h->add_drive ('guest.img');
4460 $h->mount ('/dev/sda1', '/');
4461 $h->touch ('/hello');
4466 The C<Sys::Guestfs> module provides a Perl XS binding to the
4467 libguestfs API for examining and modifying virtual machine
4470 Amongst the things this is good for: making batch configuration
4471 changes to guests, getting disk used/free statistics (see also:
4472 virt-df), migrating between virtualization systems (see also:
4473 virt-p2v), performing partial backups, performing partial guest
4474 clones, cloning guests and changing registry/UUID/hostname info, and
4477 Libguestfs uses Linux kernel and qemu code, and can access any type of
4478 guest filesystem that Linux and qemu can, including but not limited
4479 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
4480 schemes, qcow, qcow2, vmdk.
4482 Libguestfs provides ways to enumerate guest storage (eg. partitions,
4483 LVs, what filesystem is in each LV, etc.). It can also run commands
4484 in the context of the guest. Also you can access filesystems over FTP.
4488 All errors turn into calls to C<croak> (see L<Carp(3)>).
4496 package Sys::Guestfs;
4502 XSLoader::load ('Sys::Guestfs');
4504 =item $h = Sys::Guestfs->new ();
4506 Create a new guestfs handle.
4512 my $class = ref ($proto) || $proto;
4514 my $self = Sys::Guestfs::_create ();
4515 bless $self, $class;
4521 (* Actions. We only need to print documentation for these as
4522 * they are pulled in from the XS code automatically.
4525 fun (name, style, _, flags, _, _, longdesc) ->
4526 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
4528 generate_perl_prototype name style;
4530 pr "%s\n\n" longdesc;
4531 if List.mem ProtocolLimitWarning flags then
4532 pr "%s\n\n" protocol_limit_warning;
4533 if List.mem DangerWillRobinson flags then
4534 pr "%s\n\n" danger_will_robinson
4535 ) all_functions_sorted;
4547 Copyright (C) 2009 Red Hat Inc.
4551 Please see the file COPYING.LIB for the full license.
4555 L<guestfs(3)>, L<guestfish(1)>.
4560 and generate_perl_prototype name style =
4561 (match fst style with
4567 | RString n -> pr "$%s = " n
4568 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
4572 | RLVList n -> pr "@%s = " n
4575 | RHashtable n -> pr "%%%s = " n
4578 let comma = ref false in
4581 if !comma then pr ", ";
4584 | String n | OptString n | Bool n | Int n | FileIn n | FileOut n ->
4591 (* Generate Python C module. *)
4592 and generate_python_c () =
4593 generate_header CStyle LGPLv2;
4602 #include \"guestfs.h\"
4610 get_handle (PyObject *obj)
4613 assert (obj != Py_None);
4614 return ((Pyguestfs_Object *) obj)->g;
4618 put_handle (guestfs_h *g)
4622 PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
4625 /* This list should be freed (but not the strings) after use. */
4626 static const char **
4627 get_string_list (PyObject *obj)
4634 if (!PyList_Check (obj)) {
4635 PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
4639 len = PyList_Size (obj);
4640 r = malloc (sizeof (char *) * (len+1));
4642 PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
4646 for (i = 0; i < len; ++i)
4647 r[i] = PyString_AsString (PyList_GetItem (obj, i));
4654 put_string_list (char * const * const argv)
4659 for (argc = 0; argv[argc] != NULL; ++argc)
4662 list = PyList_New (argc);
4663 for (i = 0; i < argc; ++i)
4664 PyList_SetItem (list, i, PyString_FromString (argv[i]));
4670 put_table (char * const * const argv)
4672 PyObject *list, *item;
4675 for (argc = 0; argv[argc] != NULL; ++argc)
4678 list = PyList_New (argc >> 1);
4679 for (i = 0; i < argc; i += 2) {
4680 item = PyTuple_New (2);
4681 PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
4682 PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
4683 PyList_SetItem (list, i >> 1, item);
4690 free_strings (char **argv)
4694 for (argc = 0; argv[argc] != NULL; ++argc)
4700 py_guestfs_create (PyObject *self, PyObject *args)
4704 g = guestfs_create ();
4706 PyErr_SetString (PyExc_RuntimeError,
4707 \"guestfs.create: failed to allocate handle\");
4710 guestfs_set_error_handler (g, NULL, NULL);
4711 return put_handle (g);
4715 py_guestfs_close (PyObject *self, PyObject *args)
4720 if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
4722 g = get_handle (py_g);
4726 Py_INCREF (Py_None);
4732 (* LVM structures, turned into Python dictionaries. *)
4735 pr "static PyObject *\n";
4736 pr "put_lvm_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
4738 pr " PyObject *dict;\n";
4740 pr " dict = PyDict_New ();\n";
4744 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4745 pr " PyString_FromString (%s->%s));\n"
4748 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4749 pr " PyString_FromStringAndSize (%s->%s, 32));\n"
4752 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4753 pr " PyLong_FromUnsignedLongLong (%s->%s));\n"
4756 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4757 pr " PyLong_FromLongLong (%s->%s));\n"
4759 | name, `OptPercent ->
4760 pr " if (%s->%s >= 0)\n" typ name;
4761 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4762 pr " PyFloat_FromDouble ((double) %s->%s));\n"
4765 pr " Py_INCREF (Py_None);\n";
4766 pr " PyDict_SetItemString (dict, \"%s\", Py_None);" name;
4769 pr " return dict;\n";
4773 pr "static PyObject *\n";
4774 pr "put_lvm_%s_list (struct guestfs_lvm_%s_list *%ss)\n" typ typ typ;
4776 pr " PyObject *list;\n";
4779 pr " list = PyList_New (%ss->len);\n" typ;
4780 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
4781 pr " PyList_SetItem (list, i, put_lvm_%s (&%ss->val[i]));\n" typ typ;
4782 pr " return list;\n";
4785 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
4787 (* Stat structures, turned into Python dictionaries. *)
4790 pr "static PyObject *\n";
4791 pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
4793 pr " PyObject *dict;\n";
4795 pr " dict = PyDict_New ();\n";
4799 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4800 pr " PyLong_FromLongLong (%s->%s));\n"
4803 pr " return dict;\n";
4806 ) ["stat", stat_cols; "statvfs", statvfs_cols];
4808 (* Python wrapper functions. *)
4810 fun (name, style, _, _, _, _, _) ->
4811 pr "static PyObject *\n";
4812 pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
4815 pr " PyObject *py_g;\n";
4816 pr " guestfs_h *g;\n";
4817 pr " PyObject *py_r;\n";
4820 match fst style with
4821 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
4822 | RInt64 _ -> pr " int64_t r;\n"; "-1"
4823 | RConstString _ -> pr " const char *r;\n"; "NULL"
4824 | RString _ -> pr " char *r;\n"; "NULL"
4825 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
4826 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
4827 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
4828 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
4829 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
4830 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
4831 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
4835 | String n | FileIn n | FileOut n -> pr " const char *%s;\n" n
4836 | OptString n -> pr " const char *%s;\n" n
4838 pr " PyObject *py_%s;\n" n;
4839 pr " const char **%s;\n" n
4840 | Bool n -> pr " int %s;\n" n
4841 | Int n -> pr " int %s;\n" n
4846 (* Convert the parameters. *)
4847 pr " if (!PyArg_ParseTuple (args, (char *) \"O";
4850 | String _ | FileIn _ | FileOut _ -> pr "s"
4851 | OptString _ -> pr "z"
4852 | StringList _ -> pr "O"
4853 | Bool _ -> pr "i" (* XXX Python has booleans? *)
4856 pr ":guestfs_%s\",\n" name;
4860 | String n | FileIn n | FileOut n -> pr ", &%s" n
4861 | OptString n -> pr ", &%s" n
4862 | StringList n -> pr ", &py_%s" n
4863 | Bool n -> pr ", &%s" n
4864 | Int n -> pr ", &%s" n
4868 pr " return NULL;\n";
4870 pr " g = get_handle (py_g);\n";
4873 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
4875 pr " %s = get_string_list (py_%s);\n" n n;
4876 pr " if (!%s) return NULL;\n" n
4881 pr " r = guestfs_%s " name;
4882 generate_call_args ~handle:"g" (snd style);
4887 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
4889 pr " free (%s);\n" n
4892 pr " if (r == %s) {\n" error_code;
4893 pr " PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
4894 pr " return NULL;\n";
4898 (match fst style with
4900 pr " Py_INCREF (Py_None);\n";
4901 pr " py_r = Py_None;\n"
4903 | RBool _ -> pr " py_r = PyInt_FromLong ((long) r);\n"
4904 | RInt64 _ -> pr " py_r = PyLong_FromLongLong (r);\n"
4905 | RConstString _ -> pr " py_r = PyString_FromString (r);\n"
4907 pr " py_r = PyString_FromString (r);\n";
4910 pr " py_r = put_string_list (r);\n";
4911 pr " free_strings (r);\n"
4913 pr " py_r = PyTuple_New (2);\n";
4914 pr " PyTuple_SetItem (py_r, 0, PyInt_FromLong ((long) r->i));\n";
4915 pr " PyTuple_SetItem (py_r, 1, PyInt_FromLong ((long) r->b));\n";
4916 pr " guestfs_free_int_bool (r);\n"
4918 pr " py_r = put_lvm_pv_list (r);\n";
4919 pr " guestfs_free_lvm_pv_list (r);\n"
4921 pr " py_r = put_lvm_vg_list (r);\n";
4922 pr " guestfs_free_lvm_vg_list (r);\n"
4924 pr " py_r = put_lvm_lv_list (r);\n";
4925 pr " guestfs_free_lvm_lv_list (r);\n"
4927 pr " py_r = put_stat (r);\n";
4930 pr " py_r = put_statvfs (r);\n";
4933 pr " py_r = put_table (r);\n";
4934 pr " free_strings (r);\n"
4937 pr " return py_r;\n";
4942 (* Table of functions. *)
4943 pr "static PyMethodDef methods[] = {\n";
4944 pr " { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
4945 pr " { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
4947 fun (name, _, _, _, _, _, _) ->
4948 pr " { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
4951 pr " { NULL, NULL, 0, NULL }\n";
4955 (* Init function. *)
4958 initlibguestfsmod (void)
4960 static int initialized = 0;
4962 if (initialized) return;
4963 Py_InitModule ((char *) \"libguestfsmod\", methods);
4968 (* Generate Python module. *)
4969 and generate_python_py () =
4970 generate_header HashStyle LGPLv2;
4973 u\"\"\"Python bindings for libguestfs
4976 g = guestfs.GuestFS ()
4977 g.add_drive (\"guest.img\")
4980 parts = g.list_partitions ()
4982 The guestfs module provides a Python binding to the libguestfs API
4983 for examining and modifying virtual machine disk images.
4985 Amongst the things this is good for: making batch configuration
4986 changes to guests, getting disk used/free statistics (see also:
4987 virt-df), migrating between virtualization systems (see also:
4988 virt-p2v), performing partial backups, performing partial guest
4989 clones, cloning guests and changing registry/UUID/hostname info, and
4992 Libguestfs uses Linux kernel and qemu code, and can access any type of
4993 guest filesystem that Linux and qemu can, including but not limited
4994 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
4995 schemes, qcow, qcow2, vmdk.
4997 Libguestfs provides ways to enumerate guest storage (eg. partitions,
4998 LVs, what filesystem is in each LV, etc.). It can also run commands
4999 in the context of the guest. Also you can access filesystems over FTP.
5001 Errors which happen while using the API are turned into Python
5002 RuntimeError exceptions.
5004 To create a guestfs handle you usually have to perform the following
5007 # Create the handle, call add_drive at least once, and possibly
5008 # several times if the guest has multiple block devices:
5009 g = guestfs.GuestFS ()
5010 g.add_drive (\"guest.img\")
5012 # Launch the qemu subprocess and wait for it to become ready:
5016 # Now you can issue commands, for example:
5021 import libguestfsmod
5024 \"\"\"Instances of this class are libguestfs API handles.\"\"\"
5026 def __init__ (self):
5027 \"\"\"Create a new libguestfs handle.\"\"\"
5028 self._o = libguestfsmod.create ()
5031 libguestfsmod.close (self._o)
5036 fun (name, style, _, flags, _, _, longdesc) ->
5037 let doc = replace_str longdesc "C<guestfs_" "C<g." in
5039 match fst style with
5040 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _
5043 doc ^ "\n\nThis function returns a list of strings."
5045 doc ^ "\n\nThis function returns a tuple (int, bool).\n"
5047 doc ^ "\n\nThis function returns a list of PVs. Each PV is represented as a dictionary."
5049 doc ^ "\n\nThis function returns a list of VGs. Each VG is represented as a dictionary."
5051 doc ^ "\n\nThis function returns a list of LVs. Each LV is represented as a dictionary."
5053 doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the stat structure."
5055 doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the statvfs structure."
5057 doc ^ "\n\nThis function returns a dictionary." in
5059 if List.mem ProtocolLimitWarning flags then
5060 doc ^ "\n\n" ^ protocol_limit_warning
5063 if List.mem DangerWillRobinson flags then
5064 doc ^ "\n\n" ^ danger_will_robinson
5066 let doc = pod2text ~width:60 name doc in
5067 let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
5068 let doc = String.concat "\n " doc in
5071 generate_call_args ~handle:"self" (snd style);
5073 pr " u\"\"\"%s\"\"\"\n" doc;
5074 pr " return libguestfsmod.%s " name;
5075 generate_call_args ~handle:"self._o" (snd style);
5080 (* Useful if you need the longdesc POD text as plain text. Returns a
5083 and pod2text ~width name longdesc =
5084 let filename, chan = Filename.open_temp_file "gen" ".tmp" in
5085 fprintf chan "=head1 %s\n\n%s\n" name longdesc;
5087 let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
5088 let chan = Unix.open_process_in cmd in
5089 let lines = ref [] in
5091 let line = input_line chan in
5092 if i = 1 then (* discard the first line of output *)
5095 let line = triml line in
5096 lines := line :: !lines;
5099 let lines = try loop 1 with End_of_file -> List.rev !lines in
5100 Unix.unlink filename;
5101 match Unix.close_process_in chan with
5102 | Unix.WEXITED 0 -> lines
5104 failwithf "pod2text: process exited with non-zero status (%d)" i
5105 | Unix.WSIGNALED i | Unix.WSTOPPED i ->
5106 failwithf "pod2text: process signalled or stopped by signal %d" i
5108 (* Generate ruby bindings. *)
5109 and generate_ruby_c () =
5110 generate_header CStyle LGPLv2;
5118 #include \"guestfs.h\"
5120 #include \"extconf.h\"
5122 static VALUE m_guestfs; /* guestfs module */
5123 static VALUE c_guestfs; /* guestfs_h handle */
5124 static VALUE e_Error; /* used for all errors */
5126 static void ruby_guestfs_free (void *p)
5129 guestfs_close ((guestfs_h *) p);
5132 static VALUE ruby_guestfs_create (VALUE m)
5136 g = guestfs_create ();
5138 rb_raise (e_Error, \"failed to create guestfs handle\");
5140 /* Don't print error messages to stderr by default. */
5141 guestfs_set_error_handler (g, NULL, NULL);
5143 /* Wrap it, and make sure the close function is called when the
5146 return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
5149 static VALUE ruby_guestfs_close (VALUE gv)
5152 Data_Get_Struct (gv, guestfs_h, g);
5154 ruby_guestfs_free (g);
5155 DATA_PTR (gv) = NULL;
5163 fun (name, style, _, _, _, _, _) ->
5164 pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
5165 List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
5168 pr " guestfs_h *g;\n";
5169 pr " Data_Get_Struct (gv, guestfs_h, g);\n";
5171 pr " rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
5177 | String n | FileIn n | FileOut n ->
5178 pr " const char *%s = StringValueCStr (%sv);\n" n n;
5180 pr " rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
5181 pr " \"%s\", \"%s\");\n" n name
5183 pr " const char *%s = StringValueCStr (%sv);\n" n n
5187 pr " int i, len;\n";
5188 pr " len = RARRAY_LEN (%sv);\n" n;
5189 pr " %s = malloc (sizeof (char *) * (len+1));\n" n;
5190 pr " for (i = 0; i < len; ++i) {\n";
5191 pr " VALUE v = rb_ary_entry (%sv, i);\n" n;
5192 pr " %s[i] = StringValueCStr (v);\n" n;
5197 pr " int %s = NUM2INT (%sv);\n" n n
5202 match fst style with
5203 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
5204 | RInt64 _ -> pr " int64_t r;\n"; "-1"
5205 | RConstString _ -> pr " const char *r;\n"; "NULL"
5206 | RString _ -> pr " char *r;\n"; "NULL"
5207 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
5208 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
5209 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
5210 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
5211 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
5212 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
5213 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
5216 pr " r = guestfs_%s " name;
5217 generate_call_args ~handle:"g" (snd style);
5222 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
5224 pr " free (%s);\n" n
5227 pr " if (r == %s)\n" error_code;
5228 pr " rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
5231 (match fst style with
5233 pr " return Qnil;\n"
5234 | RInt _ | RBool _ ->
5235 pr " return INT2NUM (r);\n"
5237 pr " return ULL2NUM (r);\n"
5239 pr " return rb_str_new2 (r);\n";
5241 pr " VALUE rv = rb_str_new2 (r);\n";
5245 pr " int i, len = 0;\n";
5246 pr " for (i = 0; r[i] != NULL; ++i) len++;\n";
5247 pr " VALUE rv = rb_ary_new2 (len);\n";
5248 pr " for (i = 0; r[i] != NULL; ++i) {\n";
5249 pr " rb_ary_push (rv, rb_str_new2 (r[i]));\n";
5250 pr " free (r[i]);\n";
5255 pr " VALUE rv = rb_ary_new2 (2);\n";
5256 pr " rb_ary_push (rv, INT2NUM (r->i));\n";
5257 pr " rb_ary_push (rv, INT2NUM (r->b));\n";
5258 pr " guestfs_free_int_bool (r);\n";
5261 generate_ruby_lvm_code "pv" pv_cols
5263 generate_ruby_lvm_code "vg" vg_cols
5265 generate_ruby_lvm_code "lv" lv_cols
5267 pr " VALUE rv = rb_hash_new ();\n";
5271 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
5276 pr " VALUE rv = rb_hash_new ();\n";
5280 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
5285 pr " VALUE rv = rb_hash_new ();\n";
5287 pr " for (i = 0; r[i] != NULL; i+=2) {\n";
5288 pr " rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
5289 pr " free (r[i]);\n";
5290 pr " free (r[i+1]);\n";
5301 /* Initialize the module. */
5302 void Init__guestfs ()
5304 m_guestfs = rb_define_module (\"Guestfs\");
5305 c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
5306 e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
5308 rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
5309 rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
5312 (* Define the rest of the methods. *)
5314 fun (name, style, _, _, _, _, _) ->
5315 pr " rb_define_method (c_guestfs, \"%s\",\n" name;
5316 pr " ruby_guestfs_%s, %d);\n" name (List.length (snd style))
5321 (* Ruby code to return an LVM struct list. *)
5322 and generate_ruby_lvm_code typ cols =
5323 pr " VALUE rv = rb_ary_new2 (r->len);\n";
5325 pr " for (i = 0; i < r->len; ++i) {\n";
5326 pr " VALUE hv = rb_hash_new ();\n";
5330 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
5332 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
5335 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
5336 | name, `OptPercent ->
5337 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
5339 pr " rb_ary_push (rv, hv);\n";
5341 pr " guestfs_free_lvm_%s_list (r);\n" typ;
5344 let output_to filename =
5345 let filename_new = filename ^ ".new" in
5346 chan := open_out filename_new;
5350 Unix.rename filename_new filename;
5351 printf "written %s\n%!" filename;
5359 if not (Sys.file_exists "configure.ac") then (
5361 You are probably running this from the wrong directory.
5362 Run it from the top source directory using the command
5368 let close = output_to "src/guestfs_protocol.x" in
5372 let close = output_to "src/guestfs-structs.h" in
5373 generate_structs_h ();
5376 let close = output_to "src/guestfs-actions.h" in
5377 generate_actions_h ();
5380 let close = output_to "src/guestfs-actions.c" in
5381 generate_client_actions ();
5384 let close = output_to "daemon/actions.h" in
5385 generate_daemon_actions_h ();
5388 let close = output_to "daemon/stubs.c" in
5389 generate_daemon_actions ();
5392 let close = output_to "tests.c" in
5396 let close = output_to "fish/cmds.c" in
5397 generate_fish_cmds ();
5400 let close = output_to "fish/completion.c" in
5401 generate_fish_completion ();
5404 let close = output_to "guestfs-structs.pod" in
5405 generate_structs_pod ();
5408 let close = output_to "guestfs-actions.pod" in
5409 generate_actions_pod ();
5412 let close = output_to "guestfish-actions.pod" in
5413 generate_fish_actions_pod ();
5416 let close = output_to "ocaml/guestfs.mli" in
5417 generate_ocaml_mli ();
5420 let close = output_to "ocaml/guestfs.ml" in
5421 generate_ocaml_ml ();
5424 let close = output_to "ocaml/guestfs_c_actions.c" in
5425 generate_ocaml_c ();
5428 let close = output_to "perl/Guestfs.xs" in
5429 generate_perl_xs ();
5432 let close = output_to "perl/lib/Sys/Guestfs.pm" in
5433 generate_perl_pm ();
5436 let close = output_to "python/guestfs-py.c" in
5437 generate_python_c ();
5440 let close = output_to "python/guestfs.py" in
5441 generate_python_py ();
5444 let close = output_to "ruby/ext/guestfs/_guestfs.c" in