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_qemu", (RErr, [String "qemu"]), -1, [FishAlias "qemu"],
289 "set the qemu binary",
291 Set the qemu binary that we will use.
293 The default is chosen when the library was compiled by the
296 You can also override this by setting the C<LIBGUESTFS_QEMU>
297 environment variable.
299 The string C<qemu> is stashed in the libguestfs handle, so the caller
300 must make sure it remains valid for the lifetime of the handle.
302 Setting C<qemu> to C<NULL> restores the default qemu binary.");
304 ("get_qemu", (RConstString "qemu", []), -1, [],
306 "get the qemu binary",
308 Return the current qemu binary.
310 This is always non-NULL. If it wasn't set already, then this will
311 return the default qemu binary name.");
313 ("set_path", (RErr, [String "path"]), -1, [FishAlias "path"],
315 "set the search path",
317 Set the path that libguestfs searches for kernel and initrd.img.
319 The default is C<$libdir/guestfs> unless overridden by setting
320 C<LIBGUESTFS_PATH> environment variable.
322 The string C<path> is stashed in the libguestfs handle, so the caller
323 must make sure it remains valid for the lifetime of the handle.
325 Setting C<path> to C<NULL> restores the default path.");
327 ("get_path", (RConstString "path", []), -1, [],
329 "get the search path",
331 Return the current search path.
333 This is always non-NULL. If it wasn't set already, then this will
334 return the default path.");
336 ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
340 If C<autosync> is true, this enables autosync. Libguestfs will make a
341 best effort attempt to run C<guestfs_sync> when the handle is closed
342 (also if the program exits without closing handles).");
344 ("get_autosync", (RBool "autosync", []), -1, [],
348 Get the autosync flag.");
350 ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
354 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
356 Verbose messages are disabled unless the environment variable
357 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
359 ("get_verbose", (RBool "verbose", []), -1, [],
363 This returns the verbose messages flag.");
365 ("is_ready", (RBool "ready", []), -1, [],
367 "is ready to accept commands",
369 This returns true iff this handle is ready to accept commands
370 (in the C<READY> state).
372 For more information on states, see L<guestfs(3)>.");
374 ("is_config", (RBool "config", []), -1, [],
376 "is in configuration state",
378 This returns true iff this handle is being configured
379 (in the C<CONFIG> state).
381 For more information on states, see L<guestfs(3)>.");
383 ("is_launching", (RBool "launching", []), -1, [],
385 "is launching subprocess",
387 This returns true iff this handle is launching the subprocess
388 (in the C<LAUNCHING> state).
390 For more information on states, see L<guestfs(3)>.");
392 ("is_busy", (RBool "busy", []), -1, [],
394 "is busy processing a command",
396 This returns true iff this handle is busy processing a command
397 (in the C<BUSY> state).
399 For more information on states, see L<guestfs(3)>.");
401 ("get_state", (RInt "state", []), -1, [],
403 "get the current state",
405 This returns the current state as an opaque integer. This is
406 only useful for printing debug and internal error messages.
408 For more information on states, see L<guestfs(3)>.");
410 ("set_busy", (RErr, []), -1, [NotInFish],
414 This sets the state to C<BUSY>. This is only used when implementing
415 actions using the low-level API.
417 For more information on states, see L<guestfs(3)>.");
419 ("set_ready", (RErr, []), -1, [NotInFish],
421 "set state to ready",
423 This sets the state to C<READY>. This is only used when implementing
424 actions using the low-level API.
426 For more information on states, see L<guestfs(3)>.");
430 let daemon_functions = [
431 ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
432 [InitEmpty, TestOutput (
433 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
434 ["mkfs"; "ext2"; "/dev/sda1"];
435 ["mount"; "/dev/sda1"; "/"];
436 ["write_file"; "/new"; "new file contents"; "0"];
437 ["cat"; "/new"]], "new file contents")],
438 "mount a guest disk at a position in the filesystem",
440 Mount a guest disk at a position in the filesystem. Block devices
441 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
442 the guest. If those block devices contain partitions, they will have
443 the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
446 The rules are the same as for L<mount(2)>: A filesystem must
447 first be mounted on C</> before others can be mounted. Other
448 filesystems can only be mounted on directories which already
451 The mounted filesystem is writable, if we have sufficient permissions
452 on the underlying device.
454 The filesystem options C<sync> and C<noatime> are set with this
455 call, in order to improve reliability.");
457 ("sync", (RErr, []), 2, [],
458 [ InitEmpty, TestRun [["sync"]]],
459 "sync disks, writes are flushed through to the disk image",
461 This syncs the disk, so that any writes are flushed through to the
462 underlying disk image.
464 You should always call this if you have modified a disk image, before
465 closing the handle.");
467 ("touch", (RErr, [String "path"]), 3, [],
468 [InitBasicFS, TestOutputTrue (
470 ["exists"; "/new"]])],
471 "update file timestamps or create a new file",
473 Touch acts like the L<touch(1)> command. It can be used to
474 update the timestamps on a file, or, if the file does not exist,
475 to create a new zero-length file.");
477 ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
478 [InitBasicFS, TestOutput (
479 [["write_file"; "/new"; "new file contents"; "0"];
480 ["cat"; "/new"]], "new file contents")],
481 "list the contents of a file",
483 Return the contents of the file named C<path>.
485 Note that this function cannot correctly handle binary files
486 (specifically, files containing C<\\0> character which is treated
487 as end of string). For those you need to use the C<guestfs_download>
488 function which has a more complex interface.");
490 ("ll", (RString "listing", [String "directory"]), 5, [],
491 [], (* XXX Tricky to test because it depends on the exact format
492 * of the 'ls -l' command, which changes between F10 and F11.
494 "list the files in a directory (long format)",
496 List the files in C<directory> (relative to the root directory,
497 there is no cwd) in the format of 'ls -la'.
499 This command is mostly useful for interactive sessions. It
500 is I<not> intended that you try to parse the output string.");
502 ("ls", (RStringList "listing", [String "directory"]), 6, [],
503 [InitBasicFS, TestOutputList (
506 ["touch"; "/newest"];
507 ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
508 "list the files in a directory",
510 List the files in C<directory> (relative to the root directory,
511 there is no cwd). The '.' and '..' entries are not returned, but
512 hidden files are shown.
514 This command is mostly useful for interactive sessions. Programs
515 should probably use C<guestfs_readdir> instead.");
517 ("list_devices", (RStringList "devices", []), 7, [],
518 [InitEmpty, TestOutputList (
519 [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"])],
520 "list the block devices",
522 List all the block devices.
524 The full block device names are returned, eg. C</dev/sda>");
526 ("list_partitions", (RStringList "partitions", []), 8, [],
527 [InitBasicFS, TestOutputList (
528 [["list_partitions"]], ["/dev/sda1"]);
529 InitEmpty, TestOutputList (
530 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
531 ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
532 "list the partitions",
534 List all the partitions detected on all block devices.
536 The full partition device names are returned, eg. C</dev/sda1>
538 This does not return logical volumes. For that you will need to
539 call C<guestfs_lvs>.");
541 ("pvs", (RStringList "physvols", []), 9, [],
542 [InitBasicFSonLVM, TestOutputList (
543 [["pvs"]], ["/dev/sda1"]);
544 InitEmpty, TestOutputList (
545 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
546 ["pvcreate"; "/dev/sda1"];
547 ["pvcreate"; "/dev/sda2"];
548 ["pvcreate"; "/dev/sda3"];
549 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
550 "list the LVM physical volumes (PVs)",
552 List all the physical volumes detected. This is the equivalent
553 of the L<pvs(8)> command.
555 This returns a list of just the device names that contain
556 PVs (eg. C</dev/sda2>).
558 See also C<guestfs_pvs_full>.");
560 ("vgs", (RStringList "volgroups", []), 10, [],
561 [InitBasicFSonLVM, TestOutputList (
563 InitEmpty, TestOutputList (
564 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
565 ["pvcreate"; "/dev/sda1"];
566 ["pvcreate"; "/dev/sda2"];
567 ["pvcreate"; "/dev/sda3"];
568 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
569 ["vgcreate"; "VG2"; "/dev/sda3"];
570 ["vgs"]], ["VG1"; "VG2"])],
571 "list the LVM volume groups (VGs)",
573 List all the volumes groups detected. This is the equivalent
574 of the L<vgs(8)> command.
576 This returns a list of just the volume group names that were
577 detected (eg. C<VolGroup00>).
579 See also C<guestfs_vgs_full>.");
581 ("lvs", (RStringList "logvols", []), 11, [],
582 [InitBasicFSonLVM, TestOutputList (
583 [["lvs"]], ["/dev/VG/LV"]);
584 InitEmpty, TestOutputList (
585 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
586 ["pvcreate"; "/dev/sda1"];
587 ["pvcreate"; "/dev/sda2"];
588 ["pvcreate"; "/dev/sda3"];
589 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
590 ["vgcreate"; "VG2"; "/dev/sda3"];
591 ["lvcreate"; "LV1"; "VG1"; "50"];
592 ["lvcreate"; "LV2"; "VG1"; "50"];
593 ["lvcreate"; "LV3"; "VG2"; "50"];
594 ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
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.
600 This returns a list of the logical volume device names
601 (eg. C</dev/VolGroup00/LogVol00>).
603 See also C<guestfs_lvs_full>.");
605 ("pvs_full", (RPVList "physvols", []), 12, [],
606 [], (* XXX how to test? *)
607 "list the LVM physical volumes (PVs)",
609 List all the physical volumes detected. This is the equivalent
610 of the L<pvs(8)> command. The \"full\" version includes all fields.");
612 ("vgs_full", (RVGList "volgroups", []), 13, [],
613 [], (* XXX how to test? *)
614 "list the LVM volume groups (VGs)",
616 List all the volumes groups detected. This is the equivalent
617 of the L<vgs(8)> command. The \"full\" version includes all fields.");
619 ("lvs_full", (RLVList "logvols", []), 14, [],
620 [], (* XXX how to test? *)
621 "list the LVM logical volumes (LVs)",
623 List all the logical volumes detected. This is the equivalent
624 of the L<lvs(8)> command. The \"full\" version includes all fields.");
626 ("read_lines", (RStringList "lines", [String "path"]), 15, [],
627 [InitBasicFS, TestOutputList (
628 [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
629 ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);
630 InitBasicFS, TestOutputList (
631 [["write_file"; "/new"; ""; "0"];
632 ["read_lines"; "/new"]], [])],
633 "read file as lines",
635 Return the contents of the file named C<path>.
637 The file contents are returned as a list of lines. Trailing
638 C<LF> and C<CRLF> character sequences are I<not> returned.
640 Note that this function cannot correctly handle binary files
641 (specifically, files containing C<\\0> character which is treated
642 as end of line). For those you need to use the C<guestfs_read_file>
643 function which has a more complex interface.");
645 ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [],
646 [], (* XXX Augeas code needs tests. *)
647 "create a new Augeas handle",
649 Create a new Augeas handle for editing configuration files.
650 If there was any previous Augeas handle associated with this
651 guestfs session, then it is closed.
653 You must call this before using any other C<guestfs_aug_*>
656 C<root> is the filesystem root. C<root> must not be NULL,
659 The flags are the same as the flags defined in
660 E<lt>augeas.hE<gt>, the logical I<or> of the following
665 =item C<AUG_SAVE_BACKUP> = 1
667 Keep the original file with a C<.augsave> extension.
669 =item C<AUG_SAVE_NEWFILE> = 2
671 Save changes into a file with extension C<.augnew>, and
672 do not overwrite original. Overrides C<AUG_SAVE_BACKUP>.
674 =item C<AUG_TYPE_CHECK> = 4
676 Typecheck lenses (can be expensive).
678 =item C<AUG_NO_STDINC> = 8
680 Do not use standard load path for modules.
682 =item C<AUG_SAVE_NOOP> = 16
684 Make save a no-op, just record what would have been changed.
686 =item C<AUG_NO_LOAD> = 32
688 Do not load the tree in C<guestfs_aug_init>.
692 To close the handle, you can call C<guestfs_aug_close>.
694 To find out more about Augeas, see L<http://augeas.net/>.");
696 ("aug_close", (RErr, []), 26, [],
697 [], (* XXX Augeas code needs tests. *)
698 "close the current Augeas handle",
700 Close the current Augeas handle and free up any resources
701 used by it. After calling this, you have to call
702 C<guestfs_aug_init> again before you can use any other
705 ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
706 [], (* XXX Augeas code needs tests. *)
707 "define an Augeas variable",
709 Defines an Augeas variable C<name> whose value is the result
710 of evaluating C<expr>. If C<expr> is NULL, then C<name> is
713 On success this returns the number of nodes in C<expr>, or
714 C<0> if C<expr> evaluates to something which is not a nodeset.");
716 ("aug_defnode", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [],
717 [], (* XXX Augeas code needs tests. *)
718 "define an Augeas node",
720 Defines a variable C<name> whose value is the result of
723 If C<expr> evaluates to an empty nodeset, a node is created,
724 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
725 C<name> will be the nodeset containing that single node.
727 On success this returns a pair containing the
728 number of nodes in the nodeset, and a boolean flag
729 if a node was created.");
731 ("aug_get", (RString "val", [String "path"]), 19, [],
732 [], (* XXX Augeas code needs tests. *)
733 "look up the value of an Augeas path",
735 Look up the value associated with C<path>. If C<path>
736 matches exactly one node, the C<value> is returned.");
738 ("aug_set", (RErr, [String "path"; String "val"]), 20, [],
739 [], (* XXX Augeas code needs tests. *)
740 "set Augeas path to value",
742 Set the value associated with C<path> to C<value>.");
744 ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [],
745 [], (* XXX Augeas code needs tests. *)
746 "insert a sibling Augeas node",
748 Create a new sibling C<label> for C<path>, inserting it into
749 the tree before or after C<path> (depending on the boolean
752 C<path> must match exactly one existing node in the tree, and
753 C<label> must be a label, ie. not contain C</>, C<*> or end
754 with a bracketed index C<[N]>.");
756 ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
757 [], (* XXX Augeas code needs tests. *)
758 "remove an Augeas path",
760 Remove C<path> and all of its children.
762 On success this returns the number of entries which were removed.");
764 ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [],
765 [], (* XXX Augeas code needs tests. *)
768 Move the node C<src> to C<dest>. C<src> must match exactly
769 one node. C<dest> is overwritten if it exists.");
771 ("aug_match", (RStringList "matches", [String "path"]), 24, [],
772 [], (* XXX Augeas code needs tests. *)
773 "return Augeas nodes which match path",
775 Returns a list of paths which match the path expression C<path>.
776 The returned paths are sufficiently qualified so that they match
777 exactly one node in the current tree.");
779 ("aug_save", (RErr, []), 25, [],
780 [], (* XXX Augeas code needs tests. *)
781 "write all pending Augeas changes to disk",
783 This writes all pending changes to disk.
785 The flags which were passed to C<guestfs_aug_init> affect exactly
786 how files are saved.");
788 ("aug_load", (RErr, []), 27, [],
789 [], (* XXX Augeas code needs tests. *)
790 "load files into the tree",
792 Load files into the tree.
794 See C<aug_load> in the Augeas documentation for the full gory
797 ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
798 [], (* XXX Augeas code needs tests. *)
799 "list Augeas nodes under a path",
801 This is just a shortcut for listing C<guestfs_aug_match>
802 C<path/*> and sorting the resulting nodes into alphabetical order.");
804 ("rm", (RErr, [String "path"]), 29, [],
805 [InitBasicFS, TestRun
808 InitBasicFS, TestLastFail
810 InitBasicFS, TestLastFail
815 Remove the single file C<path>.");
817 ("rmdir", (RErr, [String "path"]), 30, [],
818 [InitBasicFS, TestRun
821 InitBasicFS, TestLastFail
823 InitBasicFS, TestLastFail
826 "remove a directory",
828 Remove the single directory C<path>.");
830 ("rm_rf", (RErr, [String "path"]), 31, [],
831 [InitBasicFS, TestOutputFalse
833 ["mkdir"; "/new/foo"];
834 ["touch"; "/new/foo/bar"];
836 ["exists"; "/new"]]],
837 "remove a file or directory recursively",
839 Remove the file or directory C<path>, recursively removing the
840 contents if its a directory. This is like the C<rm -rf> shell
843 ("mkdir", (RErr, [String "path"]), 32, [],
844 [InitBasicFS, TestOutputTrue
847 InitBasicFS, TestLastFail
848 [["mkdir"; "/new/foo/bar"]]],
849 "create a directory",
851 Create a directory named C<path>.");
853 ("mkdir_p", (RErr, [String "path"]), 33, [],
854 [InitBasicFS, TestOutputTrue
855 [["mkdir_p"; "/new/foo/bar"];
856 ["is_dir"; "/new/foo/bar"]];
857 InitBasicFS, TestOutputTrue
858 [["mkdir_p"; "/new/foo/bar"];
859 ["is_dir"; "/new/foo"]];
860 InitBasicFS, TestOutputTrue
861 [["mkdir_p"; "/new/foo/bar"];
862 ["is_dir"; "/new"]]],
863 "create a directory and parents",
865 Create a directory named C<path>, creating any parent directories
866 as necessary. This is like the C<mkdir -p> shell command.");
868 ("chmod", (RErr, [Int "mode"; String "path"]), 34, [],
869 [], (* XXX Need stat command to test *)
872 Change the mode (permissions) of C<path> to C<mode>. Only
873 numeric modes are supported.");
875 ("chown", (RErr, [Int "owner"; Int "group"; String "path"]), 35, [],
876 [], (* XXX Need stat command to test *)
877 "change file owner and group",
879 Change the file owner to C<owner> and group to C<group>.
881 Only numeric uid and gid are supported. If you want to use
882 names, you will need to locate and parse the password file
883 yourself (Augeas support makes this relatively easy).");
885 ("exists", (RBool "existsflag", [String "path"]), 36, [],
886 [InitBasicFS, TestOutputTrue (
888 ["exists"; "/new"]]);
889 InitBasicFS, TestOutputTrue (
891 ["exists"; "/new"]])],
892 "test if file or directory exists",
894 This returns C<true> if and only if there is a file, directory
895 (or anything) with the given C<path> name.
897 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
899 ("is_file", (RBool "fileflag", [String "path"]), 37, [],
900 [InitBasicFS, TestOutputTrue (
902 ["is_file"; "/new"]]);
903 InitBasicFS, TestOutputFalse (
905 ["is_file"; "/new"]])],
906 "test if file exists",
908 This returns C<true> if and only if there is a file
909 with the given C<path> name. Note that it returns false for
910 other objects like directories.
912 See also C<guestfs_stat>.");
914 ("is_dir", (RBool "dirflag", [String "path"]), 38, [],
915 [InitBasicFS, TestOutputFalse (
917 ["is_dir"; "/new"]]);
918 InitBasicFS, TestOutputTrue (
920 ["is_dir"; "/new"]])],
921 "test if file exists",
923 This returns C<true> if and only if there is a directory
924 with the given C<path> name. Note that it returns false for
925 other objects like files.
927 See also C<guestfs_stat>.");
929 ("pvcreate", (RErr, [String "device"]), 39, [],
930 [InitEmpty, TestOutputList (
931 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
932 ["pvcreate"; "/dev/sda1"];
933 ["pvcreate"; "/dev/sda2"];
934 ["pvcreate"; "/dev/sda3"];
935 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
936 "create an LVM physical volume",
938 This creates an LVM physical volume on the named C<device>,
939 where C<device> should usually be a partition name such
942 ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
943 [InitEmpty, TestOutputList (
944 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
945 ["pvcreate"; "/dev/sda1"];
946 ["pvcreate"; "/dev/sda2"];
947 ["pvcreate"; "/dev/sda3"];
948 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
949 ["vgcreate"; "VG2"; "/dev/sda3"];
950 ["vgs"]], ["VG1"; "VG2"])],
951 "create an LVM volume group",
953 This creates an LVM volume group called C<volgroup>
954 from the non-empty list of physical volumes C<physvols>.");
956 ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [],
957 [InitEmpty, TestOutputList (
958 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
959 ["pvcreate"; "/dev/sda1"];
960 ["pvcreate"; "/dev/sda2"];
961 ["pvcreate"; "/dev/sda3"];
962 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
963 ["vgcreate"; "VG2"; "/dev/sda3"];
964 ["lvcreate"; "LV1"; "VG1"; "50"];
965 ["lvcreate"; "LV2"; "VG1"; "50"];
966 ["lvcreate"; "LV3"; "VG2"; "50"];
967 ["lvcreate"; "LV4"; "VG2"; "50"];
968 ["lvcreate"; "LV5"; "VG2"; "50"];
970 ["/dev/VG1/LV1"; "/dev/VG1/LV2";
971 "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
972 "create an LVM volume group",
974 This creates an LVM volume group called C<logvol>
975 on the volume group C<volgroup>, with C<size> megabytes.");
977 ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [],
978 [InitEmpty, TestOutput (
979 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
980 ["mkfs"; "ext2"; "/dev/sda1"];
981 ["mount"; "/dev/sda1"; "/"];
982 ["write_file"; "/new"; "new file contents"; "0"];
983 ["cat"; "/new"]], "new file contents")],
986 This creates a filesystem on C<device> (usually a partition
987 of LVM logical volume). The filesystem type is C<fstype>, for
990 ("sfdisk", (RErr, [String "device";
991 Int "cyls"; Int "heads"; Int "sectors";
992 StringList "lines"]), 43, [DangerWillRobinson],
994 "create partitions on a block device",
996 This is a direct interface to the L<sfdisk(8)> program for creating
997 partitions on block devices.
999 C<device> should be a block device, for example C</dev/sda>.
1001 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
1002 and sectors on the device, which are passed directly to sfdisk as
1003 the I<-C>, I<-H> and I<-S> parameters. If you pass C<0> for any
1004 of these, then the corresponding parameter is omitted. Usually for
1005 'large' disks, you can just pass C<0> for these, but for small
1006 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
1007 out the right geometry and you will need to tell it.
1009 C<lines> is a list of lines that we feed to C<sfdisk>. For more
1010 information refer to the L<sfdisk(8)> manpage.
1012 To create a single partition occupying the whole disk, you would
1013 pass C<lines> as a single element list, when the single element being
1014 the string C<,> (comma).");
1016 ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
1017 [InitBasicFS, TestOutput (
1018 [["write_file"; "/new"; "new file contents"; "0"];
1019 ["cat"; "/new"]], "new file contents");
1020 InitBasicFS, TestOutput (
1021 [["write_file"; "/new"; "\nnew file contents\n"; "0"];
1022 ["cat"; "/new"]], "\nnew file contents\n");
1023 InitBasicFS, TestOutput (
1024 [["write_file"; "/new"; "\n\n"; "0"];
1025 ["cat"; "/new"]], "\n\n");
1026 InitBasicFS, TestOutput (
1027 [["write_file"; "/new"; ""; "0"];
1028 ["cat"; "/new"]], "");
1029 InitBasicFS, TestOutput (
1030 [["write_file"; "/new"; "\n\n\n"; "0"];
1031 ["cat"; "/new"]], "\n\n\n");
1032 InitBasicFS, TestOutput (
1033 [["write_file"; "/new"; "\n"; "0"];
1034 ["cat"; "/new"]], "\n")],
1037 This call creates a file called C<path>. The contents of the
1038 file is the string C<content> (which can contain any 8 bit data),
1039 with length C<size>.
1041 As a special case, if C<size> is C<0>
1042 then the length is calculated using C<strlen> (so in this case
1043 the content cannot contain embedded ASCII NULs).");
1045 ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
1046 [InitEmpty, TestOutputList (
1047 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1048 ["mkfs"; "ext2"; "/dev/sda1"];
1049 ["mount"; "/dev/sda1"; "/"];
1050 ["mounts"]], ["/dev/sda1"]);
1051 InitEmpty, TestOutputList (
1052 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1053 ["mkfs"; "ext2"; "/dev/sda1"];
1054 ["mount"; "/dev/sda1"; "/"];
1057 "unmount a filesystem",
1059 This unmounts the given filesystem. The filesystem may be
1060 specified either by its mountpoint (path) or the device which
1061 contains the filesystem.");
1063 ("mounts", (RStringList "devices", []), 46, [],
1064 [InitBasicFS, TestOutputList (
1065 [["mounts"]], ["/dev/sda1"])],
1066 "show mounted filesystems",
1068 This returns the list of currently mounted filesystems. It returns
1069 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
1071 Some internal mounts are not shown.");
1073 ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
1074 [InitBasicFS, TestOutputList (
1077 "unmount all filesystems",
1079 This unmounts all mounted filesystems.
1081 Some internal mounts are not unmounted by this call.");
1083 ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson],
1085 "remove all LVM LVs, VGs and PVs",
1087 This command removes all LVM logical volumes, volume groups
1088 and physical volumes.");
1090 ("file", (RString "description", [String "path"]), 49, [],
1091 [InitBasicFS, TestOutput (
1093 ["file"; "/new"]], "empty");
1094 InitBasicFS, TestOutput (
1095 [["write_file"; "/new"; "some content\n"; "0"];
1096 ["file"; "/new"]], "ASCII text");
1097 InitBasicFS, TestLastFail (
1098 [["file"; "/nofile"]])],
1099 "determine file type",
1101 This call uses the standard L<file(1)> command to determine
1102 the type or contents of the file. This also works on devices,
1103 for example to find out whether a partition contains a filesystem.
1105 The exact command which runs is C<file -bsL path>. Note in
1106 particular that the filename is not prepended to the output
1107 (the C<-b> option).");
1109 ("command", (RString "output", [StringList "arguments"]), 50, [],
1110 [], (* XXX how to test? *)
1111 "run a command from the guest filesystem",
1113 This call runs a command from the guest filesystem. The
1114 filesystem must be mounted, and must contain a compatible
1115 operating system (ie. something Linux, with the same
1116 or compatible processor architecture).
1118 The single parameter is an argv-style list of arguments.
1119 The first element is the name of the program to run.
1120 Subsequent elements are parameters. The list must be
1121 non-empty (ie. must contain a program name).
1123 The C<$PATH> environment variable will contain at least
1124 C</usr/bin> and C</bin>. If you require a program from
1125 another location, you should provide the full path in the
1128 Shared libraries and data files required by the program
1129 must be available on filesystems which are mounted in the
1130 correct places. It is the caller's responsibility to ensure
1131 all filesystems that are needed are mounted at the right
1134 ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [],
1135 [], (* XXX how to test? *)
1136 "run a command, returning lines",
1138 This is the same as C<guestfs_command>, but splits the
1139 result into a list of lines.");
1141 ("stat", (RStat "statbuf", [String "path"]), 52, [],
1142 [InitBasicFS, TestOutputStruct (
1144 ["stat"; "/new"]], [CompareWithInt ("size", 0)])],
1145 "get file information",
1147 Returns file information for the given C<path>.
1149 This is the same as the C<stat(2)> system call.");
1151 ("lstat", (RStat "statbuf", [String "path"]), 53, [],
1152 [InitBasicFS, TestOutputStruct (
1154 ["lstat"; "/new"]], [CompareWithInt ("size", 0)])],
1155 "get file information for a symbolic link",
1157 Returns file information for the given C<path>.
1159 This is the same as C<guestfs_stat> except that if C<path>
1160 is a symbolic link, then the link is stat-ed, not the file it
1163 This is the same as the C<lstat(2)> system call.");
1165 ("statvfs", (RStatVFS "statbuf", [String "path"]), 54, [],
1166 [InitBasicFS, TestOutputStruct (
1167 [["statvfs"; "/"]], [CompareWithInt ("bfree", 487702);
1168 CompareWithInt ("blocks", 490020);
1169 CompareWithInt ("bsize", 1024)])],
1170 "get file system statistics",
1172 Returns file system statistics for any mounted file system.
1173 C<path> should be a file or directory in the mounted file system
1174 (typically it is the mount point itself, but it doesn't need to be).
1176 This is the same as the C<statvfs(2)> system call.");
1178 ("tune2fs_l", (RHashtable "superblock", [String "device"]), 55, [],
1180 "get ext2/ext3 superblock details",
1182 This returns the contents of the ext2 or ext3 filesystem superblock
1185 It is the same as running C<tune2fs -l device>. See L<tune2fs(8)>
1186 manpage for more details. The list of fields returned isn't
1187 clearly defined, and depends on both the version of C<tune2fs>
1188 that libguestfs was built against, and the filesystem itself.");
1190 ("blockdev_setro", (RErr, [String "device"]), 56, [],
1191 [InitEmpty, TestOutputTrue (
1192 [["blockdev_setro"; "/dev/sda"];
1193 ["blockdev_getro"; "/dev/sda"]])],
1194 "set block device to read-only",
1196 Sets the block device named C<device> to read-only.
1198 This uses the L<blockdev(8)> command.");
1200 ("blockdev_setrw", (RErr, [String "device"]), 57, [],
1201 [InitEmpty, TestOutputFalse (
1202 [["blockdev_setrw"; "/dev/sda"];
1203 ["blockdev_getro"; "/dev/sda"]])],
1204 "set block device to read-write",
1206 Sets the block device named C<device> to read-write.
1208 This uses the L<blockdev(8)> command.");
1210 ("blockdev_getro", (RBool "ro", [String "device"]), 58, [],
1211 [InitEmpty, TestOutputTrue (
1212 [["blockdev_setro"; "/dev/sda"];
1213 ["blockdev_getro"; "/dev/sda"]])],
1214 "is block device set to read-only",
1216 Returns a boolean indicating if the block device is read-only
1217 (true if read-only, false if not).
1219 This uses the L<blockdev(8)> command.");
1221 ("blockdev_getss", (RInt "sectorsize", [String "device"]), 59, [],
1222 [InitEmpty, TestOutputInt (
1223 [["blockdev_getss"; "/dev/sda"]], 512)],
1224 "get sectorsize of block device",
1226 This returns the size of sectors on a block device.
1227 Usually 512, but can be larger for modern devices.
1229 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
1232 This uses the L<blockdev(8)> command.");
1234 ("blockdev_getbsz", (RInt "blocksize", [String "device"]), 60, [],
1235 [InitEmpty, TestOutputInt (
1236 [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1237 "get blocksize of block device",
1239 This returns the block size of a device.
1241 (Note this is different from both I<size in blocks> and
1242 I<filesystem block size>).
1244 This uses the L<blockdev(8)> command.");
1246 ("blockdev_setbsz", (RErr, [String "device"; Int "blocksize"]), 61, [],
1248 "set blocksize of block device",
1250 This sets the block size of a device.
1252 (Note this is different from both I<size in blocks> and
1253 I<filesystem block size>).
1255 This uses the L<blockdev(8)> command.");
1257 ("blockdev_getsz", (RInt64 "sizeinsectors", [String "device"]), 62, [],
1258 [InitEmpty, TestOutputInt (
1259 [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1260 "get total size of device in 512-byte sectors",
1262 This returns the size of the device in units of 512-byte sectors
1263 (even if the sectorsize isn't 512 bytes ... weird).
1265 See also C<guestfs_blockdev_getss> for the real sector size of
1266 the device, and C<guestfs_blockdev_getsize64> for the more
1267 useful I<size in bytes>.
1269 This uses the L<blockdev(8)> command.");
1271 ("blockdev_getsize64", (RInt64 "sizeinbytes", [String "device"]), 63, [],
1272 [InitEmpty, TestOutputInt (
1273 [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1274 "get total size of device in bytes",
1276 This returns the size of the device in bytes.
1278 See also C<guestfs_blockdev_getsz>.
1280 This uses the L<blockdev(8)> command.");
1282 ("blockdev_flushbufs", (RErr, [String "device"]), 64, [],
1284 [["blockdev_flushbufs"; "/dev/sda"]]],
1285 "flush device buffers",
1287 This tells the kernel to flush internal buffers associated
1290 This uses the L<blockdev(8)> command.");
1292 ("blockdev_rereadpt", (RErr, [String "device"]), 65, [],
1294 [["blockdev_rereadpt"; "/dev/sda"]]],
1295 "reread partition table",
1297 Reread the partition table on C<device>.
1299 This uses the L<blockdev(8)> command.");
1301 ("upload", (RErr, [FileIn "filename"; String "remotefilename"]), 66, [],
1302 [InitBasicFS, TestOutput (
1303 (* Pick a file from cwd which isn't likely to change. *)
1304 [["upload"; "COPYING.LIB"; "/COPYING.LIB"];
1305 ["checksum"; "md5"; "/COPYING.LIB"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
1306 "upload a file from the local machine",
1308 Upload local file C<filename> to C<remotefilename> on the
1311 C<filename> can also be a named pipe.
1313 See also C<guestfs_download>.");
1315 ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [],
1316 [InitBasicFS, TestOutput (
1317 (* Pick a file from cwd which isn't likely to change. *)
1318 [["upload"; "COPYING.LIB"; "/COPYING.LIB"];
1319 ["download"; "/COPYING.LIB"; "testdownload.tmp"];
1320 ["upload"; "testdownload.tmp"; "/upload"];
1321 ["checksum"; "md5"; "/upload"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
1322 "download a file to the local machine",
1324 Download file C<remotefilename> and save it as C<filename>
1325 on the local machine.
1327 C<filename> can also be a named pipe.
1329 See also C<guestfs_upload>, C<guestfs_cat>.");
1331 ("checksum", (RString "checksum", [String "csumtype"; String "path"]), 68, [],
1332 [InitBasicFS, TestOutput (
1333 [["write_file"; "/new"; "test\n"; "0"];
1334 ["checksum"; "crc"; "/new"]], "935282863");
1335 InitBasicFS, TestLastFail (
1336 [["checksum"; "crc"; "/new"]]);
1337 InitBasicFS, TestOutput (
1338 [["write_file"; "/new"; "test\n"; "0"];
1339 ["checksum"; "md5"; "/new"]], "d8e8fca2dc0f896fd7cb4cb0031ba249");
1340 InitBasicFS, TestOutput (
1341 [["write_file"; "/new"; "test\n"; "0"];
1342 ["checksum"; "sha1"; "/new"]], "4e1243bd22c66e76c2ba9eddc1f91394e57f9f83");
1343 InitBasicFS, TestOutput (
1344 [["write_file"; "/new"; "test\n"; "0"];
1345 ["checksum"; "sha224"; "/new"]], "52f1bf093f4b7588726035c176c0cdb4376cfea53819f1395ac9e6ec");
1346 InitBasicFS, TestOutput (
1347 [["write_file"; "/new"; "test\n"; "0"];
1348 ["checksum"; "sha256"; "/new"]], "f2ca1bb6c7e907d06dafe4687e579fce76b37e4e93b7605022da52e6ccc26fd2");
1349 InitBasicFS, TestOutput (
1350 [["write_file"; "/new"; "test\n"; "0"];
1351 ["checksum"; "sha384"; "/new"]], "109bb6b5b6d5547c1ce03c7a8bd7d8f80c1cb0957f50c4f7fda04692079917e4f9cad52b878f3d8234e1a170b154b72d");
1352 InitBasicFS, TestOutput (
1353 [["write_file"; "/new"; "test\n"; "0"];
1354 ["checksum"; "sha512"; "/new"]], "0e3e75234abc68f4378a86b3f4b32a198ba301845b0cd6e50106e874345700cc6663a86c1ea125dc5e92be17c98f9a0f85ca9d5f595db2012f7cc3571945c123")],
1355 "compute MD5, SHAx or CRC checksum of file",
1357 This call computes the MD5, SHAx or CRC checksum of the
1360 The type of checksum to compute is given by the C<csumtype>
1361 parameter which must have one of the following values:
1367 Compute the cyclic redundancy check (CRC) specified by POSIX
1368 for the C<cksum> command.
1372 Compute the MD5 hash (using the C<md5sum> program).
1376 Compute the SHA1 hash (using the C<sha1sum> program).
1380 Compute the SHA224 hash (using the C<sha224sum> program).
1384 Compute the SHA256 hash (using the C<sha256sum> program).
1388 Compute the SHA384 hash (using the C<sha384sum> program).
1392 Compute the SHA512 hash (using the C<sha512sum> program).
1396 The checksum is returned as a printable string.");
1398 ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [],
1399 [InitBasicFS, TestOutput (
1400 [["tar_in"; "images/helloworld.tar"; "/"];
1401 ["cat"; "/hello"]], "hello\n")],
1402 "unpack tarfile to directory",
1404 This command uploads and unpacks local file C<tarfile> (an
1405 I<uncompressed> tar file) into C<directory>.
1407 To upload a compressed tarball, use C<guestfs_tgz_in>.");
1409 ("tar_out", (RErr, [String "directory"; FileOut "tarfile"]), 70, [],
1411 "pack directory into tarfile",
1413 This command packs the contents of C<directory> and downloads
1414 it to local file C<tarfile>.
1416 To download a compressed tarball, use C<guestfs_tgz_out>.");
1418 ("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [],
1419 [InitBasicFS, TestOutput (
1420 [["tgz_in"; "images/helloworld.tar.gz"; "/"];
1421 ["cat"; "/hello"]], "hello\n")],
1422 "unpack compressed tarball to directory",
1424 This command uploads and unpacks local file C<tarball> (a
1425 I<gzip compressed> tar file) into C<directory>.
1427 To upload an uncompressed tarball, use C<guestfs_tar_in>.");
1429 ("tgz_out", (RErr, [String "directory"; FileOut "tarball"]), 72, [],
1431 "pack directory into compressed tarball",
1433 This command packs the contents of C<directory> and downloads
1434 it to local file C<tarball>.
1436 To download an uncompressed tarball, use C<guestfs_tar_out>.");
1440 let all_functions = non_daemon_functions @ daemon_functions
1442 (* In some places we want the functions to be displayed sorted
1443 * alphabetically, so this is useful:
1445 let all_functions_sorted =
1446 List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
1447 compare n1 n2) all_functions
1449 (* Column names and types from LVM PVs/VGs/LVs. *)
1458 "pv_attr", `String (* XXX *);
1459 "pv_pe_count", `Int;
1460 "pv_pe_alloc_count", `Int;
1463 "pv_mda_count", `Int;
1464 "pv_mda_free", `Bytes;
1465 (* Not in Fedora 10:
1466 "pv_mda_size", `Bytes;
1473 "vg_attr", `String (* XXX *);
1476 "vg_sysid", `String;
1477 "vg_extent_size", `Bytes;
1478 "vg_extent_count", `Int;
1479 "vg_free_count", `Int;
1487 "vg_mda_count", `Int;
1488 "vg_mda_free", `Bytes;
1489 (* Not in Fedora 10:
1490 "vg_mda_size", `Bytes;
1496 "lv_attr", `String (* XXX *);
1499 "lv_kernel_major", `Int;
1500 "lv_kernel_minor", `Int;
1504 "snap_percent", `OptPercent;
1505 "copy_percent", `OptPercent;
1508 "mirror_log", `String;
1512 (* Column names and types from stat structures.
1513 * NB. Can't use things like 'st_atime' because glibc header files
1514 * define some of these as macros. Ugh.
1531 let statvfs_cols = [
1545 (* Useful functions.
1546 * Note we don't want to use any external OCaml libraries which
1547 * makes this a bit harder than it should be.
1549 let failwithf fs = ksprintf failwith fs
1551 let replace_char s c1 c2 =
1552 let s2 = String.copy s in
1553 let r = ref false in
1554 for i = 0 to String.length s2 - 1 do
1555 if String.unsafe_get s2 i = c1 then (
1556 String.unsafe_set s2 i c2;
1560 if not !r then s else s2
1564 (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
1566 let triml ?(test = isspace) str =
1568 let n = ref (String.length str) in
1569 while !n > 0 && test str.[!i]; do
1574 else String.sub str !i !n
1576 let trimr ?(test = isspace) str =
1577 let n = ref (String.length str) in
1578 while !n > 0 && test str.[!n-1]; do
1581 if !n = String.length str then str
1582 else String.sub str 0 !n
1584 let trim ?(test = isspace) str =
1585 trimr ~test (triml ~test str)
1587 let rec find s sub =
1588 let len = String.length s in
1589 let sublen = String.length sub in
1591 if i <= len-sublen then (
1593 if j < sublen then (
1594 if s.[i+j] = sub.[j] then loop2 (j+1)
1600 if r = -1 then loop (i+1) else r
1606 let rec replace_str s s1 s2 =
1607 let len = String.length s in
1608 let sublen = String.length s1 in
1609 let i = find s s1 in
1612 let s' = String.sub s 0 i in
1613 let s'' = String.sub s (i+sublen) (len-i-sublen) in
1614 s' ^ s2 ^ replace_str s'' s1 s2
1617 let rec string_split sep str =
1618 let len = String.length str in
1619 let seplen = String.length sep in
1620 let i = find str sep in
1621 if i = -1 then [str]
1623 let s' = String.sub str 0 i in
1624 let s'' = String.sub str (i+seplen) (len-i-seplen) in
1625 s' :: string_split sep s''
1628 let rec find_map f = function
1629 | [] -> raise Not_found
1633 | None -> find_map f xs
1636 let rec loop i = function
1638 | x :: xs -> f i x; loop (i+1) xs
1643 let rec loop i = function
1645 | x :: xs -> let r = f i x in r :: loop (i+1) xs
1649 let name_of_argt = function
1650 | String n | OptString n | StringList n | Bool n | Int n
1651 | FileIn n | FileOut n -> n
1653 let seq_of_test = function
1654 | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
1655 | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s
1656 | TestOutputLength (s, _) | TestOutputStruct (s, _)
1657 | TestLastFail s -> s
1659 (* Check function names etc. for consistency. *)
1660 let check_functions () =
1661 let contains_uppercase str =
1662 let len = String.length str in
1664 if i >= len then false
1667 if c >= 'A' && c <= 'Z' then true
1674 (* Check function names. *)
1676 fun (name, _, _, _, _, _, _) ->
1677 if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
1678 failwithf "function name %s does not need 'guestfs' prefix" name;
1679 if contains_uppercase name then
1680 failwithf "function name %s should not contain uppercase chars" name;
1681 if String.contains name '-' then
1682 failwithf "function name %s should not contain '-', use '_' instead."
1686 (* Check function parameter/return names. *)
1688 fun (name, style, _, _, _, _, _) ->
1689 let check_arg_ret_name n =
1690 if contains_uppercase n then
1691 failwithf "%s param/ret %s should not contain uppercase chars"
1693 if String.contains n '-' || String.contains n '_' then
1694 failwithf "%s param/ret %s should not contain '-' or '_'"
1697 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;
1698 if n = "argv" || n = "args" then
1699 failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" n
1702 (match fst style with
1704 | RInt n | RInt64 n | RBool n | RConstString n | RString n
1705 | RStringList n | RPVList n | RVGList n | RLVList n
1706 | RStat n | RStatVFS n
1708 check_arg_ret_name n
1710 check_arg_ret_name n;
1711 check_arg_ret_name m
1713 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
1716 (* Check short descriptions. *)
1718 fun (name, _, _, _, _, shortdesc, _) ->
1719 if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
1720 failwithf "short description of %s should begin with lowercase." name;
1721 let c = shortdesc.[String.length shortdesc-1] in
1722 if c = '\n' || c = '.' then
1723 failwithf "short description of %s should not end with . or \\n." name
1726 (* Check long dscriptions. *)
1728 fun (name, _, _, _, _, _, longdesc) ->
1729 if longdesc.[String.length longdesc-1] = '\n' then
1730 failwithf "long description of %s should not end with \\n." name
1733 (* Check proc_nrs. *)
1735 fun (name, _, proc_nr, _, _, _, _) ->
1736 if proc_nr <= 0 then
1737 failwithf "daemon function %s should have proc_nr > 0" name
1741 fun (name, _, proc_nr, _, _, _, _) ->
1742 if proc_nr <> -1 then
1743 failwithf "non-daemon function %s should have proc_nr -1" name
1744 ) non_daemon_functions;
1747 List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
1750 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
1751 let rec loop = function
1754 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
1756 | (name1,nr1) :: (name2,nr2) :: _ ->
1757 failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
1765 (* Ignore functions that have no tests. We generate a
1766 * warning when the user does 'make check' instead.
1768 | name, _, _, _, [], _, _ -> ()
1769 | name, _, _, _, tests, _, _ ->
1773 match seq_of_test test with
1775 failwithf "%s has a test containing an empty sequence" name
1776 | cmds -> List.map List.hd cmds
1778 let funcs = List.flatten funcs in
1780 let tested = List.mem name funcs in
1783 failwithf "function %s has tests but does not test itself" name
1786 (* 'pr' prints to the current output file. *)
1787 let chan = ref stdout
1788 let pr fs = ksprintf (output_string !chan) fs
1790 (* Generate a header block in a number of standard styles. *)
1791 type comment_style = CStyle | HashStyle | OCamlStyle
1792 type license = GPLv2 | LGPLv2
1794 let generate_header comment license =
1795 let c = match comment with
1796 | CStyle -> pr "/* "; " *"
1797 | HashStyle -> pr "# "; "#"
1798 | OCamlStyle -> pr "(* "; " *" in
1799 pr "libguestfs generated file\n";
1800 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
1801 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
1803 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
1807 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
1808 pr "%s it under the terms of the GNU General Public License as published by\n" c;
1809 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
1810 pr "%s (at your option) any later version.\n" c;
1812 pr "%s This program is distributed in the hope that it will be useful,\n" c;
1813 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1814 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
1815 pr "%s GNU General Public License for more details.\n" c;
1817 pr "%s You should have received a copy of the GNU General Public License along\n" c;
1818 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
1819 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
1822 pr "%s This library is free software; you can redistribute it and/or\n" c;
1823 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
1824 pr "%s License as published by the Free Software Foundation; either\n" c;
1825 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
1827 pr "%s This library is distributed in the hope that it will be useful,\n" c;
1828 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1829 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
1830 pr "%s Lesser General Public License for more details.\n" c;
1832 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
1833 pr "%s License along with this library; if not, write to the Free Software\n" c;
1834 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
1837 | CStyle -> pr " */\n"
1839 | OCamlStyle -> pr " *)\n"
1843 (* Start of main code generation functions below this line. *)
1845 (* Generate the pod documentation for the C API. *)
1846 let rec generate_actions_pod () =
1848 fun (shortname, style, _, flags, _, _, longdesc) ->
1849 let name = "guestfs_" ^ shortname in
1850 pr "=head2 %s\n\n" name;
1852 generate_prototype ~extern:false ~handle:"handle" name style;
1854 pr "%s\n\n" longdesc;
1855 (match fst style with
1857 pr "This function returns 0 on success or -1 on error.\n\n"
1859 pr "On error this function returns -1.\n\n"
1861 pr "On error this function returns -1.\n\n"
1863 pr "This function returns a C truth value on success or -1 on error.\n\n"
1865 pr "This function returns a string, or NULL on error.
1866 The string is owned by the guest handle and must I<not> be freed.\n\n"
1868 pr "This function returns a string, or NULL on error.
1869 I<The caller must free the returned string after use>.\n\n"
1871 pr "This function returns a NULL-terminated array of strings
1872 (like L<environ(3)>), or NULL if there was an error.
1873 I<The caller must free the strings and the array after use>.\n\n"
1875 pr "This function returns a C<struct guestfs_int_bool *>,
1876 or NULL if there was an error.
1877 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
1879 pr "This function returns a C<struct guestfs_lvm_pv_list *>
1880 (see E<lt>guestfs-structs.hE<gt>),
1881 or NULL if there was an error.
1882 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
1884 pr "This function returns a C<struct guestfs_lvm_vg_list *>
1885 (see E<lt>guestfs-structs.hE<gt>),
1886 or NULL if there was an error.
1887 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
1889 pr "This function returns a C<struct guestfs_lvm_lv_list *>
1890 (see E<lt>guestfs-structs.hE<gt>),
1891 or NULL if there was an error.
1892 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
1894 pr "This function returns a C<struct guestfs_stat *>
1895 (see L<stat(2)> and E<lt>guestfs-structs.hE<gt>),
1896 or NULL if there was an error.
1897 I<The caller must call C<free> after use>.\n\n"
1899 pr "This function returns a C<struct guestfs_statvfs *>
1900 (see L<statvfs(2)> and E<lt>guestfs-structs.hE<gt>),
1901 or NULL if there was an error.
1902 I<The caller must call C<free> after use>.\n\n"
1904 pr "This function returns a NULL-terminated array of
1905 strings, or NULL if there was an error.
1906 The array of strings will always have length C<2n+1>, where
1907 C<n> keys and values alternate, followed by the trailing NULL entry.
1908 I<The caller must free the strings and the array after use>.\n\n"
1910 if List.mem ProtocolLimitWarning flags then
1911 pr "%s\n\n" protocol_limit_warning;
1912 if List.mem DangerWillRobinson flags then
1913 pr "%s\n\n" danger_will_robinson;
1914 ) all_functions_sorted
1916 and generate_structs_pod () =
1917 (* LVM structs documentation. *)
1920 pr "=head2 guestfs_lvm_%s\n" typ;
1922 pr " struct guestfs_lvm_%s {\n" typ;
1925 | name, `String -> pr " char *%s;\n" name
1927 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
1928 pr " char %s[32];\n" name
1929 | name, `Bytes -> pr " uint64_t %s;\n" name
1930 | name, `Int -> pr " int64_t %s;\n" name
1931 | name, `OptPercent ->
1932 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
1933 pr " float %s;\n" name
1936 pr " struct guestfs_lvm_%s_list {\n" typ;
1937 pr " uint32_t len; /* Number of elements in list. */\n";
1938 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
1941 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
1944 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1946 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
1947 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
1949 * We have to use an underscore instead of a dash because otherwise
1950 * rpcgen generates incorrect code.
1952 * This header is NOT exported to clients, but see also generate_structs_h.
1954 and generate_xdr () =
1955 generate_header CStyle LGPLv2;
1957 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
1958 pr "typedef string str<>;\n";
1961 (* LVM internal structures. *)
1965 pr "struct guestfs_lvm_int_%s {\n" typ;
1967 | name, `String -> pr " string %s<>;\n" name
1968 | name, `UUID -> pr " opaque %s[32];\n" name
1969 | name, `Bytes -> pr " hyper %s;\n" name
1970 | name, `Int -> pr " hyper %s;\n" name
1971 | name, `OptPercent -> pr " float %s;\n" name
1975 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
1977 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1979 (* Stat internal structures. *)
1983 pr "struct guestfs_int_%s {\n" typ;
1985 | name, `Int -> pr " hyper %s;\n" name
1989 ) ["stat", stat_cols; "statvfs", statvfs_cols];
1992 fun (shortname, style, _, _, _, _, _) ->
1993 let name = "guestfs_" ^ shortname in
1995 (match snd style with
1998 pr "struct %s_args {\n" name;
2001 | String n -> pr " string %s<>;\n" n
2002 | OptString n -> pr " str *%s;\n" n
2003 | StringList n -> pr " str %s<>;\n" n
2004 | Bool n -> pr " bool %s;\n" n
2005 | Int n -> pr " int %s;\n" n
2006 | FileIn _ | FileOut _ -> ()
2010 (match fst style with
2013 pr "struct %s_ret {\n" name;
2017 pr "struct %s_ret {\n" name;
2018 pr " hyper %s;\n" n;
2021 pr "struct %s_ret {\n" name;
2025 failwithf "RConstString cannot be returned from a daemon function"
2027 pr "struct %s_ret {\n" name;
2028 pr " string %s<>;\n" n;
2031 pr "struct %s_ret {\n" name;
2032 pr " str %s<>;\n" n;
2035 pr "struct %s_ret {\n" name;
2040 pr "struct %s_ret {\n" name;
2041 pr " guestfs_lvm_int_pv_list %s;\n" n;
2044 pr "struct %s_ret {\n" name;
2045 pr " guestfs_lvm_int_vg_list %s;\n" n;
2048 pr "struct %s_ret {\n" name;
2049 pr " guestfs_lvm_int_lv_list %s;\n" n;
2052 pr "struct %s_ret {\n" name;
2053 pr " guestfs_int_stat %s;\n" n;
2056 pr "struct %s_ret {\n" name;
2057 pr " guestfs_int_statvfs %s;\n" n;
2060 pr "struct %s_ret {\n" name;
2061 pr " str %s<>;\n" n;
2066 (* Table of procedure numbers. *)
2067 pr "enum guestfs_procedure {\n";
2069 fun (shortname, _, proc_nr, _, _, _, _) ->
2070 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
2072 pr " GUESTFS_PROC_NR_PROCS\n";
2076 (* Having to choose a maximum message size is annoying for several
2077 * reasons (it limits what we can do in the API), but it (a) makes
2078 * the protocol a lot simpler, and (b) provides a bound on the size
2079 * of the daemon which operates in limited memory space. For large
2080 * file transfers you should use FTP.
2082 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
2085 (* Message header, etc. *)
2087 /* The communication protocol is now documented in the guestfs(3)
2091 const GUESTFS_PROGRAM = 0x2000F5F5;
2092 const GUESTFS_PROTOCOL_VERSION = 1;
2094 /* These constants must be larger than any possible message length. */
2095 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
2096 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
2098 enum guestfs_message_direction {
2099 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
2100 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
2103 enum guestfs_message_status {
2104 GUESTFS_STATUS_OK = 0,
2105 GUESTFS_STATUS_ERROR = 1
2108 const GUESTFS_ERROR_LEN = 256;
2110 struct guestfs_message_error {
2111 string error_message<GUESTFS_ERROR_LEN>;
2114 struct guestfs_message_header {
2115 unsigned prog; /* GUESTFS_PROGRAM */
2116 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
2117 guestfs_procedure proc; /* GUESTFS_PROC_x */
2118 guestfs_message_direction direction;
2119 unsigned serial; /* message serial number */
2120 guestfs_message_status status;
2123 const GUESTFS_MAX_CHUNK_SIZE = 8192;
2125 struct guestfs_chunk {
2126 int cancel; /* if non-zero, transfer is cancelled */
2127 /* data size is 0 bytes if the transfer has finished successfully */
2128 opaque data<GUESTFS_MAX_CHUNK_SIZE>;
2132 (* Generate the guestfs-structs.h file. *)
2133 and generate_structs_h () =
2134 generate_header CStyle LGPLv2;
2136 (* This is a public exported header file containing various
2137 * structures. The structures are carefully written to have
2138 * exactly the same in-memory format as the XDR structures that
2139 * we use on the wire to the daemon. The reason for creating
2140 * copies of these structures here is just so we don't have to
2141 * export the whole of guestfs_protocol.h (which includes much
2142 * unrelated and XDR-dependent stuff that we don't want to be
2143 * public, or required by clients).
2145 * To reiterate, we will pass these structures to and from the
2146 * client with a simple assignment or memcpy, so the format
2147 * must be identical to what rpcgen / the RFC defines.
2150 (* guestfs_int_bool structure. *)
2151 pr "struct guestfs_int_bool {\n";
2157 (* LVM public structures. *)
2161 pr "struct guestfs_lvm_%s {\n" typ;
2164 | name, `String -> pr " char *%s;\n" name
2165 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
2166 | name, `Bytes -> pr " uint64_t %s;\n" name
2167 | name, `Int -> pr " int64_t %s;\n" name
2168 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
2172 pr "struct guestfs_lvm_%s_list {\n" typ;
2173 pr " uint32_t len;\n";
2174 pr " struct guestfs_lvm_%s *val;\n" typ;
2177 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2179 (* Stat structures. *)
2183 pr "struct guestfs_%s {\n" typ;
2186 | name, `Int -> pr " int64_t %s;\n" name
2190 ) ["stat", stat_cols; "statvfs", statvfs_cols]
2192 (* Generate the guestfs-actions.h file. *)
2193 and generate_actions_h () =
2194 generate_header CStyle LGPLv2;
2196 fun (shortname, style, _, _, _, _, _) ->
2197 let name = "guestfs_" ^ shortname in
2198 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
2202 (* Generate the client-side dispatch stubs. *)
2203 and generate_client_actions () =
2204 generate_header CStyle LGPLv2;
2210 #include \"guestfs.h\"
2211 #include \"guestfs_protocol.h\"
2213 #define error guestfs_error
2214 #define perrorf guestfs_perrorf
2215 #define safe_malloc guestfs_safe_malloc
2216 #define safe_realloc guestfs_safe_realloc
2217 #define safe_strdup guestfs_safe_strdup
2218 #define safe_memdup guestfs_safe_memdup
2220 /* Check the return message from a call for validity. */
2222 check_reply_header (guestfs_h *g,
2223 const struct guestfs_message_header *hdr,
2224 int proc_nr, int serial)
2226 if (hdr->prog != GUESTFS_PROGRAM) {
2227 error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
2230 if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
2231 error (g, \"wrong protocol version (%%d/%%d)\",
2232 hdr->vers, GUESTFS_PROTOCOL_VERSION);
2235 if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
2236 error (g, \"unexpected message direction (%%d/%%d)\",
2237 hdr->direction, GUESTFS_DIRECTION_REPLY);
2240 if (hdr->proc != proc_nr) {
2241 error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
2244 if (hdr->serial != serial) {
2245 error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
2252 /* Check we are in the right state to run a high-level action. */
2254 check_state (guestfs_h *g, const char *caller)
2256 if (!guestfs_is_ready (g)) {
2257 if (guestfs_is_config (g))
2258 error (g, \"%%s: call launch() before using this function\",
2260 else if (guestfs_is_launching (g))
2261 error (g, \"%%s: call wait_ready() before using this function\",
2264 error (g, \"%%s called from the wrong state, %%d != READY\",
2265 caller, guestfs_get_state (g));
2273 (* Client-side stubs for each function. *)
2275 fun (shortname, style, _, _, _, _, _) ->
2276 let name = "guestfs_" ^ shortname in
2278 (* Generate the context struct which stores the high-level
2279 * state between callback functions.
2281 pr "struct %s_ctx {\n" shortname;
2282 pr " /* This flag is set by the callbacks, so we know we've done\n";
2283 pr " * the callbacks as expected, and in the right sequence.\n";
2284 pr " * 0 = not called, 1 = send called,\n";
2285 pr " * 1001 = reply called.\n";
2287 pr " int cb_sequence;\n";
2288 pr " struct guestfs_message_header hdr;\n";
2289 pr " struct guestfs_message_error err;\n";
2290 (match fst style with
2293 failwithf "RConstString cannot be returned from a daemon function"
2295 | RBool _ | RString _ | RStringList _
2297 | RPVList _ | RVGList _ | RLVList _
2298 | RStat _ | RStatVFS _
2300 pr " struct %s_ret ret;\n" name
2305 (* Generate the reply callback function. *)
2306 pr "static void %s_reply_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
2308 pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
2309 pr " struct %s_ctx *ctx = (struct %s_ctx *) data;\n" shortname shortname;
2311 pr " ml->main_loop_quit (ml, g);\n";
2313 pr " if (!xdr_guestfs_message_header (xdr, &ctx->hdr)) {\n";
2314 pr " error (g, \"%%s: failed to parse reply header\", \"%s\");\n" name;
2317 pr " if (ctx->hdr.status == GUESTFS_STATUS_ERROR) {\n";
2318 pr " if (!xdr_guestfs_message_error (xdr, &ctx->err)) {\n";
2319 pr " error (g, \"%%s: failed to parse reply error\", \"%s\");\n"
2326 (match fst style with
2329 failwithf "RConstString cannot be returned from a daemon function"
2331 | RBool _ | RString _ | RStringList _
2333 | RPVList _ | RVGList _ | RLVList _
2334 | RStat _ | RStatVFS _
2336 pr " if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name;
2337 pr " error (g, \"%%s: failed to parse reply\", \"%s\");\n" name;
2343 pr " ctx->cb_sequence = 1001;\n";
2346 (* Generate the action stub. *)
2347 generate_prototype ~extern:false ~semicolon:false ~newline:true
2348 ~handle:"g" name style;
2351 match fst style with
2352 | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
2354 failwithf "RConstString cannot be returned from a daemon function"
2355 | RString _ | RStringList _ | RIntBool _
2356 | RPVList _ | RVGList _ | RLVList _
2357 | RStat _ | RStatVFS _
2363 (match snd style with
2365 | _ -> pr " struct %s_args args;\n" name
2368 pr " struct %s_ctx ctx;\n" shortname;
2369 pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
2370 pr " int serial;\n";
2372 pr " if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
2373 pr " guestfs_set_busy (g);\n";
2375 pr " memset (&ctx, 0, sizeof ctx);\n";
2378 (* Send the main header and arguments. *)
2379 (match snd style with
2381 pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s, NULL, NULL);\n"
2382 (String.uppercase shortname)
2387 pr " args.%s = (char *) %s;\n" n n
2389 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
2391 pr " args.%s.%s_val = (char **) %s;\n" n n n;
2392 pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
2394 pr " args.%s = %s;\n" n n
2396 pr " args.%s = %s;\n" n n
2397 | FileIn _ | FileOut _ -> ()
2399 pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s,\n"
2400 (String.uppercase shortname);
2401 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
2404 pr " if (serial == -1) {\n";
2405 pr " guestfs_set_ready (g);\n";
2406 pr " return %s;\n" error_code;
2410 (* Send any additional files (FileIn) requested. *)
2411 let need_read_reply_label = ref false in
2418 pr " r = guestfs__send_file_sync (g, %s);\n" n;
2419 pr " if (r == -1) {\n";
2420 pr " guestfs_set_ready (g);\n";
2421 pr " return %s;\n" error_code;
2423 pr " if (r == -2) /* daemon cancelled */\n";
2424 pr " goto read_reply;\n";
2425 need_read_reply_label := true;
2431 (* Wait for the reply from the remote end. *)
2432 if !need_read_reply_label then pr " read_reply:\n";
2433 pr " guestfs__switch_to_receiving (g);\n";
2434 pr " ctx.cb_sequence = 0;\n";
2435 pr " guestfs_set_reply_callback (g, %s_reply_cb, &ctx);\n" shortname;
2436 pr " (void) ml->main_loop_run (ml, g);\n";
2437 pr " guestfs_set_reply_callback (g, NULL, NULL);\n";
2438 pr " if (ctx.cb_sequence != 1001) {\n";
2439 pr " error (g, \"%%s reply failed, see earlier error messages\", \"%s\");\n" name;
2440 pr " guestfs_set_ready (g);\n";
2441 pr " return %s;\n" error_code;
2445 pr " if (check_reply_header (g, &ctx.hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
2446 (String.uppercase shortname);
2447 pr " guestfs_set_ready (g);\n";
2448 pr " return %s;\n" error_code;
2452 pr " if (ctx.hdr.status == GUESTFS_STATUS_ERROR) {\n";
2453 pr " error (g, \"%%s\", ctx.err.error_message);\n";
2454 pr " guestfs_set_ready (g);\n";
2455 pr " return %s;\n" error_code;
2459 (* Expecting to receive further files (FileOut)? *)
2463 pr " if (guestfs__receive_file_sync (g, %s) == -1) {\n" n;
2464 pr " guestfs_set_ready (g);\n";
2465 pr " return %s;\n" error_code;
2471 pr " guestfs_set_ready (g);\n";
2473 (match fst style with
2474 | RErr -> pr " return 0;\n"
2475 | RInt n | RInt64 n | RBool n ->
2476 pr " return ctx.ret.%s;\n" n
2478 failwithf "RConstString cannot be returned from a daemon function"
2480 pr " return ctx.ret.%s; /* caller will free */\n" n
2481 | RStringList n | RHashtable n ->
2482 pr " /* caller will free this, but we need to add a NULL entry */\n";
2483 pr " ctx.ret.%s.%s_val =\n" n n;
2484 pr " safe_realloc (g, ctx.ret.%s.%s_val,\n" n n;
2485 pr " sizeof (char *) * (ctx.ret.%s.%s_len + 1));\n"
2487 pr " ctx.ret.%s.%s_val[ctx.ret.%s.%s_len] = NULL;\n" n n n n;
2488 pr " return ctx.ret.%s.%s_val;\n" n n
2490 pr " /* caller with free this */\n";
2491 pr " return safe_memdup (g, &ctx.ret, sizeof (ctx.ret));\n"
2492 | RPVList n | RVGList n | RLVList n
2493 | RStat n | RStatVFS n ->
2494 pr " /* caller will free this */\n";
2495 pr " return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n
2501 (* Generate daemon/actions.h. *)
2502 and generate_daemon_actions_h () =
2503 generate_header CStyle GPLv2;
2505 pr "#include \"../src/guestfs_protocol.h\"\n";
2509 fun (name, style, _, _, _, _, _) ->
2511 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
2515 (* Generate the server-side stubs. *)
2516 and generate_daemon_actions () =
2517 generate_header CStyle GPLv2;
2519 pr "#define _GNU_SOURCE // for strchrnul\n";
2521 pr "#include <stdio.h>\n";
2522 pr "#include <stdlib.h>\n";
2523 pr "#include <string.h>\n";
2524 pr "#include <inttypes.h>\n";
2525 pr "#include <ctype.h>\n";
2526 pr "#include <rpc/types.h>\n";
2527 pr "#include <rpc/xdr.h>\n";
2529 pr "#include \"daemon.h\"\n";
2530 pr "#include \"../src/guestfs_protocol.h\"\n";
2531 pr "#include \"actions.h\"\n";
2535 fun (name, style, _, _, _, _, _) ->
2536 (* Generate server-side stubs. *)
2537 pr "static void %s_stub (XDR *xdr_in)\n" name;
2540 match fst style with
2541 | RErr | RInt _ -> pr " int r;\n"; "-1"
2542 | RInt64 _ -> pr " int64_t r;\n"; "-1"
2543 | RBool _ -> pr " int r;\n"; "-1"
2545 failwithf "RConstString cannot be returned from a daemon function"
2546 | RString _ -> pr " char *r;\n"; "NULL"
2547 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
2548 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
2549 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
2550 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
2551 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL"
2552 | RStat _ -> pr " guestfs_int_stat *r;\n"; "NULL"
2553 | RStatVFS _ -> pr " guestfs_int_statvfs *r;\n"; "NULL" in
2555 (match snd style with
2558 pr " struct guestfs_%s_args args;\n" name;
2562 | OptString n -> pr " const char *%s;\n" n
2563 | StringList n -> pr " char **%s;\n" n
2564 | Bool n -> pr " int %s;\n" n
2565 | Int n -> pr " int %s;\n" n
2566 | FileIn _ | FileOut _ -> ()
2571 (match snd style with
2574 pr " memset (&args, 0, sizeof args);\n";
2576 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
2577 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
2582 | String n -> pr " %s = args.%s;\n" n n
2583 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
2585 pr " args.%s.%s_val = realloc (args.%s.%s_val, sizeof (char *) * (args.%s.%s_len+1));\n" n n n n n n;
2586 pr " args.%s.%s_val[args.%s.%s_len] = NULL;\n" n n n n;
2587 pr " %s = args.%s.%s_val;\n" n n n
2588 | Bool n -> pr " %s = args.%s;\n" n n
2589 | Int n -> pr " %s = args.%s;\n" n n
2590 | FileIn _ | FileOut _ -> ()
2595 (* Don't want to call the impl with any FileIn or FileOut
2596 * parameters, since these go "outside" the RPC protocol.
2599 List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
2601 pr " r = do_%s " name;
2602 generate_call_args argsnofile;
2605 pr " if (r == %s)\n" error_code;
2606 pr " /* do_%s has already called reply_with_error */\n" name;
2610 (* If there are any FileOut parameters, then the impl must
2611 * send its own reply.
2614 List.exists (function FileOut _ -> true | _ -> false) (snd style) in
2616 pr " /* do_%s has already sent a reply */\n" name
2618 match fst style with
2619 | RErr -> pr " reply (NULL, NULL);\n"
2620 | RInt n | RInt64 n | RBool n ->
2621 pr " struct guestfs_%s_ret ret;\n" name;
2622 pr " ret.%s = r;\n" n;
2623 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2626 failwithf "RConstString cannot be returned from a daemon function"
2628 pr " struct guestfs_%s_ret ret;\n" name;
2629 pr " ret.%s = r;\n" n;
2630 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2633 | RStringList n | RHashtable n ->
2634 pr " struct guestfs_%s_ret ret;\n" name;
2635 pr " ret.%s.%s_len = count_strings (r);\n" n n;
2636 pr " ret.%s.%s_val = r;\n" n n;
2637 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2639 pr " free_strings (r);\n"
2641 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n"
2643 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
2644 | RPVList n | RVGList n | RLVList n
2645 | RStat n | RStatVFS n ->
2646 pr " struct guestfs_%s_ret ret;\n" name;
2647 pr " ret.%s = *r;\n" n;
2648 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
2650 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
2654 (* Free the args. *)
2655 (match snd style with
2660 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
2667 (* Dispatch function. *)
2668 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
2670 pr " switch (proc_nr) {\n";
2673 fun (name, style, _, _, _, _, _) ->
2674 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
2675 pr " %s_stub (xdr_in);\n" name;
2680 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
2685 (* LVM columns and tokenization functions. *)
2686 (* XXX This generates crap code. We should rethink how we
2692 pr "static const char *lvm_%s_cols = \"%s\";\n"
2693 typ (String.concat "," (List.map fst cols));
2696 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
2698 pr " char *tok, *p, *next;\n";
2702 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
2705 pr " if (!str) {\n";
2706 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
2709 pr " if (!*str || isspace (*str)) {\n";
2710 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
2715 fun (name, coltype) ->
2716 pr " if (!tok) {\n";
2717 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
2720 pr " p = strchrnul (tok, ',');\n";
2721 pr " if (*p) next = p+1; else next = NULL;\n";
2722 pr " *p = '\\0';\n";
2725 pr " r->%s = strdup (tok);\n" name;
2726 pr " if (r->%s == NULL) {\n" name;
2727 pr " perror (\"strdup\");\n";
2731 pr " for (i = j = 0; i < 32; ++j) {\n";
2732 pr " if (tok[j] == '\\0') {\n";
2733 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
2735 pr " } else if (tok[j] != '-')\n";
2736 pr " r->%s[i++] = tok[j];\n" name;
2739 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
2740 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2744 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
2745 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2749 pr " if (tok[0] == '\\0')\n";
2750 pr " r->%s = -1;\n" name;
2751 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
2752 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2756 pr " tok = next;\n";
2759 pr " if (tok != NULL) {\n";
2760 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
2767 pr "guestfs_lvm_int_%s_list *\n" typ;
2768 pr "parse_command_line_%ss (void)\n" typ;
2770 pr " char *out, *err;\n";
2771 pr " char *p, *pend;\n";
2773 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
2774 pr " void *newp;\n";
2776 pr " ret = malloc (sizeof *ret);\n";
2777 pr " if (!ret) {\n";
2778 pr " reply_with_perror (\"malloc\");\n";
2779 pr " return NULL;\n";
2782 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
2783 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
2785 pr " r = command (&out, &err,\n";
2786 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
2787 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
2788 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
2789 pr " if (r == -1) {\n";
2790 pr " reply_with_error (\"%%s\", err);\n";
2791 pr " free (out);\n";
2792 pr " free (err);\n";
2793 pr " free (ret);\n";
2794 pr " return NULL;\n";
2797 pr " free (err);\n";
2799 pr " /* Tokenize each line of the output. */\n";
2802 pr " while (p) {\n";
2803 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
2804 pr " if (pend) {\n";
2805 pr " *pend = '\\0';\n";
2809 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
2812 pr " if (!*p) { /* Empty line? Skip it. */\n";
2817 pr " /* Allocate some space to store this next entry. */\n";
2818 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
2819 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
2820 pr " if (newp == NULL) {\n";
2821 pr " reply_with_perror (\"realloc\");\n";
2822 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2823 pr " free (ret);\n";
2824 pr " free (out);\n";
2825 pr " return NULL;\n";
2827 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
2829 pr " /* Tokenize the next entry. */\n";
2830 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
2831 pr " if (r == -1) {\n";
2832 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
2833 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2834 pr " free (ret);\n";
2835 pr " free (out);\n";
2836 pr " return NULL;\n";
2843 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
2845 pr " free (out);\n";
2846 pr " return ret;\n";
2849 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2851 (* Generate the tests. *)
2852 and generate_tests () =
2853 generate_header CStyle GPLv2;
2860 #include <sys/types.h>
2863 #include \"guestfs.h\"
2865 static guestfs_h *g;
2866 static int suppress_error = 0;
2868 static void print_error (guestfs_h *g, void *data, const char *msg)
2870 if (!suppress_error)
2871 fprintf (stderr, \"%%s\\n\", msg);
2874 static void print_strings (char * const * const argv)
2878 for (argc = 0; argv[argc] != NULL; ++argc)
2879 printf (\"\\t%%s\\n\", argv[argc]);
2883 static void print_table (char * const * const argv)
2887 for (i = 0; argv[i] != NULL; i += 2)
2888 printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
2892 static void no_test_warnings (void)
2898 | name, _, _, _, [], _, _ ->
2899 pr " fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
2900 | name, _, _, _, tests, _, _ -> ()
2906 (* Generate the actual tests. Note that we generate the tests
2907 * in reverse order, deliberately, so that (in general) the
2908 * newest tests run first. This makes it quicker and easier to
2913 fun (name, _, _, _, tests, _, _) ->
2914 mapi (generate_one_test name) tests
2915 ) (List.rev all_functions) in
2916 let test_names = List.concat test_names in
2917 let nr_tests = List.length test_names in
2920 int main (int argc, char *argv[])
2925 const char *filename;
2927 int nr_tests, test_num = 0;
2929 no_test_warnings ();
2931 g = guestfs_create ();
2933 printf (\"guestfs_create FAILED\\n\");
2937 guestfs_set_error_handler (g, print_error, NULL);
2939 srcdir = getenv (\"srcdir\");
2940 if (!srcdir) srcdir = \".\";
2942 guestfs_set_path (g, \".\");
2944 filename = \"test1.img\";
2945 fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2950 if (lseek (fd, %d, SEEK_SET) == -1) {
2956 if (write (fd, &c, 1) == -1) {
2962 if (close (fd) == -1) {
2967 if (guestfs_add_drive (g, filename) == -1) {
2968 printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
2972 filename = \"test2.img\";
2973 fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2978 if (lseek (fd, %d, SEEK_SET) == -1) {
2984 if (write (fd, &c, 1) == -1) {
2990 if (close (fd) == -1) {
2995 if (guestfs_add_drive (g, filename) == -1) {
2996 printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
3000 filename = \"test3.img\";
3001 fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
3006 if (lseek (fd, %d, SEEK_SET) == -1) {
3012 if (write (fd, &c, 1) == -1) {
3018 if (close (fd) == -1) {
3023 if (guestfs_add_drive (g, filename) == -1) {
3024 printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
3028 if (guestfs_launch (g) == -1) {
3029 printf (\"guestfs_launch FAILED\\n\");
3032 if (guestfs_wait_ready (g) == -1) {
3033 printf (\"guestfs_wait_ready FAILED\\n\");
3039 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
3043 pr " test_num++;\n";
3044 pr " printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
3045 pr " if (%s () == -1) {\n" test_name;
3046 pr " printf (\"%s FAILED\\n\");\n" test_name;
3052 pr " guestfs_close (g);\n";
3053 pr " unlink (\"test1.img\");\n";
3054 pr " unlink (\"test2.img\");\n";
3055 pr " unlink (\"test3.img\");\n";
3058 pr " if (failed > 0) {\n";
3059 pr " printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n";
3067 and generate_one_test name i (init, test) =
3068 let test_name = sprintf "test_%s_%d" name i in
3070 pr "static int %s (void)\n" test_name;
3076 pr " /* InitEmpty for %s (%d) */\n" name i;
3077 List.iter (generate_test_command_call test_name)
3081 pr " /* InitBasicFS for %s (%d): create ext2 on /dev/sda1 */\n" name i;
3082 List.iter (generate_test_command_call test_name)
3085 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
3086 ["mkfs"; "ext2"; "/dev/sda1"];
3087 ["mount"; "/dev/sda1"; "/"]]
3088 | InitBasicFSonLVM ->
3089 pr " /* InitBasicFSonLVM for %s (%d): create ext2 on /dev/VG/LV */\n"
3091 List.iter (generate_test_command_call test_name)
3094 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
3095 ["pvcreate"; "/dev/sda1"];
3096 ["vgcreate"; "VG"; "/dev/sda1"];
3097 ["lvcreate"; "LV"; "VG"; "8"];
3098 ["mkfs"; "ext2"; "/dev/VG/LV"];
3099 ["mount"; "/dev/VG/LV"; "/"]]
3102 let get_seq_last = function
3104 failwithf "%s: you cannot use [] (empty list) when expecting a command"
3107 let seq = List.rev seq in
3108 List.rev (List.tl seq), List.hd seq
3113 pr " /* TestRun for %s (%d) */\n" name i;
3114 List.iter (generate_test_command_call test_name) seq
3115 | TestOutput (seq, expected) ->
3116 pr " /* TestOutput for %s (%d) */\n" name i;
3117 let seq, last = get_seq_last seq in
3119 pr " if (strcmp (r, \"%s\") != 0) {\n" (c_quote expected);
3120 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r);\n" test_name (c_quote expected);
3124 List.iter (generate_test_command_call test_name) seq;
3125 generate_test_command_call ~test test_name last
3126 | TestOutputList (seq, expected) ->
3127 pr " /* TestOutputList for %s (%d) */\n" name i;
3128 let seq, last = get_seq_last seq in
3132 pr " if (!r[%d]) {\n" i;
3133 pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
3134 pr " print_strings (r);\n";
3137 pr " if (strcmp (r[%d], \"%s\") != 0) {\n" i (c_quote str);
3138 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r[%d]);\n" test_name (c_quote str) i;
3142 pr " if (r[%d] != NULL) {\n" (List.length expected);
3143 pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
3145 pr " print_strings (r);\n";
3149 List.iter (generate_test_command_call test_name) seq;
3150 generate_test_command_call ~test test_name last
3151 | TestOutputInt (seq, expected) ->
3152 pr " /* TestOutputInt for %s (%d) */\n" name i;
3153 let seq, last = get_seq_last seq in
3155 pr " if (r != %d) {\n" expected;
3156 pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\","
3162 List.iter (generate_test_command_call test_name) seq;
3163 generate_test_command_call ~test test_name last
3164 | TestOutputTrue seq ->
3165 pr " /* TestOutputTrue for %s (%d) */\n" name i;
3166 let seq, last = get_seq_last seq in
3169 pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n"
3174 List.iter (generate_test_command_call test_name) seq;
3175 generate_test_command_call ~test test_name last
3176 | TestOutputFalse seq ->
3177 pr " /* TestOutputFalse for %s (%d) */\n" name i;
3178 let seq, last = get_seq_last seq in
3181 pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n"
3186 List.iter (generate_test_command_call test_name) seq;
3187 generate_test_command_call ~test test_name last
3188 | TestOutputLength (seq, expected) ->
3189 pr " /* TestOutputLength for %s (%d) */\n" name i;
3190 let seq, last = get_seq_last seq in
3193 pr " for (j = 0; j < %d; ++j)\n" expected;
3194 pr " if (r[j] == NULL) {\n";
3195 pr " fprintf (stderr, \"%s: short list returned\\n\");\n"
3197 pr " print_strings (r);\n";
3200 pr " if (r[j] != NULL) {\n";
3201 pr " fprintf (stderr, \"%s: long list returned\\n\");\n"
3203 pr " print_strings (r);\n";
3207 List.iter (generate_test_command_call test_name) seq;
3208 generate_test_command_call ~test test_name last
3209 | TestOutputStruct (seq, checks) ->
3210 pr " /* TestOutputStruct for %s (%d) */\n" name i;
3211 let seq, last = get_seq_last seq in
3215 | CompareWithInt (field, expected) ->
3216 pr " if (r->%s != %d) {\n" field expected;
3217 pr " fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
3218 test_name field expected;
3219 pr " (int) r->%s);\n" field;
3222 | CompareWithString (field, expected) ->
3223 pr " if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
3224 pr " fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
3225 test_name field expected;
3226 pr " r->%s);\n" field;
3229 | CompareFieldsIntEq (field1, field2) ->
3230 pr " if (r->%s != r->%s) {\n" field1 field2;
3231 pr " fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
3232 test_name field1 field2;
3233 pr " (int) r->%s, (int) r->%s);\n" field1 field2;
3236 | CompareFieldsStrEq (field1, field2) ->
3237 pr " if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
3238 pr " fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
3239 test_name field1 field2;
3240 pr " r->%s, r->%s);\n" field1 field2;
3245 List.iter (generate_test_command_call test_name) seq;
3246 generate_test_command_call ~test test_name last
3247 | TestLastFail seq ->
3248 pr " /* TestLastFail for %s (%d) */\n" name i;
3249 let seq, last = get_seq_last seq in
3250 List.iter (generate_test_command_call test_name) seq;
3251 generate_test_command_call test_name ~expect_error:true last
3259 (* Generate the code to run a command, leaving the result in 'r'.
3260 * If you expect to get an error then you should set expect_error:true.
3262 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
3264 | [] -> assert false
3266 (* Look up the command to find out what args/ret it has. *)
3269 let _, style, _, _, _, _, _ =
3270 List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
3273 failwithf "%s: in test, command %s was not found" test_name name in
3275 if List.length (snd style) <> List.length args then
3276 failwithf "%s: in test, wrong number of args given to %s"
3287 | FileIn _, _ | FileOut _, _ -> ()
3288 | StringList n, arg ->
3289 pr " char *%s[] = {\n" n;
3290 let strs = string_split " " arg in
3292 fun str -> pr " \"%s\",\n" (c_quote str)
3296 ) (List.combine (snd style) args);
3299 match fst style with
3300 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
3301 | RInt64 _ -> pr " int64_t r;\n"; "-1"
3302 | RConstString _ -> pr " const char *r;\n"; "NULL"
3303 | RString _ -> pr " char *r;\n"; "NULL"
3304 | RStringList _ | RHashtable _ ->
3309 pr " struct guestfs_int_bool *r;\n"; "NULL"
3311 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
3313 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
3315 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
3317 pr " struct guestfs_stat *r;\n"; "NULL"
3319 pr " struct guestfs_statvfs *r;\n"; "NULL" in
3321 pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
3322 pr " r = guestfs_%s (g" name;
3324 (* Generate the parameters. *)
3328 | FileIn _, arg | FileOut _, arg ->
3329 pr ", \"%s\"" (c_quote arg)
3330 | OptString _, arg ->
3331 if arg = "NULL" then pr ", NULL" else pr ", \"%s\"" (c_quote arg)
3332 | StringList n, _ ->
3336 try int_of_string arg
3337 with Failure "int_of_string" ->
3338 failwithf "%s: expecting an int, but got '%s'" test_name arg in
3341 let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
3342 ) (List.combine (snd style) args);
3345 if not expect_error then
3346 pr " if (r == %s)\n" error_code
3348 pr " if (r != %s)\n" error_code;
3351 (* Insert the test code. *)
3357 (match fst style with
3358 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ -> ()
3359 | RString _ -> pr " free (r);\n"
3360 | RStringList _ | RHashtable _ ->
3361 pr " for (i = 0; r[i] != NULL; ++i)\n";
3362 pr " free (r[i]);\n";
3365 pr " guestfs_free_int_bool (r);\n"
3367 pr " guestfs_free_lvm_pv_list (r);\n"
3369 pr " guestfs_free_lvm_vg_list (r);\n"
3371 pr " guestfs_free_lvm_lv_list (r);\n"
3372 | RStat _ | RStatVFS _ ->
3379 let str = replace_str str "\r" "\\r" in
3380 let str = replace_str str "\n" "\\n" in
3381 let str = replace_str str "\t" "\\t" in
3384 (* Generate a lot of different functions for guestfish. *)
3385 and generate_fish_cmds () =
3386 generate_header CStyle GPLv2;
3390 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3392 let all_functions_sorted =
3394 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3395 ) all_functions_sorted in
3397 pr "#include <stdio.h>\n";
3398 pr "#include <stdlib.h>\n";
3399 pr "#include <string.h>\n";
3400 pr "#include <inttypes.h>\n";
3402 pr "#include <guestfs.h>\n";
3403 pr "#include \"fish.h\"\n";
3406 (* list_commands function, which implements guestfish -h *)
3407 pr "void list_commands (void)\n";
3409 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
3410 pr " list_builtin_commands ();\n";
3412 fun (name, _, _, flags, _, shortdesc, _) ->
3413 let name = replace_char name '_' '-' in
3414 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
3416 ) all_functions_sorted;
3417 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
3421 (* display_command function, which implements guestfish -h cmd *)
3422 pr "void display_command (const char *cmd)\n";
3425 fun (name, style, _, flags, _, shortdesc, longdesc) ->
3426 let name2 = replace_char name '_' '-' in
3428 try find_map (function FishAlias n -> Some n | _ -> None) flags
3429 with Not_found -> name in
3430 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
3432 match snd style with
3436 name2 (String.concat "> <" (List.map name_of_argt args)) in
3439 if List.mem ProtocolLimitWarning flags then
3440 ("\n\n" ^ protocol_limit_warning)
3443 (* For DangerWillRobinson commands, we should probably have
3444 * guestfish prompt before allowing you to use them (especially
3445 * in interactive mode). XXX
3449 if List.mem DangerWillRobinson flags then
3450 ("\n\n" ^ danger_will_robinson)
3453 let describe_alias =
3454 if name <> alias then
3455 sprintf "\n\nYou can use '%s' as an alias for this command." alias
3459 pr "strcasecmp (cmd, \"%s\") == 0" name;
3460 if name <> name2 then
3461 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
3462 if name <> alias then
3463 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
3465 pr " pod2text (\"%s - %s\", %S);\n"
3467 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
3470 pr " display_builtin_command (cmd);\n";
3474 (* print_{pv,vg,lv}_list functions *)
3478 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
3485 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
3487 pr " printf (\"%s: \");\n" name;
3488 pr " for (i = 0; i < 32; ++i)\n";
3489 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
3490 pr " printf (\"\\n\");\n"
3492 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
3494 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
3495 | name, `OptPercent ->
3496 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
3497 typ name name typ name;
3498 pr " else printf (\"%s: \\n\");\n" name
3502 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
3507 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
3508 pr " print_%s (&%ss->val[i]);\n" typ typ;
3511 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3513 (* print_{stat,statvfs} functions *)
3517 pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
3522 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
3526 ) ["stat", stat_cols; "statvfs", statvfs_cols];
3528 (* run_<action> actions *)
3530 fun (name, style, _, flags, _, _, _) ->
3531 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
3533 (match fst style with
3536 | RBool _ -> pr " int r;\n"
3537 | RInt64 _ -> pr " int64_t r;\n"
3538 | RConstString _ -> pr " const char *r;\n"
3539 | RString _ -> pr " char *r;\n"
3540 | RStringList _ | RHashtable _ -> pr " char **r;\n"
3541 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
3542 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
3543 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
3544 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
3545 | RStat _ -> pr " struct guestfs_stat *r;\n"
3546 | RStatVFS _ -> pr " struct guestfs_statvfs *r;\n"
3553 | FileOut n -> pr " const char *%s;\n" n
3554 | StringList n -> pr " char **%s;\n" n
3555 | Bool n -> pr " int %s;\n" n
3556 | Int n -> pr " int %s;\n" n
3559 (* Check and convert parameters. *)
3560 let argc_expected = List.length (snd style) in
3561 pr " if (argc != %d) {\n" argc_expected;
3562 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
3564 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
3570 | String name -> pr " %s = argv[%d];\n" name i
3572 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
3575 pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdin\";\n"
3578 pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n"
3580 | StringList name ->
3581 pr " %s = parse_string_list (argv[%d]);\n" name i
3583 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
3585 pr " %s = atoi (argv[%d]);\n" name i
3588 (* Call C API function. *)
3590 try find_map (function FishAction n -> Some n | _ -> None) flags
3591 with Not_found -> sprintf "guestfs_%s" name in
3593 generate_call_args ~handle:"g" (snd style);
3596 (* Check return value for errors and display command results. *)
3597 (match fst style with
3598 | RErr -> pr " return r;\n"
3600 pr " if (r == -1) return -1;\n";
3601 pr " printf (\"%%d\\n\", r);\n";
3604 pr " if (r == -1) return -1;\n";
3605 pr " printf (\"%%\" PRIi64 \"\\n\", r);\n";
3608 pr " if (r == -1) return -1;\n";
3609 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
3612 pr " if (r == NULL) return -1;\n";
3613 pr " printf (\"%%s\\n\", r);\n";
3616 pr " if (r == NULL) return -1;\n";
3617 pr " printf (\"%%s\\n\", r);\n";
3621 pr " if (r == NULL) return -1;\n";
3622 pr " print_strings (r);\n";
3623 pr " free_strings (r);\n";
3626 pr " if (r == NULL) return -1;\n";
3627 pr " printf (\"%%d, %%s\\n\", r->i,\n";
3628 pr " r->b ? \"true\" : \"false\");\n";
3629 pr " guestfs_free_int_bool (r);\n";
3632 pr " if (r == NULL) return -1;\n";
3633 pr " print_pv_list (r);\n";
3634 pr " guestfs_free_lvm_pv_list (r);\n";
3637 pr " if (r == NULL) return -1;\n";
3638 pr " print_vg_list (r);\n";
3639 pr " guestfs_free_lvm_vg_list (r);\n";
3642 pr " if (r == NULL) return -1;\n";
3643 pr " print_lv_list (r);\n";
3644 pr " guestfs_free_lvm_lv_list (r);\n";
3647 pr " if (r == NULL) return -1;\n";
3648 pr " print_stat (r);\n";
3652 pr " if (r == NULL) return -1;\n";
3653 pr " print_statvfs (r);\n";
3657 pr " if (r == NULL) return -1;\n";
3658 pr " print_table (r);\n";
3659 pr " free_strings (r);\n";
3666 (* run_action function *)
3667 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
3670 fun (name, _, _, flags, _, _, _) ->
3671 let name2 = replace_char name '_' '-' in
3673 try find_map (function FishAlias n -> Some n | _ -> None) flags
3674 with Not_found -> name in
3676 pr "strcasecmp (cmd, \"%s\") == 0" name;
3677 if name <> name2 then
3678 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
3679 if name <> alias then
3680 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
3682 pr " return run_%s (cmd, argc, argv);\n" name;
3686 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
3693 (* Readline completion for guestfish. *)
3694 and generate_fish_completion () =
3695 generate_header CStyle GPLv2;
3699 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3709 #ifdef HAVE_LIBREADLINE
3710 #include <readline/readline.h>
3715 #ifdef HAVE_LIBREADLINE
3717 static const char *commands[] = {
3720 (* Get the commands and sort them, including the aliases. *)
3723 fun (name, _, _, flags, _, _, _) ->
3724 let name2 = replace_char name '_' '-' in
3726 try find_map (function FishAlias n -> Some n | _ -> None) flags
3727 with Not_found -> name in
3729 if name <> alias then [name2; alias] else [name2]
3731 let commands = List.flatten commands in
3732 let commands = List.sort compare commands in
3734 List.iter (pr " \"%s\",\n") commands;
3740 generator (const char *text, int state)
3742 static int index, len;
3747 len = strlen (text);
3750 while ((name = commands[index]) != NULL) {
3752 if (strncasecmp (name, text, len) == 0)
3753 return strdup (name);
3759 #endif /* HAVE_LIBREADLINE */
3761 char **do_completion (const char *text, int start, int end)
3763 char **matches = NULL;
3765 #ifdef HAVE_LIBREADLINE
3767 matches = rl_completion_matches (text, generator);
3774 (* Generate the POD documentation for guestfish. *)
3775 and generate_fish_actions_pod () =
3776 let all_functions_sorted =
3778 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3779 ) all_functions_sorted in
3782 fun (name, style, _, flags, _, _, longdesc) ->
3783 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
3784 let name = replace_char name '_' '-' in
3786 try find_map (function FishAlias n -> Some n | _ -> None) flags
3787 with Not_found -> name in
3789 pr "=head2 %s" name;
3790 if name <> alias then
3797 | String n -> pr " %s" n
3798 | OptString n -> pr " %s" n
3799 | StringList n -> pr " '%s ...'" n
3800 | Bool _ -> pr " true|false"
3801 | Int n -> pr " %s" n
3802 | FileIn n | FileOut n -> pr " (%s|-)" n
3806 pr "%s\n\n" longdesc;
3808 if List.exists (function FileIn _ | FileOut _ -> true
3809 | _ -> false) (snd style) then
3810 pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
3812 if List.mem ProtocolLimitWarning flags then
3813 pr "%s\n\n" protocol_limit_warning;
3815 if List.mem DangerWillRobinson flags then
3816 pr "%s\n\n" danger_will_robinson
3817 ) all_functions_sorted
3819 (* Generate a C function prototype. *)
3820 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
3821 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
3823 ?handle name style =
3824 if extern then pr "extern ";
3825 if static then pr "static ";
3826 (match fst style with
3828 | RInt _ -> pr "int "
3829 | RInt64 _ -> pr "int64_t "
3830 | RBool _ -> pr "int "
3831 | RConstString _ -> pr "const char *"
3832 | RString _ -> pr "char *"
3833 | RStringList _ | RHashtable _ -> pr "char **"
3835 if not in_daemon then pr "struct guestfs_int_bool *"
3836 else pr "guestfs_%s_ret *" name
3838 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
3839 else pr "guestfs_lvm_int_pv_list *"
3841 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
3842 else pr "guestfs_lvm_int_vg_list *"
3844 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
3845 else pr "guestfs_lvm_int_lv_list *"
3847 if not in_daemon then pr "struct guestfs_stat *"
3848 else pr "guestfs_int_stat *"
3850 if not in_daemon then pr "struct guestfs_statvfs *"
3851 else pr "guestfs_int_statvfs *"
3853 pr "%s%s (" prefix name;
3854 if handle = None && List.length (snd style) = 0 then
3857 let comma = ref false in
3860 | Some handle -> pr "guestfs_h *%s" handle; comma := true
3864 if single_line then pr ", " else pr ",\n\t\t"
3871 | OptString n -> next (); pr "const char *%s" n
3872 | StringList n -> next (); pr "char * const* const %s" n
3873 | Bool n -> next (); pr "int %s" n
3874 | Int n -> next (); pr "int %s" n
3877 if not in_daemon then (next (); pr "const char *%s" n)
3881 if semicolon then pr ";";
3882 if newline then pr "\n"
3884 (* Generate C call arguments, eg "(handle, foo, bar)" *)
3885 and generate_call_args ?handle args =
3887 let comma = ref false in
3890 | Some handle -> pr "%s" handle; comma := true
3894 if !comma then pr ", ";
3896 pr "%s" (name_of_argt arg)
3900 (* Generate the OCaml bindings interface. *)
3901 and generate_ocaml_mli () =
3902 generate_header OCamlStyle LGPLv2;
3905 (** For API documentation you should refer to the C API
3906 in the guestfs(3) manual page. The OCaml API uses almost
3907 exactly the same calls. *)
3910 (** A [guestfs_h] handle. *)
3912 exception Error of string
3913 (** This exception is raised when there is an error. *)
3915 val create : unit -> t
3917 val close : t -> unit
3918 (** Handles are closed by the garbage collector when they become
3919 unreferenced, but callers can also call this in order to
3920 provide predictable cleanup. *)
3923 generate_ocaml_lvm_structure_decls ();
3925 generate_ocaml_stat_structure_decls ();
3929 fun (name, style, _, _, _, shortdesc, _) ->
3930 generate_ocaml_prototype name style;
3931 pr "(** %s *)\n" shortdesc;
3935 (* Generate the OCaml bindings implementation. *)
3936 and generate_ocaml_ml () =
3937 generate_header OCamlStyle LGPLv2;
3941 exception Error of string
3942 external create : unit -> t = \"ocaml_guestfs_create\"
3943 external close : t -> unit = \"ocaml_guestfs_close\"
3946 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
3950 generate_ocaml_lvm_structure_decls ();
3952 generate_ocaml_stat_structure_decls ();
3956 fun (name, style, _, _, _, shortdesc, _) ->
3957 generate_ocaml_prototype ~is_external:true name style;
3960 (* Generate the OCaml bindings C implementation. *)
3961 and generate_ocaml_c () =
3962 generate_header CStyle LGPLv2;
3969 #include <caml/config.h>
3970 #include <caml/alloc.h>
3971 #include <caml/callback.h>
3972 #include <caml/fail.h>
3973 #include <caml/memory.h>
3974 #include <caml/mlvalues.h>
3975 #include <caml/signals.h>
3977 #include <guestfs.h>
3979 #include \"guestfs_c.h\"
3981 /* Copy a hashtable of string pairs into an assoc-list. We return
3982 * the list in reverse order, but hashtables aren't supposed to be
3985 static CAMLprim value
3986 copy_table (char * const * argv)
3989 CAMLlocal5 (rv, pairv, kv, vv, cons);
3993 for (i = 0; argv[i] != NULL; i += 2) {
3994 kv = caml_copy_string (argv[i]);
3995 vv = caml_copy_string (argv[i+1]);
3996 pairv = caml_alloc (2, 0);
3997 Store_field (pairv, 0, kv);
3998 Store_field (pairv, 1, vv);
3999 cons = caml_alloc (2, 0);
4000 Store_field (cons, 1, rv);
4002 Store_field (cons, 0, pairv);
4010 (* LVM struct copy functions. *)
4013 let has_optpercent_col =
4014 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
4016 pr "static CAMLprim value\n";
4017 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
4019 pr " CAMLparam0 ();\n";
4020 if has_optpercent_col then
4021 pr " CAMLlocal3 (rv, v, v2);\n"
4023 pr " CAMLlocal2 (rv, v);\n";
4025 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
4030 pr " v = caml_copy_string (%s->%s);\n" typ name
4032 pr " v = caml_alloc_string (32);\n";
4033 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
4036 pr " v = caml_copy_int64 (%s->%s);\n" typ name
4037 | name, `OptPercent ->
4038 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
4039 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
4040 pr " v = caml_alloc (1, 0);\n";
4041 pr " Store_field (v, 0, v2);\n";
4042 pr " } else /* None */\n";
4043 pr " v = Val_int (0);\n";
4045 pr " Store_field (rv, %d, v);\n" i
4047 pr " CAMLreturn (rv);\n";
4051 pr "static CAMLprim value\n";
4052 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
4055 pr " CAMLparam0 ();\n";
4056 pr " CAMLlocal2 (rv, v);\n";
4059 pr " if (%ss->len == 0)\n" typ;
4060 pr " CAMLreturn (Atom (0));\n";
4062 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
4063 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
4064 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
4065 pr " caml_modify (&Field (rv, i), v);\n";
4067 pr " CAMLreturn (rv);\n";
4071 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
4073 (* Stat copy functions. *)
4076 pr "static CAMLprim value\n";
4077 pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
4079 pr " CAMLparam0 ();\n";
4080 pr " CAMLlocal2 (rv, v);\n";
4082 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
4087 pr " v = caml_copy_int64 (%s->%s);\n" typ name
4089 pr " Store_field (rv, %d, v);\n" i
4091 pr " CAMLreturn (rv);\n";
4094 ) ["stat", stat_cols; "statvfs", statvfs_cols];
4098 fun (name, style, _, _, _, _, _) ->
4100 "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
4102 pr "CAMLprim value\n";
4103 pr "ocaml_guestfs_%s (value %s" name (List.hd params);
4104 List.iter (pr ", value %s") (List.tl params);
4109 | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
4110 pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
4111 pr " CAMLxparam%d (%s);\n"
4112 (List.length rest) (String.concat ", " rest)
4114 pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
4116 pr " CAMLlocal1 (rv);\n";
4119 pr " guestfs_h *g = Guestfs_val (gv);\n";
4120 pr " if (g == NULL)\n";
4121 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
4129 pr " const char *%s = String_val (%sv);\n" n n
4131 pr " const char *%s =\n" n;
4132 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
4135 pr " char **%s = ocaml_guestfs_strings_val (%sv);\n" n n
4137 pr " int %s = Bool_val (%sv);\n" n n
4139 pr " int %s = Int_val (%sv);\n" n n
4142 match fst style with
4143 | RErr -> pr " int r;\n"; "-1"
4144 | RInt _ -> pr " int r;\n"; "-1"
4145 | RInt64 _ -> pr " int64_t r;\n"; "-1"
4146 | RBool _ -> pr " int r;\n"; "-1"
4147 | RConstString _ -> pr " const char *r;\n"; "NULL"
4148 | RString _ -> pr " char *r;\n"; "NULL"
4154 pr " struct guestfs_int_bool *r;\n"; "NULL"
4156 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
4158 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
4160 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
4162 pr " struct guestfs_stat *r;\n"; "NULL"
4164 pr " struct guestfs_statvfs *r;\n"; "NULL"
4171 pr " caml_enter_blocking_section ();\n";
4172 pr " r = guestfs_%s " name;
4173 generate_call_args ~handle:"g" (snd style);
4175 pr " caml_leave_blocking_section ();\n";
4180 pr " ocaml_guestfs_free_strings (%s);\n" n;
4181 | String _ | OptString _ | Bool _ | Int _ | FileIn _ | FileOut _ -> ()
4184 pr " if (r == %s)\n" error_code;
4185 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
4188 (match fst style with
4189 | RErr -> pr " rv = Val_unit;\n"
4190 | RInt _ -> pr " rv = Val_int (r);\n"
4192 pr " rv = caml_copy_int64 (r);\n"
4193 | RBool _ -> pr " rv = Val_bool (r);\n"
4194 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
4196 pr " rv = caml_copy_string (r);\n";
4199 pr " rv = caml_copy_string_array ((const char **) r);\n";
4200 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
4203 pr " rv = caml_alloc (2, 0);\n";
4204 pr " Store_field (rv, 0, Val_int (r->i));\n";
4205 pr " Store_field (rv, 1, Val_bool (r->b));\n";
4206 pr " guestfs_free_int_bool (r);\n";
4208 pr " rv = copy_lvm_pv_list (r);\n";
4209 pr " guestfs_free_lvm_pv_list (r);\n";
4211 pr " rv = copy_lvm_vg_list (r);\n";
4212 pr " guestfs_free_lvm_vg_list (r);\n";
4214 pr " rv = copy_lvm_lv_list (r);\n";
4215 pr " guestfs_free_lvm_lv_list (r);\n";
4217 pr " rv = copy_stat (r);\n";
4220 pr " rv = copy_statvfs (r);\n";
4223 pr " rv = copy_table (r);\n";
4224 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
4228 pr " CAMLreturn (rv);\n";
4232 if List.length params > 5 then (
4233 pr "CAMLprim value\n";
4234 pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
4236 pr " return ocaml_guestfs_%s (argv[0]" name;
4237 iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
4244 and generate_ocaml_lvm_structure_decls () =
4247 pr "type lvm_%s = {\n" typ;
4250 | name, `String -> pr " %s : string;\n" name
4251 | name, `UUID -> pr " %s : string;\n" name
4252 | name, `Bytes -> pr " %s : int64;\n" name
4253 | name, `Int -> pr " %s : int64;\n" name
4254 | name, `OptPercent -> pr " %s : float option;\n" name
4258 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
4260 and generate_ocaml_stat_structure_decls () =
4263 pr "type %s = {\n" typ;
4266 | name, `Int -> pr " %s : int64;\n" name
4270 ) ["stat", stat_cols; "statvfs", statvfs_cols]
4272 and generate_ocaml_prototype ?(is_external = false) name style =
4273 if is_external then pr "external " else pr "val ";
4274 pr "%s : t -> " name;
4277 | String _ | FileIn _ | FileOut _ -> pr "string -> "
4278 | OptString _ -> pr "string option -> "
4279 | StringList _ -> pr "string array -> "
4280 | Bool _ -> pr "bool -> "
4281 | Int _ -> pr "int -> "
4283 (match fst style with
4284 | RErr -> pr "unit" (* all errors are turned into exceptions *)
4285 | RInt _ -> pr "int"
4286 | RInt64 _ -> pr "int64"
4287 | RBool _ -> pr "bool"
4288 | RConstString _ -> pr "string"
4289 | RString _ -> pr "string"
4290 | RStringList _ -> pr "string array"
4291 | RIntBool _ -> pr "int * bool"
4292 | RPVList _ -> pr "lvm_pv array"
4293 | RVGList _ -> pr "lvm_vg array"
4294 | RLVList _ -> pr "lvm_lv array"
4295 | RStat _ -> pr "stat"
4296 | RStatVFS _ -> pr "statvfs"
4297 | RHashtable _ -> pr "(string * string) list"
4299 if is_external then (
4301 if List.length (snd style) + 1 > 5 then
4302 pr "\"ocaml_guestfs_%s_byte\" " name;
4303 pr "\"ocaml_guestfs_%s\"" name
4307 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
4308 and generate_perl_xs () =
4309 generate_header CStyle LGPLv2;
4312 #include \"EXTERN.h\"
4316 #include <guestfs.h>
4319 #define PRId64 \"lld\"
4323 my_newSVll(long long val) {
4324 #ifdef USE_64_BIT_ALL
4325 return newSViv(val);
4329 len = snprintf(buf, 100, \"%%\" PRId64, val);
4330 return newSVpv(buf, len);
4335 #define PRIu64 \"llu\"
4339 my_newSVull(unsigned long long val) {
4340 #ifdef USE_64_BIT_ALL
4341 return newSVuv(val);
4345 len = snprintf(buf, 100, \"%%\" PRIu64, val);
4346 return newSVpv(buf, len);
4350 /* http://www.perlmonks.org/?node_id=680842 */
4352 XS_unpack_charPtrPtr (SV *arg) {
4357 if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV) {
4358 croak (\"array reference expected\");
4361 av = (AV *)SvRV (arg);
4362 ret = (char **)malloc (av_len (av) + 1 + 1);
4364 for (i = 0; i <= av_len (av); i++) {
4365 SV **elem = av_fetch (av, i, 0);
4367 if (!elem || !*elem)
4368 croak (\"missing element in list\");
4370 ret[i] = SvPV_nolen (*elem);
4378 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
4383 RETVAL = guestfs_create ();
4385 croak (\"could not create guestfs handle\");
4386 guestfs_set_error_handler (RETVAL, NULL, NULL);
4399 fun (name, style, _, _, _, _, _) ->
4400 (match fst style with
4401 | RErr -> pr "void\n"
4402 | RInt _ -> pr "SV *\n"
4403 | RInt64 _ -> pr "SV *\n"
4404 | RBool _ -> pr "SV *\n"
4405 | RConstString _ -> pr "SV *\n"
4406 | RString _ -> pr "SV *\n"
4409 | RPVList _ | RVGList _ | RLVList _
4410 | RStat _ | RStatVFS _
4412 pr "void\n" (* all lists returned implictly on the stack *)
4414 (* Call and arguments. *)
4416 generate_call_args ~handle:"g" (snd style);
4418 pr " guestfs_h *g;\n";
4421 | String n | FileIn n | FileOut n -> pr " char *%s;\n" n
4422 | OptString n -> pr " char *%s;\n" n
4423 | StringList n -> pr " char **%s;\n" n
4424 | Bool n -> pr " int %s;\n" n
4425 | Int n -> pr " int %s;\n" n
4428 let do_cleanups () =
4431 | String _ | OptString _ | Bool _ | Int _
4432 | FileIn _ | FileOut _ -> ()
4433 | StringList n -> pr " free (%s);\n" n
4438 (match fst style with
4443 pr " r = guestfs_%s " name;
4444 generate_call_args ~handle:"g" (snd style);
4447 pr " if (r == -1)\n";
4448 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4454 pr " %s = guestfs_%s " n name;
4455 generate_call_args ~handle:"g" (snd style);
4458 pr " if (%s == -1)\n" n;
4459 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4460 pr " RETVAL = newSViv (%s);\n" n;
4465 pr " int64_t %s;\n" n;
4467 pr " %s = guestfs_%s " n name;
4468 generate_call_args ~handle:"g" (snd style);
4471 pr " if (%s == -1)\n" n;
4472 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4473 pr " RETVAL = my_newSVll (%s);\n" n;
4478 pr " const char *%s;\n" n;
4480 pr " %s = guestfs_%s " n name;
4481 generate_call_args ~handle:"g" (snd style);
4484 pr " if (%s == NULL)\n" n;
4485 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4486 pr " RETVAL = newSVpv (%s, 0);\n" n;
4491 pr " char *%s;\n" 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 " RETVAL = newSVpv (%s, 0);\n" n;
4500 pr " free (%s);\n" n;
4503 | RStringList n | RHashtable n ->
4505 pr " char **%s;\n" n;
4508 pr " %s = guestfs_%s " n name;
4509 generate_call_args ~handle:"g" (snd style);
4512 pr " if (%s == NULL)\n" n;
4513 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4514 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
4515 pr " EXTEND (SP, n);\n";
4516 pr " for (i = 0; i < n; ++i) {\n";
4517 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
4518 pr " free (%s[i]);\n" n;
4520 pr " free (%s);\n" n;
4523 pr " struct guestfs_int_bool *r;\n";
4525 pr " r = guestfs_%s " name;
4526 generate_call_args ~handle:"g" (snd style);
4529 pr " if (r == NULL)\n";
4530 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4531 pr " EXTEND (SP, 2);\n";
4532 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
4533 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
4534 pr " guestfs_free_int_bool (r);\n";
4536 generate_perl_lvm_code "pv" pv_cols name style n do_cleanups
4538 generate_perl_lvm_code "vg" vg_cols name style n do_cleanups
4540 generate_perl_lvm_code "lv" lv_cols name style n do_cleanups
4542 generate_perl_stat_code "stat" stat_cols name style n do_cleanups
4544 generate_perl_stat_code
4545 "statvfs" statvfs_cols name style n do_cleanups
4551 and generate_perl_lvm_code typ cols name style n do_cleanups =
4553 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
4557 pr " %s = guestfs_%s " n name;
4558 generate_call_args ~handle:"g" (snd style);
4561 pr " if (%s == NULL)\n" n;
4562 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4563 pr " EXTEND (SP, %s->len);\n" n;
4564 pr " for (i = 0; i < %s->len; ++i) {\n" n;
4565 pr " hv = newHV ();\n";
4569 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
4570 name (String.length name) n name
4572 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
4573 name (String.length name) n name
4575 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
4576 name (String.length name) n name
4578 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
4579 name (String.length name) n name
4580 | name, `OptPercent ->
4581 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
4582 name (String.length name) n name
4584 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
4586 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
4588 and generate_perl_stat_code typ cols name style n do_cleanups =
4590 pr " struct guestfs_%s *%s;\n" typ n;
4592 pr " %s = guestfs_%s " n name;
4593 generate_call_args ~handle:"g" (snd style);
4596 pr " if (%s == NULL)\n" n;
4597 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4598 pr " EXTEND (SP, %d);\n" (List.length cols);
4602 pr " PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n" n name
4604 pr " free (%s);\n" n
4606 (* Generate Sys/Guestfs.pm. *)
4607 and generate_perl_pm () =
4608 generate_header HashStyle LGPLv2;
4615 Sys::Guestfs - Perl bindings for libguestfs
4621 my $h = Sys::Guestfs->new ();
4622 $h->add_drive ('guest.img');
4625 $h->mount ('/dev/sda1', '/');
4626 $h->touch ('/hello');
4631 The C<Sys::Guestfs> module provides a Perl XS binding to the
4632 libguestfs API for examining and modifying virtual machine
4635 Amongst the things this is good for: making batch configuration
4636 changes to guests, getting disk used/free statistics (see also:
4637 virt-df), migrating between virtualization systems (see also:
4638 virt-p2v), performing partial backups, performing partial guest
4639 clones, cloning guests and changing registry/UUID/hostname info, and
4642 Libguestfs uses Linux kernel and qemu code, and can access any type of
4643 guest filesystem that Linux and qemu can, including but not limited
4644 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
4645 schemes, qcow, qcow2, vmdk.
4647 Libguestfs provides ways to enumerate guest storage (eg. partitions,
4648 LVs, what filesystem is in each LV, etc.). It can also run commands
4649 in the context of the guest. Also you can access filesystems over FTP.
4653 All errors turn into calls to C<croak> (see L<Carp(3)>).
4661 package Sys::Guestfs;
4667 XSLoader::load ('Sys::Guestfs');
4669 =item $h = Sys::Guestfs->new ();
4671 Create a new guestfs handle.
4677 my $class = ref ($proto) || $proto;
4679 my $self = Sys::Guestfs::_create ();
4680 bless $self, $class;
4686 (* Actions. We only need to print documentation for these as
4687 * they are pulled in from the XS code automatically.
4690 fun (name, style, _, flags, _, _, longdesc) ->
4691 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
4693 generate_perl_prototype name style;
4695 pr "%s\n\n" longdesc;
4696 if List.mem ProtocolLimitWarning flags then
4697 pr "%s\n\n" protocol_limit_warning;
4698 if List.mem DangerWillRobinson flags then
4699 pr "%s\n\n" danger_will_robinson
4700 ) all_functions_sorted;
4712 Copyright (C) 2009 Red Hat Inc.
4716 Please see the file COPYING.LIB for the full license.
4720 L<guestfs(3)>, L<guestfish(1)>.
4725 and generate_perl_prototype name style =
4726 (match fst style with
4732 | RString n -> pr "$%s = " n
4733 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
4737 | RLVList n -> pr "@%s = " n
4740 | RHashtable n -> pr "%%%s = " n
4743 let comma = ref false in
4746 if !comma then pr ", ";
4749 | String n | OptString n | Bool n | Int n | FileIn n | FileOut n ->
4756 (* Generate Python C module. *)
4757 and generate_python_c () =
4758 generate_header CStyle LGPLv2;
4767 #include \"guestfs.h\"
4775 get_handle (PyObject *obj)
4778 assert (obj != Py_None);
4779 return ((Pyguestfs_Object *) obj)->g;
4783 put_handle (guestfs_h *g)
4787 PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
4790 /* This list should be freed (but not the strings) after use. */
4791 static const char **
4792 get_string_list (PyObject *obj)
4799 if (!PyList_Check (obj)) {
4800 PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
4804 len = PyList_Size (obj);
4805 r = malloc (sizeof (char *) * (len+1));
4807 PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
4811 for (i = 0; i < len; ++i)
4812 r[i] = PyString_AsString (PyList_GetItem (obj, i));
4819 put_string_list (char * const * const argv)
4824 for (argc = 0; argv[argc] != NULL; ++argc)
4827 list = PyList_New (argc);
4828 for (i = 0; i < argc; ++i)
4829 PyList_SetItem (list, i, PyString_FromString (argv[i]));
4835 put_table (char * const * const argv)
4837 PyObject *list, *item;
4840 for (argc = 0; argv[argc] != NULL; ++argc)
4843 list = PyList_New (argc >> 1);
4844 for (i = 0; i < argc; i += 2) {
4845 item = PyTuple_New (2);
4846 PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
4847 PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
4848 PyList_SetItem (list, i >> 1, item);
4855 free_strings (char **argv)
4859 for (argc = 0; argv[argc] != NULL; ++argc)
4865 py_guestfs_create (PyObject *self, PyObject *args)
4869 g = guestfs_create ();
4871 PyErr_SetString (PyExc_RuntimeError,
4872 \"guestfs.create: failed to allocate handle\");
4875 guestfs_set_error_handler (g, NULL, NULL);
4876 return put_handle (g);
4880 py_guestfs_close (PyObject *self, PyObject *args)
4885 if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
4887 g = get_handle (py_g);
4891 Py_INCREF (Py_None);
4897 (* LVM structures, turned into Python dictionaries. *)
4900 pr "static PyObject *\n";
4901 pr "put_lvm_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
4903 pr " PyObject *dict;\n";
4905 pr " dict = PyDict_New ();\n";
4909 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4910 pr " PyString_FromString (%s->%s));\n"
4913 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4914 pr " PyString_FromStringAndSize (%s->%s, 32));\n"
4917 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4918 pr " PyLong_FromUnsignedLongLong (%s->%s));\n"
4921 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4922 pr " PyLong_FromLongLong (%s->%s));\n"
4924 | name, `OptPercent ->
4925 pr " if (%s->%s >= 0)\n" typ name;
4926 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4927 pr " PyFloat_FromDouble ((double) %s->%s));\n"
4930 pr " Py_INCREF (Py_None);\n";
4931 pr " PyDict_SetItemString (dict, \"%s\", Py_None);" name;
4934 pr " return dict;\n";
4938 pr "static PyObject *\n";
4939 pr "put_lvm_%s_list (struct guestfs_lvm_%s_list *%ss)\n" typ typ typ;
4941 pr " PyObject *list;\n";
4944 pr " list = PyList_New (%ss->len);\n" typ;
4945 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
4946 pr " PyList_SetItem (list, i, put_lvm_%s (&%ss->val[i]));\n" typ typ;
4947 pr " return list;\n";
4950 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
4952 (* Stat structures, turned into Python dictionaries. *)
4955 pr "static PyObject *\n";
4956 pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
4958 pr " PyObject *dict;\n";
4960 pr " dict = PyDict_New ();\n";
4964 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4965 pr " PyLong_FromLongLong (%s->%s));\n"
4968 pr " return dict;\n";
4971 ) ["stat", stat_cols; "statvfs", statvfs_cols];
4973 (* Python wrapper functions. *)
4975 fun (name, style, _, _, _, _, _) ->
4976 pr "static PyObject *\n";
4977 pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
4980 pr " PyObject *py_g;\n";
4981 pr " guestfs_h *g;\n";
4982 pr " PyObject *py_r;\n";
4985 match fst style with
4986 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
4987 | RInt64 _ -> pr " int64_t r;\n"; "-1"
4988 | RConstString _ -> pr " const char *r;\n"; "NULL"
4989 | RString _ -> pr " char *r;\n"; "NULL"
4990 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
4991 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
4992 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
4993 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
4994 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
4995 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
4996 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
5000 | String n | FileIn n | FileOut n -> pr " const char *%s;\n" n
5001 | OptString n -> pr " const char *%s;\n" n
5003 pr " PyObject *py_%s;\n" n;
5004 pr " const char **%s;\n" n
5005 | Bool n -> pr " int %s;\n" n
5006 | Int n -> pr " int %s;\n" n
5011 (* Convert the parameters. *)
5012 pr " if (!PyArg_ParseTuple (args, (char *) \"O";
5015 | String _ | FileIn _ | FileOut _ -> pr "s"
5016 | OptString _ -> pr "z"
5017 | StringList _ -> pr "O"
5018 | Bool _ -> pr "i" (* XXX Python has booleans? *)
5021 pr ":guestfs_%s\",\n" name;
5025 | String n | FileIn n | FileOut n -> pr ", &%s" n
5026 | OptString n -> pr ", &%s" n
5027 | StringList n -> pr ", &py_%s" n
5028 | Bool n -> pr ", &%s" n
5029 | Int n -> pr ", &%s" n
5033 pr " return NULL;\n";
5035 pr " g = get_handle (py_g);\n";
5038 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
5040 pr " %s = get_string_list (py_%s);\n" n n;
5041 pr " if (!%s) return NULL;\n" n
5046 pr " r = guestfs_%s " name;
5047 generate_call_args ~handle:"g" (snd style);
5052 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
5054 pr " free (%s);\n" n
5057 pr " if (r == %s) {\n" error_code;
5058 pr " PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
5059 pr " return NULL;\n";
5063 (match fst style with
5065 pr " Py_INCREF (Py_None);\n";
5066 pr " py_r = Py_None;\n"
5068 | RBool _ -> pr " py_r = PyInt_FromLong ((long) r);\n"
5069 | RInt64 _ -> pr " py_r = PyLong_FromLongLong (r);\n"
5070 | RConstString _ -> pr " py_r = PyString_FromString (r);\n"
5072 pr " py_r = PyString_FromString (r);\n";
5075 pr " py_r = put_string_list (r);\n";
5076 pr " free_strings (r);\n"
5078 pr " py_r = PyTuple_New (2);\n";
5079 pr " PyTuple_SetItem (py_r, 0, PyInt_FromLong ((long) r->i));\n";
5080 pr " PyTuple_SetItem (py_r, 1, PyInt_FromLong ((long) r->b));\n";
5081 pr " guestfs_free_int_bool (r);\n"
5083 pr " py_r = put_lvm_pv_list (r);\n";
5084 pr " guestfs_free_lvm_pv_list (r);\n"
5086 pr " py_r = put_lvm_vg_list (r);\n";
5087 pr " guestfs_free_lvm_vg_list (r);\n"
5089 pr " py_r = put_lvm_lv_list (r);\n";
5090 pr " guestfs_free_lvm_lv_list (r);\n"
5092 pr " py_r = put_stat (r);\n";
5095 pr " py_r = put_statvfs (r);\n";
5098 pr " py_r = put_table (r);\n";
5099 pr " free_strings (r);\n"
5102 pr " return py_r;\n";
5107 (* Table of functions. *)
5108 pr "static PyMethodDef methods[] = {\n";
5109 pr " { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
5110 pr " { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
5112 fun (name, _, _, _, _, _, _) ->
5113 pr " { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
5116 pr " { NULL, NULL, 0, NULL }\n";
5120 (* Init function. *)
5123 initlibguestfsmod (void)
5125 static int initialized = 0;
5127 if (initialized) return;
5128 Py_InitModule ((char *) \"libguestfsmod\", methods);
5133 (* Generate Python module. *)
5134 and generate_python_py () =
5135 generate_header HashStyle LGPLv2;
5138 u\"\"\"Python bindings for libguestfs
5141 g = guestfs.GuestFS ()
5142 g.add_drive (\"guest.img\")
5145 parts = g.list_partitions ()
5147 The guestfs module provides a Python binding to the libguestfs API
5148 for examining and modifying virtual machine disk images.
5150 Amongst the things this is good for: making batch configuration
5151 changes to guests, getting disk used/free statistics (see also:
5152 virt-df), migrating between virtualization systems (see also:
5153 virt-p2v), performing partial backups, performing partial guest
5154 clones, cloning guests and changing registry/UUID/hostname info, and
5157 Libguestfs uses Linux kernel and qemu code, and can access any type of
5158 guest filesystem that Linux and qemu can, including but not limited
5159 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
5160 schemes, qcow, qcow2, vmdk.
5162 Libguestfs provides ways to enumerate guest storage (eg. partitions,
5163 LVs, what filesystem is in each LV, etc.). It can also run commands
5164 in the context of the guest. Also you can access filesystems over FTP.
5166 Errors which happen while using the API are turned into Python
5167 RuntimeError exceptions.
5169 To create a guestfs handle you usually have to perform the following
5172 # Create the handle, call add_drive at least once, and possibly
5173 # several times if the guest has multiple block devices:
5174 g = guestfs.GuestFS ()
5175 g.add_drive (\"guest.img\")
5177 # Launch the qemu subprocess and wait for it to become ready:
5181 # Now you can issue commands, for example:
5186 import libguestfsmod
5189 \"\"\"Instances of this class are libguestfs API handles.\"\"\"
5191 def __init__ (self):
5192 \"\"\"Create a new libguestfs handle.\"\"\"
5193 self._o = libguestfsmod.create ()
5196 libguestfsmod.close (self._o)
5201 fun (name, style, _, flags, _, _, longdesc) ->
5202 let doc = replace_str longdesc "C<guestfs_" "C<g." in
5204 match fst style with
5205 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _
5208 doc ^ "\n\nThis function returns a list of strings."
5210 doc ^ "\n\nThis function returns a tuple (int, bool).\n"
5212 doc ^ "\n\nThis function returns a list of PVs. Each PV is represented as a dictionary."
5214 doc ^ "\n\nThis function returns a list of VGs. Each VG is represented as a dictionary."
5216 doc ^ "\n\nThis function returns a list of LVs. Each LV is represented as a dictionary."
5218 doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the stat structure."
5220 doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the statvfs structure."
5222 doc ^ "\n\nThis function returns a dictionary." in
5224 if List.mem ProtocolLimitWarning flags then
5225 doc ^ "\n\n" ^ protocol_limit_warning
5228 if List.mem DangerWillRobinson flags then
5229 doc ^ "\n\n" ^ danger_will_robinson
5231 let doc = pod2text ~width:60 name doc in
5232 let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
5233 let doc = String.concat "\n " doc in
5236 generate_call_args ~handle:"self" (snd style);
5238 pr " u\"\"\"%s\"\"\"\n" doc;
5239 pr " return libguestfsmod.%s " name;
5240 generate_call_args ~handle:"self._o" (snd style);
5245 (* Useful if you need the longdesc POD text as plain text. Returns a
5248 * This is the slowest thing about autogeneration.
5250 and pod2text ~width name longdesc =
5251 let filename, chan = Filename.open_temp_file "gen" ".tmp" in
5252 fprintf chan "=head1 %s\n\n%s\n" name longdesc;
5254 let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
5255 let chan = Unix.open_process_in cmd in
5256 let lines = ref [] in
5258 let line = input_line chan in
5259 if i = 1 then (* discard the first line of output *)
5262 let line = triml line in
5263 lines := line :: !lines;
5266 let lines = try loop 1 with End_of_file -> List.rev !lines in
5267 Unix.unlink filename;
5268 match Unix.close_process_in chan with
5269 | Unix.WEXITED 0 -> lines
5271 failwithf "pod2text: process exited with non-zero status (%d)" i
5272 | Unix.WSIGNALED i | Unix.WSTOPPED i ->
5273 failwithf "pod2text: process signalled or stopped by signal %d" i
5275 (* Generate ruby bindings. *)
5276 and generate_ruby_c () =
5277 generate_header CStyle LGPLv2;
5285 #include \"guestfs.h\"
5287 #include \"extconf.h\"
5289 static VALUE m_guestfs; /* guestfs module */
5290 static VALUE c_guestfs; /* guestfs_h handle */
5291 static VALUE e_Error; /* used for all errors */
5293 static void ruby_guestfs_free (void *p)
5296 guestfs_close ((guestfs_h *) p);
5299 static VALUE ruby_guestfs_create (VALUE m)
5303 g = guestfs_create ();
5305 rb_raise (e_Error, \"failed to create guestfs handle\");
5307 /* Don't print error messages to stderr by default. */
5308 guestfs_set_error_handler (g, NULL, NULL);
5310 /* Wrap it, and make sure the close function is called when the
5313 return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
5316 static VALUE ruby_guestfs_close (VALUE gv)
5319 Data_Get_Struct (gv, guestfs_h, g);
5321 ruby_guestfs_free (g);
5322 DATA_PTR (gv) = NULL;
5330 fun (name, style, _, _, _, _, _) ->
5331 pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
5332 List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
5335 pr " guestfs_h *g;\n";
5336 pr " Data_Get_Struct (gv, guestfs_h, g);\n";
5338 pr " rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
5344 | String n | FileIn n | FileOut n ->
5345 pr " const char *%s = StringValueCStr (%sv);\n" n n;
5347 pr " rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
5348 pr " \"%s\", \"%s\");\n" n name
5350 pr " const char *%s = StringValueCStr (%sv);\n" n n
5354 pr " int i, len;\n";
5355 pr " len = RARRAY_LEN (%sv);\n" n;
5356 pr " %s = malloc (sizeof (char *) * (len+1));\n" n;
5357 pr " for (i = 0; i < len; ++i) {\n";
5358 pr " VALUE v = rb_ary_entry (%sv, i);\n" n;
5359 pr " %s[i] = StringValueCStr (v);\n" n;
5364 pr " int %s = NUM2INT (%sv);\n" n n
5369 match fst style with
5370 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
5371 | RInt64 _ -> pr " int64_t r;\n"; "-1"
5372 | RConstString _ -> pr " const char *r;\n"; "NULL"
5373 | RString _ -> pr " char *r;\n"; "NULL"
5374 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
5375 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
5376 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
5377 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
5378 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
5379 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
5380 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
5383 pr " r = guestfs_%s " name;
5384 generate_call_args ~handle:"g" (snd style);
5389 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
5391 pr " free (%s);\n" n
5394 pr " if (r == %s)\n" error_code;
5395 pr " rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
5398 (match fst style with
5400 pr " return Qnil;\n"
5401 | RInt _ | RBool _ ->
5402 pr " return INT2NUM (r);\n"
5404 pr " return ULL2NUM (r);\n"
5406 pr " return rb_str_new2 (r);\n";
5408 pr " VALUE rv = rb_str_new2 (r);\n";
5412 pr " int i, len = 0;\n";
5413 pr " for (i = 0; r[i] != NULL; ++i) len++;\n";
5414 pr " VALUE rv = rb_ary_new2 (len);\n";
5415 pr " for (i = 0; r[i] != NULL; ++i) {\n";
5416 pr " rb_ary_push (rv, rb_str_new2 (r[i]));\n";
5417 pr " free (r[i]);\n";
5422 pr " VALUE rv = rb_ary_new2 (2);\n";
5423 pr " rb_ary_push (rv, INT2NUM (r->i));\n";
5424 pr " rb_ary_push (rv, INT2NUM (r->b));\n";
5425 pr " guestfs_free_int_bool (r);\n";
5428 generate_ruby_lvm_code "pv" pv_cols
5430 generate_ruby_lvm_code "vg" vg_cols
5432 generate_ruby_lvm_code "lv" lv_cols
5434 pr " VALUE rv = rb_hash_new ();\n";
5438 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
5443 pr " VALUE rv = rb_hash_new ();\n";
5447 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
5452 pr " VALUE rv = rb_hash_new ();\n";
5454 pr " for (i = 0; r[i] != NULL; i+=2) {\n";
5455 pr " rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
5456 pr " free (r[i]);\n";
5457 pr " free (r[i+1]);\n";
5468 /* Initialize the module. */
5469 void Init__guestfs ()
5471 m_guestfs = rb_define_module (\"Guestfs\");
5472 c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
5473 e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
5475 rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
5476 rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
5479 (* Define the rest of the methods. *)
5481 fun (name, style, _, _, _, _, _) ->
5482 pr " rb_define_method (c_guestfs, \"%s\",\n" name;
5483 pr " ruby_guestfs_%s, %d);\n" name (List.length (snd style))
5488 (* Ruby code to return an LVM struct list. *)
5489 and generate_ruby_lvm_code typ cols =
5490 pr " VALUE rv = rb_ary_new2 (r->len);\n";
5492 pr " for (i = 0; i < r->len; ++i) {\n";
5493 pr " VALUE hv = rb_hash_new ();\n";
5497 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
5499 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
5502 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
5503 | name, `OptPercent ->
5504 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
5506 pr " rb_ary_push (rv, hv);\n";
5508 pr " guestfs_free_lvm_%s_list (r);\n" typ;
5511 (* Generate Java bindings GuestFS.java file. *)
5512 and generate_java_java () =
5513 generate_header CStyle LGPLv2;
5516 package com.redhat.et.libguestfs;
5518 import java.util.HashMap;
5519 import com.redhat.et.libguestfs.LibGuestFSException;
5520 import com.redhat.et.libguestfs.PV;
5521 import com.redhat.et.libguestfs.VG;
5522 import com.redhat.et.libguestfs.LV;
5523 import com.redhat.et.libguestfs.Stat;
5524 import com.redhat.et.libguestfs.StatVFS;
5525 import com.redhat.et.libguestfs.IntBool;
5528 * The GuestFS object is a libguestfs handle.
5532 public class GuestFS {
5533 // Load the native code.
5535 System.loadLibrary (\"guestfs_jni\");
5539 * The native guestfs_h pointer.
5544 * Create a libguestfs handle.
5546 * @throws LibGuestFSException
5548 public GuestFS () throws LibGuestFSException
5552 private native long _create () throws LibGuestFSException;
5555 * Close a libguestfs handle.
5557 * You can also leave handles to be collected by the garbage
5558 * collector, but this method ensures that the resources used
5559 * by the handle are freed up immediately. If you call any
5560 * other methods after closing the handle, you will get an
5563 * @throws LibGuestFSException
5565 public void close () throws LibGuestFSException
5571 private native void _close (long g) throws LibGuestFSException;
5573 public void finalize () throws LibGuestFSException
5581 fun (name, style, _, flags, _, shortdesc, longdesc) ->
5582 let doc = replace_str longdesc "C<guestfs_" "C<g." in
5584 if List.mem ProtocolLimitWarning flags then
5585 doc ^ "\n\n" ^ protocol_limit_warning
5588 if List.mem DangerWillRobinson flags then
5589 doc ^ "\n\n" ^ danger_will_robinson
5591 let doc = pod2text ~width:60 name doc in
5592 let doc = String.concat "\n * " doc in
5595 pr " * %s\n" shortdesc;
5598 pr " * @throws LibGuestFSException\n";
5601 generate_java_prototype ~public:true ~semicolon:false name style;
5604 pr " if (g == 0)\n";
5605 pr " throw new LibGuestFSException (\"%s: handle is closed\");\n"
5608 if fst style <> RErr then pr "return ";
5610 generate_call_args ~handle:"g" (snd style);
5614 generate_java_prototype ~privat:true ~native:true name style;
5621 and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
5622 ?(semicolon=true) name style =
5623 if privat then pr "private ";
5624 if public then pr "public ";
5625 if native then pr "native ";
5628 (match fst style with
5629 | RErr -> pr "void ";
5630 | RInt _ -> pr "int ";
5631 | RInt64 _ -> pr "long ";
5632 | RBool _ -> pr "boolean ";
5633 | RConstString _ | RString _ -> pr "String ";
5634 | RStringList _ -> pr "String[] ";
5635 | RIntBool _ -> pr "IntBool ";
5636 | RPVList _ -> pr "PV[] ";
5637 | RVGList _ -> pr "VG[] ";
5638 | RLVList _ -> pr "LV[] ";
5639 | RStat _ -> pr "Stat ";
5640 | RStatVFS _ -> pr "StatVFS ";
5641 | RHashtable _ -> pr "HashMap<String,String> ";
5644 if native then pr "_%s " name else pr "%s " name;
5646 let needs_comma = ref false in
5655 if !needs_comma then pr ", ";
5656 needs_comma := true;
5673 pr " throws LibGuestFSException";
5674 if semicolon then pr ";"
5676 and generate_java_struct typ cols =
5677 generate_header CStyle LGPLv2;
5680 package com.redhat.et.libguestfs;
5683 * Libguestfs %s structure.
5694 | name, `UUID -> pr " public String %s;\n" name
5696 | name, `Int -> pr " public long %s;\n" name
5697 | name, `OptPercent ->
5698 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
5699 pr " public float %s;\n" name
5704 and generate_java_c () =
5705 generate_header CStyle LGPLv2;
5712 #include \"com_redhat_et_libguestfs_GuestFS.h\"
5713 #include \"guestfs.h\"
5715 /* Note that this function returns. The exception is not thrown
5716 * until after the wrapper function returns.
5719 throw_exception (JNIEnv *env, const char *msg)
5722 cl = (*env)->FindClass (env,
5723 \"com/redhat/et/libguestfs/LibGuestFSException\");
5724 (*env)->ThrowNew (env, cl, msg);
5727 JNIEXPORT jlong JNICALL
5728 Java_com_redhat_et_libguestfs_GuestFS__1create
5729 (JNIEnv *env, jobject obj)
5733 g = guestfs_create ();
5735 throw_exception (env, \"GuestFS.create: failed to allocate handle\");
5738 guestfs_set_error_handler (g, NULL, NULL);
5742 JNIEXPORT void JNICALL
5743 Java_com_redhat_et_libguestfs_GuestFS__1close
5744 (JNIEnv *env, jobject obj, jlong jg)
5746 guestfs_h *g = (guestfs_h *) jg;
5753 fun (name, style, _, _, _, _, _) ->
5755 (match fst style with
5756 | RErr -> pr "void ";
5757 | RInt _ -> pr "jint ";
5758 | RInt64 _ -> pr "jlong ";
5759 | RBool _ -> pr "jboolean ";
5760 | RConstString _ | RString _ -> pr "jstring ";
5761 | RIntBool _ | RStat _ | RStatVFS _ | RHashtable _ ->
5763 | RStringList _ | RPVList _ | RVGList _ | RLVList _ ->
5767 pr "Java_com_redhat_et_libguestfs_GuestFS_";
5768 pr "%s" (replace_str ("_" ^ name) "_" "_1");
5770 pr " (JNIEnv *env, jobject obj, jlong jg";
5777 pr ", jstring j%s" n
5779 pr ", jobjectArray j%s" n
5781 pr ", jboolean j%s" n
5787 pr " guestfs_h *g = (guestfs_h *) jg;\n";
5788 let error_code, no_ret =
5789 match fst style with
5790 | RErr -> pr " int r;\n"; "-1", ""
5792 | RInt _ -> pr " int r;\n"; "-1", "0"
5793 | RInt64 _ -> pr " int64_t r;\n"; "-1", "0"
5794 | RConstString _ -> pr " const char *r;\n"; "NULL", "NULL"
5796 pr " jstring jr;\n";
5797 pr " char *r;\n"; "NULL", "NULL"
5799 pr " jobjectArray jr;\n";
5802 pr " jstring jstr;\n";
5803 pr " char **r;\n"; "NULL", "NULL"
5805 pr " jobject jr;\n";
5807 pr " jfieldID fl;\n";
5808 pr " struct guestfs_int_bool *r;\n"; "NULL", "NULL"
5810 pr " jobject jr;\n";
5812 pr " jfieldID fl;\n";
5813 pr " struct guestfs_stat *r;\n"; "NULL", "NULL"
5815 pr " jobject jr;\n";
5817 pr " jfieldID fl;\n";
5818 pr " struct guestfs_statvfs *r;\n"; "NULL", "NULL"
5820 pr " jobjectArray jr;\n";
5822 pr " jfieldID fl;\n";
5823 pr " jobject jfl;\n";
5824 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL", "NULL"
5826 pr " jobjectArray jr;\n";
5828 pr " jfieldID fl;\n";
5829 pr " jobject jfl;\n";
5830 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL", "NULL"
5832 pr " jobjectArray jr;\n";
5834 pr " jfieldID fl;\n";
5835 pr " jobject jfl;\n";
5836 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL", "NULL"
5837 | RHashtable _ -> pr " char **r;\n"; "NULL", "NULL" in
5844 pr " const char *%s;\n" n
5846 pr " int %s_len;\n" n;
5847 pr " const char **%s;\n" n
5854 (match fst style with
5855 | RStringList _ | RPVList _ | RVGList _ | RLVList _ -> true
5856 | RErr _ | RBool _ | RInt _ | RInt64 _ | RConstString _
5857 | RString _ | RIntBool _ | RStat _ | RStatVFS _
5858 | RHashtable _ -> false) ||
5859 List.exists (function StringList _ -> true | _ -> false) (snd style) in
5865 (* Get the parameters. *)
5872 pr " %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
5874 pr " %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
5875 pr " %s = malloc (sizeof (char *) * (%s_len+1));\n" n n;
5876 pr " for (i = 0; i < %s_len; ++i) {\n" n;
5877 pr " jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
5879 pr " %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
5881 pr " %s[%s_len] = NULL;\n" n n;
5884 pr " %s = j%s;\n" n n
5887 (* Make the call. *)
5888 pr " r = guestfs_%s " name;
5889 generate_call_args ~handle:"g" (snd style);
5892 (* Release the parameters. *)
5899 pr " (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
5901 pr " for (i = 0; i < %s_len; ++i) {\n" n;
5902 pr " jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
5904 pr " (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
5906 pr " free (%s);\n" n
5911 (* Check for errors. *)
5912 pr " if (r == %s) {\n" error_code;
5913 pr " throw_exception (env, guestfs_last_error (g));\n";
5914 pr " return %s;\n" no_ret;
5918 (match fst style with
5920 | RInt _ -> pr " return (jint) r;\n"
5921 | RBool _ -> pr " return (jboolean) r;\n"
5922 | RInt64 _ -> pr " return (jlong) r;\n"
5923 | RConstString _ -> pr " return (*env)->NewStringUTF (env, r);\n"
5925 pr " jr = (*env)->NewStringUTF (env, r);\n";
5929 pr " for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
5930 pr " cl = (*env)->FindClass (env, \"java/lang/String\");\n";
5931 pr " jstr = (*env)->NewStringUTF (env, \"\");\n";
5932 pr " jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n";
5933 pr " for (i = 0; i < r_len; ++i) {\n";
5934 pr " jstr = (*env)->NewStringUTF (env, r[i]);\n";
5935 pr " (*env)->SetObjectArrayElement (env, jr, i, jstr);\n";
5936 pr " free (r[i]);\n";
5941 pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/IntBool\");\n";
5942 pr " jr = (*env)->AllocObject (env, cl);\n";
5943 pr " fl = (*env)->GetFieldID (env, cl, \"i\", \"I\");\n";
5944 pr " (*env)->SetIntField (env, jr, fl, r->i);\n";
5945 pr " fl = (*env)->GetFieldID (env, cl, \"i\", \"Z\");\n";
5946 pr " (*env)->SetBooleanField (env, jr, fl, r->b);\n";
5947 pr " guestfs_free_int_bool (r);\n";
5950 pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/Stat\");\n";
5951 pr " jr = (*env)->AllocObject (env, cl);\n";
5955 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n"
5957 pr " (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
5962 pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/StatVFS\");\n";
5963 pr " jr = (*env)->AllocObject (env, cl);\n";
5967 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n"
5969 pr " (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
5974 generate_java_lvm_return "pv" "PV" pv_cols
5976 generate_java_lvm_return "vg" "VG" vg_cols
5978 generate_java_lvm_return "lv" "LV" lv_cols
5981 pr " throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
5982 pr " return NULL;\n"
5989 and generate_java_lvm_return typ jtyp cols =
5990 pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
5991 pr " jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n";
5992 pr " for (i = 0; i < r->len; ++i) {\n";
5993 pr " jfl = (*env)->AllocObject (env, cl);\n";
5997 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
5998 pr " (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name;
6001 pr " char s[33];\n";
6002 pr " memcpy (s, r->val[i].%s, 32);\n" name;
6004 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
6005 pr " (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
6007 | name, (`Bytes|`Int) ->
6008 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
6009 pr " (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
6010 | name, `OptPercent ->
6011 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
6012 pr " (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\n" name;
6014 pr " (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n";
6016 pr " guestfs_free_lvm_%s_list (r);\n" typ;
6019 let output_to filename =
6020 let filename_new = filename ^ ".new" in
6021 chan := open_out filename_new;
6025 Unix.rename filename_new filename;
6026 printf "written %s\n%!" filename;
6034 if not (Sys.file_exists "configure.ac") then (
6036 You are probably running this from the wrong directory.
6037 Run it from the top source directory using the command
6043 let close = output_to "src/guestfs_protocol.x" in
6047 let close = output_to "src/guestfs-structs.h" in
6048 generate_structs_h ();
6051 let close = output_to "src/guestfs-actions.h" in
6052 generate_actions_h ();
6055 let close = output_to "src/guestfs-actions.c" in
6056 generate_client_actions ();
6059 let close = output_to "daemon/actions.h" in
6060 generate_daemon_actions_h ();
6063 let close = output_to "daemon/stubs.c" in
6064 generate_daemon_actions ();
6067 let close = output_to "tests.c" in
6071 let close = output_to "fish/cmds.c" in
6072 generate_fish_cmds ();
6075 let close = output_to "fish/completion.c" in
6076 generate_fish_completion ();
6079 let close = output_to "guestfs-structs.pod" in
6080 generate_structs_pod ();
6083 let close = output_to "guestfs-actions.pod" in
6084 generate_actions_pod ();
6087 let close = output_to "guestfish-actions.pod" in
6088 generate_fish_actions_pod ();
6091 let close = output_to "ocaml/guestfs.mli" in
6092 generate_ocaml_mli ();
6095 let close = output_to "ocaml/guestfs.ml" in
6096 generate_ocaml_ml ();
6099 let close = output_to "ocaml/guestfs_c_actions.c" in
6100 generate_ocaml_c ();
6103 let close = output_to "perl/Guestfs.xs" in
6104 generate_perl_xs ();
6107 let close = output_to "perl/lib/Sys/Guestfs.pm" in
6108 generate_perl_pm ();
6111 let close = output_to "python/guestfs-py.c" in
6112 generate_python_c ();
6115 let close = output_to "python/guestfs.py" in
6116 generate_python_py ();
6119 let close = output_to "ruby/ext/guestfs/_guestfs.c" in
6123 let close = output_to "java/com/redhat/et/libguestfs/GuestFS.java" in
6124 generate_java_java ();
6127 let close = output_to "java/com/redhat/et/libguestfs/PV.java" in
6128 generate_java_struct "PV" pv_cols;
6131 let close = output_to "java/com/redhat/et/libguestfs/VG.java" in
6132 generate_java_struct "VG" vg_cols;
6135 let close = output_to "java/com/redhat/et/libguestfs/LV.java" in
6136 generate_java_struct "LV" lv_cols;
6139 let close = output_to "java/com/redhat/et/libguestfs/Stat.java" in
6140 generate_java_struct "Stat" stat_cols;
6143 let close = output_to "java/com/redhat/et/libguestfs/StatVFS.java" in
6144 generate_java_struct "StatVFS" statvfs_cols;
6147 let close = output_to "java/com_redhat_et_libguestfs_GuestFS.c" in