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)>.");
384 ("set_busy", (RErr, []), -1, [NotInFish],
388 This sets the state to C<BUSY>. This is only used when implementing
389 actions using the low-level API.
391 For more information on states, see L<guestfs(3)>.");
393 ("set_ready", (RErr, []), -1, [NotInFish],
395 "set state to ready",
397 This sets the state to C<READY>. This is only used when implementing
398 actions using the low-level API.
400 For more information on states, see L<guestfs(3)>.");
404 let daemon_functions = [
405 ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
406 [InitEmpty, TestOutput (
407 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
408 ["mkfs"; "ext2"; "/dev/sda1"];
409 ["mount"; "/dev/sda1"; "/"];
410 ["write_file"; "/new"; "new file contents"; "0"];
411 ["cat"; "/new"]], "new file contents")],
412 "mount a guest disk at a position in the filesystem",
414 Mount a guest disk at a position in the filesystem. Block devices
415 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
416 the guest. If those block devices contain partitions, they will have
417 the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
420 The rules are the same as for L<mount(2)>: A filesystem must
421 first be mounted on C</> before others can be mounted. Other
422 filesystems can only be mounted on directories which already
425 The mounted filesystem is writable, if we have sufficient permissions
426 on the underlying device.
428 The filesystem options C<sync> and C<noatime> are set with this
429 call, in order to improve reliability.");
431 ("sync", (RErr, []), 2, [],
432 [ InitEmpty, TestRun [["sync"]]],
433 "sync disks, writes are flushed through to the disk image",
435 This syncs the disk, so that any writes are flushed through to the
436 underlying disk image.
438 You should always call this if you have modified a disk image, before
439 closing the handle.");
441 ("touch", (RErr, [String "path"]), 3, [],
442 [InitBasicFS, TestOutputTrue (
444 ["exists"; "/new"]])],
445 "update file timestamps or create a new file",
447 Touch acts like the L<touch(1)> command. It can be used to
448 update the timestamps on a file, or, if the file does not exist,
449 to create a new zero-length file.");
451 ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
452 [InitBasicFS, TestOutput (
453 [["write_file"; "/new"; "new file contents"; "0"];
454 ["cat"; "/new"]], "new file contents")],
455 "list the contents of a file",
457 Return the contents of the file named C<path>.
459 Note that this function cannot correctly handle binary files
460 (specifically, files containing C<\\0> character which is treated
461 as end of string). For those you need to use the C<guestfs_download>
462 function which has a more complex interface.");
464 ("ll", (RString "listing", [String "directory"]), 5, [],
465 [], (* XXX Tricky to test because it depends on the exact format
466 * of the 'ls -l' command, which changes between F10 and F11.
468 "list the files in a directory (long format)",
470 List the files in C<directory> (relative to the root directory,
471 there is no cwd) in the format of 'ls -la'.
473 This command is mostly useful for interactive sessions. It
474 is I<not> intended that you try to parse the output string.");
476 ("ls", (RStringList "listing", [String "directory"]), 6, [],
477 [InitBasicFS, TestOutputList (
480 ["touch"; "/newest"];
481 ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
482 "list the files in a directory",
484 List the files in C<directory> (relative to the root directory,
485 there is no cwd). The '.' and '..' entries are not returned, but
486 hidden files are shown.
488 This command is mostly useful for interactive sessions. Programs
489 should probably use C<guestfs_readdir> instead.");
491 ("list_devices", (RStringList "devices", []), 7, [],
492 [InitEmpty, TestOutputList (
493 [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"])],
494 "list the block devices",
496 List all the block devices.
498 The full block device names are returned, eg. C</dev/sda>");
500 ("list_partitions", (RStringList "partitions", []), 8, [],
501 [InitBasicFS, TestOutputList (
502 [["list_partitions"]], ["/dev/sda1"]);
503 InitEmpty, TestOutputList (
504 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
505 ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
506 "list the partitions",
508 List all the partitions detected on all block devices.
510 The full partition device names are returned, eg. C</dev/sda1>
512 This does not return logical volumes. For that you will need to
513 call C<guestfs_lvs>.");
515 ("pvs", (RStringList "physvols", []), 9, [],
516 [InitBasicFSonLVM, TestOutputList (
517 [["pvs"]], ["/dev/sda1"]);
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 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
524 "list the LVM physical volumes (PVs)",
526 List all the physical volumes detected. This is the equivalent
527 of the L<pvs(8)> command.
529 This returns a list of just the device names that contain
530 PVs (eg. C</dev/sda2>).
532 See also C<guestfs_pvs_full>.");
534 ("vgs", (RStringList "volgroups", []), 10, [],
535 [InitBasicFSonLVM, TestOutputList (
537 InitEmpty, TestOutputList (
538 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
539 ["pvcreate"; "/dev/sda1"];
540 ["pvcreate"; "/dev/sda2"];
541 ["pvcreate"; "/dev/sda3"];
542 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
543 ["vgcreate"; "VG2"; "/dev/sda3"];
544 ["vgs"]], ["VG1"; "VG2"])],
545 "list the LVM volume groups (VGs)",
547 List all the volumes groups detected. This is the equivalent
548 of the L<vgs(8)> command.
550 This returns a list of just the volume group names that were
551 detected (eg. C<VolGroup00>).
553 See also C<guestfs_vgs_full>.");
555 ("lvs", (RStringList "logvols", []), 11, [],
556 [InitBasicFSonLVM, TestOutputList (
557 [["lvs"]], ["/dev/VG/LV"]);
558 InitEmpty, TestOutputList (
559 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
560 ["pvcreate"; "/dev/sda1"];
561 ["pvcreate"; "/dev/sda2"];
562 ["pvcreate"; "/dev/sda3"];
563 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
564 ["vgcreate"; "VG2"; "/dev/sda3"];
565 ["lvcreate"; "LV1"; "VG1"; "50"];
566 ["lvcreate"; "LV2"; "VG1"; "50"];
567 ["lvcreate"; "LV3"; "VG2"; "50"];
568 ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
569 "list the LVM logical volumes (LVs)",
571 List all the logical volumes detected. This is the equivalent
572 of the L<lvs(8)> command.
574 This returns a list of the logical volume device names
575 (eg. C</dev/VolGroup00/LogVol00>).
577 See also C<guestfs_lvs_full>.");
579 ("pvs_full", (RPVList "physvols", []), 12, [],
580 [], (* XXX how to test? *)
581 "list the LVM physical volumes (PVs)",
583 List all the physical volumes detected. This is the equivalent
584 of the L<pvs(8)> command. The \"full\" version includes all fields.");
586 ("vgs_full", (RVGList "volgroups", []), 13, [],
587 [], (* XXX how to test? *)
588 "list the LVM volume groups (VGs)",
590 List all the volumes groups detected. This is the equivalent
591 of the L<vgs(8)> command. The \"full\" version includes all fields.");
593 ("lvs_full", (RLVList "logvols", []), 14, [],
594 [], (* XXX how to test? *)
595 "list the LVM logical volumes (LVs)",
597 List all the logical volumes detected. This is the equivalent
598 of the L<lvs(8)> command. The \"full\" version includes all fields.");
600 ("read_lines", (RStringList "lines", [String "path"]), 15, [],
601 [InitBasicFS, TestOutputList (
602 [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
603 ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);
604 InitBasicFS, TestOutputList (
605 [["write_file"; "/new"; ""; "0"];
606 ["read_lines"; "/new"]], [])],
607 "read file as lines",
609 Return the contents of the file named C<path>.
611 The file contents are returned as a list of lines. Trailing
612 C<LF> and C<CRLF> character sequences are I<not> returned.
614 Note that this function cannot correctly handle binary files
615 (specifically, files containing C<\\0> character which is treated
616 as end of line). For those you need to use the C<guestfs_read_file>
617 function which has a more complex interface.");
619 ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [],
620 [], (* XXX Augeas code needs tests. *)
621 "create a new Augeas handle",
623 Create a new Augeas handle for editing configuration files.
624 If there was any previous Augeas handle associated with this
625 guestfs session, then it is closed.
627 You must call this before using any other C<guestfs_aug_*>
630 C<root> is the filesystem root. C<root> must not be NULL,
633 The flags are the same as the flags defined in
634 E<lt>augeas.hE<gt>, the logical I<or> of the following
639 =item C<AUG_SAVE_BACKUP> = 1
641 Keep the original file with a C<.augsave> extension.
643 =item C<AUG_SAVE_NEWFILE> = 2
645 Save changes into a file with extension C<.augnew>, and
646 do not overwrite original. Overrides C<AUG_SAVE_BACKUP>.
648 =item C<AUG_TYPE_CHECK> = 4
650 Typecheck lenses (can be expensive).
652 =item C<AUG_NO_STDINC> = 8
654 Do not use standard load path for modules.
656 =item C<AUG_SAVE_NOOP> = 16
658 Make save a no-op, just record what would have been changed.
660 =item C<AUG_NO_LOAD> = 32
662 Do not load the tree in C<guestfs_aug_init>.
666 To close the handle, you can call C<guestfs_aug_close>.
668 To find out more about Augeas, see L<http://augeas.net/>.");
670 ("aug_close", (RErr, []), 26, [],
671 [], (* XXX Augeas code needs tests. *)
672 "close the current Augeas handle",
674 Close the current Augeas handle and free up any resources
675 used by it. After calling this, you have to call
676 C<guestfs_aug_init> again before you can use any other
679 ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
680 [], (* XXX Augeas code needs tests. *)
681 "define an Augeas variable",
683 Defines an Augeas variable C<name> whose value is the result
684 of evaluating C<expr>. If C<expr> is NULL, then C<name> is
687 On success this returns the number of nodes in C<expr>, or
688 C<0> if C<expr> evaluates to something which is not a nodeset.");
690 ("aug_defnode", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [],
691 [], (* XXX Augeas code needs tests. *)
692 "define an Augeas node",
694 Defines a variable C<name> whose value is the result of
697 If C<expr> evaluates to an empty nodeset, a node is created,
698 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
699 C<name> will be the nodeset containing that single node.
701 On success this returns a pair containing the
702 number of nodes in the nodeset, and a boolean flag
703 if a node was created.");
705 ("aug_get", (RString "val", [String "path"]), 19, [],
706 [], (* XXX Augeas code needs tests. *)
707 "look up the value of an Augeas path",
709 Look up the value associated with C<path>. If C<path>
710 matches exactly one node, the C<value> is returned.");
712 ("aug_set", (RErr, [String "path"; String "val"]), 20, [],
713 [], (* XXX Augeas code needs tests. *)
714 "set Augeas path to value",
716 Set the value associated with C<path> to C<value>.");
718 ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [],
719 [], (* XXX Augeas code needs tests. *)
720 "insert a sibling Augeas node",
722 Create a new sibling C<label> for C<path>, inserting it into
723 the tree before or after C<path> (depending on the boolean
726 C<path> must match exactly one existing node in the tree, and
727 C<label> must be a label, ie. not contain C</>, C<*> or end
728 with a bracketed index C<[N]>.");
730 ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
731 [], (* XXX Augeas code needs tests. *)
732 "remove an Augeas path",
734 Remove C<path> and all of its children.
736 On success this returns the number of entries which were removed.");
738 ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [],
739 [], (* XXX Augeas code needs tests. *)
742 Move the node C<src> to C<dest>. C<src> must match exactly
743 one node. C<dest> is overwritten if it exists.");
745 ("aug_match", (RStringList "matches", [String "path"]), 24, [],
746 [], (* XXX Augeas code needs tests. *)
747 "return Augeas nodes which match path",
749 Returns a list of paths which match the path expression C<path>.
750 The returned paths are sufficiently qualified so that they match
751 exactly one node in the current tree.");
753 ("aug_save", (RErr, []), 25, [],
754 [], (* XXX Augeas code needs tests. *)
755 "write all pending Augeas changes to disk",
757 This writes all pending changes to disk.
759 The flags which were passed to C<guestfs_aug_init> affect exactly
760 how files are saved.");
762 ("aug_load", (RErr, []), 27, [],
763 [], (* XXX Augeas code needs tests. *)
764 "load files into the tree",
766 Load files into the tree.
768 See C<aug_load> in the Augeas documentation for the full gory
771 ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
772 [], (* XXX Augeas code needs tests. *)
773 "list Augeas nodes under a path",
775 This is just a shortcut for listing C<guestfs_aug_match>
776 C<path/*> and sorting the resulting nodes into alphabetical order.");
778 ("rm", (RErr, [String "path"]), 29, [],
779 [InitBasicFS, TestRun
782 InitBasicFS, TestLastFail
784 InitBasicFS, TestLastFail
789 Remove the single file C<path>.");
791 ("rmdir", (RErr, [String "path"]), 30, [],
792 [InitBasicFS, TestRun
795 InitBasicFS, TestLastFail
797 InitBasicFS, TestLastFail
800 "remove a directory",
802 Remove the single directory C<path>.");
804 ("rm_rf", (RErr, [String "path"]), 31, [],
805 [InitBasicFS, TestOutputFalse
807 ["mkdir"; "/new/foo"];
808 ["touch"; "/new/foo/bar"];
810 ["exists"; "/new"]]],
811 "remove a file or directory recursively",
813 Remove the file or directory C<path>, recursively removing the
814 contents if its a directory. This is like the C<rm -rf> shell
817 ("mkdir", (RErr, [String "path"]), 32, [],
818 [InitBasicFS, TestOutputTrue
821 InitBasicFS, TestLastFail
822 [["mkdir"; "/new/foo/bar"]]],
823 "create a directory",
825 Create a directory named C<path>.");
827 ("mkdir_p", (RErr, [String "path"]), 33, [],
828 [InitBasicFS, TestOutputTrue
829 [["mkdir_p"; "/new/foo/bar"];
830 ["is_dir"; "/new/foo/bar"]];
831 InitBasicFS, TestOutputTrue
832 [["mkdir_p"; "/new/foo/bar"];
833 ["is_dir"; "/new/foo"]];
834 InitBasicFS, TestOutputTrue
835 [["mkdir_p"; "/new/foo/bar"];
836 ["is_dir"; "/new"]]],
837 "create a directory and parents",
839 Create a directory named C<path>, creating any parent directories
840 as necessary. This is like the C<mkdir -p> shell command.");
842 ("chmod", (RErr, [Int "mode"; String "path"]), 34, [],
843 [], (* XXX Need stat command to test *)
846 Change the mode (permissions) of C<path> to C<mode>. Only
847 numeric modes are supported.");
849 ("chown", (RErr, [Int "owner"; Int "group"; String "path"]), 35, [],
850 [], (* XXX Need stat command to test *)
851 "change file owner and group",
853 Change the file owner to C<owner> and group to C<group>.
855 Only numeric uid and gid are supported. If you want to use
856 names, you will need to locate and parse the password file
857 yourself (Augeas support makes this relatively easy).");
859 ("exists", (RBool "existsflag", [String "path"]), 36, [],
860 [InitBasicFS, TestOutputTrue (
862 ["exists"; "/new"]]);
863 InitBasicFS, TestOutputTrue (
865 ["exists"; "/new"]])],
866 "test if file or directory exists",
868 This returns C<true> if and only if there is a file, directory
869 (or anything) with the given C<path> name.
871 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
873 ("is_file", (RBool "fileflag", [String "path"]), 37, [],
874 [InitBasicFS, TestOutputTrue (
876 ["is_file"; "/new"]]);
877 InitBasicFS, TestOutputFalse (
879 ["is_file"; "/new"]])],
880 "test if file exists",
882 This returns C<true> if and only if there is a file
883 with the given C<path> name. Note that it returns false for
884 other objects like directories.
886 See also C<guestfs_stat>.");
888 ("is_dir", (RBool "dirflag", [String "path"]), 38, [],
889 [InitBasicFS, TestOutputFalse (
891 ["is_dir"; "/new"]]);
892 InitBasicFS, TestOutputTrue (
894 ["is_dir"; "/new"]])],
895 "test if file exists",
897 This returns C<true> if and only if there is a directory
898 with the given C<path> name. Note that it returns false for
899 other objects like files.
901 See also C<guestfs_stat>.");
903 ("pvcreate", (RErr, [String "device"]), 39, [],
904 [InitEmpty, TestOutputList (
905 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
906 ["pvcreate"; "/dev/sda1"];
907 ["pvcreate"; "/dev/sda2"];
908 ["pvcreate"; "/dev/sda3"];
909 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
910 "create an LVM physical volume",
912 This creates an LVM physical volume on the named C<device>,
913 where C<device> should usually be a partition name such
916 ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
917 [InitEmpty, TestOutputList (
918 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
919 ["pvcreate"; "/dev/sda1"];
920 ["pvcreate"; "/dev/sda2"];
921 ["pvcreate"; "/dev/sda3"];
922 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
923 ["vgcreate"; "VG2"; "/dev/sda3"];
924 ["vgs"]], ["VG1"; "VG2"])],
925 "create an LVM volume group",
927 This creates an LVM volume group called C<volgroup>
928 from the non-empty list of physical volumes C<physvols>.");
930 ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [],
931 [InitEmpty, TestOutputList (
932 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
933 ["pvcreate"; "/dev/sda1"];
934 ["pvcreate"; "/dev/sda2"];
935 ["pvcreate"; "/dev/sda3"];
936 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
937 ["vgcreate"; "VG2"; "/dev/sda3"];
938 ["lvcreate"; "LV1"; "VG1"; "50"];
939 ["lvcreate"; "LV2"; "VG1"; "50"];
940 ["lvcreate"; "LV3"; "VG2"; "50"];
941 ["lvcreate"; "LV4"; "VG2"; "50"];
942 ["lvcreate"; "LV5"; "VG2"; "50"];
944 ["/dev/VG1/LV1"; "/dev/VG1/LV2";
945 "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
946 "create an LVM volume group",
948 This creates an LVM volume group called C<logvol>
949 on the volume group C<volgroup>, with C<size> megabytes.");
951 ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [],
952 [InitEmpty, TestOutput (
953 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
954 ["mkfs"; "ext2"; "/dev/sda1"];
955 ["mount"; "/dev/sda1"; "/"];
956 ["write_file"; "/new"; "new file contents"; "0"];
957 ["cat"; "/new"]], "new file contents")],
960 This creates a filesystem on C<device> (usually a partition
961 of LVM logical volume). The filesystem type is C<fstype>, for
964 ("sfdisk", (RErr, [String "device";
965 Int "cyls"; Int "heads"; Int "sectors";
966 StringList "lines"]), 43, [DangerWillRobinson],
968 "create partitions on a block device",
970 This is a direct interface to the L<sfdisk(8)> program for creating
971 partitions on block devices.
973 C<device> should be a block device, for example C</dev/sda>.
975 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
976 and sectors on the device, which are passed directly to sfdisk as
977 the I<-C>, I<-H> and I<-S> parameters. If you pass C<0> for any
978 of these, then the corresponding parameter is omitted. Usually for
979 'large' disks, you can just pass C<0> for these, but for small
980 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
981 out the right geometry and you will need to tell it.
983 C<lines> is a list of lines that we feed to C<sfdisk>. For more
984 information refer to the L<sfdisk(8)> manpage.
986 To create a single partition occupying the whole disk, you would
987 pass C<lines> as a single element list, when the single element being
988 the string C<,> (comma).");
990 ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
991 [InitBasicFS, TestOutput (
992 [["write_file"; "/new"; "new file contents"; "0"];
993 ["cat"; "/new"]], "new file contents");
994 InitBasicFS, TestOutput (
995 [["write_file"; "/new"; "\nnew file contents\n"; "0"];
996 ["cat"; "/new"]], "\nnew file contents\n");
997 InitBasicFS, TestOutput (
998 [["write_file"; "/new"; "\n\n"; "0"];
999 ["cat"; "/new"]], "\n\n");
1000 InitBasicFS, TestOutput (
1001 [["write_file"; "/new"; ""; "0"];
1002 ["cat"; "/new"]], "");
1003 InitBasicFS, TestOutput (
1004 [["write_file"; "/new"; "\n\n\n"; "0"];
1005 ["cat"; "/new"]], "\n\n\n");
1006 InitBasicFS, TestOutput (
1007 [["write_file"; "/new"; "\n"; "0"];
1008 ["cat"; "/new"]], "\n")],
1011 This call creates a file called C<path>. The contents of the
1012 file is the string C<content> (which can contain any 8 bit data),
1013 with length C<size>.
1015 As a special case, if C<size> is C<0>
1016 then the length is calculated using C<strlen> (so in this case
1017 the content cannot contain embedded ASCII NULs).");
1019 ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
1020 [InitEmpty, TestOutputList (
1021 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1022 ["mkfs"; "ext2"; "/dev/sda1"];
1023 ["mount"; "/dev/sda1"; "/"];
1024 ["mounts"]], ["/dev/sda1"]);
1025 InitEmpty, TestOutputList (
1026 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1027 ["mkfs"; "ext2"; "/dev/sda1"];
1028 ["mount"; "/dev/sda1"; "/"];
1031 "unmount a filesystem",
1033 This unmounts the given filesystem. The filesystem may be
1034 specified either by its mountpoint (path) or the device which
1035 contains the filesystem.");
1037 ("mounts", (RStringList "devices", []), 46, [],
1038 [InitBasicFS, TestOutputList (
1039 [["mounts"]], ["/dev/sda1"])],
1040 "show mounted filesystems",
1042 This returns the list of currently mounted filesystems. It returns
1043 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
1045 Some internal mounts are not shown.");
1047 ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
1048 [InitBasicFS, TestOutputList (
1051 "unmount all filesystems",
1053 This unmounts all mounted filesystems.
1055 Some internal mounts are not unmounted by this call.");
1057 ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson],
1059 "remove all LVM LVs, VGs and PVs",
1061 This command removes all LVM logical volumes, volume groups
1062 and physical volumes.");
1064 ("file", (RString "description", [String "path"]), 49, [],
1065 [InitBasicFS, TestOutput (
1067 ["file"; "/new"]], "empty");
1068 InitBasicFS, TestOutput (
1069 [["write_file"; "/new"; "some content\n"; "0"];
1070 ["file"; "/new"]], "ASCII text");
1071 InitBasicFS, TestLastFail (
1072 [["file"; "/nofile"]])],
1073 "determine file type",
1075 This call uses the standard L<file(1)> command to determine
1076 the type or contents of the file. This also works on devices,
1077 for example to find out whether a partition contains a filesystem.
1079 The exact command which runs is C<file -bsL path>. Note in
1080 particular that the filename is not prepended to the output
1081 (the C<-b> option).");
1083 ("command", (RString "output", [StringList "arguments"]), 50, [],
1084 [], (* XXX how to test? *)
1085 "run a command from the guest filesystem",
1087 This call runs a command from the guest filesystem. The
1088 filesystem must be mounted, and must contain a compatible
1089 operating system (ie. something Linux, with the same
1090 or compatible processor architecture).
1092 The single parameter is an argv-style list of arguments.
1093 The first element is the name of the program to run.
1094 Subsequent elements are parameters. The list must be
1095 non-empty (ie. must contain a program name).
1097 The C<$PATH> environment variable will contain at least
1098 C</usr/bin> and C</bin>. If you require a program from
1099 another location, you should provide the full path in the
1102 Shared libraries and data files required by the program
1103 must be available on filesystems which are mounted in the
1104 correct places. It is the caller's responsibility to ensure
1105 all filesystems that are needed are mounted at the right
1108 ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [],
1109 [], (* XXX how to test? *)
1110 "run a command, returning lines",
1112 This is the same as C<guestfs_command>, but splits the
1113 result into a list of lines.");
1115 ("stat", (RStat "statbuf", [String "path"]), 52, [],
1116 [InitBasicFS, TestOutputStruct (
1118 ["stat"; "/new"]], [CompareWithInt ("size", 0)])],
1119 "get file information",
1121 Returns file information for the given C<path>.
1123 This is the same as the C<stat(2)> system call.");
1125 ("lstat", (RStat "statbuf", [String "path"]), 53, [],
1126 [InitBasicFS, TestOutputStruct (
1128 ["lstat"; "/new"]], [CompareWithInt ("size", 0)])],
1129 "get file information for a symbolic link",
1131 Returns file information for the given C<path>.
1133 This is the same as C<guestfs_stat> except that if C<path>
1134 is a symbolic link, then the link is stat-ed, not the file it
1137 This is the same as the C<lstat(2)> system call.");
1139 ("statvfs", (RStatVFS "statbuf", [String "path"]), 54, [],
1140 [InitBasicFS, TestOutputStruct (
1141 [["statvfs"; "/"]], [CompareWithInt ("bfree", 487702);
1142 CompareWithInt ("blocks", 490020);
1143 CompareWithInt ("bsize", 1024)])],
1144 "get file system statistics",
1146 Returns file system statistics for any mounted file system.
1147 C<path> should be a file or directory in the mounted file system
1148 (typically it is the mount point itself, but it doesn't need to be).
1150 This is the same as the C<statvfs(2)> system call.");
1152 ("tune2fs_l", (RHashtable "superblock", [String "device"]), 55, [],
1154 "get ext2/ext3 superblock details",
1156 This returns the contents of the ext2 or ext3 filesystem superblock
1159 It is the same as running C<tune2fs -l device>. See L<tune2fs(8)>
1160 manpage for more details. The list of fields returned isn't
1161 clearly defined, and depends on both the version of C<tune2fs>
1162 that libguestfs was built against, and the filesystem itself.");
1164 ("blockdev_setro", (RErr, [String "device"]), 56, [],
1165 [InitEmpty, TestOutputTrue (
1166 [["blockdev_setro"; "/dev/sda"];
1167 ["blockdev_getro"; "/dev/sda"]])],
1168 "set block device to read-only",
1170 Sets the block device named C<device> to read-only.
1172 This uses the L<blockdev(8)> command.");
1174 ("blockdev_setrw", (RErr, [String "device"]), 57, [],
1175 [InitEmpty, TestOutputFalse (
1176 [["blockdev_setrw"; "/dev/sda"];
1177 ["blockdev_getro"; "/dev/sda"]])],
1178 "set block device to read-write",
1180 Sets the block device named C<device> to read-write.
1182 This uses the L<blockdev(8)> command.");
1184 ("blockdev_getro", (RBool "ro", [String "device"]), 58, [],
1185 [InitEmpty, TestOutputTrue (
1186 [["blockdev_setro"; "/dev/sda"];
1187 ["blockdev_getro"; "/dev/sda"]])],
1188 "is block device set to read-only",
1190 Returns a boolean indicating if the block device is read-only
1191 (true if read-only, false if not).
1193 This uses the L<blockdev(8)> command.");
1195 ("blockdev_getss", (RInt "sectorsize", [String "device"]), 59, [],
1196 [InitEmpty, TestOutputInt (
1197 [["blockdev_getss"; "/dev/sda"]], 512)],
1198 "get sectorsize of block device",
1200 This returns the size of sectors on a block device.
1201 Usually 512, but can be larger for modern devices.
1203 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
1206 This uses the L<blockdev(8)> command.");
1208 ("blockdev_getbsz", (RInt "blocksize", [String "device"]), 60, [],
1209 [InitEmpty, TestOutputInt (
1210 [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1211 "get blocksize of block device",
1213 This returns the block size of a device.
1215 (Note this is different from both I<size in blocks> and
1216 I<filesystem block size>).
1218 This uses the L<blockdev(8)> command.");
1220 ("blockdev_setbsz", (RErr, [String "device"; Int "blocksize"]), 61, [],
1222 "set blocksize of block device",
1224 This sets the block size of a device.
1226 (Note this is different from both I<size in blocks> and
1227 I<filesystem block size>).
1229 This uses the L<blockdev(8)> command.");
1231 ("blockdev_getsz", (RInt64 "sizeinsectors", [String "device"]), 62, [],
1232 [InitEmpty, TestOutputInt (
1233 [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1234 "get total size of device in 512-byte sectors",
1236 This returns the size of the device in units of 512-byte sectors
1237 (even if the sectorsize isn't 512 bytes ... weird).
1239 See also C<guestfs_blockdev_getss> for the real sector size of
1240 the device, and C<guestfs_blockdev_getsize64> for the more
1241 useful I<size in bytes>.
1243 This uses the L<blockdev(8)> command.");
1245 ("blockdev_getsize64", (RInt64 "sizeinbytes", [String "device"]), 63, [],
1246 [InitEmpty, TestOutputInt (
1247 [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1248 "get total size of device in bytes",
1250 This returns the size of the device in bytes.
1252 See also C<guestfs_blockdev_getsz>.
1254 This uses the L<blockdev(8)> command.");
1256 ("blockdev_flushbufs", (RErr, [String "device"]), 64, [],
1258 [["blockdev_flushbufs"; "/dev/sda"]]],
1259 "flush device buffers",
1261 This tells the kernel to flush internal buffers associated
1264 This uses the L<blockdev(8)> command.");
1266 ("blockdev_rereadpt", (RErr, [String "device"]), 65, [],
1268 [["blockdev_rereadpt"; "/dev/sda"]]],
1269 "reread partition table",
1271 Reread the partition table on C<device>.
1273 This uses the L<blockdev(8)> command.");
1275 ("upload", (RErr, [FileIn "filename"; String "remotefilename"]), 66, [],
1276 [InitBasicFS, TestOutput (
1277 (* Pick a file from cwd which isn't likely to change. *)
1278 [["upload"; "COPYING.LIB"; "/COPYING.LIB"];
1279 ["checksum"; "md5"; "/COPYING.LIB"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
1280 "upload a file from the local machine",
1282 Upload local file C<filename> to C<remotefilename> on the
1285 C<filename> can also be a named pipe.
1287 See also C<guestfs_download>.");
1289 ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [],
1290 [InitBasicFS, TestOutput (
1291 (* Pick a file from cwd which isn't likely to change. *)
1292 [["upload"; "COPYING.LIB"; "/COPYING.LIB"];
1293 ["download"; "/COPYING.LIB"; "testdownload.tmp"];
1294 ["upload"; "testdownload.tmp"; "/upload"];
1295 ["checksum"; "md5"; "/upload"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
1296 "download a file to the local machine",
1298 Download file C<remotefilename> and save it as C<filename>
1299 on the local machine.
1301 C<filename> can also be a named pipe.
1303 See also C<guestfs_upload>, C<guestfs_cat>.");
1305 ("checksum", (RString "checksum", [String "csumtype"; String "path"]), 68, [],
1306 [InitBasicFS, TestOutput (
1307 [["write_file"; "/new"; "test\n"; "0"];
1308 ["checksum"; "crc"; "/new"]], "935282863");
1309 InitBasicFS, TestLastFail (
1310 [["checksum"; "crc"; "/new"]]);
1311 InitBasicFS, TestOutput (
1312 [["write_file"; "/new"; "test\n"; "0"];
1313 ["checksum"; "md5"; "/new"]], "d8e8fca2dc0f896fd7cb4cb0031ba249");
1314 InitBasicFS, TestOutput (
1315 [["write_file"; "/new"; "test\n"; "0"];
1316 ["checksum"; "sha1"; "/new"]], "4e1243bd22c66e76c2ba9eddc1f91394e57f9f83");
1317 InitBasicFS, TestOutput (
1318 [["write_file"; "/new"; "test\n"; "0"];
1319 ["checksum"; "sha224"; "/new"]], "52f1bf093f4b7588726035c176c0cdb4376cfea53819f1395ac9e6ec");
1320 InitBasicFS, TestOutput (
1321 [["write_file"; "/new"; "test\n"; "0"];
1322 ["checksum"; "sha256"; "/new"]], "f2ca1bb6c7e907d06dafe4687e579fce76b37e4e93b7605022da52e6ccc26fd2");
1323 InitBasicFS, TestOutput (
1324 [["write_file"; "/new"; "test\n"; "0"];
1325 ["checksum"; "sha384"; "/new"]], "109bb6b5b6d5547c1ce03c7a8bd7d8f80c1cb0957f50c4f7fda04692079917e4f9cad52b878f3d8234e1a170b154b72d");
1326 InitBasicFS, TestOutput (
1327 [["write_file"; "/new"; "test\n"; "0"];
1328 ["checksum"; "sha512"; "/new"]], "0e3e75234abc68f4378a86b3f4b32a198ba301845b0cd6e50106e874345700cc6663a86c1ea125dc5e92be17c98f9a0f85ca9d5f595db2012f7cc3571945c123")],
1329 "compute MD5, SHAx or CRC checksum of file",
1331 This call computes the MD5, SHAx or CRC checksum of the
1334 The type of checksum to compute is given by the C<csumtype>
1335 parameter which must have one of the following values:
1341 Compute the cyclic redundancy check (CRC) specified by POSIX
1342 for the C<cksum> command.
1346 Compute the MD5 hash (using the C<md5sum> program).
1350 Compute the SHA1 hash (using the C<sha1sum> program).
1354 Compute the SHA224 hash (using the C<sha224sum> program).
1358 Compute the SHA256 hash (using the C<sha256sum> program).
1362 Compute the SHA384 hash (using the C<sha384sum> program).
1366 Compute the SHA512 hash (using the C<sha512sum> program).
1370 The checksum is returned as a printable string.");
1374 let all_functions = non_daemon_functions @ daemon_functions
1376 (* In some places we want the functions to be displayed sorted
1377 * alphabetically, so this is useful:
1379 let all_functions_sorted =
1380 List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
1381 compare n1 n2) all_functions
1383 (* Column names and types from LVM PVs/VGs/LVs. *)
1392 "pv_attr", `String (* XXX *);
1393 "pv_pe_count", `Int;
1394 "pv_pe_alloc_count", `Int;
1397 "pv_mda_count", `Int;
1398 "pv_mda_free", `Bytes;
1399 (* Not in Fedora 10:
1400 "pv_mda_size", `Bytes;
1407 "vg_attr", `String (* XXX *);
1410 "vg_sysid", `String;
1411 "vg_extent_size", `Bytes;
1412 "vg_extent_count", `Int;
1413 "vg_free_count", `Int;
1421 "vg_mda_count", `Int;
1422 "vg_mda_free", `Bytes;
1423 (* Not in Fedora 10:
1424 "vg_mda_size", `Bytes;
1430 "lv_attr", `String (* XXX *);
1433 "lv_kernel_major", `Int;
1434 "lv_kernel_minor", `Int;
1438 "snap_percent", `OptPercent;
1439 "copy_percent", `OptPercent;
1442 "mirror_log", `String;
1446 (* Column names and types from stat structures.
1447 * NB. Can't use things like 'st_atime' because glibc header files
1448 * define some of these as macros. Ugh.
1465 let statvfs_cols = [
1479 (* Useful functions.
1480 * Note we don't want to use any external OCaml libraries which
1481 * makes this a bit harder than it should be.
1483 let failwithf fs = ksprintf failwith fs
1485 let replace_char s c1 c2 =
1486 let s2 = String.copy s in
1487 let r = ref false in
1488 for i = 0 to String.length s2 - 1 do
1489 if String.unsafe_get s2 i = c1 then (
1490 String.unsafe_set s2 i c2;
1494 if not !r then s else s2
1498 (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
1500 let triml ?(test = isspace) str =
1502 let n = ref (String.length str) in
1503 while !n > 0 && test str.[!i]; do
1508 else String.sub str !i !n
1510 let trimr ?(test = isspace) str =
1511 let n = ref (String.length str) in
1512 while !n > 0 && test str.[!n-1]; do
1515 if !n = String.length str then str
1516 else String.sub str 0 !n
1518 let trim ?(test = isspace) str =
1519 trimr ~test (triml ~test str)
1521 let rec find s sub =
1522 let len = String.length s in
1523 let sublen = String.length sub in
1525 if i <= len-sublen then (
1527 if j < sublen then (
1528 if s.[i+j] = sub.[j] then loop2 (j+1)
1534 if r = -1 then loop (i+1) else r
1540 let rec replace_str s s1 s2 =
1541 let len = String.length s in
1542 let sublen = String.length s1 in
1543 let i = find s s1 in
1546 let s' = String.sub s 0 i in
1547 let s'' = String.sub s (i+sublen) (len-i-sublen) in
1548 s' ^ s2 ^ replace_str s'' s1 s2
1551 let rec string_split sep str =
1552 let len = String.length str in
1553 let seplen = String.length sep in
1554 let i = find str sep in
1555 if i = -1 then [str]
1557 let s' = String.sub str 0 i in
1558 let s'' = String.sub str (i+seplen) (len-i-seplen) in
1559 s' :: string_split sep s''
1562 let rec find_map f = function
1563 | [] -> raise Not_found
1567 | None -> find_map f xs
1570 let rec loop i = function
1572 | x :: xs -> f i x; loop (i+1) xs
1577 let rec loop i = function
1579 | x :: xs -> let r = f i x in r :: loop (i+1) xs
1583 let name_of_argt = function
1584 | String n | OptString n | StringList n | Bool n | Int n
1585 | FileIn n | FileOut n -> n
1587 let seq_of_test = function
1588 | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
1589 | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s
1590 | TestOutputLength (s, _) | TestOutputStruct (s, _)
1591 | TestLastFail s -> s
1593 (* Check function names etc. for consistency. *)
1594 let check_functions () =
1595 let contains_uppercase str =
1596 let len = String.length str in
1598 if i >= len then false
1601 if c >= 'A' && c <= 'Z' then true
1608 (* Check function names. *)
1610 fun (name, _, _, _, _, _, _) ->
1611 if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
1612 failwithf "function name %s does not need 'guestfs' prefix" name;
1613 if contains_uppercase name then
1614 failwithf "function name %s should not contain uppercase chars" name;
1615 if String.contains name '-' then
1616 failwithf "function name %s should not contain '-', use '_' instead."
1620 (* Check function parameter/return names. *)
1622 fun (name, style, _, _, _, _, _) ->
1623 let check_arg_ret_name n =
1624 if contains_uppercase n then
1625 failwithf "%s param/ret %s should not contain uppercase chars"
1627 if String.contains n '-' || String.contains n '_' then
1628 failwithf "%s param/ret %s should not contain '-' or '_'"
1631 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;
1632 if n = "argv" || n = "args" then
1633 failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" n
1636 (match fst style with
1638 | RInt n | RInt64 n | RBool n | RConstString n | RString n
1639 | RStringList n | RPVList n | RVGList n | RLVList n
1640 | RStat n | RStatVFS n
1642 check_arg_ret_name n
1644 check_arg_ret_name n;
1645 check_arg_ret_name m
1647 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
1650 (* Check short descriptions. *)
1652 fun (name, _, _, _, _, shortdesc, _) ->
1653 if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
1654 failwithf "short description of %s should begin with lowercase." name;
1655 let c = shortdesc.[String.length shortdesc-1] in
1656 if c = '\n' || c = '.' then
1657 failwithf "short description of %s should not end with . or \\n." name
1660 (* Check long dscriptions. *)
1662 fun (name, _, _, _, _, _, longdesc) ->
1663 if longdesc.[String.length longdesc-1] = '\n' then
1664 failwithf "long description of %s should not end with \\n." name
1667 (* Check proc_nrs. *)
1669 fun (name, _, proc_nr, _, _, _, _) ->
1670 if proc_nr <= 0 then
1671 failwithf "daemon function %s should have proc_nr > 0" name
1675 fun (name, _, proc_nr, _, _, _, _) ->
1676 if proc_nr <> -1 then
1677 failwithf "non-daemon function %s should have proc_nr -1" name
1678 ) non_daemon_functions;
1681 List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
1684 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
1685 let rec loop = function
1688 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
1690 | (name1,nr1) :: (name2,nr2) :: _ ->
1691 failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
1699 (* Ignore functions that have no tests. We generate a
1700 * warning when the user does 'make check' instead.
1702 | name, _, _, _, [], _, _ -> ()
1703 | name, _, _, _, tests, _, _ ->
1707 match seq_of_test test with
1709 failwithf "%s has a test containing an empty sequence" name
1710 | cmds -> List.map List.hd cmds
1712 let funcs = List.flatten funcs in
1714 let tested = List.mem name funcs in
1717 failwithf "function %s has tests but does not test itself" name
1720 (* 'pr' prints to the current output file. *)
1721 let chan = ref stdout
1722 let pr fs = ksprintf (output_string !chan) fs
1724 (* Generate a header block in a number of standard styles. *)
1725 type comment_style = CStyle | HashStyle | OCamlStyle
1726 type license = GPLv2 | LGPLv2
1728 let generate_header comment license =
1729 let c = match comment with
1730 | CStyle -> pr "/* "; " *"
1731 | HashStyle -> pr "# "; "#"
1732 | OCamlStyle -> pr "(* "; " *" in
1733 pr "libguestfs generated file\n";
1734 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
1735 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
1737 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
1741 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
1742 pr "%s it under the terms of the GNU General Public License as published by\n" c;
1743 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
1744 pr "%s (at your option) any later version.\n" c;
1746 pr "%s This program is distributed in the hope that it will be useful,\n" c;
1747 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1748 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
1749 pr "%s GNU General Public License for more details.\n" c;
1751 pr "%s You should have received a copy of the GNU General Public License along\n" c;
1752 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
1753 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
1756 pr "%s This library is free software; you can redistribute it and/or\n" c;
1757 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
1758 pr "%s License as published by the Free Software Foundation; either\n" c;
1759 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
1761 pr "%s This library is distributed in the hope that it will be useful,\n" c;
1762 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1763 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
1764 pr "%s Lesser General Public License for more details.\n" c;
1766 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
1767 pr "%s License along with this library; if not, write to the Free Software\n" c;
1768 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
1771 | CStyle -> pr " */\n"
1773 | OCamlStyle -> pr " *)\n"
1777 (* Start of main code generation functions below this line. *)
1779 (* Generate the pod documentation for the C API. *)
1780 let rec generate_actions_pod () =
1782 fun (shortname, style, _, flags, _, _, longdesc) ->
1783 let name = "guestfs_" ^ shortname in
1784 pr "=head2 %s\n\n" name;
1786 generate_prototype ~extern:false ~handle:"handle" name style;
1788 pr "%s\n\n" longdesc;
1789 (match fst style with
1791 pr "This function returns 0 on success or -1 on error.\n\n"
1793 pr "On error this function returns -1.\n\n"
1795 pr "On error this function returns -1.\n\n"
1797 pr "This function returns a C truth value on success or -1 on error.\n\n"
1799 pr "This function returns a string, or NULL on error.
1800 The string is owned by the guest handle and must I<not> be freed.\n\n"
1802 pr "This function returns a string, or NULL on error.
1803 I<The caller must free the returned string after use>.\n\n"
1805 pr "This function returns a NULL-terminated array of strings
1806 (like L<environ(3)>), or NULL if there was an error.
1807 I<The caller must free the strings and the array after use>.\n\n"
1809 pr "This function returns a C<struct guestfs_int_bool *>,
1810 or NULL if there was an error.
1811 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
1813 pr "This function returns a C<struct guestfs_lvm_pv_list *>
1814 (see E<lt>guestfs-structs.hE<gt>),
1815 or NULL if there was an error.
1816 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
1818 pr "This function returns a C<struct guestfs_lvm_vg_list *>
1819 (see E<lt>guestfs-structs.hE<gt>),
1820 or NULL if there was an error.
1821 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
1823 pr "This function returns a C<struct guestfs_lvm_lv_list *>
1824 (see E<lt>guestfs-structs.hE<gt>),
1825 or NULL if there was an error.
1826 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
1828 pr "This function returns a C<struct guestfs_stat *>
1829 (see L<stat(2)> and E<lt>guestfs-structs.hE<gt>),
1830 or NULL if there was an error.
1831 I<The caller must call C<free> after use>.\n\n"
1833 pr "This function returns a C<struct guestfs_statvfs *>
1834 (see L<statvfs(2)> and E<lt>guestfs-structs.hE<gt>),
1835 or NULL if there was an error.
1836 I<The caller must call C<free> after use>.\n\n"
1838 pr "This function returns a NULL-terminated array of
1839 strings, or NULL if there was an error.
1840 The array of strings will always have length C<2n+1>, where
1841 C<n> keys and values alternate, followed by the trailing NULL entry.
1842 I<The caller must free the strings and the array after use>.\n\n"
1844 if List.mem ProtocolLimitWarning flags then
1845 pr "%s\n\n" protocol_limit_warning;
1846 if List.mem DangerWillRobinson flags then
1847 pr "%s\n\n" danger_will_robinson;
1848 ) all_functions_sorted
1850 and generate_structs_pod () =
1851 (* LVM structs documentation. *)
1854 pr "=head2 guestfs_lvm_%s\n" typ;
1856 pr " struct guestfs_lvm_%s {\n" typ;
1859 | name, `String -> pr " char *%s;\n" name
1861 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
1862 pr " char %s[32];\n" name
1863 | name, `Bytes -> pr " uint64_t %s;\n" name
1864 | name, `Int -> pr " int64_t %s;\n" name
1865 | name, `OptPercent ->
1866 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
1867 pr " float %s;\n" name
1870 pr " struct guestfs_lvm_%s_list {\n" typ;
1871 pr " uint32_t len; /* Number of elements in list. */\n";
1872 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
1875 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
1878 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1880 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
1881 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
1883 * We have to use an underscore instead of a dash because otherwise
1884 * rpcgen generates incorrect code.
1886 * This header is NOT exported to clients, but see also generate_structs_h.
1888 and generate_xdr () =
1889 generate_header CStyle LGPLv2;
1891 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
1892 pr "typedef string str<>;\n";
1895 (* LVM internal structures. *)
1899 pr "struct guestfs_lvm_int_%s {\n" typ;
1901 | name, `String -> pr " string %s<>;\n" name
1902 | name, `UUID -> pr " opaque %s[32];\n" name
1903 | name, `Bytes -> pr " hyper %s;\n" name
1904 | name, `Int -> pr " hyper %s;\n" name
1905 | name, `OptPercent -> pr " float %s;\n" name
1909 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
1911 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1913 (* Stat internal structures. *)
1917 pr "struct guestfs_int_%s {\n" typ;
1919 | name, `Int -> pr " hyper %s;\n" name
1923 ) ["stat", stat_cols; "statvfs", statvfs_cols];
1926 fun (shortname, style, _, _, _, _, _) ->
1927 let name = "guestfs_" ^ shortname in
1929 (match snd style with
1932 pr "struct %s_args {\n" name;
1935 | String n -> pr " string %s<>;\n" n
1936 | OptString n -> pr " str *%s;\n" n
1937 | StringList n -> pr " str %s<>;\n" n
1938 | Bool n -> pr " bool %s;\n" n
1939 | Int n -> pr " int %s;\n" n
1940 | FileIn _ | FileOut _ -> ()
1944 (match fst style with
1947 pr "struct %s_ret {\n" name;
1951 pr "struct %s_ret {\n" name;
1952 pr " hyper %s;\n" n;
1955 pr "struct %s_ret {\n" name;
1959 failwithf "RConstString cannot be returned from a daemon function"
1961 pr "struct %s_ret {\n" name;
1962 pr " string %s<>;\n" n;
1965 pr "struct %s_ret {\n" name;
1966 pr " str %s<>;\n" n;
1969 pr "struct %s_ret {\n" name;
1974 pr "struct %s_ret {\n" name;
1975 pr " guestfs_lvm_int_pv_list %s;\n" n;
1978 pr "struct %s_ret {\n" name;
1979 pr " guestfs_lvm_int_vg_list %s;\n" n;
1982 pr "struct %s_ret {\n" name;
1983 pr " guestfs_lvm_int_lv_list %s;\n" n;
1986 pr "struct %s_ret {\n" name;
1987 pr " guestfs_int_stat %s;\n" n;
1990 pr "struct %s_ret {\n" name;
1991 pr " guestfs_int_statvfs %s;\n" n;
1994 pr "struct %s_ret {\n" name;
1995 pr " str %s<>;\n" n;
2000 (* Table of procedure numbers. *)
2001 pr "enum guestfs_procedure {\n";
2003 fun (shortname, _, proc_nr, _, _, _, _) ->
2004 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
2006 pr " GUESTFS_PROC_NR_PROCS\n";
2010 (* Having to choose a maximum message size is annoying for several
2011 * reasons (it limits what we can do in the API), but it (a) makes
2012 * the protocol a lot simpler, and (b) provides a bound on the size
2013 * of the daemon which operates in limited memory space. For large
2014 * file transfers you should use FTP.
2016 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
2019 (* Message header, etc. *)
2021 /* The communication protocol is now documented in the guestfs(3)
2025 const GUESTFS_PROGRAM = 0x2000F5F5;
2026 const GUESTFS_PROTOCOL_VERSION = 1;
2028 /* These constants must be larger than any possible message length. */
2029 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
2030 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
2032 enum guestfs_message_direction {
2033 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
2034 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
2037 enum guestfs_message_status {
2038 GUESTFS_STATUS_OK = 0,
2039 GUESTFS_STATUS_ERROR = 1
2042 const GUESTFS_ERROR_LEN = 256;
2044 struct guestfs_message_error {
2045 string error_message<GUESTFS_ERROR_LEN>;
2048 struct guestfs_message_header {
2049 unsigned prog; /* GUESTFS_PROGRAM */
2050 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
2051 guestfs_procedure proc; /* GUESTFS_PROC_x */
2052 guestfs_message_direction direction;
2053 unsigned serial; /* message serial number */
2054 guestfs_message_status status;
2057 const GUESTFS_MAX_CHUNK_SIZE = 8192;
2059 struct guestfs_chunk {
2060 int cancel; /* if non-zero, transfer is cancelled */
2061 /* data size is 0 bytes if the transfer has finished successfully */
2062 opaque data<GUESTFS_MAX_CHUNK_SIZE>;
2066 (* Generate the guestfs-structs.h file. *)
2067 and generate_structs_h () =
2068 generate_header CStyle LGPLv2;
2070 (* This is a public exported header file containing various
2071 * structures. The structures are carefully written to have
2072 * exactly the same in-memory format as the XDR structures that
2073 * we use on the wire to the daemon. The reason for creating
2074 * copies of these structures here is just so we don't have to
2075 * export the whole of guestfs_protocol.h (which includes much
2076 * unrelated and XDR-dependent stuff that we don't want to be
2077 * public, or required by clients).
2079 * To reiterate, we will pass these structures to and from the
2080 * client with a simple assignment or memcpy, so the format
2081 * must be identical to what rpcgen / the RFC defines.
2084 (* guestfs_int_bool structure. *)
2085 pr "struct guestfs_int_bool {\n";
2091 (* LVM public structures. *)
2095 pr "struct guestfs_lvm_%s {\n" typ;
2098 | name, `String -> pr " char *%s;\n" name
2099 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
2100 | name, `Bytes -> pr " uint64_t %s;\n" name
2101 | name, `Int -> pr " int64_t %s;\n" name
2102 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
2106 pr "struct guestfs_lvm_%s_list {\n" typ;
2107 pr " uint32_t len;\n";
2108 pr " struct guestfs_lvm_%s *val;\n" typ;
2111 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2113 (* Stat structures. *)
2117 pr "struct guestfs_%s {\n" typ;
2120 | name, `Int -> pr " int64_t %s;\n" name
2124 ) ["stat", stat_cols; "statvfs", statvfs_cols]
2126 (* Generate the guestfs-actions.h file. *)
2127 and generate_actions_h () =
2128 generate_header CStyle LGPLv2;
2130 fun (shortname, style, _, _, _, _, _) ->
2131 let name = "guestfs_" ^ shortname in
2132 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
2136 (* Generate the client-side dispatch stubs. *)
2137 and generate_client_actions () =
2138 generate_header CStyle LGPLv2;
2144 #include \"guestfs.h\"
2145 #include \"guestfs_protocol.h\"
2147 #define error guestfs_error
2148 #define perrorf guestfs_perrorf
2149 #define safe_malloc guestfs_safe_malloc
2150 #define safe_realloc guestfs_safe_realloc
2151 #define safe_strdup guestfs_safe_strdup
2152 #define safe_memdup guestfs_safe_memdup
2154 /* Check the return message from a call for validity. */
2156 check_reply_header (guestfs_h *g,
2157 const struct guestfs_message_header *hdr,
2158 int proc_nr, int serial)
2160 if (hdr->prog != GUESTFS_PROGRAM) {
2161 error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
2164 if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
2165 error (g, \"wrong protocol version (%%d/%%d)\",
2166 hdr->vers, GUESTFS_PROTOCOL_VERSION);
2169 if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
2170 error (g, \"unexpected message direction (%%d/%%d)\",
2171 hdr->direction, GUESTFS_DIRECTION_REPLY);
2174 if (hdr->proc != proc_nr) {
2175 error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
2178 if (hdr->serial != serial) {
2179 error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
2186 /* Check we are in the right state to run a high-level action. */
2188 check_state (guestfs_h *g, const char *caller)
2190 if (!guestfs_is_ready (g)) {
2191 if (guestfs_is_config (g))
2192 error (g, \"%%s: call launch() before using this function\",
2194 else if (guestfs_is_launching (g))
2195 error (g, \"%%s: call wait_ready() before using this function\",
2198 error (g, \"%%s called from the wrong state, %%d != READY\",
2199 caller, guestfs_get_state (g));
2207 (* Client-side stubs for each function. *)
2209 fun (shortname, style, _, _, _, _, _) ->
2210 let name = "guestfs_" ^ shortname in
2212 (* Generate the context struct which stores the high-level
2213 * state between callback functions.
2215 pr "struct %s_ctx {\n" shortname;
2216 pr " /* This flag is set by the callbacks, so we know we've done\n";
2217 pr " * the callbacks as expected, and in the right sequence.\n";
2218 pr " * 0 = not called, 1 = send called,\n";
2219 pr " * 1001 = reply called.\n";
2221 pr " int cb_sequence;\n";
2222 pr " struct guestfs_message_header hdr;\n";
2223 pr " struct guestfs_message_error err;\n";
2224 (match fst style with
2227 failwithf "RConstString cannot be returned from a daemon function"
2229 | RBool _ | RString _ | RStringList _
2231 | RPVList _ | RVGList _ | RLVList _
2232 | RStat _ | RStatVFS _
2234 pr " struct %s_ret ret;\n" name
2239 (* Generate the reply callback function. *)
2240 pr "static void %s_reply_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
2242 pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
2243 pr " struct %s_ctx *ctx = (struct %s_ctx *) data;\n" shortname shortname;
2245 pr " ml->main_loop_quit (ml, g);\n";
2247 pr " if (!xdr_guestfs_message_header (xdr, &ctx->hdr)) {\n";
2248 pr " error (g, \"%%s: failed to parse reply header\", \"%s\");\n" name;
2251 pr " if (ctx->hdr.status == GUESTFS_STATUS_ERROR) {\n";
2252 pr " if (!xdr_guestfs_message_error (xdr, &ctx->err)) {\n";
2253 pr " error (g, \"%%s: failed to parse reply error\", \"%s\");\n"
2260 (match fst style with
2263 failwithf "RConstString cannot be returned from a daemon function"
2265 | RBool _ | RString _ | RStringList _
2267 | RPVList _ | RVGList _ | RLVList _
2268 | RStat _ | RStatVFS _
2270 pr " if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name;
2271 pr " error (g, \"%%s: failed to parse reply\", \"%s\");\n" name;
2277 pr " ctx->cb_sequence = 1001;\n";
2280 (* Generate the action stub. *)
2281 generate_prototype ~extern:false ~semicolon:false ~newline:true
2282 ~handle:"g" name style;
2285 match fst style with
2286 | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
2288 failwithf "RConstString cannot be returned from a daemon function"
2289 | RString _ | RStringList _ | RIntBool _
2290 | RPVList _ | RVGList _ | RLVList _
2291 | RStat _ | RStatVFS _
2297 (match snd style with
2299 | _ -> pr " struct %s_args args;\n" name
2302 pr " struct %s_ctx ctx;\n" shortname;
2303 pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
2304 pr " int serial;\n";
2306 pr " if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
2307 pr " guestfs_set_busy (g);\n";
2309 pr " memset (&ctx, 0, sizeof ctx);\n";
2312 (* Send the main header and arguments. *)
2313 (match snd style with
2315 pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s, NULL, NULL);\n"
2316 (String.uppercase shortname)
2321 pr " args.%s = (char *) %s;\n" n n
2323 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
2325 pr " args.%s.%s_val = (char **) %s;\n" n n n;
2326 pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
2328 pr " args.%s = %s;\n" n n
2330 pr " args.%s = %s;\n" n n
2331 | FileIn _ | FileOut _ -> ()
2333 pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s,\n"
2334 (String.uppercase shortname);
2335 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
2338 pr " if (serial == -1) {\n";
2339 pr " guestfs_set_ready (g);\n";
2340 pr " return %s;\n" error_code;
2344 (* Send any additional files (FileIn) requested. *)
2345 let need_read_reply_label = ref false in
2352 pr " r = guestfs__send_file_sync (g, %s);\n" n;
2353 pr " if (r == -1) {\n";
2354 pr " guestfs_set_ready (g);\n";
2355 pr " return %s;\n" error_code;
2357 pr " if (r == -2) /* daemon cancelled */\n";
2358 pr " goto read_reply;\n";
2359 need_read_reply_label := true;
2365 (* Wait for the reply from the remote end. *)
2366 if !need_read_reply_label then pr " read_reply:\n";
2367 pr " guestfs__switch_to_receiving (g);\n";
2368 pr " ctx.cb_sequence = 0;\n";
2369 pr " guestfs_set_reply_callback (g, %s_reply_cb, &ctx);\n" shortname;
2370 pr " (void) ml->main_loop_run (ml, g);\n";
2371 pr " guestfs_set_reply_callback (g, NULL, NULL);\n";
2372 pr " if (ctx.cb_sequence != 1001) {\n";
2373 pr " error (g, \"%%s reply failed, see earlier error messages\", \"%s\");\n" name;
2374 pr " guestfs_set_ready (g);\n";
2375 pr " return %s;\n" error_code;
2379 pr " if (check_reply_header (g, &ctx.hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
2380 (String.uppercase shortname);
2381 pr " guestfs_set_ready (g);\n";
2382 pr " return %s;\n" error_code;
2386 pr " if (ctx.hdr.status == GUESTFS_STATUS_ERROR) {\n";
2387 pr " error (g, \"%%s\", ctx.err.error_message);\n";
2388 pr " guestfs_set_ready (g);\n";
2389 pr " return %s;\n" error_code;
2393 (* Expecting to receive further files (FileOut)? *)
2397 pr " if (guestfs__receive_file_sync (g, %s) == -1) {\n" n;
2398 pr " guestfs_set_ready (g);\n";
2399 pr " return %s;\n" error_code;
2405 pr " guestfs_set_ready (g);\n";
2407 (match fst style with
2408 | RErr -> pr " return 0;\n"
2409 | RInt n | RInt64 n | RBool n ->
2410 pr " return ctx.ret.%s;\n" n
2412 failwithf "RConstString cannot be returned from a daemon function"
2414 pr " return ctx.ret.%s; /* caller will free */\n" n
2415 | RStringList n | RHashtable n ->
2416 pr " /* caller will free this, but we need to add a NULL entry */\n";
2417 pr " ctx.ret.%s.%s_val =\n" n n;
2418 pr " safe_realloc (g, ctx.ret.%s.%s_val,\n" n n;
2419 pr " sizeof (char *) * (ctx.ret.%s.%s_len + 1));\n"
2421 pr " ctx.ret.%s.%s_val[ctx.ret.%s.%s_len] = NULL;\n" n n n n;
2422 pr " return ctx.ret.%s.%s_val;\n" n n
2424 pr " /* caller with free this */\n";
2425 pr " return safe_memdup (g, &ctx.ret, sizeof (ctx.ret));\n"
2426 | RPVList n | RVGList n | RLVList n
2427 | RStat n | RStatVFS n ->
2428 pr " /* caller will free this */\n";
2429 pr " return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n
2435 (* Generate daemon/actions.h. *)
2436 and generate_daemon_actions_h () =
2437 generate_header CStyle GPLv2;
2439 pr "#include \"../src/guestfs_protocol.h\"\n";
2443 fun (name, style, _, _, _, _, _) ->
2445 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
2449 (* Generate the server-side stubs. *)
2450 and generate_daemon_actions () =
2451 generate_header CStyle GPLv2;
2453 pr "#define _GNU_SOURCE // for strchrnul\n";
2455 pr "#include <stdio.h>\n";
2456 pr "#include <stdlib.h>\n";
2457 pr "#include <string.h>\n";
2458 pr "#include <inttypes.h>\n";
2459 pr "#include <ctype.h>\n";
2460 pr "#include <rpc/types.h>\n";
2461 pr "#include <rpc/xdr.h>\n";
2463 pr "#include \"daemon.h\"\n";
2464 pr "#include \"../src/guestfs_protocol.h\"\n";
2465 pr "#include \"actions.h\"\n";
2469 fun (name, style, _, _, _, _, _) ->
2470 (* Generate server-side stubs. *)
2471 pr "static void %s_stub (XDR *xdr_in)\n" name;
2474 match fst style with
2475 | RErr | RInt _ -> pr " int r;\n"; "-1"
2476 | RInt64 _ -> pr " int64_t r;\n"; "-1"
2477 | RBool _ -> pr " int r;\n"; "-1"
2479 failwithf "RConstString cannot be returned from a daemon function"
2480 | RString _ -> pr " char *r;\n"; "NULL"
2481 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
2482 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
2483 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
2484 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
2485 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL"
2486 | RStat _ -> pr " guestfs_int_stat *r;\n"; "NULL"
2487 | RStatVFS _ -> pr " guestfs_int_statvfs *r;\n"; "NULL" in
2489 (match snd style with
2492 pr " struct guestfs_%s_args args;\n" name;
2496 | OptString n -> pr " const char *%s;\n" n
2497 | StringList n -> pr " char **%s;\n" n
2498 | Bool n -> pr " int %s;\n" n
2499 | Int n -> pr " int %s;\n" n
2500 | FileIn _ | FileOut _ -> ()
2505 (match snd style with
2508 pr " memset (&args, 0, sizeof args);\n";
2510 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
2511 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
2516 | String n -> pr " %s = args.%s;\n" n n
2517 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
2519 pr " args.%s.%s_val = realloc (args.%s.%s_val, sizeof (char *) * (args.%s.%s_len+1));\n" n n n n n n;
2520 pr " args.%s.%s_val[args.%s.%s_len] = NULL;\n" n n n n;
2521 pr " %s = args.%s.%s_val;\n" n n n
2522 | Bool n -> pr " %s = args.%s;\n" n n
2523 | Int n -> pr " %s = args.%s;\n" n n
2524 | FileIn _ | FileOut _ -> ()
2529 (* Don't want to call the impl with any FileIn or FileOut
2530 * parameters, since these go "outside" the RPC protocol.
2533 List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
2535 pr " r = do_%s " name;
2536 generate_call_args argsnofile;
2539 pr " if (r == %s)\n" error_code;
2540 pr " /* do_%s has already called reply_with_error */\n" name;
2544 (* If there are any FileOut parameters, then the impl must
2545 * send its own reply.
2548 List.exists (function FileOut _ -> true | _ -> false) (snd style) in
2550 pr " /* do_%s has already sent a reply */\n" name
2552 match fst style with
2553 | RErr -> pr " reply (NULL, NULL);\n"
2554 | RInt n | RInt64 n | RBool n ->
2555 pr " struct guestfs_%s_ret ret;\n" name;
2556 pr " ret.%s = r;\n" n;
2557 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2560 failwithf "RConstString cannot be returned from a daemon function"
2562 pr " struct guestfs_%s_ret ret;\n" name;
2563 pr " ret.%s = r;\n" n;
2564 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2567 | RStringList n | RHashtable n ->
2568 pr " struct guestfs_%s_ret ret;\n" name;
2569 pr " ret.%s.%s_len = count_strings (r);\n" n n;
2570 pr " ret.%s.%s_val = r;\n" n n;
2571 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2573 pr " free_strings (r);\n"
2575 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n"
2577 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
2578 | RPVList n | RVGList n | RLVList n
2579 | RStat n | RStatVFS n ->
2580 pr " struct guestfs_%s_ret ret;\n" name;
2581 pr " ret.%s = *r;\n" n;
2582 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
2584 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
2588 (* Free the args. *)
2589 (match snd style with
2594 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
2601 (* Dispatch function. *)
2602 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
2604 pr " switch (proc_nr) {\n";
2607 fun (name, style, _, _, _, _, _) ->
2608 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
2609 pr " %s_stub (xdr_in);\n" name;
2614 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
2619 (* LVM columns and tokenization functions. *)
2620 (* XXX This generates crap code. We should rethink how we
2626 pr "static const char *lvm_%s_cols = \"%s\";\n"
2627 typ (String.concat "," (List.map fst cols));
2630 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
2632 pr " char *tok, *p, *next;\n";
2636 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
2639 pr " if (!str) {\n";
2640 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
2643 pr " if (!*str || isspace (*str)) {\n";
2644 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
2649 fun (name, coltype) ->
2650 pr " if (!tok) {\n";
2651 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
2654 pr " p = strchrnul (tok, ',');\n";
2655 pr " if (*p) next = p+1; else next = NULL;\n";
2656 pr " *p = '\\0';\n";
2659 pr " r->%s = strdup (tok);\n" name;
2660 pr " if (r->%s == NULL) {\n" name;
2661 pr " perror (\"strdup\");\n";
2665 pr " for (i = j = 0; i < 32; ++j) {\n";
2666 pr " if (tok[j] == '\\0') {\n";
2667 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
2669 pr " } else if (tok[j] != '-')\n";
2670 pr " r->%s[i++] = tok[j];\n" name;
2673 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
2674 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2678 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
2679 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2683 pr " if (tok[0] == '\\0')\n";
2684 pr " r->%s = -1;\n" name;
2685 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
2686 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2690 pr " tok = next;\n";
2693 pr " if (tok != NULL) {\n";
2694 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
2701 pr "guestfs_lvm_int_%s_list *\n" typ;
2702 pr "parse_command_line_%ss (void)\n" typ;
2704 pr " char *out, *err;\n";
2705 pr " char *p, *pend;\n";
2707 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
2708 pr " void *newp;\n";
2710 pr " ret = malloc (sizeof *ret);\n";
2711 pr " if (!ret) {\n";
2712 pr " reply_with_perror (\"malloc\");\n";
2713 pr " return NULL;\n";
2716 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
2717 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
2719 pr " r = command (&out, &err,\n";
2720 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
2721 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
2722 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
2723 pr " if (r == -1) {\n";
2724 pr " reply_with_error (\"%%s\", err);\n";
2725 pr " free (out);\n";
2726 pr " free (err);\n";
2727 pr " free (ret);\n";
2728 pr " return NULL;\n";
2731 pr " free (err);\n";
2733 pr " /* Tokenize each line of the output. */\n";
2736 pr " while (p) {\n";
2737 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
2738 pr " if (pend) {\n";
2739 pr " *pend = '\\0';\n";
2743 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
2746 pr " if (!*p) { /* Empty line? Skip it. */\n";
2751 pr " /* Allocate some space to store this next entry. */\n";
2752 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
2753 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
2754 pr " if (newp == NULL) {\n";
2755 pr " reply_with_perror (\"realloc\");\n";
2756 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2757 pr " free (ret);\n";
2758 pr " free (out);\n";
2759 pr " return NULL;\n";
2761 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
2763 pr " /* Tokenize the next entry. */\n";
2764 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
2765 pr " if (r == -1) {\n";
2766 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
2767 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2768 pr " free (ret);\n";
2769 pr " free (out);\n";
2770 pr " return NULL;\n";
2777 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
2779 pr " free (out);\n";
2780 pr " return ret;\n";
2783 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2785 (* Generate the tests. *)
2786 and generate_tests () =
2787 generate_header CStyle GPLv2;
2794 #include <sys/types.h>
2797 #include \"guestfs.h\"
2799 static guestfs_h *g;
2800 static int suppress_error = 0;
2802 static void print_error (guestfs_h *g, void *data, const char *msg)
2804 if (!suppress_error)
2805 fprintf (stderr, \"%%s\\n\", msg);
2808 static void print_strings (char * const * const argv)
2812 for (argc = 0; argv[argc] != NULL; ++argc)
2813 printf (\"\\t%%s\\n\", argv[argc]);
2817 static void print_table (char * const * const argv)
2821 for (i = 0; argv[i] != NULL; i += 2)
2822 printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
2826 static void no_test_warnings (void)
2832 | name, _, _, _, [], _, _ ->
2833 pr " fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
2834 | name, _, _, _, tests, _, _ -> ()
2840 (* Generate the actual tests. Note that we generate the tests
2841 * in reverse order, deliberately, so that (in general) the
2842 * newest tests run first. This makes it quicker and easier to
2847 fun (name, _, _, _, tests, _, _) ->
2848 mapi (generate_one_test name) tests
2849 ) (List.rev all_functions) in
2850 let test_names = List.concat test_names in
2851 let nr_tests = List.length test_names in
2854 int main (int argc, char *argv[])
2861 int nr_tests, test_num = 0;
2863 no_test_warnings ();
2865 g = guestfs_create ();
2867 printf (\"guestfs_create FAILED\\n\");
2871 guestfs_set_error_handler (g, print_error, NULL);
2873 srcdir = getenv (\"srcdir\");
2874 if (!srcdir) srcdir = \".\";
2875 guestfs_set_path (g, srcdir);
2877 snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);
2878 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2883 if (lseek (fd, %d, SEEK_SET) == -1) {
2889 if (write (fd, &c, 1) == -1) {
2895 if (close (fd) == -1) {
2900 if (guestfs_add_drive (g, buf) == -1) {
2901 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2905 snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);
2906 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2911 if (lseek (fd, %d, SEEK_SET) == -1) {
2917 if (write (fd, &c, 1) == -1) {
2923 if (close (fd) == -1) {
2928 if (guestfs_add_drive (g, buf) == -1) {
2929 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2933 snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);
2934 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2939 if (lseek (fd, %d, SEEK_SET) == -1) {
2945 if (write (fd, &c, 1) == -1) {
2951 if (close (fd) == -1) {
2956 if (guestfs_add_drive (g, buf) == -1) {
2957 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2961 if (guestfs_launch (g) == -1) {
2962 printf (\"guestfs_launch FAILED\\n\");
2965 if (guestfs_wait_ready (g) == -1) {
2966 printf (\"guestfs_wait_ready FAILED\\n\");
2972 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
2976 pr " test_num++;\n";
2977 pr " printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
2978 pr " if (%s () == -1) {\n" test_name;
2979 pr " printf (\"%s FAILED\\n\");\n" test_name;
2985 pr " guestfs_close (g);\n";
2986 pr " snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);\n";
2987 pr " unlink (buf);\n";
2988 pr " snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);\n";
2989 pr " unlink (buf);\n";
2990 pr " snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);\n";
2991 pr " unlink (buf);\n";
2994 pr " if (failed > 0) {\n";
2995 pr " printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n";
3003 and generate_one_test name i (init, test) =
3004 let test_name = sprintf "test_%s_%d" name i in
3006 pr "static int %s (void)\n" test_name;
3012 pr " /* InitEmpty for %s (%d) */\n" name i;
3013 List.iter (generate_test_command_call test_name)
3017 pr " /* InitBasicFS for %s (%d): create ext2 on /dev/sda1 */\n" name i;
3018 List.iter (generate_test_command_call test_name)
3021 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
3022 ["mkfs"; "ext2"; "/dev/sda1"];
3023 ["mount"; "/dev/sda1"; "/"]]
3024 | InitBasicFSonLVM ->
3025 pr " /* InitBasicFSonLVM for %s (%d): create ext2 on /dev/VG/LV */\n"
3027 List.iter (generate_test_command_call test_name)
3030 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
3031 ["pvcreate"; "/dev/sda1"];
3032 ["vgcreate"; "VG"; "/dev/sda1"];
3033 ["lvcreate"; "LV"; "VG"; "8"];
3034 ["mkfs"; "ext2"; "/dev/VG/LV"];
3035 ["mount"; "/dev/VG/LV"; "/"]]
3038 let get_seq_last = function
3040 failwithf "%s: you cannot use [] (empty list) when expecting a command"
3043 let seq = List.rev seq in
3044 List.rev (List.tl seq), List.hd seq
3049 pr " /* TestRun for %s (%d) */\n" name i;
3050 List.iter (generate_test_command_call test_name) seq
3051 | TestOutput (seq, expected) ->
3052 pr " /* TestOutput for %s (%d) */\n" name i;
3053 let seq, last = get_seq_last seq in
3055 pr " if (strcmp (r, \"%s\") != 0) {\n" (c_quote expected);
3056 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r);\n" test_name (c_quote expected);
3060 List.iter (generate_test_command_call test_name) seq;
3061 generate_test_command_call ~test test_name last
3062 | TestOutputList (seq, expected) ->
3063 pr " /* TestOutputList for %s (%d) */\n" name i;
3064 let seq, last = get_seq_last seq in
3068 pr " if (!r[%d]) {\n" i;
3069 pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
3070 pr " print_strings (r);\n";
3073 pr " if (strcmp (r[%d], \"%s\") != 0) {\n" i (c_quote str);
3074 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r[%d]);\n" test_name (c_quote str) i;
3078 pr " if (r[%d] != NULL) {\n" (List.length expected);
3079 pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
3081 pr " print_strings (r);\n";
3085 List.iter (generate_test_command_call test_name) seq;
3086 generate_test_command_call ~test test_name last
3087 | TestOutputInt (seq, expected) ->
3088 pr " /* TestOutputInt for %s (%d) */\n" name i;
3089 let seq, last = get_seq_last seq in
3091 pr " if (r != %d) {\n" expected;
3092 pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\","
3098 List.iter (generate_test_command_call test_name) seq;
3099 generate_test_command_call ~test test_name last
3100 | TestOutputTrue seq ->
3101 pr " /* TestOutputTrue for %s (%d) */\n" name i;
3102 let seq, last = get_seq_last seq in
3105 pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n"
3110 List.iter (generate_test_command_call test_name) seq;
3111 generate_test_command_call ~test test_name last
3112 | TestOutputFalse seq ->
3113 pr " /* TestOutputFalse for %s (%d) */\n" name i;
3114 let seq, last = get_seq_last seq in
3117 pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n"
3122 List.iter (generate_test_command_call test_name) seq;
3123 generate_test_command_call ~test test_name last
3124 | TestOutputLength (seq, expected) ->
3125 pr " /* TestOutputLength for %s (%d) */\n" name i;
3126 let seq, last = get_seq_last seq in
3129 pr " for (j = 0; j < %d; ++j)\n" expected;
3130 pr " if (r[j] == NULL) {\n";
3131 pr " fprintf (stderr, \"%s: short list returned\\n\");\n"
3133 pr " print_strings (r);\n";
3136 pr " if (r[j] != NULL) {\n";
3137 pr " fprintf (stderr, \"%s: long list returned\\n\");\n"
3139 pr " print_strings (r);\n";
3143 List.iter (generate_test_command_call test_name) seq;
3144 generate_test_command_call ~test test_name last
3145 | TestOutputStruct (seq, checks) ->
3146 pr " /* TestOutputStruct for %s (%d) */\n" name i;
3147 let seq, last = get_seq_last seq in
3151 | CompareWithInt (field, expected) ->
3152 pr " if (r->%s != %d) {\n" field expected;
3153 pr " fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
3154 test_name field expected;
3155 pr " (int) r->%s);\n" field;
3158 | CompareWithString (field, expected) ->
3159 pr " if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
3160 pr " fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
3161 test_name field expected;
3162 pr " r->%s);\n" field;
3165 | CompareFieldsIntEq (field1, field2) ->
3166 pr " if (r->%s != r->%s) {\n" field1 field2;
3167 pr " fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
3168 test_name field1 field2;
3169 pr " (int) r->%s, (int) r->%s);\n" field1 field2;
3172 | CompareFieldsStrEq (field1, field2) ->
3173 pr " if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
3174 pr " fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
3175 test_name field1 field2;
3176 pr " r->%s, r->%s);\n" field1 field2;
3181 List.iter (generate_test_command_call test_name) seq;
3182 generate_test_command_call ~test test_name last
3183 | TestLastFail seq ->
3184 pr " /* TestLastFail for %s (%d) */\n" name i;
3185 let seq, last = get_seq_last seq in
3186 List.iter (generate_test_command_call test_name) seq;
3187 generate_test_command_call test_name ~expect_error:true last
3195 (* Generate the code to run a command, leaving the result in 'r'.
3196 * If you expect to get an error then you should set expect_error:true.
3198 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
3200 | [] -> assert false
3202 (* Look up the command to find out what args/ret it has. *)
3205 let _, style, _, _, _, _, _ =
3206 List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
3209 failwithf "%s: in test, command %s was not found" test_name name in
3211 if List.length (snd style) <> List.length args then
3212 failwithf "%s: in test, wrong number of args given to %s"
3223 | FileIn _, _ | FileOut _, _ -> ()
3224 | StringList n, arg ->
3225 pr " char *%s[] = {\n" n;
3226 let strs = string_split " " arg in
3228 fun str -> pr " \"%s\",\n" (c_quote str)
3232 ) (List.combine (snd style) args);
3235 match fst style with
3236 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
3237 | RInt64 _ -> pr " int64_t r;\n"; "-1"
3238 | RConstString _ -> pr " const char *r;\n"; "NULL"
3239 | RString _ -> pr " char *r;\n"; "NULL"
3240 | RStringList _ | RHashtable _ ->
3245 pr " struct guestfs_int_bool *r;\n"; "NULL"
3247 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
3249 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
3251 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
3253 pr " struct guestfs_stat *r;\n"; "NULL"
3255 pr " struct guestfs_statvfs *r;\n"; "NULL" in
3257 pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
3258 pr " r = guestfs_%s (g" name;
3260 (* Generate the parameters. *)
3264 | FileIn _, arg | FileOut _, arg ->
3265 pr ", \"%s\"" (c_quote arg)
3266 | OptString _, arg ->
3267 if arg = "NULL" then pr ", NULL" else pr ", \"%s\"" (c_quote arg)
3268 | StringList n, _ ->
3272 try int_of_string arg
3273 with Failure "int_of_string" ->
3274 failwithf "%s: expecting an int, but got '%s'" test_name arg in
3277 let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
3278 ) (List.combine (snd style) args);
3281 if not expect_error then
3282 pr " if (r == %s)\n" error_code
3284 pr " if (r != %s)\n" error_code;
3287 (* Insert the test code. *)
3293 (match fst style with
3294 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ -> ()
3295 | RString _ -> pr " free (r);\n"
3296 | RStringList _ | RHashtable _ ->
3297 pr " for (i = 0; r[i] != NULL; ++i)\n";
3298 pr " free (r[i]);\n";
3301 pr " guestfs_free_int_bool (r);\n"
3303 pr " guestfs_free_lvm_pv_list (r);\n"
3305 pr " guestfs_free_lvm_vg_list (r);\n"
3307 pr " guestfs_free_lvm_lv_list (r);\n"
3308 | RStat _ | RStatVFS _ ->
3315 let str = replace_str str "\r" "\\r" in
3316 let str = replace_str str "\n" "\\n" in
3317 let str = replace_str str "\t" "\\t" in
3320 (* Generate a lot of different functions for guestfish. *)
3321 and generate_fish_cmds () =
3322 generate_header CStyle GPLv2;
3326 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3328 let all_functions_sorted =
3330 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3331 ) all_functions_sorted in
3333 pr "#include <stdio.h>\n";
3334 pr "#include <stdlib.h>\n";
3335 pr "#include <string.h>\n";
3336 pr "#include <inttypes.h>\n";
3338 pr "#include <guestfs.h>\n";
3339 pr "#include \"fish.h\"\n";
3342 (* list_commands function, which implements guestfish -h *)
3343 pr "void list_commands (void)\n";
3345 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
3346 pr " list_builtin_commands ();\n";
3348 fun (name, _, _, flags, _, shortdesc, _) ->
3349 let name = replace_char name '_' '-' in
3350 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
3352 ) all_functions_sorted;
3353 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
3357 (* display_command function, which implements guestfish -h cmd *)
3358 pr "void display_command (const char *cmd)\n";
3361 fun (name, style, _, flags, _, shortdesc, longdesc) ->
3362 let name2 = replace_char name '_' '-' in
3364 try find_map (function FishAlias n -> Some n | _ -> None) flags
3365 with Not_found -> name in
3366 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
3368 match snd style with
3372 name2 (String.concat "> <" (List.map name_of_argt args)) in
3375 if List.mem ProtocolLimitWarning flags then
3376 ("\n\n" ^ protocol_limit_warning)
3379 (* For DangerWillRobinson commands, we should probably have
3380 * guestfish prompt before allowing you to use them (especially
3381 * in interactive mode). XXX
3385 if List.mem DangerWillRobinson flags then
3386 ("\n\n" ^ danger_will_robinson)
3389 let describe_alias =
3390 if name <> alias then
3391 sprintf "\n\nYou can use '%s' as an alias for this command." alias
3395 pr "strcasecmp (cmd, \"%s\") == 0" name;
3396 if name <> name2 then
3397 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
3398 if name <> alias then
3399 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
3401 pr " pod2text (\"%s - %s\", %S);\n"
3403 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
3406 pr " display_builtin_command (cmd);\n";
3410 (* print_{pv,vg,lv}_list functions *)
3414 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
3421 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
3423 pr " printf (\"%s: \");\n" name;
3424 pr " for (i = 0; i < 32; ++i)\n";
3425 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
3426 pr " printf (\"\\n\");\n"
3428 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
3430 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
3431 | name, `OptPercent ->
3432 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
3433 typ name name typ name;
3434 pr " else printf (\"%s: \\n\");\n" name
3438 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
3443 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
3444 pr " print_%s (&%ss->val[i]);\n" typ typ;
3447 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3449 (* print_{stat,statvfs} functions *)
3453 pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
3458 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
3462 ) ["stat", stat_cols; "statvfs", statvfs_cols];
3464 (* run_<action> actions *)
3466 fun (name, style, _, flags, _, _, _) ->
3467 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
3469 (match fst style with
3472 | RBool _ -> pr " int r;\n"
3473 | RInt64 _ -> pr " int64_t r;\n"
3474 | RConstString _ -> pr " const char *r;\n"
3475 | RString _ -> pr " char *r;\n"
3476 | RStringList _ | RHashtable _ -> pr " char **r;\n"
3477 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
3478 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
3479 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
3480 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
3481 | RStat _ -> pr " struct guestfs_stat *r;\n"
3482 | RStatVFS _ -> pr " struct guestfs_statvfs *r;\n"
3489 | FileOut n -> pr " const char *%s;\n" n
3490 | StringList n -> pr " char **%s;\n" n
3491 | Bool n -> pr " int %s;\n" n
3492 | Int n -> pr " int %s;\n" n
3495 (* Check and convert parameters. *)
3496 let argc_expected = List.length (snd style) in
3497 pr " if (argc != %d) {\n" argc_expected;
3498 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
3500 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
3506 | String name -> pr " %s = argv[%d];\n" name i
3508 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
3511 pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdin\";\n"
3514 pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n"
3516 | StringList name ->
3517 pr " %s = parse_string_list (argv[%d]);\n" name i
3519 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
3521 pr " %s = atoi (argv[%d]);\n" name i
3524 (* Call C API function. *)
3526 try find_map (function FishAction n -> Some n | _ -> None) flags
3527 with Not_found -> sprintf "guestfs_%s" name in
3529 generate_call_args ~handle:"g" (snd style);
3532 (* Check return value for errors and display command results. *)
3533 (match fst style with
3534 | RErr -> pr " return r;\n"
3536 pr " if (r == -1) return -1;\n";
3537 pr " printf (\"%%d\\n\", r);\n";
3540 pr " if (r == -1) return -1;\n";
3541 pr " printf (\"%%\" PRIi64 \"\\n\", r);\n";
3544 pr " if (r == -1) return -1;\n";
3545 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
3548 pr " if (r == NULL) return -1;\n";
3549 pr " printf (\"%%s\\n\", r);\n";
3552 pr " if (r == NULL) return -1;\n";
3553 pr " printf (\"%%s\\n\", r);\n";
3557 pr " if (r == NULL) return -1;\n";
3558 pr " print_strings (r);\n";
3559 pr " free_strings (r);\n";
3562 pr " if (r == NULL) return -1;\n";
3563 pr " printf (\"%%d, %%s\\n\", r->i,\n";
3564 pr " r->b ? \"true\" : \"false\");\n";
3565 pr " guestfs_free_int_bool (r);\n";
3568 pr " if (r == NULL) return -1;\n";
3569 pr " print_pv_list (r);\n";
3570 pr " guestfs_free_lvm_pv_list (r);\n";
3573 pr " if (r == NULL) return -1;\n";
3574 pr " print_vg_list (r);\n";
3575 pr " guestfs_free_lvm_vg_list (r);\n";
3578 pr " if (r == NULL) return -1;\n";
3579 pr " print_lv_list (r);\n";
3580 pr " guestfs_free_lvm_lv_list (r);\n";
3583 pr " if (r == NULL) return -1;\n";
3584 pr " print_stat (r);\n";
3588 pr " if (r == NULL) return -1;\n";
3589 pr " print_statvfs (r);\n";
3593 pr " if (r == NULL) return -1;\n";
3594 pr " print_table (r);\n";
3595 pr " free_strings (r);\n";
3602 (* run_action function *)
3603 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
3606 fun (name, _, _, flags, _, _, _) ->
3607 let name2 = replace_char name '_' '-' in
3609 try find_map (function FishAlias n -> Some n | _ -> None) flags
3610 with Not_found -> name in
3612 pr "strcasecmp (cmd, \"%s\") == 0" name;
3613 if name <> name2 then
3614 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
3615 if name <> alias then
3616 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
3618 pr " return run_%s (cmd, argc, argv);\n" name;
3622 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
3629 (* Readline completion for guestfish. *)
3630 and generate_fish_completion () =
3631 generate_header CStyle GPLv2;
3635 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3645 #ifdef HAVE_LIBREADLINE
3646 #include <readline/readline.h>
3651 #ifdef HAVE_LIBREADLINE
3653 static const char *commands[] = {
3656 (* Get the commands and sort them, including the aliases. *)
3659 fun (name, _, _, flags, _, _, _) ->
3660 let name2 = replace_char name '_' '-' in
3662 try find_map (function FishAlias n -> Some n | _ -> None) flags
3663 with Not_found -> name in
3665 if name <> alias then [name2; alias] else [name2]
3667 let commands = List.flatten commands in
3668 let commands = List.sort compare commands in
3670 List.iter (pr " \"%s\",\n") commands;
3676 generator (const char *text, int state)
3678 static int index, len;
3683 len = strlen (text);
3686 while ((name = commands[index]) != NULL) {
3688 if (strncasecmp (name, text, len) == 0)
3689 return strdup (name);
3695 #endif /* HAVE_LIBREADLINE */
3697 char **do_completion (const char *text, int start, int end)
3699 char **matches = NULL;
3701 #ifdef HAVE_LIBREADLINE
3703 matches = rl_completion_matches (text, generator);
3710 (* Generate the POD documentation for guestfish. *)
3711 and generate_fish_actions_pod () =
3712 let all_functions_sorted =
3714 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3715 ) all_functions_sorted in
3718 fun (name, style, _, flags, _, _, longdesc) ->
3719 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
3720 let name = replace_char name '_' '-' in
3722 try find_map (function FishAlias n -> Some n | _ -> None) flags
3723 with Not_found -> name in
3725 pr "=head2 %s" name;
3726 if name <> alias then
3733 | String n -> pr " %s" n
3734 | OptString n -> pr " %s" n
3735 | StringList n -> pr " %s,..." n
3736 | Bool _ -> pr " true|false"
3737 | Int n -> pr " %s" n
3738 | FileIn n | FileOut n -> pr " (%s|-)" n
3742 pr "%s\n\n" longdesc;
3744 if List.exists (function FileIn _ | FileOut _ -> true
3745 | _ -> false) (snd style) then
3746 pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
3748 if List.mem ProtocolLimitWarning flags then
3749 pr "%s\n\n" protocol_limit_warning;
3751 if List.mem DangerWillRobinson flags then
3752 pr "%s\n\n" danger_will_robinson
3753 ) all_functions_sorted
3755 (* Generate a C function prototype. *)
3756 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
3757 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
3759 ?handle name style =
3760 if extern then pr "extern ";
3761 if static then pr "static ";
3762 (match fst style with
3764 | RInt _ -> pr "int "
3765 | RInt64 _ -> pr "int64_t "
3766 | RBool _ -> pr "int "
3767 | RConstString _ -> pr "const char *"
3768 | RString _ -> pr "char *"
3769 | RStringList _ | RHashtable _ -> pr "char **"
3771 if not in_daemon then pr "struct guestfs_int_bool *"
3772 else pr "guestfs_%s_ret *" name
3774 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
3775 else pr "guestfs_lvm_int_pv_list *"
3777 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
3778 else pr "guestfs_lvm_int_vg_list *"
3780 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
3781 else pr "guestfs_lvm_int_lv_list *"
3783 if not in_daemon then pr "struct guestfs_stat *"
3784 else pr "guestfs_int_stat *"
3786 if not in_daemon then pr "struct guestfs_statvfs *"
3787 else pr "guestfs_int_statvfs *"
3789 pr "%s%s (" prefix name;
3790 if handle = None && List.length (snd style) = 0 then
3793 let comma = ref false in
3796 | Some handle -> pr "guestfs_h *%s" handle; comma := true
3800 if single_line then pr ", " else pr ",\n\t\t"
3807 | OptString n -> next (); pr "const char *%s" n
3808 | StringList n -> next (); pr "char * const* const %s" n
3809 | Bool n -> next (); pr "int %s" n
3810 | Int n -> next (); pr "int %s" n
3813 if not in_daemon then (next (); pr "const char *%s" n)
3817 if semicolon then pr ";";
3818 if newline then pr "\n"
3820 (* Generate C call arguments, eg "(handle, foo, bar)" *)
3821 and generate_call_args ?handle args =
3823 let comma = ref false in
3826 | Some handle -> pr "%s" handle; comma := true
3830 if !comma then pr ", ";
3832 pr "%s" (name_of_argt arg)
3836 (* Generate the OCaml bindings interface. *)
3837 and generate_ocaml_mli () =
3838 generate_header OCamlStyle LGPLv2;
3841 (** For API documentation you should refer to the C API
3842 in the guestfs(3) manual page. The OCaml API uses almost
3843 exactly the same calls. *)
3846 (** A [guestfs_h] handle. *)
3848 exception Error of string
3849 (** This exception is raised when there is an error. *)
3851 val create : unit -> t
3853 val close : t -> unit
3854 (** Handles are closed by the garbage collector when they become
3855 unreferenced, but callers can also call this in order to
3856 provide predictable cleanup. *)
3859 generate_ocaml_lvm_structure_decls ();
3861 generate_ocaml_stat_structure_decls ();
3865 fun (name, style, _, _, _, shortdesc, _) ->
3866 generate_ocaml_prototype name style;
3867 pr "(** %s *)\n" shortdesc;
3871 (* Generate the OCaml bindings implementation. *)
3872 and generate_ocaml_ml () =
3873 generate_header OCamlStyle LGPLv2;
3877 exception Error of string
3878 external create : unit -> t = \"ocaml_guestfs_create\"
3879 external close : t -> unit = \"ocaml_guestfs_close\"
3882 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
3886 generate_ocaml_lvm_structure_decls ();
3888 generate_ocaml_stat_structure_decls ();
3892 fun (name, style, _, _, _, shortdesc, _) ->
3893 generate_ocaml_prototype ~is_external:true name style;
3896 (* Generate the OCaml bindings C implementation. *)
3897 and generate_ocaml_c () =
3898 generate_header CStyle LGPLv2;
3905 #include <caml/config.h>
3906 #include <caml/alloc.h>
3907 #include <caml/callback.h>
3908 #include <caml/fail.h>
3909 #include <caml/memory.h>
3910 #include <caml/mlvalues.h>
3911 #include <caml/signals.h>
3913 #include <guestfs.h>
3915 #include \"guestfs_c.h\"
3917 /* Copy a hashtable of string pairs into an assoc-list. We return
3918 * the list in reverse order, but hashtables aren't supposed to be
3921 static CAMLprim value
3922 copy_table (char * const * argv)
3925 CAMLlocal5 (rv, pairv, kv, vv, cons);
3929 for (i = 0; argv[i] != NULL; i += 2) {
3930 kv = caml_copy_string (argv[i]);
3931 vv = caml_copy_string (argv[i+1]);
3932 pairv = caml_alloc (2, 0);
3933 Store_field (pairv, 0, kv);
3934 Store_field (pairv, 1, vv);
3935 cons = caml_alloc (2, 0);
3936 Store_field (cons, 1, rv);
3938 Store_field (cons, 0, pairv);
3946 (* LVM struct copy functions. *)
3949 let has_optpercent_col =
3950 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
3952 pr "static CAMLprim value\n";
3953 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
3955 pr " CAMLparam0 ();\n";
3956 if has_optpercent_col then
3957 pr " CAMLlocal3 (rv, v, v2);\n"
3959 pr " CAMLlocal2 (rv, v);\n";
3961 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
3966 pr " v = caml_copy_string (%s->%s);\n" typ name
3968 pr " v = caml_alloc_string (32);\n";
3969 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
3972 pr " v = caml_copy_int64 (%s->%s);\n" typ name
3973 | name, `OptPercent ->
3974 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
3975 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
3976 pr " v = caml_alloc (1, 0);\n";
3977 pr " Store_field (v, 0, v2);\n";
3978 pr " } else /* None */\n";
3979 pr " v = Val_int (0);\n";
3981 pr " Store_field (rv, %d, v);\n" i
3983 pr " CAMLreturn (rv);\n";
3987 pr "static CAMLprim value\n";
3988 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
3991 pr " CAMLparam0 ();\n";
3992 pr " CAMLlocal2 (rv, v);\n";
3995 pr " if (%ss->len == 0)\n" typ;
3996 pr " CAMLreturn (Atom (0));\n";
3998 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
3999 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
4000 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
4001 pr " caml_modify (&Field (rv, i), v);\n";
4003 pr " CAMLreturn (rv);\n";
4007 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
4009 (* Stat copy functions. *)
4012 pr "static CAMLprim value\n";
4013 pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
4015 pr " CAMLparam0 ();\n";
4016 pr " CAMLlocal2 (rv, v);\n";
4018 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
4023 pr " v = caml_copy_int64 (%s->%s);\n" typ name
4025 pr " Store_field (rv, %d, v);\n" i
4027 pr " CAMLreturn (rv);\n";
4030 ) ["stat", stat_cols; "statvfs", statvfs_cols];
4034 fun (name, style, _, _, _, _, _) ->
4036 "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
4038 pr "CAMLprim value\n";
4039 pr "ocaml_guestfs_%s (value %s" name (List.hd params);
4040 List.iter (pr ", value %s") (List.tl params);
4045 | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
4046 pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
4047 pr " CAMLxparam%d (%s);\n"
4048 (List.length rest) (String.concat ", " rest)
4050 pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
4052 pr " CAMLlocal1 (rv);\n";
4055 pr " guestfs_h *g = Guestfs_val (gv);\n";
4056 pr " if (g == NULL)\n";
4057 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
4065 pr " const char *%s = String_val (%sv);\n" n n
4067 pr " const char *%s =\n" n;
4068 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
4071 pr " char **%s = ocaml_guestfs_strings_val (%sv);\n" n n
4073 pr " int %s = Bool_val (%sv);\n" n n
4075 pr " int %s = Int_val (%sv);\n" n n
4078 match fst style with
4079 | RErr -> pr " int r;\n"; "-1"
4080 | RInt _ -> pr " int r;\n"; "-1"
4081 | RInt64 _ -> pr " int64_t r;\n"; "-1"
4082 | RBool _ -> pr " int r;\n"; "-1"
4083 | RConstString _ -> pr " const char *r;\n"; "NULL"
4084 | RString _ -> pr " char *r;\n"; "NULL"
4090 pr " struct guestfs_int_bool *r;\n"; "NULL"
4092 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
4094 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
4096 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
4098 pr " struct guestfs_stat *r;\n"; "NULL"
4100 pr " struct guestfs_statvfs *r;\n"; "NULL"
4107 pr " caml_enter_blocking_section ();\n";
4108 pr " r = guestfs_%s " name;
4109 generate_call_args ~handle:"g" (snd style);
4111 pr " caml_leave_blocking_section ();\n";
4116 pr " ocaml_guestfs_free_strings (%s);\n" n;
4117 | String _ | OptString _ | Bool _ | Int _ | FileIn _ | FileOut _ -> ()
4120 pr " if (r == %s)\n" error_code;
4121 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
4124 (match fst style with
4125 | RErr -> pr " rv = Val_unit;\n"
4126 | RInt _ -> pr " rv = Val_int (r);\n"
4128 pr " rv = caml_copy_int64 (r);\n"
4129 | RBool _ -> pr " rv = Val_bool (r);\n"
4130 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
4132 pr " rv = caml_copy_string (r);\n";
4135 pr " rv = caml_copy_string_array ((const char **) r);\n";
4136 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
4139 pr " rv = caml_alloc (2, 0);\n";
4140 pr " Store_field (rv, 0, Val_int (r->i));\n";
4141 pr " Store_field (rv, 1, Val_bool (r->b));\n";
4142 pr " guestfs_free_int_bool (r);\n";
4144 pr " rv = copy_lvm_pv_list (r);\n";
4145 pr " guestfs_free_lvm_pv_list (r);\n";
4147 pr " rv = copy_lvm_vg_list (r);\n";
4148 pr " guestfs_free_lvm_vg_list (r);\n";
4150 pr " rv = copy_lvm_lv_list (r);\n";
4151 pr " guestfs_free_lvm_lv_list (r);\n";
4153 pr " rv = copy_stat (r);\n";
4156 pr " rv = copy_statvfs (r);\n";
4159 pr " rv = copy_table (r);\n";
4160 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
4164 pr " CAMLreturn (rv);\n";
4168 if List.length params > 5 then (
4169 pr "CAMLprim value\n";
4170 pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
4172 pr " return ocaml_guestfs_%s (argv[0]" name;
4173 iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
4180 and generate_ocaml_lvm_structure_decls () =
4183 pr "type lvm_%s = {\n" typ;
4186 | name, `String -> pr " %s : string;\n" name
4187 | name, `UUID -> pr " %s : string;\n" name
4188 | name, `Bytes -> pr " %s : int64;\n" name
4189 | name, `Int -> pr " %s : int64;\n" name
4190 | name, `OptPercent -> pr " %s : float option;\n" name
4194 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
4196 and generate_ocaml_stat_structure_decls () =
4199 pr "type %s = {\n" typ;
4202 | name, `Int -> pr " %s : int64;\n" name
4206 ) ["stat", stat_cols; "statvfs", statvfs_cols]
4208 and generate_ocaml_prototype ?(is_external = false) name style =
4209 if is_external then pr "external " else pr "val ";
4210 pr "%s : t -> " name;
4213 | String _ | FileIn _ | FileOut _ -> pr "string -> "
4214 | OptString _ -> pr "string option -> "
4215 | StringList _ -> pr "string array -> "
4216 | Bool _ -> pr "bool -> "
4217 | Int _ -> pr "int -> "
4219 (match fst style with
4220 | RErr -> pr "unit" (* all errors are turned into exceptions *)
4221 | RInt _ -> pr "int"
4222 | RInt64 _ -> pr "int64"
4223 | RBool _ -> pr "bool"
4224 | RConstString _ -> pr "string"
4225 | RString _ -> pr "string"
4226 | RStringList _ -> pr "string array"
4227 | RIntBool _ -> pr "int * bool"
4228 | RPVList _ -> pr "lvm_pv array"
4229 | RVGList _ -> pr "lvm_vg array"
4230 | RLVList _ -> pr "lvm_lv array"
4231 | RStat _ -> pr "stat"
4232 | RStatVFS _ -> pr "statvfs"
4233 | RHashtable _ -> pr "(string * string) list"
4235 if is_external then (
4237 if List.length (snd style) + 1 > 5 then
4238 pr "\"ocaml_guestfs_%s_byte\" " name;
4239 pr "\"ocaml_guestfs_%s\"" name
4243 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
4244 and generate_perl_xs () =
4245 generate_header CStyle LGPLv2;
4248 #include \"EXTERN.h\"
4252 #include <guestfs.h>
4255 #define PRId64 \"lld\"
4259 my_newSVll(long long val) {
4260 #ifdef USE_64_BIT_ALL
4261 return newSViv(val);
4265 len = snprintf(buf, 100, \"%%\" PRId64, val);
4266 return newSVpv(buf, len);
4271 #define PRIu64 \"llu\"
4275 my_newSVull(unsigned long long val) {
4276 #ifdef USE_64_BIT_ALL
4277 return newSVuv(val);
4281 len = snprintf(buf, 100, \"%%\" PRIu64, val);
4282 return newSVpv(buf, len);
4286 /* http://www.perlmonks.org/?node_id=680842 */
4288 XS_unpack_charPtrPtr (SV *arg) {
4293 if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV) {
4294 croak (\"array reference expected\");
4297 av = (AV *)SvRV (arg);
4298 ret = (char **)malloc (av_len (av) + 1 + 1);
4300 for (i = 0; i <= av_len (av); i++) {
4301 SV **elem = av_fetch (av, i, 0);
4303 if (!elem || !*elem)
4304 croak (\"missing element in list\");
4306 ret[i] = SvPV_nolen (*elem);
4314 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
4319 RETVAL = guestfs_create ();
4321 croak (\"could not create guestfs handle\");
4322 guestfs_set_error_handler (RETVAL, NULL, NULL);
4335 fun (name, style, _, _, _, _, _) ->
4336 (match fst style with
4337 | RErr -> pr "void\n"
4338 | RInt _ -> pr "SV *\n"
4339 | RInt64 _ -> pr "SV *\n"
4340 | RBool _ -> pr "SV *\n"
4341 | RConstString _ -> pr "SV *\n"
4342 | RString _ -> pr "SV *\n"
4345 | RPVList _ | RVGList _ | RLVList _
4346 | RStat _ | RStatVFS _
4348 pr "void\n" (* all lists returned implictly on the stack *)
4350 (* Call and arguments. *)
4352 generate_call_args ~handle:"g" (snd style);
4354 pr " guestfs_h *g;\n";
4357 | String n | FileIn n | FileOut n -> pr " char *%s;\n" n
4358 | OptString n -> pr " char *%s;\n" n
4359 | StringList n -> pr " char **%s;\n" n
4360 | Bool n -> pr " int %s;\n" n
4361 | Int n -> pr " int %s;\n" n
4364 let do_cleanups () =
4367 | String _ | OptString _ | Bool _ | Int _
4368 | FileIn _ | FileOut _ -> ()
4369 | StringList n -> pr " free (%s);\n" n
4374 (match fst style with
4379 pr " r = guestfs_%s " name;
4380 generate_call_args ~handle:"g" (snd style);
4383 pr " if (r == -1)\n";
4384 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4390 pr " %s = guestfs_%s " n name;
4391 generate_call_args ~handle:"g" (snd style);
4394 pr " if (%s == -1)\n" n;
4395 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4396 pr " RETVAL = newSViv (%s);\n" n;
4401 pr " int64_t %s;\n" n;
4403 pr " %s = guestfs_%s " n name;
4404 generate_call_args ~handle:"g" (snd style);
4407 pr " if (%s == -1)\n" n;
4408 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4409 pr " RETVAL = my_newSVll (%s);\n" n;
4414 pr " const char *%s;\n" n;
4416 pr " %s = guestfs_%s " n name;
4417 generate_call_args ~handle:"g" (snd style);
4420 pr " if (%s == NULL)\n" n;
4421 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4422 pr " RETVAL = newSVpv (%s, 0);\n" n;
4427 pr " char *%s;\n" n;
4429 pr " %s = guestfs_%s " n name;
4430 generate_call_args ~handle:"g" (snd style);
4433 pr " if (%s == NULL)\n" n;
4434 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4435 pr " RETVAL = newSVpv (%s, 0);\n" n;
4436 pr " free (%s);\n" n;
4439 | RStringList n | RHashtable n ->
4441 pr " char **%s;\n" n;
4444 pr " %s = guestfs_%s " n name;
4445 generate_call_args ~handle:"g" (snd style);
4448 pr " if (%s == NULL)\n" n;
4449 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4450 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
4451 pr " EXTEND (SP, n);\n";
4452 pr " for (i = 0; i < n; ++i) {\n";
4453 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
4454 pr " free (%s[i]);\n" n;
4456 pr " free (%s);\n" n;
4459 pr " struct guestfs_int_bool *r;\n";
4461 pr " r = guestfs_%s " name;
4462 generate_call_args ~handle:"g" (snd style);
4465 pr " if (r == NULL)\n";
4466 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4467 pr " EXTEND (SP, 2);\n";
4468 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
4469 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
4470 pr " guestfs_free_int_bool (r);\n";
4472 generate_perl_lvm_code "pv" pv_cols name style n do_cleanups
4474 generate_perl_lvm_code "vg" vg_cols name style n do_cleanups
4476 generate_perl_lvm_code "lv" lv_cols name style n do_cleanups
4478 generate_perl_stat_code "stat" stat_cols name style n do_cleanups
4480 generate_perl_stat_code
4481 "statvfs" statvfs_cols name style n do_cleanups
4487 and generate_perl_lvm_code typ cols name style n do_cleanups =
4489 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
4493 pr " %s = guestfs_%s " n name;
4494 generate_call_args ~handle:"g" (snd style);
4497 pr " if (%s == NULL)\n" n;
4498 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4499 pr " EXTEND (SP, %s->len);\n" n;
4500 pr " for (i = 0; i < %s->len; ++i) {\n" n;
4501 pr " hv = newHV ();\n";
4505 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
4506 name (String.length name) n name
4508 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
4509 name (String.length name) n name
4511 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
4512 name (String.length name) n name
4514 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
4515 name (String.length name) n name
4516 | name, `OptPercent ->
4517 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
4518 name (String.length name) n name
4520 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
4522 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
4524 and generate_perl_stat_code typ cols name style n do_cleanups =
4526 pr " struct guestfs_%s *%s;\n" typ n;
4528 pr " %s = guestfs_%s " n name;
4529 generate_call_args ~handle:"g" (snd style);
4532 pr " if (%s == NULL)\n" n;
4533 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4534 pr " EXTEND (SP, %d);\n" (List.length cols);
4538 pr " PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n" n name
4540 pr " free (%s);\n" n
4542 (* Generate Sys/Guestfs.pm. *)
4543 and generate_perl_pm () =
4544 generate_header HashStyle LGPLv2;
4551 Sys::Guestfs - Perl bindings for libguestfs
4557 my $h = Sys::Guestfs->new ();
4558 $h->add_drive ('guest.img');
4561 $h->mount ('/dev/sda1', '/');
4562 $h->touch ('/hello');
4567 The C<Sys::Guestfs> module provides a Perl XS binding to the
4568 libguestfs API for examining and modifying virtual machine
4571 Amongst the things this is good for: making batch configuration
4572 changes to guests, getting disk used/free statistics (see also:
4573 virt-df), migrating between virtualization systems (see also:
4574 virt-p2v), performing partial backups, performing partial guest
4575 clones, cloning guests and changing registry/UUID/hostname info, and
4578 Libguestfs uses Linux kernel and qemu code, and can access any type of
4579 guest filesystem that Linux and qemu can, including but not limited
4580 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
4581 schemes, qcow, qcow2, vmdk.
4583 Libguestfs provides ways to enumerate guest storage (eg. partitions,
4584 LVs, what filesystem is in each LV, etc.). It can also run commands
4585 in the context of the guest. Also you can access filesystems over FTP.
4589 All errors turn into calls to C<croak> (see L<Carp(3)>).
4597 package Sys::Guestfs;
4603 XSLoader::load ('Sys::Guestfs');
4605 =item $h = Sys::Guestfs->new ();
4607 Create a new guestfs handle.
4613 my $class = ref ($proto) || $proto;
4615 my $self = Sys::Guestfs::_create ();
4616 bless $self, $class;
4622 (* Actions. We only need to print documentation for these as
4623 * they are pulled in from the XS code automatically.
4626 fun (name, style, _, flags, _, _, longdesc) ->
4627 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
4629 generate_perl_prototype name style;
4631 pr "%s\n\n" longdesc;
4632 if List.mem ProtocolLimitWarning flags then
4633 pr "%s\n\n" protocol_limit_warning;
4634 if List.mem DangerWillRobinson flags then
4635 pr "%s\n\n" danger_will_robinson
4636 ) all_functions_sorted;
4648 Copyright (C) 2009 Red Hat Inc.
4652 Please see the file COPYING.LIB for the full license.
4656 L<guestfs(3)>, L<guestfish(1)>.
4661 and generate_perl_prototype name style =
4662 (match fst style with
4668 | RString n -> pr "$%s = " n
4669 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
4673 | RLVList n -> pr "@%s = " n
4676 | RHashtable n -> pr "%%%s = " n
4679 let comma = ref false in
4682 if !comma then pr ", ";
4685 | String n | OptString n | Bool n | Int n | FileIn n | FileOut n ->
4692 (* Generate Python C module. *)
4693 and generate_python_c () =
4694 generate_header CStyle LGPLv2;
4703 #include \"guestfs.h\"
4711 get_handle (PyObject *obj)
4714 assert (obj != Py_None);
4715 return ((Pyguestfs_Object *) obj)->g;
4719 put_handle (guestfs_h *g)
4723 PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
4726 /* This list should be freed (but not the strings) after use. */
4727 static const char **
4728 get_string_list (PyObject *obj)
4735 if (!PyList_Check (obj)) {
4736 PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
4740 len = PyList_Size (obj);
4741 r = malloc (sizeof (char *) * (len+1));
4743 PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
4747 for (i = 0; i < len; ++i)
4748 r[i] = PyString_AsString (PyList_GetItem (obj, i));
4755 put_string_list (char * const * const argv)
4760 for (argc = 0; argv[argc] != NULL; ++argc)
4763 list = PyList_New (argc);
4764 for (i = 0; i < argc; ++i)
4765 PyList_SetItem (list, i, PyString_FromString (argv[i]));
4771 put_table (char * const * const argv)
4773 PyObject *list, *item;
4776 for (argc = 0; argv[argc] != NULL; ++argc)
4779 list = PyList_New (argc >> 1);
4780 for (i = 0; i < argc; i += 2) {
4781 item = PyTuple_New (2);
4782 PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
4783 PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
4784 PyList_SetItem (list, i >> 1, item);
4791 free_strings (char **argv)
4795 for (argc = 0; argv[argc] != NULL; ++argc)
4801 py_guestfs_create (PyObject *self, PyObject *args)
4805 g = guestfs_create ();
4807 PyErr_SetString (PyExc_RuntimeError,
4808 \"guestfs.create: failed to allocate handle\");
4811 guestfs_set_error_handler (g, NULL, NULL);
4812 return put_handle (g);
4816 py_guestfs_close (PyObject *self, PyObject *args)
4821 if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
4823 g = get_handle (py_g);
4827 Py_INCREF (Py_None);
4833 (* LVM structures, turned into Python dictionaries. *)
4836 pr "static PyObject *\n";
4837 pr "put_lvm_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
4839 pr " PyObject *dict;\n";
4841 pr " dict = PyDict_New ();\n";
4845 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4846 pr " PyString_FromString (%s->%s));\n"
4849 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4850 pr " PyString_FromStringAndSize (%s->%s, 32));\n"
4853 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4854 pr " PyLong_FromUnsignedLongLong (%s->%s));\n"
4857 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4858 pr " PyLong_FromLongLong (%s->%s));\n"
4860 | name, `OptPercent ->
4861 pr " if (%s->%s >= 0)\n" typ name;
4862 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4863 pr " PyFloat_FromDouble ((double) %s->%s));\n"
4866 pr " Py_INCREF (Py_None);\n";
4867 pr " PyDict_SetItemString (dict, \"%s\", Py_None);" name;
4870 pr " return dict;\n";
4874 pr "static PyObject *\n";
4875 pr "put_lvm_%s_list (struct guestfs_lvm_%s_list *%ss)\n" typ typ typ;
4877 pr " PyObject *list;\n";
4880 pr " list = PyList_New (%ss->len);\n" typ;
4881 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
4882 pr " PyList_SetItem (list, i, put_lvm_%s (&%ss->val[i]));\n" typ typ;
4883 pr " return list;\n";
4886 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
4888 (* Stat structures, turned into Python dictionaries. *)
4891 pr "static PyObject *\n";
4892 pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
4894 pr " PyObject *dict;\n";
4896 pr " dict = PyDict_New ();\n";
4900 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4901 pr " PyLong_FromLongLong (%s->%s));\n"
4904 pr " return dict;\n";
4907 ) ["stat", stat_cols; "statvfs", statvfs_cols];
4909 (* Python wrapper functions. *)
4911 fun (name, style, _, _, _, _, _) ->
4912 pr "static PyObject *\n";
4913 pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
4916 pr " PyObject *py_g;\n";
4917 pr " guestfs_h *g;\n";
4918 pr " PyObject *py_r;\n";
4921 match fst style with
4922 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
4923 | RInt64 _ -> pr " int64_t r;\n"; "-1"
4924 | RConstString _ -> pr " const char *r;\n"; "NULL"
4925 | RString _ -> pr " char *r;\n"; "NULL"
4926 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
4927 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
4928 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
4929 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
4930 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
4931 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
4932 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
4936 | String n | FileIn n | FileOut n -> pr " const char *%s;\n" n
4937 | OptString n -> pr " const char *%s;\n" n
4939 pr " PyObject *py_%s;\n" n;
4940 pr " const char **%s;\n" n
4941 | Bool n -> pr " int %s;\n" n
4942 | Int n -> pr " int %s;\n" n
4947 (* Convert the parameters. *)
4948 pr " if (!PyArg_ParseTuple (args, (char *) \"O";
4951 | String _ | FileIn _ | FileOut _ -> pr "s"
4952 | OptString _ -> pr "z"
4953 | StringList _ -> pr "O"
4954 | Bool _ -> pr "i" (* XXX Python has booleans? *)
4957 pr ":guestfs_%s\",\n" name;
4961 | String n | FileIn n | FileOut n -> pr ", &%s" n
4962 | OptString n -> pr ", &%s" n
4963 | StringList n -> pr ", &py_%s" n
4964 | Bool n -> pr ", &%s" n
4965 | Int n -> pr ", &%s" n
4969 pr " return NULL;\n";
4971 pr " g = get_handle (py_g);\n";
4974 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
4976 pr " %s = get_string_list (py_%s);\n" n n;
4977 pr " if (!%s) return NULL;\n" n
4982 pr " r = guestfs_%s " name;
4983 generate_call_args ~handle:"g" (snd style);
4988 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
4990 pr " free (%s);\n" n
4993 pr " if (r == %s) {\n" error_code;
4994 pr " PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
4995 pr " return NULL;\n";
4999 (match fst style with
5001 pr " Py_INCREF (Py_None);\n";
5002 pr " py_r = Py_None;\n"
5004 | RBool _ -> pr " py_r = PyInt_FromLong ((long) r);\n"
5005 | RInt64 _ -> pr " py_r = PyLong_FromLongLong (r);\n"
5006 | RConstString _ -> pr " py_r = PyString_FromString (r);\n"
5008 pr " py_r = PyString_FromString (r);\n";
5011 pr " py_r = put_string_list (r);\n";
5012 pr " free_strings (r);\n"
5014 pr " py_r = PyTuple_New (2);\n";
5015 pr " PyTuple_SetItem (py_r, 0, PyInt_FromLong ((long) r->i));\n";
5016 pr " PyTuple_SetItem (py_r, 1, PyInt_FromLong ((long) r->b));\n";
5017 pr " guestfs_free_int_bool (r);\n"
5019 pr " py_r = put_lvm_pv_list (r);\n";
5020 pr " guestfs_free_lvm_pv_list (r);\n"
5022 pr " py_r = put_lvm_vg_list (r);\n";
5023 pr " guestfs_free_lvm_vg_list (r);\n"
5025 pr " py_r = put_lvm_lv_list (r);\n";
5026 pr " guestfs_free_lvm_lv_list (r);\n"
5028 pr " py_r = put_stat (r);\n";
5031 pr " py_r = put_statvfs (r);\n";
5034 pr " py_r = put_table (r);\n";
5035 pr " free_strings (r);\n"
5038 pr " return py_r;\n";
5043 (* Table of functions. *)
5044 pr "static PyMethodDef methods[] = {\n";
5045 pr " { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
5046 pr " { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
5048 fun (name, _, _, _, _, _, _) ->
5049 pr " { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
5052 pr " { NULL, NULL, 0, NULL }\n";
5056 (* Init function. *)
5059 initlibguestfsmod (void)
5061 static int initialized = 0;
5063 if (initialized) return;
5064 Py_InitModule ((char *) \"libguestfsmod\", methods);
5069 (* Generate Python module. *)
5070 and generate_python_py () =
5071 generate_header HashStyle LGPLv2;
5074 u\"\"\"Python bindings for libguestfs
5077 g = guestfs.GuestFS ()
5078 g.add_drive (\"guest.img\")
5081 parts = g.list_partitions ()
5083 The guestfs module provides a Python binding to the libguestfs API
5084 for examining and modifying virtual machine disk images.
5086 Amongst the things this is good for: making batch configuration
5087 changes to guests, getting disk used/free statistics (see also:
5088 virt-df), migrating between virtualization systems (see also:
5089 virt-p2v), performing partial backups, performing partial guest
5090 clones, cloning guests and changing registry/UUID/hostname info, and
5093 Libguestfs uses Linux kernel and qemu code, and can access any type of
5094 guest filesystem that Linux and qemu can, including but not limited
5095 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
5096 schemes, qcow, qcow2, vmdk.
5098 Libguestfs provides ways to enumerate guest storage (eg. partitions,
5099 LVs, what filesystem is in each LV, etc.). It can also run commands
5100 in the context of the guest. Also you can access filesystems over FTP.
5102 Errors which happen while using the API are turned into Python
5103 RuntimeError exceptions.
5105 To create a guestfs handle you usually have to perform the following
5108 # Create the handle, call add_drive at least once, and possibly
5109 # several times if the guest has multiple block devices:
5110 g = guestfs.GuestFS ()
5111 g.add_drive (\"guest.img\")
5113 # Launch the qemu subprocess and wait for it to become ready:
5117 # Now you can issue commands, for example:
5122 import libguestfsmod
5125 \"\"\"Instances of this class are libguestfs API handles.\"\"\"
5127 def __init__ (self):
5128 \"\"\"Create a new libguestfs handle.\"\"\"
5129 self._o = libguestfsmod.create ()
5132 libguestfsmod.close (self._o)
5137 fun (name, style, _, flags, _, _, longdesc) ->
5138 let doc = replace_str longdesc "C<guestfs_" "C<g." in
5140 match fst style with
5141 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _
5144 doc ^ "\n\nThis function returns a list of strings."
5146 doc ^ "\n\nThis function returns a tuple (int, bool).\n"
5148 doc ^ "\n\nThis function returns a list of PVs. Each PV is represented as a dictionary."
5150 doc ^ "\n\nThis function returns a list of VGs. Each VG is represented as a dictionary."
5152 doc ^ "\n\nThis function returns a list of LVs. Each LV is represented as a dictionary."
5154 doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the stat structure."
5156 doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the statvfs structure."
5158 doc ^ "\n\nThis function returns a dictionary." in
5160 if List.mem ProtocolLimitWarning flags then
5161 doc ^ "\n\n" ^ protocol_limit_warning
5164 if List.mem DangerWillRobinson flags then
5165 doc ^ "\n\n" ^ danger_will_robinson
5167 let doc = pod2text ~width:60 name doc in
5168 let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
5169 let doc = String.concat "\n " doc in
5172 generate_call_args ~handle:"self" (snd style);
5174 pr " u\"\"\"%s\"\"\"\n" doc;
5175 pr " return libguestfsmod.%s " name;
5176 generate_call_args ~handle:"self._o" (snd style);
5181 (* Useful if you need the longdesc POD text as plain text. Returns a
5184 and pod2text ~width name longdesc =
5185 let filename, chan = Filename.open_temp_file "gen" ".tmp" in
5186 fprintf chan "=head1 %s\n\n%s\n" name longdesc;
5188 let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
5189 let chan = Unix.open_process_in cmd in
5190 let lines = ref [] in
5192 let line = input_line chan in
5193 if i = 1 then (* discard the first line of output *)
5196 let line = triml line in
5197 lines := line :: !lines;
5200 let lines = try loop 1 with End_of_file -> List.rev !lines in
5201 Unix.unlink filename;
5202 match Unix.close_process_in chan with
5203 | Unix.WEXITED 0 -> lines
5205 failwithf "pod2text: process exited with non-zero status (%d)" i
5206 | Unix.WSIGNALED i | Unix.WSTOPPED i ->
5207 failwithf "pod2text: process signalled or stopped by signal %d" i
5209 (* Generate ruby bindings. *)
5210 and generate_ruby_c () =
5211 generate_header CStyle LGPLv2;
5219 #include \"guestfs.h\"
5221 #include \"extconf.h\"
5223 static VALUE m_guestfs; /* guestfs module */
5224 static VALUE c_guestfs; /* guestfs_h handle */
5225 static VALUE e_Error; /* used for all errors */
5227 static void ruby_guestfs_free (void *p)
5230 guestfs_close ((guestfs_h *) p);
5233 static VALUE ruby_guestfs_create (VALUE m)
5237 g = guestfs_create ();
5239 rb_raise (e_Error, \"failed to create guestfs handle\");
5241 /* Don't print error messages to stderr by default. */
5242 guestfs_set_error_handler (g, NULL, NULL);
5244 /* Wrap it, and make sure the close function is called when the
5247 return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
5250 static VALUE ruby_guestfs_close (VALUE gv)
5253 Data_Get_Struct (gv, guestfs_h, g);
5255 ruby_guestfs_free (g);
5256 DATA_PTR (gv) = NULL;
5264 fun (name, style, _, _, _, _, _) ->
5265 pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
5266 List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
5269 pr " guestfs_h *g;\n";
5270 pr " Data_Get_Struct (gv, guestfs_h, g);\n";
5272 pr " rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
5278 | String n | FileIn n | FileOut n ->
5279 pr " const char *%s = StringValueCStr (%sv);\n" n n;
5281 pr " rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
5282 pr " \"%s\", \"%s\");\n" n name
5284 pr " const char *%s = StringValueCStr (%sv);\n" n n
5288 pr " int i, len;\n";
5289 pr " len = RARRAY_LEN (%sv);\n" n;
5290 pr " %s = malloc (sizeof (char *) * (len+1));\n" n;
5291 pr " for (i = 0; i < len; ++i) {\n";
5292 pr " VALUE v = rb_ary_entry (%sv, i);\n" n;
5293 pr " %s[i] = StringValueCStr (v);\n" n;
5298 pr " int %s = NUM2INT (%sv);\n" n n
5303 match fst style with
5304 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
5305 | RInt64 _ -> pr " int64_t r;\n"; "-1"
5306 | RConstString _ -> pr " const char *r;\n"; "NULL"
5307 | RString _ -> pr " char *r;\n"; "NULL"
5308 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
5309 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
5310 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
5311 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
5312 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
5313 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
5314 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
5317 pr " r = guestfs_%s " name;
5318 generate_call_args ~handle:"g" (snd style);
5323 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
5325 pr " free (%s);\n" n
5328 pr " if (r == %s)\n" error_code;
5329 pr " rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
5332 (match fst style with
5334 pr " return Qnil;\n"
5335 | RInt _ | RBool _ ->
5336 pr " return INT2NUM (r);\n"
5338 pr " return ULL2NUM (r);\n"
5340 pr " return rb_str_new2 (r);\n";
5342 pr " VALUE rv = rb_str_new2 (r);\n";
5346 pr " int i, len = 0;\n";
5347 pr " for (i = 0; r[i] != NULL; ++i) len++;\n";
5348 pr " VALUE rv = rb_ary_new2 (len);\n";
5349 pr " for (i = 0; r[i] != NULL; ++i) {\n";
5350 pr " rb_ary_push (rv, rb_str_new2 (r[i]));\n";
5351 pr " free (r[i]);\n";
5356 pr " VALUE rv = rb_ary_new2 (2);\n";
5357 pr " rb_ary_push (rv, INT2NUM (r->i));\n";
5358 pr " rb_ary_push (rv, INT2NUM (r->b));\n";
5359 pr " guestfs_free_int_bool (r);\n";
5362 generate_ruby_lvm_code "pv" pv_cols
5364 generate_ruby_lvm_code "vg" vg_cols
5366 generate_ruby_lvm_code "lv" lv_cols
5368 pr " VALUE rv = rb_hash_new ();\n";
5372 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
5377 pr " VALUE rv = rb_hash_new ();\n";
5381 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
5386 pr " VALUE rv = rb_hash_new ();\n";
5388 pr " for (i = 0; r[i] != NULL; i+=2) {\n";
5389 pr " rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
5390 pr " free (r[i]);\n";
5391 pr " free (r[i+1]);\n";
5402 /* Initialize the module. */
5403 void Init__guestfs ()
5405 m_guestfs = rb_define_module (\"Guestfs\");
5406 c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
5407 e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
5409 rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
5410 rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
5413 (* Define the rest of the methods. *)
5415 fun (name, style, _, _, _, _, _) ->
5416 pr " rb_define_method (c_guestfs, \"%s\",\n" name;
5417 pr " ruby_guestfs_%s, %d);\n" name (List.length (snd style))
5422 (* Ruby code to return an LVM struct list. *)
5423 and generate_ruby_lvm_code typ cols =
5424 pr " VALUE rv = rb_ary_new2 (r->len);\n";
5426 pr " for (i = 0; i < r->len; ++i) {\n";
5427 pr " VALUE hv = rb_hash_new ();\n";
5431 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
5433 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
5436 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
5437 | name, `OptPercent ->
5438 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
5440 pr " rb_ary_push (rv, hv);\n";
5442 pr " guestfs_free_lvm_%s_list (r);\n" typ;
5445 let output_to filename =
5446 let filename_new = filename ^ ".new" in
5447 chan := open_out filename_new;
5451 Unix.rename filename_new filename;
5452 printf "written %s\n%!" filename;
5460 if not (Sys.file_exists "configure.ac") then (
5462 You are probably running this from the wrong directory.
5463 Run it from the top source directory using the command
5469 let close = output_to "src/guestfs_protocol.x" in
5473 let close = output_to "src/guestfs-structs.h" in
5474 generate_structs_h ();
5477 let close = output_to "src/guestfs-actions.h" in
5478 generate_actions_h ();
5481 let close = output_to "src/guestfs-actions.c" in
5482 generate_client_actions ();
5485 let close = output_to "daemon/actions.h" in
5486 generate_daemon_actions_h ();
5489 let close = output_to "daemon/stubs.c" in
5490 generate_daemon_actions ();
5493 let close = output_to "tests.c" in
5497 let close = output_to "fish/cmds.c" in
5498 generate_fish_cmds ();
5501 let close = output_to "fish/completion.c" in
5502 generate_fish_completion ();
5505 let close = output_to "guestfs-structs.pod" in
5506 generate_structs_pod ();
5509 let close = output_to "guestfs-actions.pod" in
5510 generate_actions_pod ();
5513 let close = output_to "guestfish-actions.pod" in
5514 generate_fish_actions_pod ();
5517 let close = output_to "ocaml/guestfs.mli" in
5518 generate_ocaml_mli ();
5521 let close = output_to "ocaml/guestfs.ml" in
5522 generate_ocaml_ml ();
5525 let close = output_to "ocaml/guestfs_c_actions.c" in
5526 generate_ocaml_c ();
5529 let close = output_to "perl/Guestfs.xs" in
5530 generate_perl_xs ();
5533 let close = output_to "perl/lib/Sys/Guestfs.pm" in
5534 generate_perl_pm ();
5537 let close = output_to "python/guestfs-py.c" in
5538 generate_python_c ();
5541 let close = output_to "python/guestfs.py" in
5542 generate_python_py ();
5545 let close = output_to "ruby/ext/guestfs/_guestfs.c" in