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]
40 type style = ret * args
42 (* "RErr" as a return value means an int used as a simple error
43 * indication, ie. 0 or -1.
46 (* "RInt" as a return value means an int which is -1 for error
47 * or any value >= 0 on success. Only use this for smallish
48 * positive ints (0 <= i < 2^30).
51 (* "RInt64" is the same as RInt, but is guaranteed to be able
52 * to return a full 64 bit value, _except_ that -1 means error
53 * (so -1 cannot be a valid, non-error return value).
56 (* "RBool" is a bool return value which can be true/false or
60 (* "RConstString" is a string that refers to a constant value.
61 * Try to avoid using this. In particular you cannot use this
62 * for values returned from the daemon, because there is no
63 * thread-safe way to return them in the C API.
65 | RConstString of string
66 (* "RString" and "RStringList" are caller-frees. *)
68 | RStringList of string
69 (* Some limited tuples are possible: *)
70 | RIntBool of string * string
71 (* LVM PVs, VGs and LVs. *)
78 (* Key-value pairs of untyped strings. Turns into a hashtable or
79 * dictionary in languages which support it. DON'T use this as a
80 * general "bucket" for results. Prefer a stronger typed return
81 * value if one is available, or write a custom struct. Don't use
82 * this if the list could potentially be very long, since it is
83 * inefficient. Keys should be unique. NULLs are not permitted.
85 | RHashtable of string
87 and args = argt list (* Function parameters, guestfs handle is implicit. *)
89 (* Note in future we should allow a "variable args" parameter as
90 * the final parameter, to allow commands like
91 * chmod mode file [file(s)...]
92 * This is not implemented yet, but many commands (such as chmod)
93 * are currently defined with the argument order keeping this future
94 * possibility in mind.
97 | String of string (* const char *name, cannot be NULL *)
98 | OptString of string (* const char *name, may be NULL *)
99 | StringList of string(* list of strings (each string cannot be NULL) *)
100 | Bool of string (* boolean *)
101 | Int of string (* int (smallish ints, signed, <= 31 bits) *)
102 (* These are treated as filenames (simple string parameters) in
103 * the C API and bindings. But in the RPC protocol, we transfer
104 * the actual file content up to or down from the daemon.
105 * FileIn: local machine -> daemon (in request)
106 * FileOut: daemon -> local machine (in reply)
107 * In guestfish (only), the special name "-" means read from
108 * stdin or write to stdout.
114 | ProtocolLimitWarning (* display warning about protocol size limits *)
115 | DangerWillRobinson (* flags particularly dangerous commands *)
116 | FishAlias of string (* provide an alias for this cmd in guestfish *)
117 | FishAction of string (* call this function in guestfish *)
118 | NotInFish (* do not export via guestfish *)
120 let protocol_limit_warning =
121 "Because of the message protocol, there is a transfer limit
122 of somewhere between 2MB and 4MB. To transfer large files you should use
125 let danger_will_robinson =
126 "B<This command is dangerous. Without careful use you
127 can easily destroy all your data>."
129 (* You can supply zero or as many tests as you want per API call.
131 * Note that the test environment has 3 block devices, of size 500MB,
132 * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc).
133 * Note for partitioning purposes, the 500MB device has 63 cylinders.
135 * To be able to run the tests in a reasonable amount of time,
136 * the virtual machine and block devices are reused between tests.
137 * So don't try testing kill_subprocess :-x
139 * Between each test we blockdev-setrw, umount-all, lvm-remove-all
142 * If the appliance is running an older Linux kernel (eg. RHEL 5) then
143 * devices are named /dev/hda etc. To cope with this, the test suite
144 * adds some hairly logic to detect this case, and then automagically
145 * replaces all strings which match "/dev/sd.*" with "/dev/hd.*".
146 * When writing test cases you shouldn't have to worry about this
149 * Don't assume anything about the previous contents of the block
150 * devices. Use 'Init*' to create some initial scenarios.
152 type tests = (test_init * test) list
154 (* Run the command sequence and just expect nothing to fail. *)
156 (* Run the command sequence and expect the output of the final
157 * command to be the string.
159 | TestOutput of seq * string
160 (* Run the command sequence and expect the output of the final
161 * command to be the list of strings.
163 | TestOutputList of seq * string list
164 (* Run the command sequence and expect the output of the final
165 * command to be the integer.
167 | TestOutputInt of seq * int
168 (* Run the command sequence and expect the output of the final
169 * command to be a true value (!= 0 or != NULL).
171 | TestOutputTrue of seq
172 (* Run the command sequence and expect the output of the final
173 * command to be a false value (== 0 or == NULL, but not an error).
175 | TestOutputFalse of seq
176 (* Run the command sequence and expect the output of the final
177 * command to be a list of the given length (but don't care about
180 | TestOutputLength of seq * int
181 (* Run the command sequence and expect the output of the final
182 * command to be a structure.
184 | TestOutputStruct of seq * test_field_compare list
185 (* Run the command sequence and expect the final command (only)
188 | TestLastFail of seq
190 and test_field_compare =
191 | CompareWithInt of string * int
192 | CompareWithString of string * string
193 | CompareFieldsIntEq of string * string
194 | CompareFieldsStrEq of string * string
196 (* Some initial scenarios for testing. *)
198 (* Do nothing, block devices could contain random stuff including
199 * LVM PVs, and some filesystems might be mounted. This is usually
203 (* Block devices are empty and no filesystems are mounted. *)
205 (* /dev/sda contains a single partition /dev/sda1, which is formatted
206 * as ext2, empty [except for lost+found] and mounted on /.
207 * /dev/sdb and /dev/sdc may have random content.
212 * /dev/sda1 (is a PV):
213 * /dev/VG/LV (size 8MB):
214 * formatted as ext2, empty [except for lost+found], mounted on /
215 * /dev/sdb and /dev/sdc may have random content.
219 (* Sequence of commands for testing. *)
221 and cmd = string list
223 (* Note about long descriptions: When referring to another
224 * action, use the format C<guestfs_other> (ie. the full name of
225 * the C function). This will be replaced as appropriate in other
228 * Apart from that, long descriptions are just perldoc paragraphs.
231 let non_daemon_functions = [
232 ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
234 "launch the qemu subprocess",
236 Internally libguestfs is implemented by running a virtual machine
239 You should call this after configuring the handle
240 (eg. adding drives) but before performing any actions.");
242 ("wait_ready", (RErr, []), -1, [NotInFish],
244 "wait until the qemu subprocess launches",
246 Internally libguestfs is implemented by running a virtual machine
249 You should call this after C<guestfs_launch> to wait for the launch
252 ("kill_subprocess", (RErr, []), -1, [],
254 "kill the qemu subprocess",
256 This kills the qemu subprocess. You should never need to call this.");
258 ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
260 "add an image to examine or modify",
262 This function adds a virtual machine disk image C<filename> to the
263 guest. The first time you call this function, the disk appears as IDE
264 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
267 You don't necessarily need to be root when using libguestfs. However
268 you obviously do need sufficient permissions to access the filename
269 for whatever operations you want to perform (ie. read access if you
270 just want to read the image or write access if you want to modify the
273 This is equivalent to the qemu parameter C<-drive file=filename>.");
275 ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
277 "add a CD-ROM disk image to examine",
279 This function adds a virtual CD-ROM disk image to the guest.
281 This is equivalent to the qemu parameter C<-cdrom filename>.");
283 ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
285 "add qemu parameters",
287 This can be used to add arbitrary qemu command line parameters
288 of the form C<-param value>. Actually it's not quite arbitrary - we
289 prevent you from setting some parameters which would interfere with
290 parameters that we use.
292 The first character of C<param> string must be a C<-> (dash).
294 C<value> can be NULL.");
296 ("set_qemu", (RErr, [String "qemu"]), -1, [FishAlias "qemu"],
298 "set the qemu binary",
300 Set the qemu binary that we will use.
302 The default is chosen when the library was compiled by the
305 You can also override this by setting the C<LIBGUESTFS_QEMU>
306 environment variable.
308 The string C<qemu> is stashed in the libguestfs handle, so the caller
309 must make sure it remains valid for the lifetime of the handle.
311 Setting C<qemu> to C<NULL> restores the default qemu binary.");
313 ("get_qemu", (RConstString "qemu", []), -1, [],
315 "get the qemu binary",
317 Return the current qemu binary.
319 This is always non-NULL. If it wasn't set already, then this will
320 return the default qemu binary name.");
322 ("set_path", (RErr, [String "path"]), -1, [FishAlias "path"],
324 "set the search path",
326 Set the path that libguestfs searches for kernel and initrd.img.
328 The default is C<$libdir/guestfs> unless overridden by setting
329 C<LIBGUESTFS_PATH> environment variable.
331 The string C<path> is stashed in the libguestfs handle, so the caller
332 must make sure it remains valid for the lifetime of the handle.
334 Setting C<path> to C<NULL> restores the default path.");
336 ("get_path", (RConstString "path", []), -1, [],
338 "get the search path",
340 Return the current search path.
342 This is always non-NULL. If it wasn't set already, then this will
343 return the default path.");
345 ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
349 If C<autosync> is true, this enables autosync. Libguestfs will make a
350 best effort attempt to run C<guestfs_umount_all> followed by
351 C<guestfs_sync> when the handle is closed
352 (also if the program exits without closing handles).
354 This is disabled by default (except in guestfish where it is
355 enabled by default).");
357 ("get_autosync", (RBool "autosync", []), -1, [],
361 Get the autosync flag.");
363 ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
367 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
369 Verbose messages are disabled unless the environment variable
370 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
372 ("get_verbose", (RBool "verbose", []), -1, [],
376 This returns the verbose messages flag.");
378 ("is_ready", (RBool "ready", []), -1, [],
380 "is ready to accept commands",
382 This returns true iff this handle is ready to accept commands
383 (in the C<READY> state).
385 For more information on states, see L<guestfs(3)>.");
387 ("is_config", (RBool "config", []), -1, [],
389 "is in configuration state",
391 This returns true iff this handle is being configured
392 (in the C<CONFIG> state).
394 For more information on states, see L<guestfs(3)>.");
396 ("is_launching", (RBool "launching", []), -1, [],
398 "is launching subprocess",
400 This returns true iff this handle is launching the subprocess
401 (in the C<LAUNCHING> state).
403 For more information on states, see L<guestfs(3)>.");
405 ("is_busy", (RBool "busy", []), -1, [],
407 "is busy processing a command",
409 This returns true iff this handle is busy processing a command
410 (in the C<BUSY> state).
412 For more information on states, see L<guestfs(3)>.");
414 ("get_state", (RInt "state", []), -1, [],
416 "get the current state",
418 This returns the current state as an opaque integer. This is
419 only useful for printing debug and internal error messages.
421 For more information on states, see L<guestfs(3)>.");
423 ("set_busy", (RErr, []), -1, [NotInFish],
427 This sets the state to C<BUSY>. This is only used when implementing
428 actions using the low-level API.
430 For more information on states, see L<guestfs(3)>.");
432 ("set_ready", (RErr, []), -1, [NotInFish],
434 "set state to ready",
436 This sets the state to C<READY>. This is only used when implementing
437 actions using the low-level API.
439 For more information on states, see L<guestfs(3)>.");
443 let daemon_functions = [
444 ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
445 [InitEmpty, TestOutput (
446 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
447 ["mkfs"; "ext2"; "/dev/sda1"];
448 ["mount"; "/dev/sda1"; "/"];
449 ["write_file"; "/new"; "new file contents"; "0"];
450 ["cat"; "/new"]], "new file contents")],
451 "mount a guest disk at a position in the filesystem",
453 Mount a guest disk at a position in the filesystem. Block devices
454 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
455 the guest. If those block devices contain partitions, they will have
456 the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
459 The rules are the same as for L<mount(2)>: A filesystem must
460 first be mounted on C</> before others can be mounted. Other
461 filesystems can only be mounted on directories which already
464 The mounted filesystem is writable, if we have sufficient permissions
465 on the underlying device.
467 The filesystem options C<sync> and C<noatime> are set with this
468 call, in order to improve reliability.");
470 ("sync", (RErr, []), 2, [],
471 [ InitEmpty, TestRun [["sync"]]],
472 "sync disks, writes are flushed through to the disk image",
474 This syncs the disk, so that any writes are flushed through to the
475 underlying disk image.
477 You should always call this if you have modified a disk image, before
478 closing the handle.");
480 ("touch", (RErr, [String "path"]), 3, [],
481 [InitBasicFS, TestOutputTrue (
483 ["exists"; "/new"]])],
484 "update file timestamps or create a new file",
486 Touch acts like the L<touch(1)> command. It can be used to
487 update the timestamps on a file, or, if the file does not exist,
488 to create a new zero-length file.");
490 ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
491 [InitBasicFS, TestOutput (
492 [["write_file"; "/new"; "new file contents"; "0"];
493 ["cat"; "/new"]], "new file contents")],
494 "list the contents of a file",
496 Return the contents of the file named C<path>.
498 Note that this function cannot correctly handle binary files
499 (specifically, files containing C<\\0> character which is treated
500 as end of string). For those you need to use the C<guestfs_download>
501 function which has a more complex interface.");
503 ("ll", (RString "listing", [String "directory"]), 5, [],
504 [], (* XXX Tricky to test because it depends on the exact format
505 * of the 'ls -l' command, which changes between F10 and F11.
507 "list the files in a directory (long format)",
509 List the files in C<directory> (relative to the root directory,
510 there is no cwd) in the format of 'ls -la'.
512 This command is mostly useful for interactive sessions. It
513 is I<not> intended that you try to parse the output string.");
515 ("ls", (RStringList "listing", [String "directory"]), 6, [],
516 [InitBasicFS, TestOutputList (
519 ["touch"; "/newest"];
520 ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
521 "list the files in a directory",
523 List the files in C<directory> (relative to the root directory,
524 there is no cwd). The '.' and '..' entries are not returned, but
525 hidden files are shown.
527 This command is mostly useful for interactive sessions. Programs
528 should probably use C<guestfs_readdir> instead.");
530 ("list_devices", (RStringList "devices", []), 7, [],
531 [InitEmpty, TestOutputList (
532 [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"])],
533 "list the block devices",
535 List all the block devices.
537 The full block device names are returned, eg. C</dev/sda>");
539 ("list_partitions", (RStringList "partitions", []), 8, [],
540 [InitBasicFS, TestOutputList (
541 [["list_partitions"]], ["/dev/sda1"]);
542 InitEmpty, TestOutputList (
543 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
544 ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
545 "list the partitions",
547 List all the partitions detected on all block devices.
549 The full partition device names are returned, eg. C</dev/sda1>
551 This does not return logical volumes. For that you will need to
552 call C<guestfs_lvs>.");
554 ("pvs", (RStringList "physvols", []), 9, [],
555 [InitBasicFSonLVM, TestOutputList (
556 [["pvs"]], ["/dev/sda1"]);
557 InitEmpty, TestOutputList (
558 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
559 ["pvcreate"; "/dev/sda1"];
560 ["pvcreate"; "/dev/sda2"];
561 ["pvcreate"; "/dev/sda3"];
562 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
563 "list the LVM physical volumes (PVs)",
565 List all the physical volumes detected. This is the equivalent
566 of the L<pvs(8)> command.
568 This returns a list of just the device names that contain
569 PVs (eg. C</dev/sda2>).
571 See also C<guestfs_pvs_full>.");
573 ("vgs", (RStringList "volgroups", []), 10, [],
574 [InitBasicFSonLVM, TestOutputList (
576 InitEmpty, TestOutputList (
577 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
578 ["pvcreate"; "/dev/sda1"];
579 ["pvcreate"; "/dev/sda2"];
580 ["pvcreate"; "/dev/sda3"];
581 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
582 ["vgcreate"; "VG2"; "/dev/sda3"];
583 ["vgs"]], ["VG1"; "VG2"])],
584 "list the LVM volume groups (VGs)",
586 List all the volumes groups detected. This is the equivalent
587 of the L<vgs(8)> command.
589 This returns a list of just the volume group names that were
590 detected (eg. C<VolGroup00>).
592 See also C<guestfs_vgs_full>.");
594 ("lvs", (RStringList "logvols", []), 11, [],
595 [InitBasicFSonLVM, TestOutputList (
596 [["lvs"]], ["/dev/VG/LV"]);
597 InitEmpty, TestOutputList (
598 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
599 ["pvcreate"; "/dev/sda1"];
600 ["pvcreate"; "/dev/sda2"];
601 ["pvcreate"; "/dev/sda3"];
602 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
603 ["vgcreate"; "VG2"; "/dev/sda3"];
604 ["lvcreate"; "LV1"; "VG1"; "50"];
605 ["lvcreate"; "LV2"; "VG1"; "50"];
606 ["lvcreate"; "LV3"; "VG2"; "50"];
607 ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
608 "list the LVM logical volumes (LVs)",
610 List all the logical volumes detected. This is the equivalent
611 of the L<lvs(8)> command.
613 This returns a list of the logical volume device names
614 (eg. C</dev/VolGroup00/LogVol00>).
616 See also C<guestfs_lvs_full>.");
618 ("pvs_full", (RPVList "physvols", []), 12, [],
619 [], (* XXX how to test? *)
620 "list the LVM physical volumes (PVs)",
622 List all the physical volumes detected. This is the equivalent
623 of the L<pvs(8)> command. The \"full\" version includes all fields.");
625 ("vgs_full", (RVGList "volgroups", []), 13, [],
626 [], (* XXX how to test? *)
627 "list the LVM volume groups (VGs)",
629 List all the volumes groups detected. This is the equivalent
630 of the L<vgs(8)> command. The \"full\" version includes all fields.");
632 ("lvs_full", (RLVList "logvols", []), 14, [],
633 [], (* XXX how to test? *)
634 "list the LVM logical volumes (LVs)",
636 List all the logical volumes detected. This is the equivalent
637 of the L<lvs(8)> command. The \"full\" version includes all fields.");
639 ("read_lines", (RStringList "lines", [String "path"]), 15, [],
640 [InitBasicFS, TestOutputList (
641 [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
642 ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);
643 InitBasicFS, TestOutputList (
644 [["write_file"; "/new"; ""; "0"];
645 ["read_lines"; "/new"]], [])],
646 "read file as lines",
648 Return the contents of the file named C<path>.
650 The file contents are returned as a list of lines. Trailing
651 C<LF> and C<CRLF> character sequences are I<not> returned.
653 Note that this function cannot correctly handle binary files
654 (specifically, files containing C<\\0> character which is treated
655 as end of line). For those you need to use the C<guestfs_read_file>
656 function which has a more complex interface.");
658 ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [],
659 [], (* XXX Augeas code needs tests. *)
660 "create a new Augeas handle",
662 Create a new Augeas handle for editing configuration files.
663 If there was any previous Augeas handle associated with this
664 guestfs session, then it is closed.
666 You must call this before using any other C<guestfs_aug_*>
669 C<root> is the filesystem root. C<root> must not be NULL,
672 The flags are the same as the flags defined in
673 E<lt>augeas.hE<gt>, the logical I<or> of the following
678 =item C<AUG_SAVE_BACKUP> = 1
680 Keep the original file with a C<.augsave> extension.
682 =item C<AUG_SAVE_NEWFILE> = 2
684 Save changes into a file with extension C<.augnew>, and
685 do not overwrite original. Overrides C<AUG_SAVE_BACKUP>.
687 =item C<AUG_TYPE_CHECK> = 4
689 Typecheck lenses (can be expensive).
691 =item C<AUG_NO_STDINC> = 8
693 Do not use standard load path for modules.
695 =item C<AUG_SAVE_NOOP> = 16
697 Make save a no-op, just record what would have been changed.
699 =item C<AUG_NO_LOAD> = 32
701 Do not load the tree in C<guestfs_aug_init>.
705 To close the handle, you can call C<guestfs_aug_close>.
707 To find out more about Augeas, see L<http://augeas.net/>.");
709 ("aug_close", (RErr, []), 26, [],
710 [], (* XXX Augeas code needs tests. *)
711 "close the current Augeas handle",
713 Close the current Augeas handle and free up any resources
714 used by it. After calling this, you have to call
715 C<guestfs_aug_init> again before you can use any other
718 ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
719 [], (* XXX Augeas code needs tests. *)
720 "define an Augeas variable",
722 Defines an Augeas variable C<name> whose value is the result
723 of evaluating C<expr>. If C<expr> is NULL, then C<name> is
726 On success this returns the number of nodes in C<expr>, or
727 C<0> if C<expr> evaluates to something which is not a nodeset.");
729 ("aug_defnode", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [],
730 [], (* XXX Augeas code needs tests. *)
731 "define an Augeas node",
733 Defines a variable C<name> whose value is the result of
736 If C<expr> evaluates to an empty nodeset, a node is created,
737 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
738 C<name> will be the nodeset containing that single node.
740 On success this returns a pair containing the
741 number of nodes in the nodeset, and a boolean flag
742 if a node was created.");
744 ("aug_get", (RString "val", [String "path"]), 19, [],
745 [], (* XXX Augeas code needs tests. *)
746 "look up the value of an Augeas path",
748 Look up the value associated with C<path>. If C<path>
749 matches exactly one node, the C<value> is returned.");
751 ("aug_set", (RErr, [String "path"; String "val"]), 20, [],
752 [], (* XXX Augeas code needs tests. *)
753 "set Augeas path to value",
755 Set the value associated with C<path> to C<value>.");
757 ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [],
758 [], (* XXX Augeas code needs tests. *)
759 "insert a sibling Augeas node",
761 Create a new sibling C<label> for C<path>, inserting it into
762 the tree before or after C<path> (depending on the boolean
765 C<path> must match exactly one existing node in the tree, and
766 C<label> must be a label, ie. not contain C</>, C<*> or end
767 with a bracketed index C<[N]>.");
769 ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
770 [], (* XXX Augeas code needs tests. *)
771 "remove an Augeas path",
773 Remove C<path> and all of its children.
775 On success this returns the number of entries which were removed.");
777 ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [],
778 [], (* XXX Augeas code needs tests. *)
781 Move the node C<src> to C<dest>. C<src> must match exactly
782 one node. C<dest> is overwritten if it exists.");
784 ("aug_match", (RStringList "matches", [String "path"]), 24, [],
785 [], (* XXX Augeas code needs tests. *)
786 "return Augeas nodes which match path",
788 Returns a list of paths which match the path expression C<path>.
789 The returned paths are sufficiently qualified so that they match
790 exactly one node in the current tree.");
792 ("aug_save", (RErr, []), 25, [],
793 [], (* XXX Augeas code needs tests. *)
794 "write all pending Augeas changes to disk",
796 This writes all pending changes to disk.
798 The flags which were passed to C<guestfs_aug_init> affect exactly
799 how files are saved.");
801 ("aug_load", (RErr, []), 27, [],
802 [], (* XXX Augeas code needs tests. *)
803 "load files into the tree",
805 Load files into the tree.
807 See C<aug_load> in the Augeas documentation for the full gory
810 ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
811 [], (* XXX Augeas code needs tests. *)
812 "list Augeas nodes under a path",
814 This is just a shortcut for listing C<guestfs_aug_match>
815 C<path/*> and sorting the resulting nodes into alphabetical order.");
817 ("rm", (RErr, [String "path"]), 29, [],
818 [InitBasicFS, TestRun
821 InitBasicFS, TestLastFail
823 InitBasicFS, TestLastFail
828 Remove the single file C<path>.");
830 ("rmdir", (RErr, [String "path"]), 30, [],
831 [InitBasicFS, TestRun
834 InitBasicFS, TestLastFail
836 InitBasicFS, TestLastFail
839 "remove a directory",
841 Remove the single directory C<path>.");
843 ("rm_rf", (RErr, [String "path"]), 31, [],
844 [InitBasicFS, TestOutputFalse
846 ["mkdir"; "/new/foo"];
847 ["touch"; "/new/foo/bar"];
849 ["exists"; "/new"]]],
850 "remove a file or directory recursively",
852 Remove the file or directory C<path>, recursively removing the
853 contents if its a directory. This is like the C<rm -rf> shell
856 ("mkdir", (RErr, [String "path"]), 32, [],
857 [InitBasicFS, TestOutputTrue
860 InitBasicFS, TestLastFail
861 [["mkdir"; "/new/foo/bar"]]],
862 "create a directory",
864 Create a directory named C<path>.");
866 ("mkdir_p", (RErr, [String "path"]), 33, [],
867 [InitBasicFS, TestOutputTrue
868 [["mkdir_p"; "/new/foo/bar"];
869 ["is_dir"; "/new/foo/bar"]];
870 InitBasicFS, TestOutputTrue
871 [["mkdir_p"; "/new/foo/bar"];
872 ["is_dir"; "/new/foo"]];
873 InitBasicFS, TestOutputTrue
874 [["mkdir_p"; "/new/foo/bar"];
875 ["is_dir"; "/new"]]],
876 "create a directory and parents",
878 Create a directory named C<path>, creating any parent directories
879 as necessary. This is like the C<mkdir -p> shell command.");
881 ("chmod", (RErr, [Int "mode"; String "path"]), 34, [],
882 [], (* XXX Need stat command to test *)
885 Change the mode (permissions) of C<path> to C<mode>. Only
886 numeric modes are supported.");
888 ("chown", (RErr, [Int "owner"; Int "group"; String "path"]), 35, [],
889 [], (* XXX Need stat command to test *)
890 "change file owner and group",
892 Change the file owner to C<owner> and group to C<group>.
894 Only numeric uid and gid are supported. If you want to use
895 names, you will need to locate and parse the password file
896 yourself (Augeas support makes this relatively easy).");
898 ("exists", (RBool "existsflag", [String "path"]), 36, [],
899 [InitBasicFS, TestOutputTrue (
901 ["exists"; "/new"]]);
902 InitBasicFS, TestOutputTrue (
904 ["exists"; "/new"]])],
905 "test if file or directory exists",
907 This returns C<true> if and only if there is a file, directory
908 (or anything) with the given C<path> name.
910 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
912 ("is_file", (RBool "fileflag", [String "path"]), 37, [],
913 [InitBasicFS, TestOutputTrue (
915 ["is_file"; "/new"]]);
916 InitBasicFS, TestOutputFalse (
918 ["is_file"; "/new"]])],
919 "test if file exists",
921 This returns C<true> if and only if there is a file
922 with the given C<path> name. Note that it returns false for
923 other objects like directories.
925 See also C<guestfs_stat>.");
927 ("is_dir", (RBool "dirflag", [String "path"]), 38, [],
928 [InitBasicFS, TestOutputFalse (
930 ["is_dir"; "/new"]]);
931 InitBasicFS, TestOutputTrue (
933 ["is_dir"; "/new"]])],
934 "test if file exists",
936 This returns C<true> if and only if there is a directory
937 with the given C<path> name. Note that it returns false for
938 other objects like files.
940 See also C<guestfs_stat>.");
942 ("pvcreate", (RErr, [String "device"]), 39, [],
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 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
949 "create an LVM physical volume",
951 This creates an LVM physical volume on the named C<device>,
952 where C<device> should usually be a partition name such
955 ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
956 [InitEmpty, TestOutputList (
957 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
958 ["pvcreate"; "/dev/sda1"];
959 ["pvcreate"; "/dev/sda2"];
960 ["pvcreate"; "/dev/sda3"];
961 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
962 ["vgcreate"; "VG2"; "/dev/sda3"];
963 ["vgs"]], ["VG1"; "VG2"])],
964 "create an LVM volume group",
966 This creates an LVM volume group called C<volgroup>
967 from the non-empty list of physical volumes C<physvols>.");
969 ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [],
970 [InitEmpty, TestOutputList (
971 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
972 ["pvcreate"; "/dev/sda1"];
973 ["pvcreate"; "/dev/sda2"];
974 ["pvcreate"; "/dev/sda3"];
975 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
976 ["vgcreate"; "VG2"; "/dev/sda3"];
977 ["lvcreate"; "LV1"; "VG1"; "50"];
978 ["lvcreate"; "LV2"; "VG1"; "50"];
979 ["lvcreate"; "LV3"; "VG2"; "50"];
980 ["lvcreate"; "LV4"; "VG2"; "50"];
981 ["lvcreate"; "LV5"; "VG2"; "50"];
983 ["/dev/VG1/LV1"; "/dev/VG1/LV2";
984 "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
985 "create an LVM volume group",
987 This creates an LVM volume group called C<logvol>
988 on the volume group C<volgroup>, with C<size> megabytes.");
990 ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [],
991 [InitEmpty, TestOutput (
992 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
993 ["mkfs"; "ext2"; "/dev/sda1"];
994 ["mount"; "/dev/sda1"; "/"];
995 ["write_file"; "/new"; "new file contents"; "0"];
996 ["cat"; "/new"]], "new file contents")],
999 This creates a filesystem on C<device> (usually a partition
1000 or LVM logical volume). The filesystem type is C<fstype>, for
1003 ("sfdisk", (RErr, [String "device";
1004 Int "cyls"; Int "heads"; Int "sectors";
1005 StringList "lines"]), 43, [DangerWillRobinson],
1007 "create partitions on a block device",
1009 This is a direct interface to the L<sfdisk(8)> program for creating
1010 partitions on block devices.
1012 C<device> should be a block device, for example C</dev/sda>.
1014 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
1015 and sectors on the device, which are passed directly to sfdisk as
1016 the I<-C>, I<-H> and I<-S> parameters. If you pass C<0> for any
1017 of these, then the corresponding parameter is omitted. Usually for
1018 'large' disks, you can just pass C<0> for these, but for small
1019 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
1020 out the right geometry and you will need to tell it.
1022 C<lines> is a list of lines that we feed to C<sfdisk>. For more
1023 information refer to the L<sfdisk(8)> manpage.
1025 To create a single partition occupying the whole disk, you would
1026 pass C<lines> as a single element list, when the single element being
1027 the string C<,> (comma).");
1029 ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
1030 [InitBasicFS, TestOutput (
1031 [["write_file"; "/new"; "new file contents"; "0"];
1032 ["cat"; "/new"]], "new file contents");
1033 InitBasicFS, TestOutput (
1034 [["write_file"; "/new"; "\nnew file contents\n"; "0"];
1035 ["cat"; "/new"]], "\nnew file contents\n");
1036 InitBasicFS, TestOutput (
1037 [["write_file"; "/new"; "\n\n"; "0"];
1038 ["cat"; "/new"]], "\n\n");
1039 InitBasicFS, TestOutput (
1040 [["write_file"; "/new"; ""; "0"];
1041 ["cat"; "/new"]], "");
1042 InitBasicFS, TestOutput (
1043 [["write_file"; "/new"; "\n\n\n"; "0"];
1044 ["cat"; "/new"]], "\n\n\n");
1045 InitBasicFS, TestOutput (
1046 [["write_file"; "/new"; "\n"; "0"];
1047 ["cat"; "/new"]], "\n")],
1050 This call creates a file called C<path>. The contents of the
1051 file is the string C<content> (which can contain any 8 bit data),
1052 with length C<size>.
1054 As a special case, if C<size> is C<0>
1055 then the length is calculated using C<strlen> (so in this case
1056 the content cannot contain embedded ASCII NULs).
1058 I<NB.> Owing to a bug, writing content containing ASCII NUL
1059 characters does I<not> work, even if the length is specified.
1060 We hope to resolve this bug in a future version. In the meantime
1061 use C<guestfs_upload>.");
1063 ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
1064 [InitEmpty, TestOutputList (
1065 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1066 ["mkfs"; "ext2"; "/dev/sda1"];
1067 ["mount"; "/dev/sda1"; "/"];
1068 ["mounts"]], ["/dev/sda1"]);
1069 InitEmpty, TestOutputList (
1070 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1071 ["mkfs"; "ext2"; "/dev/sda1"];
1072 ["mount"; "/dev/sda1"; "/"];
1075 "unmount a filesystem",
1077 This unmounts the given filesystem. The filesystem may be
1078 specified either by its mountpoint (path) or the device which
1079 contains the filesystem.");
1081 ("mounts", (RStringList "devices", []), 46, [],
1082 [InitBasicFS, TestOutputList (
1083 [["mounts"]], ["/dev/sda1"])],
1084 "show mounted filesystems",
1086 This returns the list of currently mounted filesystems. It returns
1087 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
1089 Some internal mounts are not shown.");
1091 ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
1092 [InitBasicFS, TestOutputList (
1095 (* check that umount_all can unmount nested mounts correctly: *)
1096 InitEmpty, TestOutputList (
1097 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
1098 ["mkfs"; "ext2"; "/dev/sda1"];
1099 ["mkfs"; "ext2"; "/dev/sda2"];
1100 ["mkfs"; "ext2"; "/dev/sda3"];
1101 ["mount"; "/dev/sda1"; "/"];
1103 ["mount"; "/dev/sda2"; "/mp1"];
1104 ["mkdir"; "/mp1/mp2"];
1105 ["mount"; "/dev/sda3"; "/mp1/mp2"];
1106 ["mkdir"; "/mp1/mp2/mp3"];
1109 "unmount all filesystems",
1111 This unmounts all mounted filesystems.
1113 Some internal mounts are not unmounted by this call.");
1115 ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson],
1117 "remove all LVM LVs, VGs and PVs",
1119 This command removes all LVM logical volumes, volume groups
1120 and physical volumes.");
1122 ("file", (RString "description", [String "path"]), 49, [],
1123 [InitBasicFS, TestOutput (
1125 ["file"; "/new"]], "empty");
1126 InitBasicFS, TestOutput (
1127 [["write_file"; "/new"; "some content\n"; "0"];
1128 ["file"; "/new"]], "ASCII text");
1129 InitBasicFS, TestLastFail (
1130 [["file"; "/nofile"]])],
1131 "determine file type",
1133 This call uses the standard L<file(1)> command to determine
1134 the type or contents of the file. This also works on devices,
1135 for example to find out whether a partition contains a filesystem.
1137 The exact command which runs is C<file -bsL path>. Note in
1138 particular that the filename is not prepended to the output
1139 (the C<-b> option).");
1141 ("command", (RString "output", [StringList "arguments"]), 50, [],
1142 [], (* XXX how to test? *)
1143 "run a command from the guest filesystem",
1145 This call runs a command from the guest filesystem. The
1146 filesystem must be mounted, and must contain a compatible
1147 operating system (ie. something Linux, with the same
1148 or compatible processor architecture).
1150 The single parameter is an argv-style list of arguments.
1151 The first element is the name of the program to run.
1152 Subsequent elements are parameters. The list must be
1153 non-empty (ie. must contain a program name).
1155 The C<$PATH> environment variable will contain at least
1156 C</usr/bin> and C</bin>. If you require a program from
1157 another location, you should provide the full path in the
1160 Shared libraries and data files required by the program
1161 must be available on filesystems which are mounted in the
1162 correct places. It is the caller's responsibility to ensure
1163 all filesystems that are needed are mounted at the right
1166 ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [],
1167 [], (* XXX how to test? *)
1168 "run a command, returning lines",
1170 This is the same as C<guestfs_command>, but splits the
1171 result into a list of lines.");
1173 ("stat", (RStat "statbuf", [String "path"]), 52, [],
1174 [InitBasicFS, TestOutputStruct (
1176 ["stat"; "/new"]], [CompareWithInt ("size", 0)])],
1177 "get file information",
1179 Returns file information for the given C<path>.
1181 This is the same as the C<stat(2)> system call.");
1183 ("lstat", (RStat "statbuf", [String "path"]), 53, [],
1184 [InitBasicFS, TestOutputStruct (
1186 ["lstat"; "/new"]], [CompareWithInt ("size", 0)])],
1187 "get file information for a symbolic link",
1189 Returns file information for the given C<path>.
1191 This is the same as C<guestfs_stat> except that if C<path>
1192 is a symbolic link, then the link is stat-ed, not the file it
1195 This is the same as the C<lstat(2)> system call.");
1197 ("statvfs", (RStatVFS "statbuf", [String "path"]), 54, [],
1198 [InitBasicFS, TestOutputStruct (
1199 [["statvfs"; "/"]], [CompareWithInt ("bfree", 487702);
1200 CompareWithInt ("blocks", 490020);
1201 CompareWithInt ("bsize", 1024)])],
1202 "get file system statistics",
1204 Returns file system statistics for any mounted file system.
1205 C<path> should be a file or directory in the mounted file system
1206 (typically it is the mount point itself, but it doesn't need to be).
1208 This is the same as the C<statvfs(2)> system call.");
1210 ("tune2fs_l", (RHashtable "superblock", [String "device"]), 55, [],
1212 "get ext2/ext3/ext4 superblock details",
1214 This returns the contents of the ext2, ext3 or ext4 filesystem
1215 superblock on C<device>.
1217 It is the same as running C<tune2fs -l device>. See L<tune2fs(8)>
1218 manpage for more details. The list of fields returned isn't
1219 clearly defined, and depends on both the version of C<tune2fs>
1220 that libguestfs was built against, and the filesystem itself.");
1222 ("blockdev_setro", (RErr, [String "device"]), 56, [],
1223 [InitEmpty, TestOutputTrue (
1224 [["blockdev_setro"; "/dev/sda"];
1225 ["blockdev_getro"; "/dev/sda"]])],
1226 "set block device to read-only",
1228 Sets the block device named C<device> to read-only.
1230 This uses the L<blockdev(8)> command.");
1232 ("blockdev_setrw", (RErr, [String "device"]), 57, [],
1233 [InitEmpty, TestOutputFalse (
1234 [["blockdev_setrw"; "/dev/sda"];
1235 ["blockdev_getro"; "/dev/sda"]])],
1236 "set block device to read-write",
1238 Sets the block device named C<device> to read-write.
1240 This uses the L<blockdev(8)> command.");
1242 ("blockdev_getro", (RBool "ro", [String "device"]), 58, [],
1243 [InitEmpty, TestOutputTrue (
1244 [["blockdev_setro"; "/dev/sda"];
1245 ["blockdev_getro"; "/dev/sda"]])],
1246 "is block device set to read-only",
1248 Returns a boolean indicating if the block device is read-only
1249 (true if read-only, false if not).
1251 This uses the L<blockdev(8)> command.");
1253 ("blockdev_getss", (RInt "sectorsize", [String "device"]), 59, [],
1254 [InitEmpty, TestOutputInt (
1255 [["blockdev_getss"; "/dev/sda"]], 512)],
1256 "get sectorsize of block device",
1258 This returns the size of sectors on a block device.
1259 Usually 512, but can be larger for modern devices.
1261 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
1264 This uses the L<blockdev(8)> command.");
1266 ("blockdev_getbsz", (RInt "blocksize", [String "device"]), 60, [],
1267 [InitEmpty, TestOutputInt (
1268 [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1269 "get blocksize of block device",
1271 This returns the block size of a device.
1273 (Note this is different from both I<size in blocks> and
1274 I<filesystem block size>).
1276 This uses the L<blockdev(8)> command.");
1278 ("blockdev_setbsz", (RErr, [String "device"; Int "blocksize"]), 61, [],
1280 "set blocksize of block device",
1282 This sets the block size of a device.
1284 (Note this is different from both I<size in blocks> and
1285 I<filesystem block size>).
1287 This uses the L<blockdev(8)> command.");
1289 ("blockdev_getsz", (RInt64 "sizeinsectors", [String "device"]), 62, [],
1290 [InitEmpty, TestOutputInt (
1291 [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1292 "get total size of device in 512-byte sectors",
1294 This returns the size of the device in units of 512-byte sectors
1295 (even if the sectorsize isn't 512 bytes ... weird).
1297 See also C<guestfs_blockdev_getss> for the real sector size of
1298 the device, and C<guestfs_blockdev_getsize64> for the more
1299 useful I<size in bytes>.
1301 This uses the L<blockdev(8)> command.");
1303 ("blockdev_getsize64", (RInt64 "sizeinbytes", [String "device"]), 63, [],
1304 [InitEmpty, TestOutputInt (
1305 [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1306 "get total size of device in bytes",
1308 This returns the size of the device in bytes.
1310 See also C<guestfs_blockdev_getsz>.
1312 This uses the L<blockdev(8)> command.");
1314 ("blockdev_flushbufs", (RErr, [String "device"]), 64, [],
1316 [["blockdev_flushbufs"; "/dev/sda"]]],
1317 "flush device buffers",
1319 This tells the kernel to flush internal buffers associated
1322 This uses the L<blockdev(8)> command.");
1324 ("blockdev_rereadpt", (RErr, [String "device"]), 65, [],
1326 [["blockdev_rereadpt"; "/dev/sda"]]],
1327 "reread partition table",
1329 Reread the partition table on C<device>.
1331 This uses the L<blockdev(8)> command.");
1333 ("upload", (RErr, [FileIn "filename"; String "remotefilename"]), 66, [],
1334 [InitBasicFS, TestOutput (
1335 (* Pick a file from cwd which isn't likely to change. *)
1336 [["upload"; "COPYING.LIB"; "/COPYING.LIB"];
1337 ["checksum"; "md5"; "/COPYING.LIB"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
1338 "upload a file from the local machine",
1340 Upload local file C<filename> to C<remotefilename> on the
1343 C<filename> can also be a named pipe.
1345 See also C<guestfs_download>.");
1347 ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [],
1348 [InitBasicFS, TestOutput (
1349 (* Pick a file from cwd which isn't likely to change. *)
1350 [["upload"; "COPYING.LIB"; "/COPYING.LIB"];
1351 ["download"; "/COPYING.LIB"; "testdownload.tmp"];
1352 ["upload"; "testdownload.tmp"; "/upload"];
1353 ["checksum"; "md5"; "/upload"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
1354 "download a file to the local machine",
1356 Download file C<remotefilename> and save it as C<filename>
1357 on the local machine.
1359 C<filename> can also be a named pipe.
1361 See also C<guestfs_upload>, C<guestfs_cat>.");
1363 ("checksum", (RString "checksum", [String "csumtype"; String "path"]), 68, [],
1364 [InitBasicFS, TestOutput (
1365 [["write_file"; "/new"; "test\n"; "0"];
1366 ["checksum"; "crc"; "/new"]], "935282863");
1367 InitBasicFS, TestLastFail (
1368 [["checksum"; "crc"; "/new"]]);
1369 InitBasicFS, TestOutput (
1370 [["write_file"; "/new"; "test\n"; "0"];
1371 ["checksum"; "md5"; "/new"]], "d8e8fca2dc0f896fd7cb4cb0031ba249");
1372 InitBasicFS, TestOutput (
1373 [["write_file"; "/new"; "test\n"; "0"];
1374 ["checksum"; "sha1"; "/new"]], "4e1243bd22c66e76c2ba9eddc1f91394e57f9f83");
1375 InitBasicFS, TestOutput (
1376 [["write_file"; "/new"; "test\n"; "0"];
1377 ["checksum"; "sha224"; "/new"]], "52f1bf093f4b7588726035c176c0cdb4376cfea53819f1395ac9e6ec");
1378 InitBasicFS, TestOutput (
1379 [["write_file"; "/new"; "test\n"; "0"];
1380 ["checksum"; "sha256"; "/new"]], "f2ca1bb6c7e907d06dafe4687e579fce76b37e4e93b7605022da52e6ccc26fd2");
1381 InitBasicFS, TestOutput (
1382 [["write_file"; "/new"; "test\n"; "0"];
1383 ["checksum"; "sha384"; "/new"]], "109bb6b5b6d5547c1ce03c7a8bd7d8f80c1cb0957f50c4f7fda04692079917e4f9cad52b878f3d8234e1a170b154b72d");
1384 InitBasicFS, TestOutput (
1385 [["write_file"; "/new"; "test\n"; "0"];
1386 ["checksum"; "sha512"; "/new"]], "0e3e75234abc68f4378a86b3f4b32a198ba301845b0cd6e50106e874345700cc6663a86c1ea125dc5e92be17c98f9a0f85ca9d5f595db2012f7cc3571945c123")],
1387 "compute MD5, SHAx or CRC checksum of file",
1389 This call computes the MD5, SHAx or CRC checksum of the
1392 The type of checksum to compute is given by the C<csumtype>
1393 parameter which must have one of the following values:
1399 Compute the cyclic redundancy check (CRC) specified by POSIX
1400 for the C<cksum> command.
1404 Compute the MD5 hash (using the C<md5sum> program).
1408 Compute the SHA1 hash (using the C<sha1sum> program).
1412 Compute the SHA224 hash (using the C<sha224sum> program).
1416 Compute the SHA256 hash (using the C<sha256sum> program).
1420 Compute the SHA384 hash (using the C<sha384sum> program).
1424 Compute the SHA512 hash (using the C<sha512sum> program).
1428 The checksum is returned as a printable string.");
1430 ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [],
1431 [InitBasicFS, TestOutput (
1432 [["tar_in"; "images/helloworld.tar"; "/"];
1433 ["cat"; "/hello"]], "hello\n")],
1434 "unpack tarfile to directory",
1436 This command uploads and unpacks local file C<tarfile> (an
1437 I<uncompressed> tar file) into C<directory>.
1439 To upload a compressed tarball, use C<guestfs_tgz_in>.");
1441 ("tar_out", (RErr, [String "directory"; FileOut "tarfile"]), 70, [],
1443 "pack directory into tarfile",
1445 This command packs the contents of C<directory> and downloads
1446 it to local file C<tarfile>.
1448 To download a compressed tarball, use C<guestfs_tgz_out>.");
1450 ("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [],
1451 [InitBasicFS, TestOutput (
1452 [["tgz_in"; "images/helloworld.tar.gz"; "/"];
1453 ["cat"; "/hello"]], "hello\n")],
1454 "unpack compressed tarball to directory",
1456 This command uploads and unpacks local file C<tarball> (a
1457 I<gzip compressed> tar file) into C<directory>.
1459 To upload an uncompressed tarball, use C<guestfs_tar_in>.");
1461 ("tgz_out", (RErr, [String "directory"; FileOut "tarball"]), 72, [],
1463 "pack directory into compressed tarball",
1465 This command packs the contents of C<directory> and downloads
1466 it to local file C<tarball>.
1468 To download an uncompressed tarball, use C<guestfs_tar_out>.");
1470 ("mount_ro", (RErr, [String "device"; String "mountpoint"]), 73, [],
1471 [InitBasicFS, TestLastFail (
1473 ["mount_ro"; "/dev/sda1"; "/"];
1474 ["touch"; "/new"]]);
1475 InitBasicFS, TestOutput (
1476 [["write_file"; "/new"; "data"; "0"];
1478 ["mount_ro"; "/dev/sda1"; "/"];
1479 ["cat"; "/new"]], "data")],
1480 "mount a guest disk, read-only",
1482 This is the same as the C<guestfs_mount> command, but it
1483 mounts the filesystem with the read-only (I<-o ro>) flag.");
1485 ("mount_options", (RErr, [String "options"; String "device"; String "mountpoint"]), 74, [],
1487 "mount a guest disk with mount options",
1489 This is the same as the C<guestfs_mount> command, but it
1490 allows you to set the mount options as for the
1491 L<mount(8)> I<-o> flag.");
1493 ("mount_vfs", (RErr, [String "options"; String "vfstype"; String "device"; String "mountpoint"]), 75, [],
1495 "mount a guest disk with mount options and vfstype",
1497 This is the same as the C<guestfs_mount> command, but it
1498 allows you to set both the mount options and the vfstype
1499 as for the L<mount(8)> I<-o> and I<-t> flags.");
1501 ("debug", (RString "result", [String "subcmd"; StringList "extraargs"]), 76, [],
1503 "debugging and internals",
1505 The C<guestfs_debug> command exposes some internals of
1506 C<guestfsd> (the guestfs daemon) that runs inside the
1509 There is no comprehensive help for this command. You have
1510 to look at the file C<daemon/debug.c> in the libguestfs source
1511 to find out what you can do.");
1513 ("lvremove", (RErr, [String "device"]), 77, [],
1514 [InitEmpty, TestOutputList (
1515 [["pvcreate"; "/dev/sda"];
1516 ["vgcreate"; "VG"; "/dev/sda"];
1517 ["lvcreate"; "LV1"; "VG"; "50"];
1518 ["lvcreate"; "LV2"; "VG"; "50"];
1519 ["lvremove"; "/dev/VG/LV1"];
1520 ["lvs"]], ["/dev/VG/LV2"]);
1521 InitEmpty, TestOutputList (
1522 [["pvcreate"; "/dev/sda"];
1523 ["vgcreate"; "VG"; "/dev/sda"];
1524 ["lvcreate"; "LV1"; "VG"; "50"];
1525 ["lvcreate"; "LV2"; "VG"; "50"];
1526 ["lvremove"; "/dev/VG"];
1528 InitEmpty, TestOutputList (
1529 [["pvcreate"; "/dev/sda"];
1530 ["vgcreate"; "VG"; "/dev/sda"];
1531 ["lvcreate"; "LV1"; "VG"; "50"];
1532 ["lvcreate"; "LV2"; "VG"; "50"];
1533 ["lvremove"; "/dev/VG"];
1535 "remove an LVM logical volume",
1537 Remove an LVM logical volume C<device>, where C<device> is
1538 the path to the LV, such as C</dev/VG/LV>.
1540 You can also remove all LVs in a volume group by specifying
1541 the VG name, C</dev/VG>.");
1543 ("vgremove", (RErr, [String "vgname"]), 78, [],
1544 [InitEmpty, TestOutputList (
1545 [["pvcreate"; "/dev/sda"];
1546 ["vgcreate"; "VG"; "/dev/sda"];
1547 ["lvcreate"; "LV1"; "VG"; "50"];
1548 ["lvcreate"; "LV2"; "VG"; "50"];
1551 InitEmpty, TestOutputList (
1552 [["pvcreate"; "/dev/sda"];
1553 ["vgcreate"; "VG"; "/dev/sda"];
1554 ["lvcreate"; "LV1"; "VG"; "50"];
1555 ["lvcreate"; "LV2"; "VG"; "50"];
1558 "remove an LVM volume group",
1560 Remove an LVM volume group C<vgname>, (for example C<VG>).
1562 This also forcibly removes all logical volumes in the volume
1565 ("pvremove", (RErr, [String "device"]), 79, [],
1566 [InitEmpty, TestOutputList (
1567 [["pvcreate"; "/dev/sda"];
1568 ["vgcreate"; "VG"; "/dev/sda"];
1569 ["lvcreate"; "LV1"; "VG"; "50"];
1570 ["lvcreate"; "LV2"; "VG"; "50"];
1572 ["pvremove"; "/dev/sda"];
1574 InitEmpty, TestOutputList (
1575 [["pvcreate"; "/dev/sda"];
1576 ["vgcreate"; "VG"; "/dev/sda"];
1577 ["lvcreate"; "LV1"; "VG"; "50"];
1578 ["lvcreate"; "LV2"; "VG"; "50"];
1580 ["pvremove"; "/dev/sda"];
1582 InitEmpty, TestOutputList (
1583 [["pvcreate"; "/dev/sda"];
1584 ["vgcreate"; "VG"; "/dev/sda"];
1585 ["lvcreate"; "LV1"; "VG"; "50"];
1586 ["lvcreate"; "LV2"; "VG"; "50"];
1588 ["pvremove"; "/dev/sda"];
1590 "remove an LVM physical volume",
1592 This wipes a physical volume C<device> so that LVM will no longer
1595 The implementation uses the C<pvremove> command which refuses to
1596 wipe physical volumes that contain any volume groups, so you have
1597 to remove those first.");
1599 ("set_e2label", (RErr, [String "device"; String "label"]), 80, [],
1600 [InitBasicFS, TestOutput (
1601 [["set_e2label"; "/dev/sda1"; "testlabel"];
1602 ["get_e2label"; "/dev/sda1"]], "testlabel")],
1603 "set the ext2/3/4 filesystem label",
1605 This sets the ext2/3/4 filesystem label of the filesystem on
1606 C<device> to C<label>. Filesystem labels are limited to
1609 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2label>
1610 to return the existing label on a filesystem.");
1612 ("get_e2label", (RString "label", [String "device"]), 81, [],
1614 "get the ext2/3/4 filesystem label",
1616 This returns the ext2/3/4 filesystem label of the filesystem on
1619 ("set_e2uuid", (RErr, [String "device"; String "uuid"]), 82, [],
1620 [InitBasicFS, TestOutput (
1621 [["set_e2uuid"; "/dev/sda1"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"];
1622 ["get_e2uuid"; "/dev/sda1"]], "a3a61220-882b-4f61-89f4-cf24dcc7297d");
1623 InitBasicFS, TestOutput (
1624 [["set_e2uuid"; "/dev/sda1"; "clear"];
1625 ["get_e2uuid"; "/dev/sda1"]], "");
1626 (* We can't predict what UUIDs will be, so just check the commands run. *)
1627 InitBasicFS, TestRun (
1628 [["set_e2uuid"; "/dev/sda1"; "random"]]);
1629 InitBasicFS, TestRun (
1630 [["set_e2uuid"; "/dev/sda1"; "time"]])],
1631 "set the ext2/3/4 filesystem UUID",
1633 This sets the ext2/3/4 filesystem UUID of the filesystem on
1634 C<device> to C<uuid>. The format of the UUID and alternatives
1635 such as C<clear>, C<random> and C<time> are described in the
1636 L<tune2fs(8)> manpage.
1638 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2uuid>
1639 to return the existing UUID of a filesystem.");
1641 ("get_e2uuid", (RString "uuid", [String "device"]), 83, [],
1643 "get the ext2/3/4 filesystem UUID",
1645 This returns the ext2/3/4 filesystem UUID of the filesystem on
1648 ("fsck", (RInt "status", [String "fstype"; String "device"]), 84, [],
1649 [InitBasicFS, TestOutputInt (
1650 [["umount"; "/dev/sda1"];
1651 ["fsck"; "ext2"; "/dev/sda1"]], 0);
1652 InitBasicFS, TestOutputInt (
1653 [["umount"; "/dev/sda1"];
1654 ["zero"; "/dev/sda1"];
1655 ["fsck"; "ext2"; "/dev/sda1"]], 8)],
1656 "run the filesystem checker",
1658 This runs the filesystem checker (fsck) on C<device> which
1659 should have filesystem type C<fstype>.
1661 The returned integer is the status. See L<fsck(8)> for the
1662 list of status codes from C<fsck>.
1670 Multiple status codes can be summed together.
1674 A non-zero return code can mean \"success\", for example if
1675 errors have been corrected on the filesystem.
1679 Checking or repairing NTFS volumes is not supported
1684 This command is entirely equivalent to running C<fsck -a -t fstype device>.");
1686 ("zero", (RErr, [String "device"]), 85, [],
1687 [InitBasicFS, TestOutput (
1688 [["umount"; "/dev/sda1"];
1689 ["zero"; "/dev/sda1"];
1690 ["file"; "/dev/sda1"]], "data")],
1691 "write zeroes to the device",
1693 This command writes zeroes over the first few blocks of C<device>.
1695 How many blocks are zeroed isn't specified (but it's I<not> enough
1696 to securely wipe the device). It should be sufficient to remove
1697 any partition tables, filesystem superblocks and so on.");
1699 ("grub_install", (RErr, [String "root"; String "device"]), 86, [],
1700 [InitBasicFS, TestOutputTrue (
1701 [["grub_install"; "/"; "/dev/sda1"];
1702 ["is_dir"; "/boot"]])],
1705 This command installs GRUB (the Grand Unified Bootloader) on
1706 C<device>, with the root directory being C<root>.");
1708 ("cp", (RErr, [String "src"; String "dest"]), 87, [],
1709 [InitBasicFS, TestOutput (
1710 [["write_file"; "/old"; "file content"; "0"];
1711 ["cp"; "/old"; "/new"];
1712 ["cat"; "/new"]], "file content");
1713 InitBasicFS, TestOutputTrue (
1714 [["write_file"; "/old"; "file content"; "0"];
1715 ["cp"; "/old"; "/new"];
1716 ["is_file"; "/old"]]);
1717 InitBasicFS, TestOutput (
1718 [["write_file"; "/old"; "file content"; "0"];
1720 ["cp"; "/old"; "/dir/new"];
1721 ["cat"; "/dir/new"]], "file content")],
1724 This copies a file from C<src> to C<dest> where C<dest> is
1725 either a destination filename or destination directory.");
1727 ("cp_a", (RErr, [String "src"; String "dest"]), 88, [],
1728 [InitBasicFS, TestOutput (
1729 [["mkdir"; "/olddir"];
1730 ["mkdir"; "/newdir"];
1731 ["write_file"; "/olddir/file"; "file content"; "0"];
1732 ["cp_a"; "/olddir"; "/newdir"];
1733 ["cat"; "/newdir/olddir/file"]], "file content")],
1734 "copy a file or directory recursively",
1736 This copies a file or directory from C<src> to C<dest>
1737 recursively using the C<cp -a> command.");
1739 ("mv", (RErr, [String "src"; String "dest"]), 89, [],
1740 [InitBasicFS, TestOutput (
1741 [["write_file"; "/old"; "file content"; "0"];
1742 ["mv"; "/old"; "/new"];
1743 ["cat"; "/new"]], "file content");
1744 InitBasicFS, TestOutputFalse (
1745 [["write_file"; "/old"; "file content"; "0"];
1746 ["mv"; "/old"; "/new"];
1747 ["is_file"; "/old"]])],
1750 This moves a file from C<src> to C<dest> where C<dest> is
1751 either a destination filename or destination directory.");
1753 ("drop_caches", (RErr, [Int "whattodrop"]), 90, [],
1754 [InitEmpty, TestRun (
1755 [["drop_caches"; "3"]])],
1756 "drop kernel page cache, dentries and inodes",
1758 This instructs the guest kernel to drop its page cache,
1759 and/or dentries and inode caches. The parameter C<whattodrop>
1760 tells the kernel what precisely to drop, see
1761 L<http://linux-mm.org/Drop_Caches>
1763 Setting C<whattodrop> to 3 should drop everything.
1765 This automatically calls L<sync(2)> before the operation,
1766 so that the maximum guest memory is freed.");
1768 ("dmesg", (RString "kmsgs", []), 91, [],
1769 [InitEmpty, TestRun (
1771 "return kernel messages",
1773 This returns the kernel messages (C<dmesg> output) from
1774 the guest kernel. This is sometimes useful for extended
1775 debugging of problems.
1777 Another way to get the same information is to enable
1778 verbose messages with C<guestfs_set_verbose> or by setting
1779 the environment variable C<LIBGUESTFS_DEBUG=1> before
1780 running the program.");
1782 ("ping_daemon", (RErr, []), 92, [],
1783 [InitEmpty, TestRun (
1784 [["ping_daemon"]])],
1785 "ping the guest daemon",
1787 This is a test probe into the guestfs daemon running inside
1788 the qemu subprocess. Calling this function checks that the
1789 daemon responds to the ping message, without affecting the daemon
1790 or attached block device(s) in any other way.");
1792 ("equal", (RBool "equality", [String "file1"; String "file2"]), 93, [],
1793 [InitBasicFS, TestOutputTrue (
1794 [["write_file"; "/file1"; "contents of a file"; "0"];
1795 ["cp"; "/file1"; "/file2"];
1796 ["equal"; "/file1"; "/file2"]]);
1797 InitBasicFS, TestOutputFalse (
1798 [["write_file"; "/file1"; "contents of a file"; "0"];
1799 ["write_file"; "/file2"; "contents of another file"; "0"];
1800 ["equal"; "/file1"; "/file2"]]);
1801 InitBasicFS, TestLastFail (
1802 [["equal"; "/file1"; "/file2"]])],
1803 "test if two files have equal contents",
1805 This compares the two files C<file1> and C<file2> and returns
1806 true if their content is exactly equal, or false otherwise.
1808 The external L<cmp(1)> program is used for the comparison.");
1810 ("strings", (RStringList "stringsout", [String "path"]), 94, [ProtocolLimitWarning],
1811 [InitBasicFS, TestOutputList (
1812 [["write_file"; "/new"; "hello\nworld\n"; "0"];
1813 ["strings"; "/new"]], ["hello"; "world"])],
1814 "print the printable strings in a file",
1816 This runs the L<strings(1)> command on a file and returns
1817 the list of printable strings found.");
1819 ("strings_e", (RStringList "stringsout", [String "encoding"; String "path"]), 95, [ProtocolLimitWarning],
1820 [InitBasicFS, TestOutputList (
1821 [["write_file"; "/new"; "hello\nworld\n"; "0"];
1822 ["strings_e"; "b"; "/new"]], []);
1823 (*InitBasicFS, TestOutputList (
1824 [["write_file"; "/new"; "\000h\000e\000l\000l\000o\000\n\000w\000o\000r\000l\000d\000\n"; "24"];
1825 ["strings_e"; "b"; "/new"]], ["hello"; "world"])*)],
1826 "print the printable strings in a file",
1828 This is like the C<guestfs_strings> command, but allows you to
1829 specify the encoding.
1831 See the L<strings(1)> manpage for the full list of encodings.
1833 Commonly useful encodings are C<l> (lower case L) which will
1834 show strings inside Windows/x86 files.
1836 The returned strings are transcoded to UTF-8.");
1838 ("hexdump", (RString "dump", [String "path"]), 96, [ProtocolLimitWarning],
1839 [InitBasicFS, TestOutput (
1840 [["write_file"; "/new"; "hello\nworld\n"; "12"];
1841 ["hexdump"; "/new"]], "00000000 68 65 6c 6c 6f 0a 77 6f 72 6c 64 0a |hello.world.|\n0000000c\n")],
1842 "dump a file in hexadecimal",
1844 This runs C<hexdump -C> on the given C<path>. The result is
1845 the human-readable, canonical hex dump of the file.");
1849 let all_functions = non_daemon_functions @ daemon_functions
1851 (* In some places we want the functions to be displayed sorted
1852 * alphabetically, so this is useful:
1854 let all_functions_sorted =
1855 List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
1856 compare n1 n2) all_functions
1858 (* Column names and types from LVM PVs/VGs/LVs. *)
1867 "pv_attr", `String (* XXX *);
1868 "pv_pe_count", `Int;
1869 "pv_pe_alloc_count", `Int;
1872 "pv_mda_count", `Int;
1873 "pv_mda_free", `Bytes;
1874 (* Not in Fedora 10:
1875 "pv_mda_size", `Bytes;
1882 "vg_attr", `String (* XXX *);
1885 "vg_sysid", `String;
1886 "vg_extent_size", `Bytes;
1887 "vg_extent_count", `Int;
1888 "vg_free_count", `Int;
1896 "vg_mda_count", `Int;
1897 "vg_mda_free", `Bytes;
1898 (* Not in Fedora 10:
1899 "vg_mda_size", `Bytes;
1905 "lv_attr", `String (* XXX *);
1908 "lv_kernel_major", `Int;
1909 "lv_kernel_minor", `Int;
1913 "snap_percent", `OptPercent;
1914 "copy_percent", `OptPercent;
1917 "mirror_log", `String;
1921 (* Column names and types from stat structures.
1922 * NB. Can't use things like 'st_atime' because glibc header files
1923 * define some of these as macros. Ugh.
1940 let statvfs_cols = [
1954 (* Useful functions.
1955 * Note we don't want to use any external OCaml libraries which
1956 * makes this a bit harder than it should be.
1958 let failwithf fs = ksprintf failwith fs
1960 let replace_char s c1 c2 =
1961 let s2 = String.copy s in
1962 let r = ref false in
1963 for i = 0 to String.length s2 - 1 do
1964 if String.unsafe_get s2 i = c1 then (
1965 String.unsafe_set s2 i c2;
1969 if not !r then s else s2
1973 (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
1975 let triml ?(test = isspace) str =
1977 let n = ref (String.length str) in
1978 while !n > 0 && test str.[!i]; do
1983 else String.sub str !i !n
1985 let trimr ?(test = isspace) str =
1986 let n = ref (String.length str) in
1987 while !n > 0 && test str.[!n-1]; do
1990 if !n = String.length str then str
1991 else String.sub str 0 !n
1993 let trim ?(test = isspace) str =
1994 trimr ~test (triml ~test str)
1996 let rec find s sub =
1997 let len = String.length s in
1998 let sublen = String.length sub in
2000 if i <= len-sublen then (
2002 if j < sublen then (
2003 if s.[i+j] = sub.[j] then loop2 (j+1)
2009 if r = -1 then loop (i+1) else r
2015 let rec replace_str s s1 s2 =
2016 let len = String.length s in
2017 let sublen = String.length s1 in
2018 let i = find s s1 in
2021 let s' = String.sub s 0 i in
2022 let s'' = String.sub s (i+sublen) (len-i-sublen) in
2023 s' ^ s2 ^ replace_str s'' s1 s2
2026 let rec string_split sep str =
2027 let len = String.length str in
2028 let seplen = String.length sep in
2029 let i = find str sep in
2030 if i = -1 then [str]
2032 let s' = String.sub str 0 i in
2033 let s'' = String.sub str (i+seplen) (len-i-seplen) in
2034 s' :: string_split sep s''
2037 let files_equal n1 n2 =
2038 let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
2039 match Sys.command cmd with
2042 | i -> failwithf "%s: failed with error code %d" cmd i
2044 let rec find_map f = function
2045 | [] -> raise Not_found
2049 | None -> find_map f xs
2052 let rec loop i = function
2054 | x :: xs -> f i x; loop (i+1) xs
2059 let rec loop i = function
2061 | x :: xs -> let r = f i x in r :: loop (i+1) xs
2065 let name_of_argt = function
2066 | String n | OptString n | StringList n | Bool n | Int n
2067 | FileIn n | FileOut n -> n
2069 let seq_of_test = function
2070 | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
2071 | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s
2072 | TestOutputLength (s, _) | TestOutputStruct (s, _)
2073 | TestLastFail s -> s
2075 (* Check function names etc. for consistency. *)
2076 let check_functions () =
2077 let contains_uppercase str =
2078 let len = String.length str in
2080 if i >= len then false
2083 if c >= 'A' && c <= 'Z' then true
2090 (* Check function names. *)
2092 fun (name, _, _, _, _, _, _) ->
2093 if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
2094 failwithf "function name %s does not need 'guestfs' prefix" name;
2095 if contains_uppercase name then
2096 failwithf "function name %s should not contain uppercase chars" name;
2097 if String.contains name '-' then
2098 failwithf "function name %s should not contain '-', use '_' instead."
2102 (* Check function parameter/return names. *)
2104 fun (name, style, _, _, _, _, _) ->
2105 let check_arg_ret_name n =
2106 if contains_uppercase n then
2107 failwithf "%s param/ret %s should not contain uppercase chars"
2109 if String.contains n '-' || String.contains n '_' then
2110 failwithf "%s param/ret %s should not contain '-' or '_'"
2113 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;
2114 if n = "argv" || n = "args" then
2115 failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" n
2118 (match fst style with
2120 | RInt n | RInt64 n | RBool n | RConstString n | RString n
2121 | RStringList n | RPVList n | RVGList n | RLVList n
2122 | RStat n | RStatVFS n
2124 check_arg_ret_name n
2126 check_arg_ret_name n;
2127 check_arg_ret_name m
2129 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
2132 (* Check short descriptions. *)
2134 fun (name, _, _, _, _, shortdesc, _) ->
2135 if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
2136 failwithf "short description of %s should begin with lowercase." name;
2137 let c = shortdesc.[String.length shortdesc-1] in
2138 if c = '\n' || c = '.' then
2139 failwithf "short description of %s should not end with . or \\n." name
2142 (* Check long dscriptions. *)
2144 fun (name, _, _, _, _, _, longdesc) ->
2145 if longdesc.[String.length longdesc-1] = '\n' then
2146 failwithf "long description of %s should not end with \\n." name
2149 (* Check proc_nrs. *)
2151 fun (name, _, proc_nr, _, _, _, _) ->
2152 if proc_nr <= 0 then
2153 failwithf "daemon function %s should have proc_nr > 0" name
2157 fun (name, _, proc_nr, _, _, _, _) ->
2158 if proc_nr <> -1 then
2159 failwithf "non-daemon function %s should have proc_nr -1" name
2160 ) non_daemon_functions;
2163 List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
2166 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
2167 let rec loop = function
2170 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
2172 | (name1,nr1) :: (name2,nr2) :: _ ->
2173 failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
2181 (* Ignore functions that have no tests. We generate a
2182 * warning when the user does 'make check' instead.
2184 | name, _, _, _, [], _, _ -> ()
2185 | name, _, _, _, tests, _, _ ->
2189 match seq_of_test test with
2191 failwithf "%s has a test containing an empty sequence" name
2192 | cmds -> List.map List.hd cmds
2194 let funcs = List.flatten funcs in
2196 let tested = List.mem name funcs in
2199 failwithf "function %s has tests but does not test itself" name
2202 (* 'pr' prints to the current output file. *)
2203 let chan = ref stdout
2204 let pr fs = ksprintf (output_string !chan) fs
2206 (* Generate a header block in a number of standard styles. *)
2207 type comment_style = CStyle | HashStyle | OCamlStyle
2208 type license = GPLv2 | LGPLv2
2210 let generate_header comment license =
2211 let c = match comment with
2212 | CStyle -> pr "/* "; " *"
2213 | HashStyle -> pr "# "; "#"
2214 | OCamlStyle -> pr "(* "; " *" in
2215 pr "libguestfs generated file\n";
2216 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
2217 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
2219 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
2223 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
2224 pr "%s it under the terms of the GNU General Public License as published by\n" c;
2225 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
2226 pr "%s (at your option) any later version.\n" c;
2228 pr "%s This program is distributed in the hope that it will be useful,\n" c;
2229 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
2230 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
2231 pr "%s GNU General Public License for more details.\n" c;
2233 pr "%s You should have received a copy of the GNU General Public License along\n" c;
2234 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
2235 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
2238 pr "%s This library is free software; you can redistribute it and/or\n" c;
2239 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
2240 pr "%s License as published by the Free Software Foundation; either\n" c;
2241 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
2243 pr "%s This library is distributed in the hope that it will be useful,\n" c;
2244 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
2245 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
2246 pr "%s Lesser General Public License for more details.\n" c;
2248 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
2249 pr "%s License along with this library; if not, write to the Free Software\n" c;
2250 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
2253 | CStyle -> pr " */\n"
2255 | OCamlStyle -> pr " *)\n"
2259 (* Start of main code generation functions below this line. *)
2261 (* Generate the pod documentation for the C API. *)
2262 let rec generate_actions_pod () =
2264 fun (shortname, style, _, flags, _, _, longdesc) ->
2265 let name = "guestfs_" ^ shortname in
2266 pr "=head2 %s\n\n" name;
2268 generate_prototype ~extern:false ~handle:"handle" name style;
2270 pr "%s\n\n" longdesc;
2271 (match fst style with
2273 pr "This function returns 0 on success or -1 on error.\n\n"
2275 pr "On error this function returns -1.\n\n"
2277 pr "On error this function returns -1.\n\n"
2279 pr "This function returns a C truth value on success or -1 on error.\n\n"
2281 pr "This function returns a string, or NULL on error.
2282 The string is owned by the guest handle and must I<not> be freed.\n\n"
2284 pr "This function returns a string, or NULL on error.
2285 I<The caller must free the returned string after use>.\n\n"
2287 pr "This function returns a NULL-terminated array of strings
2288 (like L<environ(3)>), or NULL if there was an error.
2289 I<The caller must free the strings and the array after use>.\n\n"
2291 pr "This function returns a C<struct guestfs_int_bool *>,
2292 or NULL if there was an error.
2293 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
2295 pr "This function returns a C<struct guestfs_lvm_pv_list *>
2296 (see E<lt>guestfs-structs.hE<gt>),
2297 or NULL if there was an error.
2298 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
2300 pr "This function returns a C<struct guestfs_lvm_vg_list *>
2301 (see E<lt>guestfs-structs.hE<gt>),
2302 or NULL if there was an error.
2303 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
2305 pr "This function returns a C<struct guestfs_lvm_lv_list *>
2306 (see E<lt>guestfs-structs.hE<gt>),
2307 or NULL if there was an error.
2308 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
2310 pr "This function returns a C<struct guestfs_stat *>
2311 (see L<stat(2)> and E<lt>guestfs-structs.hE<gt>),
2312 or NULL if there was an error.
2313 I<The caller must call C<free> after use>.\n\n"
2315 pr "This function returns a C<struct guestfs_statvfs *>
2316 (see L<statvfs(2)> and E<lt>guestfs-structs.hE<gt>),
2317 or NULL if there was an error.
2318 I<The caller must call C<free> after use>.\n\n"
2320 pr "This function returns a NULL-terminated array of
2321 strings, or NULL if there was an error.
2322 The array of strings will always have length C<2n+1>, where
2323 C<n> keys and values alternate, followed by the trailing NULL entry.
2324 I<The caller must free the strings and the array after use>.\n\n"
2326 if List.mem ProtocolLimitWarning flags then
2327 pr "%s\n\n" protocol_limit_warning;
2328 if List.mem DangerWillRobinson flags then
2329 pr "%s\n\n" danger_will_robinson;
2330 ) all_functions_sorted
2332 and generate_structs_pod () =
2333 (* LVM structs documentation. *)
2336 pr "=head2 guestfs_lvm_%s\n" typ;
2338 pr " struct guestfs_lvm_%s {\n" typ;
2341 | name, `String -> pr " char *%s;\n" name
2343 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
2344 pr " char %s[32];\n" name
2345 | name, `Bytes -> pr " uint64_t %s;\n" name
2346 | name, `Int -> pr " int64_t %s;\n" name
2347 | name, `OptPercent ->
2348 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
2349 pr " float %s;\n" name
2352 pr " struct guestfs_lvm_%s_list {\n" typ;
2353 pr " uint32_t len; /* Number of elements in list. */\n";
2354 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
2357 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
2360 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2362 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
2363 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
2365 * We have to use an underscore instead of a dash because otherwise
2366 * rpcgen generates incorrect code.
2368 * This header is NOT exported to clients, but see also generate_structs_h.
2370 and generate_xdr () =
2371 generate_header CStyle LGPLv2;
2373 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
2374 pr "typedef string str<>;\n";
2377 (* LVM internal structures. *)
2381 pr "struct guestfs_lvm_int_%s {\n" typ;
2383 | name, `String -> pr " string %s<>;\n" name
2384 | name, `UUID -> pr " opaque %s[32];\n" name
2385 | name, `Bytes -> pr " hyper %s;\n" name
2386 | name, `Int -> pr " hyper %s;\n" name
2387 | name, `OptPercent -> pr " float %s;\n" name
2391 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
2393 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2395 (* Stat internal structures. *)
2399 pr "struct guestfs_int_%s {\n" typ;
2401 | name, `Int -> pr " hyper %s;\n" name
2405 ) ["stat", stat_cols; "statvfs", statvfs_cols];
2408 fun (shortname, style, _, _, _, _, _) ->
2409 let name = "guestfs_" ^ shortname in
2411 (match snd style with
2414 pr "struct %s_args {\n" name;
2417 | String n -> pr " string %s<>;\n" n
2418 | OptString n -> pr " str *%s;\n" n
2419 | StringList n -> pr " str %s<>;\n" n
2420 | Bool n -> pr " bool %s;\n" n
2421 | Int n -> pr " int %s;\n" n
2422 | FileIn _ | FileOut _ -> ()
2426 (match fst style with
2429 pr "struct %s_ret {\n" name;
2433 pr "struct %s_ret {\n" name;
2434 pr " hyper %s;\n" n;
2437 pr "struct %s_ret {\n" name;
2441 failwithf "RConstString cannot be returned from a daemon function"
2443 pr "struct %s_ret {\n" name;
2444 pr " string %s<>;\n" n;
2447 pr "struct %s_ret {\n" name;
2448 pr " str %s<>;\n" n;
2451 pr "struct %s_ret {\n" name;
2456 pr "struct %s_ret {\n" name;
2457 pr " guestfs_lvm_int_pv_list %s;\n" n;
2460 pr "struct %s_ret {\n" name;
2461 pr " guestfs_lvm_int_vg_list %s;\n" n;
2464 pr "struct %s_ret {\n" name;
2465 pr " guestfs_lvm_int_lv_list %s;\n" n;
2468 pr "struct %s_ret {\n" name;
2469 pr " guestfs_int_stat %s;\n" n;
2472 pr "struct %s_ret {\n" name;
2473 pr " guestfs_int_statvfs %s;\n" n;
2476 pr "struct %s_ret {\n" name;
2477 pr " str %s<>;\n" n;
2482 (* Table of procedure numbers. *)
2483 pr "enum guestfs_procedure {\n";
2485 fun (shortname, _, proc_nr, _, _, _, _) ->
2486 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
2488 pr " GUESTFS_PROC_NR_PROCS\n";
2492 (* Having to choose a maximum message size is annoying for several
2493 * reasons (it limits what we can do in the API), but it (a) makes
2494 * the protocol a lot simpler, and (b) provides a bound on the size
2495 * of the daemon which operates in limited memory space. For large
2496 * file transfers you should use FTP.
2498 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
2501 (* Message header, etc. *)
2503 /* The communication protocol is now documented in the guestfs(3)
2507 const GUESTFS_PROGRAM = 0x2000F5F5;
2508 const GUESTFS_PROTOCOL_VERSION = 1;
2510 /* These constants must be larger than any possible message length. */
2511 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
2512 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
2514 enum guestfs_message_direction {
2515 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
2516 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
2519 enum guestfs_message_status {
2520 GUESTFS_STATUS_OK = 0,
2521 GUESTFS_STATUS_ERROR = 1
2524 const GUESTFS_ERROR_LEN = 256;
2526 struct guestfs_message_error {
2527 string error_message<GUESTFS_ERROR_LEN>;
2530 struct guestfs_message_header {
2531 unsigned prog; /* GUESTFS_PROGRAM */
2532 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
2533 guestfs_procedure proc; /* GUESTFS_PROC_x */
2534 guestfs_message_direction direction;
2535 unsigned serial; /* message serial number */
2536 guestfs_message_status status;
2539 const GUESTFS_MAX_CHUNK_SIZE = 8192;
2541 struct guestfs_chunk {
2542 int cancel; /* if non-zero, transfer is cancelled */
2543 /* data size is 0 bytes if the transfer has finished successfully */
2544 opaque data<GUESTFS_MAX_CHUNK_SIZE>;
2548 (* Generate the guestfs-structs.h file. *)
2549 and generate_structs_h () =
2550 generate_header CStyle LGPLv2;
2552 (* This is a public exported header file containing various
2553 * structures. The structures are carefully written to have
2554 * exactly the same in-memory format as the XDR structures that
2555 * we use on the wire to the daemon. The reason for creating
2556 * copies of these structures here is just so we don't have to
2557 * export the whole of guestfs_protocol.h (which includes much
2558 * unrelated and XDR-dependent stuff that we don't want to be
2559 * public, or required by clients).
2561 * To reiterate, we will pass these structures to and from the
2562 * client with a simple assignment or memcpy, so the format
2563 * must be identical to what rpcgen / the RFC defines.
2566 (* guestfs_int_bool structure. *)
2567 pr "struct guestfs_int_bool {\n";
2573 (* LVM public structures. *)
2577 pr "struct guestfs_lvm_%s {\n" typ;
2580 | name, `String -> pr " char *%s;\n" name
2581 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
2582 | name, `Bytes -> pr " uint64_t %s;\n" name
2583 | name, `Int -> pr " int64_t %s;\n" name
2584 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
2588 pr "struct guestfs_lvm_%s_list {\n" typ;
2589 pr " uint32_t len;\n";
2590 pr " struct guestfs_lvm_%s *val;\n" typ;
2593 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2595 (* Stat structures. *)
2599 pr "struct guestfs_%s {\n" typ;
2602 | name, `Int -> pr " int64_t %s;\n" name
2606 ) ["stat", stat_cols; "statvfs", statvfs_cols]
2608 (* Generate the guestfs-actions.h file. *)
2609 and generate_actions_h () =
2610 generate_header CStyle LGPLv2;
2612 fun (shortname, style, _, _, _, _, _) ->
2613 let name = "guestfs_" ^ shortname in
2614 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
2618 (* Generate the client-side dispatch stubs. *)
2619 and generate_client_actions () =
2620 generate_header CStyle LGPLv2;
2626 #include \"guestfs.h\"
2627 #include \"guestfs_protocol.h\"
2629 #define error guestfs_error
2630 #define perrorf guestfs_perrorf
2631 #define safe_malloc guestfs_safe_malloc
2632 #define safe_realloc guestfs_safe_realloc
2633 #define safe_strdup guestfs_safe_strdup
2634 #define safe_memdup guestfs_safe_memdup
2636 /* Check the return message from a call for validity. */
2638 check_reply_header (guestfs_h *g,
2639 const struct guestfs_message_header *hdr,
2640 int proc_nr, int serial)
2642 if (hdr->prog != GUESTFS_PROGRAM) {
2643 error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
2646 if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
2647 error (g, \"wrong protocol version (%%d/%%d)\",
2648 hdr->vers, GUESTFS_PROTOCOL_VERSION);
2651 if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
2652 error (g, \"unexpected message direction (%%d/%%d)\",
2653 hdr->direction, GUESTFS_DIRECTION_REPLY);
2656 if (hdr->proc != proc_nr) {
2657 error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
2660 if (hdr->serial != serial) {
2661 error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
2668 /* Check we are in the right state to run a high-level action. */
2670 check_state (guestfs_h *g, const char *caller)
2672 if (!guestfs_is_ready (g)) {
2673 if (guestfs_is_config (g))
2674 error (g, \"%%s: call launch() before using this function\",
2676 else if (guestfs_is_launching (g))
2677 error (g, \"%%s: call wait_ready() before using this function\",
2680 error (g, \"%%s called from the wrong state, %%d != READY\",
2681 caller, guestfs_get_state (g));
2689 (* Client-side stubs for each function. *)
2691 fun (shortname, style, _, _, _, _, _) ->
2692 let name = "guestfs_" ^ shortname in
2694 (* Generate the context struct which stores the high-level
2695 * state between callback functions.
2697 pr "struct %s_ctx {\n" shortname;
2698 pr " /* This flag is set by the callbacks, so we know we've done\n";
2699 pr " * the callbacks as expected, and in the right sequence.\n";
2700 pr " * 0 = not called, 1 = reply_cb called.\n";
2702 pr " int cb_sequence;\n";
2703 pr " struct guestfs_message_header hdr;\n";
2704 pr " struct guestfs_message_error err;\n";
2705 (match fst style with
2708 failwithf "RConstString cannot be returned from a daemon function"
2710 | RBool _ | RString _ | RStringList _
2712 | RPVList _ | RVGList _ | RLVList _
2713 | RStat _ | RStatVFS _
2715 pr " struct %s_ret ret;\n" name
2720 (* Generate the reply callback function. *)
2721 pr "static void %s_reply_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
2723 pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
2724 pr " struct %s_ctx *ctx = (struct %s_ctx *) data;\n" shortname shortname;
2726 pr " /* This should definitely not happen. */\n";
2727 pr " if (ctx->cb_sequence != 0) {\n";
2728 pr " ctx->cb_sequence = 9999;\n";
2729 pr " error (g, \"%%s: internal error: reply callback called twice\", \"%s\");\n" name;
2733 pr " ml->main_loop_quit (ml, g);\n";
2735 pr " if (!xdr_guestfs_message_header (xdr, &ctx->hdr)) {\n";
2736 pr " error (g, \"%%s: failed to parse reply header\", \"%s\");\n" name;
2739 pr " if (ctx->hdr.status == GUESTFS_STATUS_ERROR) {\n";
2740 pr " if (!xdr_guestfs_message_error (xdr, &ctx->err)) {\n";
2741 pr " error (g, \"%%s: failed to parse reply error\", \"%s\");\n"
2748 (match fst style with
2751 failwithf "RConstString cannot be returned from a daemon function"
2753 | RBool _ | RString _ | RStringList _
2755 | RPVList _ | RVGList _ | RLVList _
2756 | RStat _ | RStatVFS _
2758 pr " if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name;
2759 pr " error (g, \"%%s: failed to parse reply\", \"%s\");\n" name;
2765 pr " ctx->cb_sequence = 1;\n";
2768 (* Generate the action stub. *)
2769 generate_prototype ~extern:false ~semicolon:false ~newline:true
2770 ~handle:"g" name style;
2773 match fst style with
2774 | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
2776 failwithf "RConstString cannot be returned from a daemon function"
2777 | RString _ | RStringList _ | RIntBool _
2778 | RPVList _ | RVGList _ | RLVList _
2779 | RStat _ | RStatVFS _
2785 (match snd style with
2787 | _ -> pr " struct %s_args args;\n" name
2790 pr " struct %s_ctx ctx;\n" shortname;
2791 pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
2792 pr " int serial;\n";
2794 pr " if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
2795 pr " guestfs_set_busy (g);\n";
2797 pr " memset (&ctx, 0, sizeof ctx);\n";
2800 (* Send the main header and arguments. *)
2801 (match snd style with
2803 pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s, NULL, NULL);\n"
2804 (String.uppercase shortname)
2809 pr " args.%s = (char *) %s;\n" n n
2811 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
2813 pr " args.%s.%s_val = (char **) %s;\n" n n n;
2814 pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
2816 pr " args.%s = %s;\n" n n
2818 pr " args.%s = %s;\n" n n
2819 | FileIn _ | FileOut _ -> ()
2821 pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s,\n"
2822 (String.uppercase shortname);
2823 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
2826 pr " if (serial == -1) {\n";
2827 pr " guestfs_set_ready (g);\n";
2828 pr " return %s;\n" error_code;
2832 (* Send any additional files (FileIn) requested. *)
2833 let need_read_reply_label = ref false in
2840 pr " r = guestfs__send_file_sync (g, %s);\n" n;
2841 pr " if (r == -1) {\n";
2842 pr " guestfs_set_ready (g);\n";
2843 pr " return %s;\n" error_code;
2845 pr " if (r == -2) /* daemon cancelled */\n";
2846 pr " goto read_reply;\n";
2847 need_read_reply_label := true;
2853 (* Wait for the reply from the remote end. *)
2854 if !need_read_reply_label then pr " read_reply:\n";
2855 pr " guestfs__switch_to_receiving (g);\n";
2856 pr " ctx.cb_sequence = 0;\n";
2857 pr " guestfs_set_reply_callback (g, %s_reply_cb, &ctx);\n" shortname;
2858 pr " (void) ml->main_loop_run (ml, g);\n";
2859 pr " guestfs_set_reply_callback (g, NULL, NULL);\n";
2860 pr " if (ctx.cb_sequence != 1) {\n";
2861 pr " error (g, \"%%s reply failed, see earlier error messages\", \"%s\");\n" name;
2862 pr " guestfs_set_ready (g);\n";
2863 pr " return %s;\n" error_code;
2867 pr " if (check_reply_header (g, &ctx.hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
2868 (String.uppercase shortname);
2869 pr " guestfs_set_ready (g);\n";
2870 pr " return %s;\n" error_code;
2874 pr " if (ctx.hdr.status == GUESTFS_STATUS_ERROR) {\n";
2875 pr " error (g, \"%%s\", ctx.err.error_message);\n";
2876 pr " guestfs_set_ready (g);\n";
2877 pr " return %s;\n" error_code;
2881 (* Expecting to receive further files (FileOut)? *)
2885 pr " if (guestfs__receive_file_sync (g, %s) == -1) {\n" n;
2886 pr " guestfs_set_ready (g);\n";
2887 pr " return %s;\n" error_code;
2893 pr " guestfs_set_ready (g);\n";
2895 (match fst style with
2896 | RErr -> pr " return 0;\n"
2897 | RInt n | RInt64 n | RBool n ->
2898 pr " return ctx.ret.%s;\n" n
2900 failwithf "RConstString cannot be returned from a daemon function"
2902 pr " return ctx.ret.%s; /* caller will free */\n" n
2903 | RStringList n | RHashtable n ->
2904 pr " /* caller will free this, but we need to add a NULL entry */\n";
2905 pr " ctx.ret.%s.%s_val =\n" n n;
2906 pr " safe_realloc (g, ctx.ret.%s.%s_val,\n" n n;
2907 pr " sizeof (char *) * (ctx.ret.%s.%s_len + 1));\n"
2909 pr " ctx.ret.%s.%s_val[ctx.ret.%s.%s_len] = NULL;\n" n n n n;
2910 pr " return ctx.ret.%s.%s_val;\n" n n
2912 pr " /* caller with free this */\n";
2913 pr " return safe_memdup (g, &ctx.ret, sizeof (ctx.ret));\n"
2914 | RPVList n | RVGList n | RLVList n
2915 | RStat n | RStatVFS n ->
2916 pr " /* caller will free this */\n";
2917 pr " return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n
2923 (* Generate daemon/actions.h. *)
2924 and generate_daemon_actions_h () =
2925 generate_header CStyle GPLv2;
2927 pr "#include \"../src/guestfs_protocol.h\"\n";
2931 fun (name, style, _, _, _, _, _) ->
2933 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
2937 (* Generate the server-side stubs. *)
2938 and generate_daemon_actions () =
2939 generate_header CStyle GPLv2;
2941 pr "#include <config.h>\n";
2943 pr "#include <stdio.h>\n";
2944 pr "#include <stdlib.h>\n";
2945 pr "#include <string.h>\n";
2946 pr "#include <inttypes.h>\n";
2947 pr "#include <ctype.h>\n";
2948 pr "#include <rpc/types.h>\n";
2949 pr "#include <rpc/xdr.h>\n";
2951 pr "#include \"daemon.h\"\n";
2952 pr "#include \"../src/guestfs_protocol.h\"\n";
2953 pr "#include \"actions.h\"\n";
2957 fun (name, style, _, _, _, _, _) ->
2958 (* Generate server-side stubs. *)
2959 pr "static void %s_stub (XDR *xdr_in)\n" name;
2962 match fst style with
2963 | RErr | RInt _ -> pr " int r;\n"; "-1"
2964 | RInt64 _ -> pr " int64_t r;\n"; "-1"
2965 | RBool _ -> pr " int r;\n"; "-1"
2967 failwithf "RConstString cannot be returned from a daemon function"
2968 | RString _ -> pr " char *r;\n"; "NULL"
2969 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
2970 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
2971 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
2972 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
2973 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL"
2974 | RStat _ -> pr " guestfs_int_stat *r;\n"; "NULL"
2975 | RStatVFS _ -> pr " guestfs_int_statvfs *r;\n"; "NULL" in
2977 (match snd style with
2980 pr " struct guestfs_%s_args args;\n" name;
2984 | OptString n -> pr " const char *%s;\n" n
2985 | StringList n -> pr " char **%s;\n" n
2986 | Bool n -> pr " int %s;\n" n
2987 | Int n -> pr " int %s;\n" n
2988 | FileIn _ | FileOut _ -> ()
2993 (match snd style with
2996 pr " memset (&args, 0, sizeof args);\n";
2998 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
2999 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
3004 | String n -> pr " %s = args.%s;\n" n n
3005 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
3007 pr " %s = realloc (args.%s.%s_val,\n" n n n;
3008 pr " sizeof (char *) * (args.%s.%s_len+1));\n" n n;
3009 pr " if (%s == NULL) {\n" n;
3010 pr " reply_with_perror (\"realloc\");\n";
3013 pr " %s[args.%s.%s_len] = NULL;\n" n n n;
3014 pr " args.%s.%s_val = %s;\n" n n n;
3015 | Bool n -> pr " %s = args.%s;\n" n n
3016 | Int n -> pr " %s = args.%s;\n" n n
3017 | FileIn _ | FileOut _ -> ()
3022 (* Don't want to call the impl with any FileIn or FileOut
3023 * parameters, since these go "outside" the RPC protocol.
3026 List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
3028 pr " r = do_%s " name;
3029 generate_call_args argsnofile;
3032 pr " if (r == %s)\n" error_code;
3033 pr " /* do_%s has already called reply_with_error */\n" name;
3037 (* If there are any FileOut parameters, then the impl must
3038 * send its own reply.
3041 List.exists (function FileOut _ -> true | _ -> false) (snd style) in
3043 pr " /* do_%s has already sent a reply */\n" name
3045 match fst style with
3046 | RErr -> pr " reply (NULL, NULL);\n"
3047 | RInt n | RInt64 n | RBool n ->
3048 pr " struct guestfs_%s_ret ret;\n" name;
3049 pr " ret.%s = r;\n" n;
3050 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
3053 failwithf "RConstString cannot be returned from a daemon function"
3055 pr " struct guestfs_%s_ret ret;\n" name;
3056 pr " ret.%s = r;\n" n;
3057 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
3060 | RStringList n | RHashtable n ->
3061 pr " struct guestfs_%s_ret ret;\n" name;
3062 pr " ret.%s.%s_len = count_strings (r);\n" n n;
3063 pr " ret.%s.%s_val = r;\n" n n;
3064 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
3066 pr " free_strings (r);\n"
3068 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n"
3070 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
3071 | RPVList n | RVGList n | RLVList n
3072 | RStat n | RStatVFS n ->
3073 pr " struct guestfs_%s_ret ret;\n" name;
3074 pr " ret.%s = *r;\n" n;
3075 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
3077 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
3081 (* Free the args. *)
3082 (match snd style with
3087 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
3094 (* Dispatch function. *)
3095 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
3097 pr " switch (proc_nr) {\n";
3100 fun (name, style, _, _, _, _, _) ->
3101 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
3102 pr " %s_stub (xdr_in);\n" name;
3107 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
3112 (* LVM columns and tokenization functions. *)
3113 (* XXX This generates crap code. We should rethink how we
3119 pr "static const char *lvm_%s_cols = \"%s\";\n"
3120 typ (String.concat "," (List.map fst cols));
3123 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
3125 pr " char *tok, *p, *next;\n";
3129 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
3132 pr " if (!str) {\n";
3133 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
3136 pr " if (!*str || isspace (*str)) {\n";
3137 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
3142 fun (name, coltype) ->
3143 pr " if (!tok) {\n";
3144 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
3147 pr " p = strchrnul (tok, ',');\n";
3148 pr " if (*p) next = p+1; else next = NULL;\n";
3149 pr " *p = '\\0';\n";
3152 pr " r->%s = strdup (tok);\n" name;
3153 pr " if (r->%s == NULL) {\n" name;
3154 pr " perror (\"strdup\");\n";
3158 pr " for (i = j = 0; i < 32; ++j) {\n";
3159 pr " if (tok[j] == '\\0') {\n";
3160 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
3162 pr " } else if (tok[j] != '-')\n";
3163 pr " r->%s[i++] = tok[j];\n" name;
3166 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
3167 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
3171 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
3172 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
3176 pr " if (tok[0] == '\\0')\n";
3177 pr " r->%s = -1;\n" name;
3178 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
3179 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
3183 pr " tok = next;\n";
3186 pr " if (tok != NULL) {\n";
3187 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
3194 pr "guestfs_lvm_int_%s_list *\n" typ;
3195 pr "parse_command_line_%ss (void)\n" typ;
3197 pr " char *out, *err;\n";
3198 pr " char *p, *pend;\n";
3200 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
3201 pr " void *newp;\n";
3203 pr " ret = malloc (sizeof *ret);\n";
3204 pr " if (!ret) {\n";
3205 pr " reply_with_perror (\"malloc\");\n";
3206 pr " return NULL;\n";
3209 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
3210 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
3212 pr " r = command (&out, &err,\n";
3213 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
3214 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
3215 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
3216 pr " if (r == -1) {\n";
3217 pr " reply_with_error (\"%%s\", err);\n";
3218 pr " free (out);\n";
3219 pr " free (err);\n";
3220 pr " free (ret);\n";
3221 pr " return NULL;\n";
3224 pr " free (err);\n";
3226 pr " /* Tokenize each line of the output. */\n";
3229 pr " while (p) {\n";
3230 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
3231 pr " if (pend) {\n";
3232 pr " *pend = '\\0';\n";
3236 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
3239 pr " if (!*p) { /* Empty line? Skip it. */\n";
3244 pr " /* Allocate some space to store this next entry. */\n";
3245 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
3246 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
3247 pr " if (newp == NULL) {\n";
3248 pr " reply_with_perror (\"realloc\");\n";
3249 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
3250 pr " free (ret);\n";
3251 pr " free (out);\n";
3252 pr " return NULL;\n";
3254 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
3256 pr " /* Tokenize the next entry. */\n";
3257 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
3258 pr " if (r == -1) {\n";
3259 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
3260 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
3261 pr " free (ret);\n";
3262 pr " free (out);\n";
3263 pr " return NULL;\n";
3270 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
3272 pr " free (out);\n";
3273 pr " return ret;\n";
3276 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
3278 (* Generate the tests. *)
3279 and generate_tests () =
3280 generate_header CStyle GPLv2;
3287 #include <sys/types.h>
3290 #include \"guestfs.h\"
3292 static guestfs_h *g;
3293 static int suppress_error = 0;
3295 /* This will be 's' or 'h' depending on whether the guest kernel
3296 * names IDE devices /dev/sd* or /dev/hd*.
3298 static char devchar = 's';
3300 static void print_error (guestfs_h *g, void *data, const char *msg)
3302 if (!suppress_error)
3303 fprintf (stderr, \"%%s\\n\", msg);
3306 static void print_strings (char * const * const argv)
3310 for (argc = 0; argv[argc] != NULL; ++argc)
3311 printf (\"\\t%%s\\n\", argv[argc]);
3315 static void print_table (char * const * const argv)
3319 for (i = 0; argv[i] != NULL; i += 2)
3320 printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
3324 static void no_test_warnings (void)
3330 | name, _, _, _, [], _, _ ->
3331 pr " fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
3332 | name, _, _, _, tests, _, _ -> ()
3338 (* Generate the actual tests. Note that we generate the tests
3339 * in reverse order, deliberately, so that (in general) the
3340 * newest tests run first. This makes it quicker and easier to
3345 fun (name, _, _, _, tests, _, _) ->
3346 mapi (generate_one_test name) tests
3347 ) (List.rev all_functions) in
3348 let test_names = List.concat test_names in
3349 let nr_tests = List.length test_names in
3352 int main (int argc, char *argv[])
3357 const char *filename;
3359 int nr_tests, test_num = 0;
3362 no_test_warnings ();
3364 g = guestfs_create ();
3366 printf (\"guestfs_create FAILED\\n\");
3370 guestfs_set_error_handler (g, print_error, NULL);
3372 srcdir = getenv (\"srcdir\");
3373 if (!srcdir) srcdir = \".\";
3375 guestfs_set_path (g, \".\");
3377 filename = \"test1.img\";
3378 fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
3383 if (lseek (fd, %d, SEEK_SET) == -1) {
3389 if (write (fd, &c, 1) == -1) {
3395 if (close (fd) == -1) {
3400 if (guestfs_add_drive (g, filename) == -1) {
3401 printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
3405 filename = \"test2.img\";
3406 fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
3411 if (lseek (fd, %d, SEEK_SET) == -1) {
3417 if (write (fd, &c, 1) == -1) {
3423 if (close (fd) == -1) {
3428 if (guestfs_add_drive (g, filename) == -1) {
3429 printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
3433 filename = \"test3.img\";
3434 fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
3439 if (lseek (fd, %d, SEEK_SET) == -1) {
3445 if (write (fd, &c, 1) == -1) {
3451 if (close (fd) == -1) {
3456 if (guestfs_add_drive (g, filename) == -1) {
3457 printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
3461 if (guestfs_launch (g) == -1) {
3462 printf (\"guestfs_launch FAILED\\n\");
3465 if (guestfs_wait_ready (g) == -1) {
3466 printf (\"guestfs_wait_ready FAILED\\n\");
3470 /* Detect if the appliance uses /dev/sd* or /dev/hd* in device
3471 * names. This changed between RHEL 5 and RHEL 6 so we have to
3474 devs = guestfs_list_devices (g);
3475 if (devs == NULL || devs[0] == NULL) {
3476 printf (\"guestfs_list_devices FAILED\\n\");
3479 if (strncmp (devs[0], \"/dev/sd\", 7) == 0)
3481 else if (strncmp (devs[0], \"/dev/hd\", 7) == 0)
3484 printf (\"guestfs_list_devices returned unexpected string '%%s'\\n\",
3488 for (i = 0; devs[i] != NULL; ++i)
3494 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
3498 pr " test_num++;\n";
3499 pr " printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
3500 pr " if (%s () == -1) {\n" test_name;
3501 pr " printf (\"%s FAILED\\n\");\n" test_name;
3507 pr " guestfs_close (g);\n";
3508 pr " unlink (\"test1.img\");\n";
3509 pr " unlink (\"test2.img\");\n";
3510 pr " unlink (\"test3.img\");\n";
3513 pr " if (failed > 0) {\n";
3514 pr " printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n";
3522 and generate_one_test name i (init, test) =
3523 let test_name = sprintf "test_%s_%d" name i in
3525 pr "static int %s (void)\n" test_name;
3531 pr " /* InitEmpty for %s (%d) */\n" name i;
3532 List.iter (generate_test_command_call test_name)
3533 [["blockdev_setrw"; "/dev/sda"];
3537 pr " /* InitBasicFS for %s (%d): create ext2 on /dev/sda1 */\n" name i;
3538 List.iter (generate_test_command_call test_name)
3539 [["blockdev_setrw"; "/dev/sda"];
3542 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
3543 ["mkfs"; "ext2"; "/dev/sda1"];
3544 ["mount"; "/dev/sda1"; "/"]]
3545 | InitBasicFSonLVM ->
3546 pr " /* InitBasicFSonLVM for %s (%d): create ext2 on /dev/VG/LV */\n"
3548 List.iter (generate_test_command_call test_name)
3549 [["blockdev_setrw"; "/dev/sda"];
3552 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
3553 ["pvcreate"; "/dev/sda1"];
3554 ["vgcreate"; "VG"; "/dev/sda1"];
3555 ["lvcreate"; "LV"; "VG"; "8"];
3556 ["mkfs"; "ext2"; "/dev/VG/LV"];
3557 ["mount"; "/dev/VG/LV"; "/"]]
3560 let get_seq_last = function
3562 failwithf "%s: you cannot use [] (empty list) when expecting a command"
3565 let seq = List.rev seq in
3566 List.rev (List.tl seq), List.hd seq
3571 pr " /* TestRun for %s (%d) */\n" name i;
3572 List.iter (generate_test_command_call test_name) seq
3573 | TestOutput (seq, expected) ->
3574 pr " /* TestOutput for %s (%d) */\n" name i;
3575 pr " char expected[] = \"%s\";\n" (c_quote expected);
3576 if String.length expected > 7 &&
3577 String.sub expected 0 7 = "/dev/sd" then
3578 pr " expected[5] = devchar;\n";
3579 let seq, last = get_seq_last seq in
3581 pr " if (strcmp (r, expected) != 0) {\n";
3582 pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
3586 List.iter (generate_test_command_call test_name) seq;
3587 generate_test_command_call ~test test_name last
3588 | TestOutputList (seq, expected) ->
3589 pr " /* TestOutputList for %s (%d) */\n" name i;
3590 let seq, last = get_seq_last seq in
3594 pr " if (!r[%d]) {\n" i;
3595 pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
3596 pr " print_strings (r);\n";
3600 pr " char expected[] = \"%s\";\n" (c_quote str);
3601 if String.length str > 7 && String.sub str 0 7 = "/dev/sd" then
3602 pr " expected[5] = devchar;\n";
3603 pr " if (strcmp (r[%d], expected) != 0) {\n" i;
3604 pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
3609 pr " if (r[%d] != NULL) {\n" (List.length expected);
3610 pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
3612 pr " print_strings (r);\n";
3616 List.iter (generate_test_command_call test_name) seq;
3617 generate_test_command_call ~test test_name last
3618 | TestOutputInt (seq, expected) ->
3619 pr " /* TestOutputInt for %s (%d) */\n" name i;
3620 let seq, last = get_seq_last seq in
3622 pr " if (r != %d) {\n" expected;
3623 pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\","
3629 List.iter (generate_test_command_call test_name) seq;
3630 generate_test_command_call ~test test_name last
3631 | TestOutputTrue seq ->
3632 pr " /* TestOutputTrue for %s (%d) */\n" name i;
3633 let seq, last = get_seq_last seq in
3636 pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n"
3641 List.iter (generate_test_command_call test_name) seq;
3642 generate_test_command_call ~test test_name last
3643 | TestOutputFalse seq ->
3644 pr " /* TestOutputFalse for %s (%d) */\n" name i;
3645 let seq, last = get_seq_last seq in
3648 pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n"
3653 List.iter (generate_test_command_call test_name) seq;
3654 generate_test_command_call ~test test_name last
3655 | TestOutputLength (seq, expected) ->
3656 pr " /* TestOutputLength for %s (%d) */\n" name i;
3657 let seq, last = get_seq_last seq in
3660 pr " for (j = 0; j < %d; ++j)\n" expected;
3661 pr " if (r[j] == NULL) {\n";
3662 pr " fprintf (stderr, \"%s: short list returned\\n\");\n"
3664 pr " print_strings (r);\n";
3667 pr " if (r[j] != NULL) {\n";
3668 pr " fprintf (stderr, \"%s: long list returned\\n\");\n"
3670 pr " print_strings (r);\n";
3674 List.iter (generate_test_command_call test_name) seq;
3675 generate_test_command_call ~test test_name last
3676 | TestOutputStruct (seq, checks) ->
3677 pr " /* TestOutputStruct for %s (%d) */\n" name i;
3678 let seq, last = get_seq_last seq in
3682 | CompareWithInt (field, expected) ->
3683 pr " if (r->%s != %d) {\n" field expected;
3684 pr " fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
3685 test_name field expected;
3686 pr " (int) r->%s);\n" field;
3689 | CompareWithString (field, expected) ->
3690 pr " if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
3691 pr " fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
3692 test_name field expected;
3693 pr " r->%s);\n" field;
3696 | CompareFieldsIntEq (field1, field2) ->
3697 pr " if (r->%s != r->%s) {\n" field1 field2;
3698 pr " fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
3699 test_name field1 field2;
3700 pr " (int) r->%s, (int) r->%s);\n" field1 field2;
3703 | CompareFieldsStrEq (field1, field2) ->
3704 pr " if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
3705 pr " fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
3706 test_name field1 field2;
3707 pr " r->%s, r->%s);\n" field1 field2;
3712 List.iter (generate_test_command_call test_name) seq;
3713 generate_test_command_call ~test test_name last
3714 | TestLastFail seq ->
3715 pr " /* TestLastFail for %s (%d) */\n" name i;
3716 let seq, last = get_seq_last seq in
3717 List.iter (generate_test_command_call test_name) seq;
3718 generate_test_command_call test_name ~expect_error:true last
3726 (* Generate the code to run a command, leaving the result in 'r'.
3727 * If you expect to get an error then you should set expect_error:true.
3729 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
3731 | [] -> assert false
3733 (* Look up the command to find out what args/ret it has. *)
3736 let _, style, _, _, _, _, _ =
3737 List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
3740 failwithf "%s: in test, command %s was not found" test_name name in
3742 if List.length (snd style) <> List.length args then
3743 failwithf "%s: in test, wrong number of args given to %s"
3750 | OptString n, "NULL" -> ()
3752 | OptString n, arg ->
3753 pr " char %s[] = \"%s\";\n" n (c_quote arg);
3754 if String.length arg > 7 && String.sub arg 0 7 = "/dev/sd" then
3755 pr " %s[5] = devchar;\n" n
3758 | FileIn _, _ | FileOut _, _ -> ()
3759 | StringList n, arg ->
3760 let strs = string_split " " arg in
3763 pr " char %s_%d[] = \"%s\";\n" n i (c_quote str);
3764 if String.length str > 7 && String.sub str 0 7 = "/dev/sd" then
3765 pr " %s_%d[5] = devchar;\n" n i
3767 pr " char *%s[] = {\n" n;
3769 fun i _ -> pr " %s_%d,\n" n i
3773 ) (List.combine (snd style) args);
3776 match fst style with
3777 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
3778 | RInt64 _ -> pr " int64_t r;\n"; "-1"
3779 | RConstString _ -> pr " const char *r;\n"; "NULL"
3780 | RString _ -> pr " char *r;\n"; "NULL"
3781 | RStringList _ | RHashtable _ ->
3786 pr " struct guestfs_int_bool *r;\n"; "NULL"
3788 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
3790 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
3792 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
3794 pr " struct guestfs_stat *r;\n"; "NULL"
3796 pr " struct guestfs_statvfs *r;\n"; "NULL" in
3798 pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
3799 pr " r = guestfs_%s (g" name;
3801 (* Generate the parameters. *)
3804 | OptString _, "NULL" -> pr ", NULL"
3808 | FileIn _, arg | FileOut _, arg ->
3809 pr ", \"%s\"" (c_quote arg)
3810 | StringList n, _ ->
3814 try int_of_string arg
3815 with Failure "int_of_string" ->
3816 failwithf "%s: expecting an int, but got '%s'" test_name arg in
3819 let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
3820 ) (List.combine (snd style) args);
3823 if not expect_error then
3824 pr " if (r == %s)\n" error_code
3826 pr " if (r != %s)\n" error_code;
3829 (* Insert the test code. *)
3835 (match fst style with
3836 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ -> ()
3837 | RString _ -> pr " free (r);\n"
3838 | RStringList _ | RHashtable _ ->
3839 pr " for (i = 0; r[i] != NULL; ++i)\n";
3840 pr " free (r[i]);\n";
3843 pr " guestfs_free_int_bool (r);\n"
3845 pr " guestfs_free_lvm_pv_list (r);\n"
3847 pr " guestfs_free_lvm_vg_list (r);\n"
3849 pr " guestfs_free_lvm_lv_list (r);\n"
3850 | RStat _ | RStatVFS _ ->
3857 let str = replace_str str "\r" "\\r" in
3858 let str = replace_str str "\n" "\\n" in
3859 let str = replace_str str "\t" "\\t" in
3860 let str = replace_str str "\000" "\\0" in
3863 (* Generate a lot of different functions for guestfish. *)
3864 and generate_fish_cmds () =
3865 generate_header CStyle GPLv2;
3869 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3871 let all_functions_sorted =
3873 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3874 ) all_functions_sorted in
3876 pr "#include <stdio.h>\n";
3877 pr "#include <stdlib.h>\n";
3878 pr "#include <string.h>\n";
3879 pr "#include <inttypes.h>\n";
3881 pr "#include <guestfs.h>\n";
3882 pr "#include \"fish.h\"\n";
3885 (* list_commands function, which implements guestfish -h *)
3886 pr "void list_commands (void)\n";
3888 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
3889 pr " list_builtin_commands ();\n";
3891 fun (name, _, _, flags, _, shortdesc, _) ->
3892 let name = replace_char name '_' '-' in
3893 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
3895 ) all_functions_sorted;
3896 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
3900 (* display_command function, which implements guestfish -h cmd *)
3901 pr "void display_command (const char *cmd)\n";
3904 fun (name, style, _, flags, _, shortdesc, longdesc) ->
3905 let name2 = replace_char name '_' '-' in
3907 try find_map (function FishAlias n -> Some n | _ -> None) flags
3908 with Not_found -> name in
3909 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
3911 match snd style with
3915 name2 (String.concat "> <" (List.map name_of_argt args)) in
3918 if List.mem ProtocolLimitWarning flags then
3919 ("\n\n" ^ protocol_limit_warning)
3922 (* For DangerWillRobinson commands, we should probably have
3923 * guestfish prompt before allowing you to use them (especially
3924 * in interactive mode). XXX
3928 if List.mem DangerWillRobinson flags then
3929 ("\n\n" ^ danger_will_robinson)
3932 let describe_alias =
3933 if name <> alias then
3934 sprintf "\n\nYou can use '%s' as an alias for this command." alias
3938 pr "strcasecmp (cmd, \"%s\") == 0" name;
3939 if name <> name2 then
3940 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
3941 if name <> alias then
3942 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
3944 pr " pod2text (\"%s - %s\", %S);\n"
3946 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
3949 pr " display_builtin_command (cmd);\n";
3953 (* print_{pv,vg,lv}_list functions *)
3957 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
3964 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
3966 pr " printf (\"%s: \");\n" name;
3967 pr " for (i = 0; i < 32; ++i)\n";
3968 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
3969 pr " printf (\"\\n\");\n"
3971 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
3973 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
3974 | name, `OptPercent ->
3975 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
3976 typ name name typ name;
3977 pr " else printf (\"%s: \\n\");\n" name
3981 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
3986 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
3987 pr " print_%s (&%ss->val[i]);\n" typ typ;
3990 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3992 (* print_{stat,statvfs} functions *)
3996 pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
4001 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
4005 ) ["stat", stat_cols; "statvfs", statvfs_cols];
4007 (* run_<action> actions *)
4009 fun (name, style, _, flags, _, _, _) ->
4010 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
4012 (match fst style with
4015 | RBool _ -> pr " int r;\n"
4016 | RInt64 _ -> pr " int64_t r;\n"
4017 | RConstString _ -> pr " const char *r;\n"
4018 | RString _ -> pr " char *r;\n"
4019 | RStringList _ | RHashtable _ -> pr " char **r;\n"
4020 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
4021 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
4022 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
4023 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
4024 | RStat _ -> pr " struct guestfs_stat *r;\n"
4025 | RStatVFS _ -> pr " struct guestfs_statvfs *r;\n"
4032 | FileOut n -> pr " const char *%s;\n" n
4033 | StringList n -> pr " char **%s;\n" n
4034 | Bool n -> pr " int %s;\n" n
4035 | Int n -> pr " int %s;\n" n
4038 (* Check and convert parameters. *)
4039 let argc_expected = List.length (snd style) in
4040 pr " if (argc != %d) {\n" argc_expected;
4041 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
4043 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
4049 | String name -> pr " %s = argv[%d];\n" name i
4051 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
4054 pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdin\";\n"
4057 pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n"
4059 | StringList name ->
4060 pr " %s = parse_string_list (argv[%d]);\n" name i
4062 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
4064 pr " %s = atoi (argv[%d]);\n" name i
4067 (* Call C API function. *)
4069 try find_map (function FishAction n -> Some n | _ -> None) flags
4070 with Not_found -> sprintf "guestfs_%s" name in
4072 generate_call_args ~handle:"g" (snd style);
4075 (* Check return value for errors and display command results. *)
4076 (match fst style with
4077 | RErr -> pr " return r;\n"
4079 pr " if (r == -1) return -1;\n";
4080 pr " printf (\"%%d\\n\", r);\n";
4083 pr " if (r == -1) return -1;\n";
4084 pr " printf (\"%%\" PRIi64 \"\\n\", r);\n";
4087 pr " if (r == -1) return -1;\n";
4088 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
4091 pr " if (r == NULL) return -1;\n";
4092 pr " printf (\"%%s\\n\", r);\n";
4095 pr " if (r == NULL) return -1;\n";
4096 pr " printf (\"%%s\\n\", r);\n";
4100 pr " if (r == NULL) return -1;\n";
4101 pr " print_strings (r);\n";
4102 pr " free_strings (r);\n";
4105 pr " if (r == NULL) return -1;\n";
4106 pr " printf (\"%%d, %%s\\n\", r->i,\n";
4107 pr " r->b ? \"true\" : \"false\");\n";
4108 pr " guestfs_free_int_bool (r);\n";
4111 pr " if (r == NULL) return -1;\n";
4112 pr " print_pv_list (r);\n";
4113 pr " guestfs_free_lvm_pv_list (r);\n";
4116 pr " if (r == NULL) return -1;\n";
4117 pr " print_vg_list (r);\n";
4118 pr " guestfs_free_lvm_vg_list (r);\n";
4121 pr " if (r == NULL) return -1;\n";
4122 pr " print_lv_list (r);\n";
4123 pr " guestfs_free_lvm_lv_list (r);\n";
4126 pr " if (r == NULL) return -1;\n";
4127 pr " print_stat (r);\n";
4131 pr " if (r == NULL) return -1;\n";
4132 pr " print_statvfs (r);\n";
4136 pr " if (r == NULL) return -1;\n";
4137 pr " print_table (r);\n";
4138 pr " free_strings (r);\n";
4145 (* run_action function *)
4146 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
4149 fun (name, _, _, flags, _, _, _) ->
4150 let name2 = replace_char name '_' '-' in
4152 try find_map (function FishAlias n -> Some n | _ -> None) flags
4153 with Not_found -> name in
4155 pr "strcasecmp (cmd, \"%s\") == 0" name;
4156 if name <> name2 then
4157 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
4158 if name <> alias then
4159 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
4161 pr " return run_%s (cmd, argc, argv);\n" name;
4165 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
4172 (* Readline completion for guestfish. *)
4173 and generate_fish_completion () =
4174 generate_header CStyle GPLv2;
4178 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
4188 #ifdef HAVE_LIBREADLINE
4189 #include <readline/readline.h>
4194 #ifdef HAVE_LIBREADLINE
4196 static const char *const commands[] = {
4199 (* Get the commands and sort them, including the aliases. *)
4202 fun (name, _, _, flags, _, _, _) ->
4203 let name2 = replace_char name '_' '-' in
4205 try find_map (function FishAlias n -> Some n | _ -> None) flags
4206 with Not_found -> name in
4208 if name <> alias then [name2; alias] else [name2]
4210 let commands = List.flatten commands in
4211 let commands = List.sort compare commands in
4213 List.iter (pr " \"%s\",\n") commands;
4219 generator (const char *text, int state)
4221 static int index, len;
4226 len = strlen (text);
4229 while ((name = commands[index]) != NULL) {
4231 if (strncasecmp (name, text, len) == 0)
4232 return strdup (name);
4238 #endif /* HAVE_LIBREADLINE */
4240 char **do_completion (const char *text, int start, int end)
4242 char **matches = NULL;
4244 #ifdef HAVE_LIBREADLINE
4246 matches = rl_completion_matches (text, generator);
4253 (* Generate the POD documentation for guestfish. *)
4254 and generate_fish_actions_pod () =
4255 let all_functions_sorted =
4257 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
4258 ) all_functions_sorted in
4260 let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
4263 fun (name, style, _, flags, _, _, longdesc) ->
4265 Str.global_substitute rex (
4268 try Str.matched_group 1 s
4270 failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
4271 "C<" ^ replace_char sub '_' '-' ^ ">"
4273 let name = replace_char name '_' '-' in
4275 try find_map (function FishAlias n -> Some n | _ -> None) flags
4276 with Not_found -> name in
4278 pr "=head2 %s" name;
4279 if name <> alias then
4286 | String n -> pr " %s" n
4287 | OptString n -> pr " %s" n
4288 | StringList n -> pr " '%s ...'" n
4289 | Bool _ -> pr " true|false"
4290 | Int n -> pr " %s" n
4291 | FileIn n | FileOut n -> pr " (%s|-)" n
4295 pr "%s\n\n" longdesc;
4297 if List.exists (function FileIn _ | FileOut _ -> true
4298 | _ -> false) (snd style) then
4299 pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
4301 if List.mem ProtocolLimitWarning flags then
4302 pr "%s\n\n" protocol_limit_warning;
4304 if List.mem DangerWillRobinson flags then
4305 pr "%s\n\n" danger_will_robinson
4306 ) all_functions_sorted
4308 (* Generate a C function prototype. *)
4309 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
4310 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
4312 ?handle name style =
4313 if extern then pr "extern ";
4314 if static then pr "static ";
4315 (match fst style with
4317 | RInt _ -> pr "int "
4318 | RInt64 _ -> pr "int64_t "
4319 | RBool _ -> pr "int "
4320 | RConstString _ -> pr "const char *"
4321 | RString _ -> pr "char *"
4322 | RStringList _ | RHashtable _ -> pr "char **"
4324 if not in_daemon then pr "struct guestfs_int_bool *"
4325 else pr "guestfs_%s_ret *" name
4327 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
4328 else pr "guestfs_lvm_int_pv_list *"
4330 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
4331 else pr "guestfs_lvm_int_vg_list *"
4333 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
4334 else pr "guestfs_lvm_int_lv_list *"
4336 if not in_daemon then pr "struct guestfs_stat *"
4337 else pr "guestfs_int_stat *"
4339 if not in_daemon then pr "struct guestfs_statvfs *"
4340 else pr "guestfs_int_statvfs *"
4342 pr "%s%s (" prefix name;
4343 if handle = None && List.length (snd style) = 0 then
4346 let comma = ref false in
4349 | Some handle -> pr "guestfs_h *%s" handle; comma := true
4353 if single_line then pr ", " else pr ",\n\t\t"
4360 | OptString n -> next (); pr "const char *%s" n
4361 | StringList n -> next (); pr "char * const* const %s" n
4362 | Bool n -> next (); pr "int %s" n
4363 | Int n -> next (); pr "int %s" n
4366 if not in_daemon then (next (); pr "const char *%s" n)
4370 if semicolon then pr ";";
4371 if newline then pr "\n"
4373 (* Generate C call arguments, eg "(handle, foo, bar)" *)
4374 and generate_call_args ?handle args =
4376 let comma = ref false in
4379 | Some handle -> pr "%s" handle; comma := true
4383 if !comma then pr ", ";
4385 pr "%s" (name_of_argt arg)
4389 (* Generate the OCaml bindings interface. *)
4390 and generate_ocaml_mli () =
4391 generate_header OCamlStyle LGPLv2;
4394 (** For API documentation you should refer to the C API
4395 in the guestfs(3) manual page. The OCaml API uses almost
4396 exactly the same calls. *)
4399 (** A [guestfs_h] handle. *)
4401 exception Error of string
4402 (** This exception is raised when there is an error. *)
4404 val create : unit -> t
4406 val close : t -> unit
4407 (** Handles are closed by the garbage collector when they become
4408 unreferenced, but callers can also call this in order to
4409 provide predictable cleanup. *)
4412 generate_ocaml_lvm_structure_decls ();
4414 generate_ocaml_stat_structure_decls ();
4418 fun (name, style, _, _, _, shortdesc, _) ->
4419 generate_ocaml_prototype name style;
4420 pr "(** %s *)\n" shortdesc;
4424 (* Generate the OCaml bindings implementation. *)
4425 and generate_ocaml_ml () =
4426 generate_header OCamlStyle LGPLv2;
4430 exception Error of string
4431 external create : unit -> t = \"ocaml_guestfs_create\"
4432 external close : t -> unit = \"ocaml_guestfs_close\"
4435 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
4439 generate_ocaml_lvm_structure_decls ();
4441 generate_ocaml_stat_structure_decls ();
4445 fun (name, style, _, _, _, shortdesc, _) ->
4446 generate_ocaml_prototype ~is_external:true name style;
4449 (* Generate the OCaml bindings C implementation. *)
4450 and generate_ocaml_c () =
4451 generate_header CStyle LGPLv2;
4458 #include <caml/config.h>
4459 #include <caml/alloc.h>
4460 #include <caml/callback.h>
4461 #include <caml/fail.h>
4462 #include <caml/memory.h>
4463 #include <caml/mlvalues.h>
4464 #include <caml/signals.h>
4466 #include <guestfs.h>
4468 #include \"guestfs_c.h\"
4470 /* Copy a hashtable of string pairs into an assoc-list. We return
4471 * the list in reverse order, but hashtables aren't supposed to be
4474 static CAMLprim value
4475 copy_table (char * const * argv)
4478 CAMLlocal5 (rv, pairv, kv, vv, cons);
4482 for (i = 0; argv[i] != NULL; i += 2) {
4483 kv = caml_copy_string (argv[i]);
4484 vv = caml_copy_string (argv[i+1]);
4485 pairv = caml_alloc (2, 0);
4486 Store_field (pairv, 0, kv);
4487 Store_field (pairv, 1, vv);
4488 cons = caml_alloc (2, 0);
4489 Store_field (cons, 1, rv);
4491 Store_field (cons, 0, pairv);
4499 (* LVM struct copy functions. *)
4502 let has_optpercent_col =
4503 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
4505 pr "static CAMLprim value\n";
4506 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
4508 pr " CAMLparam0 ();\n";
4509 if has_optpercent_col then
4510 pr " CAMLlocal3 (rv, v, v2);\n"
4512 pr " CAMLlocal2 (rv, v);\n";
4514 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
4519 pr " v = caml_copy_string (%s->%s);\n" typ name
4521 pr " v = caml_alloc_string (32);\n";
4522 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
4525 pr " v = caml_copy_int64 (%s->%s);\n" typ name
4526 | name, `OptPercent ->
4527 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
4528 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
4529 pr " v = caml_alloc (1, 0);\n";
4530 pr " Store_field (v, 0, v2);\n";
4531 pr " } else /* None */\n";
4532 pr " v = Val_int (0);\n";
4534 pr " Store_field (rv, %d, v);\n" i
4536 pr " CAMLreturn (rv);\n";
4540 pr "static CAMLprim value\n";
4541 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
4544 pr " CAMLparam0 ();\n";
4545 pr " CAMLlocal2 (rv, v);\n";
4548 pr " if (%ss->len == 0)\n" typ;
4549 pr " CAMLreturn (Atom (0));\n";
4551 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
4552 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
4553 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
4554 pr " caml_modify (&Field (rv, i), v);\n";
4556 pr " CAMLreturn (rv);\n";
4560 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
4562 (* Stat copy functions. *)
4565 pr "static CAMLprim value\n";
4566 pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
4568 pr " CAMLparam0 ();\n";
4569 pr " CAMLlocal2 (rv, v);\n";
4571 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
4576 pr " v = caml_copy_int64 (%s->%s);\n" typ name
4578 pr " Store_field (rv, %d, v);\n" i
4580 pr " CAMLreturn (rv);\n";
4583 ) ["stat", stat_cols; "statvfs", statvfs_cols];
4587 fun (name, style, _, _, _, _, _) ->
4589 "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
4591 pr "CAMLprim value\n";
4592 pr "ocaml_guestfs_%s (value %s" name (List.hd params);
4593 List.iter (pr ", value %s") (List.tl params);
4598 | [p1; p2; p3; p4; p5] ->
4599 pr " CAMLparam5 (%s);\n" (String.concat ", " params)
4600 | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
4601 pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
4602 pr " CAMLxparam%d (%s);\n"
4603 (List.length rest) (String.concat ", " rest)
4605 pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
4607 pr " CAMLlocal1 (rv);\n";
4610 pr " guestfs_h *g = Guestfs_val (gv);\n";
4611 pr " if (g == NULL)\n";
4612 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
4620 pr " const char *%s = String_val (%sv);\n" n n
4622 pr " const char *%s =\n" n;
4623 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
4626 pr " char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
4628 pr " int %s = Bool_val (%sv);\n" n n
4630 pr " int %s = Int_val (%sv);\n" n n
4633 match fst style with
4634 | RErr -> pr " int r;\n"; "-1"
4635 | RInt _ -> pr " int r;\n"; "-1"
4636 | RInt64 _ -> pr " int64_t r;\n"; "-1"
4637 | RBool _ -> pr " int r;\n"; "-1"
4638 | RConstString _ -> pr " const char *r;\n"; "NULL"
4639 | RString _ -> pr " char *r;\n"; "NULL"
4645 pr " struct guestfs_int_bool *r;\n"; "NULL"
4647 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
4649 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
4651 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
4653 pr " struct guestfs_stat *r;\n"; "NULL"
4655 pr " struct guestfs_statvfs *r;\n"; "NULL"
4662 pr " caml_enter_blocking_section ();\n";
4663 pr " r = guestfs_%s " name;
4664 generate_call_args ~handle:"g" (snd style);
4666 pr " caml_leave_blocking_section ();\n";
4671 pr " ocaml_guestfs_free_strings (%s);\n" n;
4672 | String _ | OptString _ | Bool _ | Int _ | FileIn _ | FileOut _ -> ()
4675 pr " if (r == %s)\n" error_code;
4676 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
4679 (match fst style with
4680 | RErr -> pr " rv = Val_unit;\n"
4681 | RInt _ -> pr " rv = Val_int (r);\n"
4683 pr " rv = caml_copy_int64 (r);\n"
4684 | RBool _ -> pr " rv = Val_bool (r);\n"
4685 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
4687 pr " rv = caml_copy_string (r);\n";
4690 pr " rv = caml_copy_string_array ((const char **) r);\n";
4691 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
4694 pr " rv = caml_alloc (2, 0);\n";
4695 pr " Store_field (rv, 0, Val_int (r->i));\n";
4696 pr " Store_field (rv, 1, Val_bool (r->b));\n";
4697 pr " guestfs_free_int_bool (r);\n";
4699 pr " rv = copy_lvm_pv_list (r);\n";
4700 pr " guestfs_free_lvm_pv_list (r);\n";
4702 pr " rv = copy_lvm_vg_list (r);\n";
4703 pr " guestfs_free_lvm_vg_list (r);\n";
4705 pr " rv = copy_lvm_lv_list (r);\n";
4706 pr " guestfs_free_lvm_lv_list (r);\n";
4708 pr " rv = copy_stat (r);\n";
4711 pr " rv = copy_statvfs (r);\n";
4714 pr " rv = copy_table (r);\n";
4715 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
4719 pr " CAMLreturn (rv);\n";
4723 if List.length params > 5 then (
4724 pr "CAMLprim value\n";
4725 pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
4727 pr " return ocaml_guestfs_%s (argv[0]" name;
4728 iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
4735 and generate_ocaml_lvm_structure_decls () =
4738 pr "type lvm_%s = {\n" typ;
4741 | name, `String -> pr " %s : string;\n" name
4742 | name, `UUID -> pr " %s : string;\n" name
4743 | name, `Bytes -> pr " %s : int64;\n" name
4744 | name, `Int -> pr " %s : int64;\n" name
4745 | name, `OptPercent -> pr " %s : float option;\n" name
4749 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
4751 and generate_ocaml_stat_structure_decls () =
4754 pr "type %s = {\n" typ;
4757 | name, `Int -> pr " %s : int64;\n" name
4761 ) ["stat", stat_cols; "statvfs", statvfs_cols]
4763 and generate_ocaml_prototype ?(is_external = false) name style =
4764 if is_external then pr "external " else pr "val ";
4765 pr "%s : t -> " name;
4768 | String _ | FileIn _ | FileOut _ -> pr "string -> "
4769 | OptString _ -> pr "string option -> "
4770 | StringList _ -> pr "string array -> "
4771 | Bool _ -> pr "bool -> "
4772 | Int _ -> pr "int -> "
4774 (match fst style with
4775 | RErr -> pr "unit" (* all errors are turned into exceptions *)
4776 | RInt _ -> pr "int"
4777 | RInt64 _ -> pr "int64"
4778 | RBool _ -> pr "bool"
4779 | RConstString _ -> pr "string"
4780 | RString _ -> pr "string"
4781 | RStringList _ -> pr "string array"
4782 | RIntBool _ -> pr "int * bool"
4783 | RPVList _ -> pr "lvm_pv array"
4784 | RVGList _ -> pr "lvm_vg array"
4785 | RLVList _ -> pr "lvm_lv array"
4786 | RStat _ -> pr "stat"
4787 | RStatVFS _ -> pr "statvfs"
4788 | RHashtable _ -> pr "(string * string) list"
4790 if is_external then (
4792 if List.length (snd style) + 1 > 5 then
4793 pr "\"ocaml_guestfs_%s_byte\" " name;
4794 pr "\"ocaml_guestfs_%s\"" name
4798 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
4799 and generate_perl_xs () =
4800 generate_header CStyle LGPLv2;
4803 #include \"EXTERN.h\"
4807 #include <guestfs.h>
4810 #define PRId64 \"lld\"
4814 my_newSVll(long long val) {
4815 #ifdef USE_64_BIT_ALL
4816 return newSViv(val);
4820 len = snprintf(buf, 100, \"%%\" PRId64, val);
4821 return newSVpv(buf, len);
4826 #define PRIu64 \"llu\"
4830 my_newSVull(unsigned long long val) {
4831 #ifdef USE_64_BIT_ALL
4832 return newSVuv(val);
4836 len = snprintf(buf, 100, \"%%\" PRIu64, val);
4837 return newSVpv(buf, len);
4841 /* http://www.perlmonks.org/?node_id=680842 */
4843 XS_unpack_charPtrPtr (SV *arg) {
4848 if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
4849 croak (\"array reference expected\");
4851 av = (AV *)SvRV (arg);
4852 ret = malloc (av_len (av) + 1 + 1);
4854 croak (\"malloc failed\");
4856 for (i = 0; i <= av_len (av); i++) {
4857 SV **elem = av_fetch (av, i, 0);
4859 if (!elem || !*elem)
4860 croak (\"missing element in list\");
4862 ret[i] = SvPV_nolen (*elem);
4870 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
4877 RETVAL = guestfs_create ();
4879 croak (\"could not create guestfs handle\");
4880 guestfs_set_error_handler (RETVAL, NULL, NULL);
4893 fun (name, style, _, _, _, _, _) ->
4894 (match fst style with
4895 | RErr -> pr "void\n"
4896 | RInt _ -> pr "SV *\n"
4897 | RInt64 _ -> pr "SV *\n"
4898 | RBool _ -> pr "SV *\n"
4899 | RConstString _ -> pr "SV *\n"
4900 | RString _ -> pr "SV *\n"
4903 | RPVList _ | RVGList _ | RLVList _
4904 | RStat _ | RStatVFS _
4906 pr "void\n" (* all lists returned implictly on the stack *)
4908 (* Call and arguments. *)
4910 generate_call_args ~handle:"g" (snd style);
4912 pr " guestfs_h *g;\n";
4915 | String n | FileIn n | FileOut n -> pr " char *%s;\n" n
4916 | OptString n -> pr " char *%s;\n" n
4917 | StringList n -> pr " char **%s;\n" n
4918 | Bool n -> pr " int %s;\n" n
4919 | Int n -> pr " int %s;\n" n
4922 let do_cleanups () =
4925 | String _ | OptString _ | Bool _ | Int _
4926 | FileIn _ | FileOut _ -> ()
4927 | StringList n -> pr " free (%s);\n" n
4932 (match fst style with
4937 pr " r = guestfs_%s " name;
4938 generate_call_args ~handle:"g" (snd style);
4941 pr " if (r == -1)\n";
4942 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4948 pr " %s = guestfs_%s " n name;
4949 generate_call_args ~handle:"g" (snd style);
4952 pr " if (%s == -1)\n" n;
4953 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4954 pr " RETVAL = newSViv (%s);\n" n;
4959 pr " int64_t %s;\n" n;
4961 pr " %s = guestfs_%s " n name;
4962 generate_call_args ~handle:"g" (snd style);
4965 pr " if (%s == -1)\n" n;
4966 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4967 pr " RETVAL = my_newSVll (%s);\n" n;
4972 pr " const char *%s;\n" n;
4974 pr " %s = guestfs_%s " n name;
4975 generate_call_args ~handle:"g" (snd style);
4978 pr " if (%s == NULL)\n" n;
4979 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4980 pr " RETVAL = newSVpv (%s, 0);\n" n;
4985 pr " char *%s;\n" n;
4987 pr " %s = guestfs_%s " n name;
4988 generate_call_args ~handle:"g" (snd style);
4991 pr " if (%s == NULL)\n" n;
4992 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4993 pr " RETVAL = newSVpv (%s, 0);\n" n;
4994 pr " free (%s);\n" n;
4997 | RStringList n | RHashtable n ->
4999 pr " char **%s;\n" n;
5002 pr " %s = guestfs_%s " n name;
5003 generate_call_args ~handle:"g" (snd style);
5006 pr " if (%s == NULL)\n" n;
5007 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5008 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
5009 pr " EXTEND (SP, n);\n";
5010 pr " for (i = 0; i < n; ++i) {\n";
5011 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
5012 pr " free (%s[i]);\n" n;
5014 pr " free (%s);\n" n;
5017 pr " struct guestfs_int_bool *r;\n";
5019 pr " r = guestfs_%s " name;
5020 generate_call_args ~handle:"g" (snd style);
5023 pr " if (r == NULL)\n";
5024 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5025 pr " EXTEND (SP, 2);\n";
5026 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
5027 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
5028 pr " guestfs_free_int_bool (r);\n";
5030 generate_perl_lvm_code "pv" pv_cols name style n do_cleanups
5032 generate_perl_lvm_code "vg" vg_cols name style n do_cleanups
5034 generate_perl_lvm_code "lv" lv_cols name style n do_cleanups
5036 generate_perl_stat_code "stat" stat_cols name style n do_cleanups
5038 generate_perl_stat_code
5039 "statvfs" statvfs_cols name style n do_cleanups
5045 and generate_perl_lvm_code typ cols name style n do_cleanups =
5047 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
5051 pr " %s = guestfs_%s " n name;
5052 generate_call_args ~handle:"g" (snd style);
5055 pr " if (%s == NULL)\n" n;
5056 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5057 pr " EXTEND (SP, %s->len);\n" n;
5058 pr " for (i = 0; i < %s->len; ++i) {\n" n;
5059 pr " hv = newHV ();\n";
5063 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
5064 name (String.length name) n name
5066 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
5067 name (String.length name) n name
5069 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
5070 name (String.length name) n name
5072 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
5073 name (String.length name) n name
5074 | name, `OptPercent ->
5075 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
5076 name (String.length name) n name
5078 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
5080 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
5082 and generate_perl_stat_code typ cols name style n do_cleanups =
5084 pr " struct guestfs_%s *%s;\n" typ n;
5086 pr " %s = guestfs_%s " n name;
5087 generate_call_args ~handle:"g" (snd style);
5090 pr " if (%s == NULL)\n" n;
5091 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5092 pr " EXTEND (SP, %d);\n" (List.length cols);
5096 pr " PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n" n name
5098 pr " free (%s);\n" n
5100 (* Generate Sys/Guestfs.pm. *)
5101 and generate_perl_pm () =
5102 generate_header HashStyle LGPLv2;
5109 Sys::Guestfs - Perl bindings for libguestfs
5115 my $h = Sys::Guestfs->new ();
5116 $h->add_drive ('guest.img');
5119 $h->mount ('/dev/sda1', '/');
5120 $h->touch ('/hello');
5125 The C<Sys::Guestfs> module provides a Perl XS binding to the
5126 libguestfs API for examining and modifying virtual machine
5129 Amongst the things this is good for: making batch configuration
5130 changes to guests, getting disk used/free statistics (see also:
5131 virt-df), migrating between virtualization systems (see also:
5132 virt-p2v), performing partial backups, performing partial guest
5133 clones, cloning guests and changing registry/UUID/hostname info, and
5136 Libguestfs uses Linux kernel and qemu code, and can access any type of
5137 guest filesystem that Linux and qemu can, including but not limited
5138 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
5139 schemes, qcow, qcow2, vmdk.
5141 Libguestfs provides ways to enumerate guest storage (eg. partitions,
5142 LVs, what filesystem is in each LV, etc.). It can also run commands
5143 in the context of the guest. Also you can access filesystems over FTP.
5147 All errors turn into calls to C<croak> (see L<Carp(3)>).
5155 package Sys::Guestfs;
5161 XSLoader::load ('Sys::Guestfs');
5163 =item $h = Sys::Guestfs->new ();
5165 Create a new guestfs handle.
5171 my $class = ref ($proto) || $proto;
5173 my $self = Sys::Guestfs::_create ();
5174 bless $self, $class;
5180 (* Actions. We only need to print documentation for these as
5181 * they are pulled in from the XS code automatically.
5184 fun (name, style, _, flags, _, _, longdesc) ->
5185 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
5187 generate_perl_prototype name style;
5189 pr "%s\n\n" longdesc;
5190 if List.mem ProtocolLimitWarning flags then
5191 pr "%s\n\n" protocol_limit_warning;
5192 if List.mem DangerWillRobinson flags then
5193 pr "%s\n\n" danger_will_robinson
5194 ) all_functions_sorted;
5206 Copyright (C) 2009 Red Hat Inc.
5210 Please see the file COPYING.LIB for the full license.
5214 L<guestfs(3)>, L<guestfish(1)>.
5219 and generate_perl_prototype name style =
5220 (match fst style with
5226 | RString n -> pr "$%s = " n
5227 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
5231 | RLVList n -> pr "@%s = " n
5234 | RHashtable n -> pr "%%%s = " n
5237 let comma = ref false in
5240 if !comma then pr ", ";
5243 | String n | OptString n | Bool n | Int n | FileIn n | FileOut n ->
5250 (* Generate Python C module. *)
5251 and generate_python_c () =
5252 generate_header CStyle LGPLv2;
5261 #include \"guestfs.h\"
5269 get_handle (PyObject *obj)
5272 assert (obj != Py_None);
5273 return ((Pyguestfs_Object *) obj)->g;
5277 put_handle (guestfs_h *g)
5281 PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
5284 /* This list should be freed (but not the strings) after use. */
5285 static const char **
5286 get_string_list (PyObject *obj)
5293 if (!PyList_Check (obj)) {
5294 PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
5298 len = PyList_Size (obj);
5299 r = malloc (sizeof (char *) * (len+1));
5301 PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
5305 for (i = 0; i < len; ++i)
5306 r[i] = PyString_AsString (PyList_GetItem (obj, i));
5313 put_string_list (char * const * const argv)
5318 for (argc = 0; argv[argc] != NULL; ++argc)
5321 list = PyList_New (argc);
5322 for (i = 0; i < argc; ++i)
5323 PyList_SetItem (list, i, PyString_FromString (argv[i]));
5329 put_table (char * const * const argv)
5331 PyObject *list, *item;
5334 for (argc = 0; argv[argc] != NULL; ++argc)
5337 list = PyList_New (argc >> 1);
5338 for (i = 0; i < argc; i += 2) {
5339 item = PyTuple_New (2);
5340 PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
5341 PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
5342 PyList_SetItem (list, i >> 1, item);
5349 free_strings (char **argv)
5353 for (argc = 0; argv[argc] != NULL; ++argc)
5359 py_guestfs_create (PyObject *self, PyObject *args)
5363 g = guestfs_create ();
5365 PyErr_SetString (PyExc_RuntimeError,
5366 \"guestfs.create: failed to allocate handle\");
5369 guestfs_set_error_handler (g, NULL, NULL);
5370 return put_handle (g);
5374 py_guestfs_close (PyObject *self, PyObject *args)
5379 if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
5381 g = get_handle (py_g);
5385 Py_INCREF (Py_None);
5391 (* LVM structures, turned into Python dictionaries. *)
5394 pr "static PyObject *\n";
5395 pr "put_lvm_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
5397 pr " PyObject *dict;\n";
5399 pr " dict = PyDict_New ();\n";
5403 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
5404 pr " PyString_FromString (%s->%s));\n"
5407 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
5408 pr " PyString_FromStringAndSize (%s->%s, 32));\n"
5411 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
5412 pr " PyLong_FromUnsignedLongLong (%s->%s));\n"
5415 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
5416 pr " PyLong_FromLongLong (%s->%s));\n"
5418 | name, `OptPercent ->
5419 pr " if (%s->%s >= 0)\n" typ name;
5420 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
5421 pr " PyFloat_FromDouble ((double) %s->%s));\n"
5424 pr " Py_INCREF (Py_None);\n";
5425 pr " PyDict_SetItemString (dict, \"%s\", Py_None);" name;
5428 pr " return dict;\n";
5432 pr "static PyObject *\n";
5433 pr "put_lvm_%s_list (struct guestfs_lvm_%s_list *%ss)\n" typ typ typ;
5435 pr " PyObject *list;\n";
5438 pr " list = PyList_New (%ss->len);\n" typ;
5439 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
5440 pr " PyList_SetItem (list, i, put_lvm_%s (&%ss->val[i]));\n" typ typ;
5441 pr " return list;\n";
5444 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
5446 (* Stat structures, turned into Python dictionaries. *)
5449 pr "static PyObject *\n";
5450 pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
5452 pr " PyObject *dict;\n";
5454 pr " dict = PyDict_New ();\n";
5458 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
5459 pr " PyLong_FromLongLong (%s->%s));\n"
5462 pr " return dict;\n";
5465 ) ["stat", stat_cols; "statvfs", statvfs_cols];
5467 (* Python wrapper functions. *)
5469 fun (name, style, _, _, _, _, _) ->
5470 pr "static PyObject *\n";
5471 pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
5474 pr " PyObject *py_g;\n";
5475 pr " guestfs_h *g;\n";
5476 pr " PyObject *py_r;\n";
5479 match fst style with
5480 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
5481 | RInt64 _ -> pr " int64_t r;\n"; "-1"
5482 | RConstString _ -> pr " const char *r;\n"; "NULL"
5483 | RString _ -> pr " char *r;\n"; "NULL"
5484 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
5485 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
5486 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
5487 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
5488 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
5489 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
5490 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
5494 | String n | FileIn n | FileOut n -> pr " const char *%s;\n" n
5495 | OptString n -> pr " const char *%s;\n" n
5497 pr " PyObject *py_%s;\n" n;
5498 pr " const char **%s;\n" n
5499 | Bool n -> pr " int %s;\n" n
5500 | Int n -> pr " int %s;\n" n
5505 (* Convert the parameters. *)
5506 pr " if (!PyArg_ParseTuple (args, (char *) \"O";
5509 | String _ | FileIn _ | FileOut _ -> pr "s"
5510 | OptString _ -> pr "z"
5511 | StringList _ -> pr "O"
5512 | Bool _ -> pr "i" (* XXX Python has booleans? *)
5515 pr ":guestfs_%s\",\n" name;
5519 | String n | FileIn n | FileOut n -> pr ", &%s" n
5520 | OptString n -> pr ", &%s" n
5521 | StringList n -> pr ", &py_%s" n
5522 | Bool n -> pr ", &%s" n
5523 | Int n -> pr ", &%s" n
5527 pr " return NULL;\n";
5529 pr " g = get_handle (py_g);\n";
5532 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
5534 pr " %s = get_string_list (py_%s);\n" n n;
5535 pr " if (!%s) return NULL;\n" n
5540 pr " r = guestfs_%s " name;
5541 generate_call_args ~handle:"g" (snd style);
5546 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
5548 pr " free (%s);\n" n
5551 pr " if (r == %s) {\n" error_code;
5552 pr " PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
5553 pr " return NULL;\n";
5557 (match fst style with
5559 pr " Py_INCREF (Py_None);\n";
5560 pr " py_r = Py_None;\n"
5562 | RBool _ -> pr " py_r = PyInt_FromLong ((long) r);\n"
5563 | RInt64 _ -> pr " py_r = PyLong_FromLongLong (r);\n"
5564 | RConstString _ -> pr " py_r = PyString_FromString (r);\n"
5566 pr " py_r = PyString_FromString (r);\n";
5569 pr " py_r = put_string_list (r);\n";
5570 pr " free_strings (r);\n"
5572 pr " py_r = PyTuple_New (2);\n";
5573 pr " PyTuple_SetItem (py_r, 0, PyInt_FromLong ((long) r->i));\n";
5574 pr " PyTuple_SetItem (py_r, 1, PyInt_FromLong ((long) r->b));\n";
5575 pr " guestfs_free_int_bool (r);\n"
5577 pr " py_r = put_lvm_pv_list (r);\n";
5578 pr " guestfs_free_lvm_pv_list (r);\n"
5580 pr " py_r = put_lvm_vg_list (r);\n";
5581 pr " guestfs_free_lvm_vg_list (r);\n"
5583 pr " py_r = put_lvm_lv_list (r);\n";
5584 pr " guestfs_free_lvm_lv_list (r);\n"
5586 pr " py_r = put_stat (r);\n";
5589 pr " py_r = put_statvfs (r);\n";
5592 pr " py_r = put_table (r);\n";
5593 pr " free_strings (r);\n"
5596 pr " return py_r;\n";
5601 (* Table of functions. *)
5602 pr "static PyMethodDef methods[] = {\n";
5603 pr " { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
5604 pr " { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
5606 fun (name, _, _, _, _, _, _) ->
5607 pr " { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
5610 pr " { NULL, NULL, 0, NULL }\n";
5614 (* Init function. *)
5617 initlibguestfsmod (void)
5619 static int initialized = 0;
5621 if (initialized) return;
5622 Py_InitModule ((char *) \"libguestfsmod\", methods);
5627 (* Generate Python module. *)
5628 and generate_python_py () =
5629 generate_header HashStyle LGPLv2;
5632 u\"\"\"Python bindings for libguestfs
5635 g = guestfs.GuestFS ()
5636 g.add_drive (\"guest.img\")
5639 parts = g.list_partitions ()
5641 The guestfs module provides a Python binding to the libguestfs API
5642 for examining and modifying virtual machine disk images.
5644 Amongst the things this is good for: making batch configuration
5645 changes to guests, getting disk used/free statistics (see also:
5646 virt-df), migrating between virtualization systems (see also:
5647 virt-p2v), performing partial backups, performing partial guest
5648 clones, cloning guests and changing registry/UUID/hostname info, and
5651 Libguestfs uses Linux kernel and qemu code, and can access any type of
5652 guest filesystem that Linux and qemu can, including but not limited
5653 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
5654 schemes, qcow, qcow2, vmdk.
5656 Libguestfs provides ways to enumerate guest storage (eg. partitions,
5657 LVs, what filesystem is in each LV, etc.). It can also run commands
5658 in the context of the guest. Also you can access filesystems over FTP.
5660 Errors which happen while using the API are turned into Python
5661 RuntimeError exceptions.
5663 To create a guestfs handle you usually have to perform the following
5666 # Create the handle, call add_drive at least once, and possibly
5667 # several times if the guest has multiple block devices:
5668 g = guestfs.GuestFS ()
5669 g.add_drive (\"guest.img\")
5671 # Launch the qemu subprocess and wait for it to become ready:
5675 # Now you can issue commands, for example:
5680 import libguestfsmod
5683 \"\"\"Instances of this class are libguestfs API handles.\"\"\"
5685 def __init__ (self):
5686 \"\"\"Create a new libguestfs handle.\"\"\"
5687 self._o = libguestfsmod.create ()
5690 libguestfsmod.close (self._o)
5695 fun (name, style, _, flags, _, _, longdesc) ->
5696 let doc = replace_str longdesc "C<guestfs_" "C<g." in
5698 match fst style with
5699 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _
5702 doc ^ "\n\nThis function returns a list of strings."
5704 doc ^ "\n\nThis function returns a tuple (int, bool).\n"
5706 doc ^ "\n\nThis function returns a list of PVs. Each PV is represented as a dictionary."
5708 doc ^ "\n\nThis function returns a list of VGs. Each VG is represented as a dictionary."
5710 doc ^ "\n\nThis function returns a list of LVs. Each LV is represented as a dictionary."
5712 doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the stat structure."
5714 doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the statvfs structure."
5716 doc ^ "\n\nThis function returns a dictionary." in
5718 if List.mem ProtocolLimitWarning flags then
5719 doc ^ "\n\n" ^ protocol_limit_warning
5722 if List.mem DangerWillRobinson flags then
5723 doc ^ "\n\n" ^ danger_will_robinson
5725 let doc = pod2text ~width:60 name doc in
5726 let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
5727 let doc = String.concat "\n " doc in
5730 generate_call_args ~handle:"self" (snd style);
5732 pr " u\"\"\"%s\"\"\"\n" doc;
5733 pr " return libguestfsmod.%s " name;
5734 generate_call_args ~handle:"self._o" (snd style);
5739 (* Useful if you need the longdesc POD text as plain text. Returns a
5742 * This is the slowest thing about autogeneration.
5744 and pod2text ~width name longdesc =
5745 let filename, chan = Filename.open_temp_file "gen" ".tmp" in
5746 fprintf chan "=head1 %s\n\n%s\n" name longdesc;
5748 let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
5749 let chan = Unix.open_process_in cmd in
5750 let lines = ref [] in
5752 let line = input_line chan in
5753 if i = 1 then (* discard the first line of output *)
5756 let line = triml line in
5757 lines := line :: !lines;
5760 let lines = try loop 1 with End_of_file -> List.rev !lines in
5761 Unix.unlink filename;
5762 match Unix.close_process_in chan with
5763 | Unix.WEXITED 0 -> lines
5765 failwithf "pod2text: process exited with non-zero status (%d)" i
5766 | Unix.WSIGNALED i | Unix.WSTOPPED i ->
5767 failwithf "pod2text: process signalled or stopped by signal %d" i
5769 (* Generate ruby bindings. *)
5770 and generate_ruby_c () =
5771 generate_header CStyle LGPLv2;
5779 #include \"guestfs.h\"
5781 #include \"extconf.h\"
5783 /* For Ruby < 1.9 */
5785 #define RARRAY_LEN(r) (RARRAY((r))->len)
5788 static VALUE m_guestfs; /* guestfs module */
5789 static VALUE c_guestfs; /* guestfs_h handle */
5790 static VALUE e_Error; /* used for all errors */
5792 static void ruby_guestfs_free (void *p)
5795 guestfs_close ((guestfs_h *) p);
5798 static VALUE ruby_guestfs_create (VALUE m)
5802 g = guestfs_create ();
5804 rb_raise (e_Error, \"failed to create guestfs handle\");
5806 /* Don't print error messages to stderr by default. */
5807 guestfs_set_error_handler (g, NULL, NULL);
5809 /* Wrap it, and make sure the close function is called when the
5812 return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
5815 static VALUE ruby_guestfs_close (VALUE gv)
5818 Data_Get_Struct (gv, guestfs_h, g);
5820 ruby_guestfs_free (g);
5821 DATA_PTR (gv) = NULL;
5829 fun (name, style, _, _, _, _, _) ->
5830 pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
5831 List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
5834 pr " guestfs_h *g;\n";
5835 pr " Data_Get_Struct (gv, guestfs_h, g);\n";
5837 pr " rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
5843 | String n | FileIn n | FileOut n ->
5844 pr " const char *%s = StringValueCStr (%sv);\n" n n;
5846 pr " rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
5847 pr " \"%s\", \"%s\");\n" n name
5849 pr " const char *%s = StringValueCStr (%sv);\n" n n
5853 pr " int i, len;\n";
5854 pr " len = RARRAY_LEN (%sv);\n" n;
5855 pr " %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
5857 pr " for (i = 0; i < len; ++i) {\n";
5858 pr " VALUE v = rb_ary_entry (%sv, i);\n" n;
5859 pr " %s[i] = StringValueCStr (v);\n" n;
5861 pr " %s[len] = NULL;\n" n;
5865 pr " int %s = NUM2INT (%sv);\n" n n
5870 match fst style with
5871 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
5872 | RInt64 _ -> pr " int64_t r;\n"; "-1"
5873 | RConstString _ -> pr " const char *r;\n"; "NULL"
5874 | RString _ -> pr " char *r;\n"; "NULL"
5875 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
5876 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
5877 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
5878 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
5879 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
5880 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
5881 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
5884 pr " r = guestfs_%s " name;
5885 generate_call_args ~handle:"g" (snd style);
5890 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
5892 pr " free (%s);\n" n
5895 pr " if (r == %s)\n" error_code;
5896 pr " rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
5899 (match fst style with
5901 pr " return Qnil;\n"
5902 | RInt _ | RBool _ ->
5903 pr " return INT2NUM (r);\n"
5905 pr " return ULL2NUM (r);\n"
5907 pr " return rb_str_new2 (r);\n";
5909 pr " VALUE rv = rb_str_new2 (r);\n";
5913 pr " int i, len = 0;\n";
5914 pr " for (i = 0; r[i] != NULL; ++i) len++;\n";
5915 pr " VALUE rv = rb_ary_new2 (len);\n";
5916 pr " for (i = 0; r[i] != NULL; ++i) {\n";
5917 pr " rb_ary_push (rv, rb_str_new2 (r[i]));\n";
5918 pr " free (r[i]);\n";
5923 pr " VALUE rv = rb_ary_new2 (2);\n";
5924 pr " rb_ary_push (rv, INT2NUM (r->i));\n";
5925 pr " rb_ary_push (rv, INT2NUM (r->b));\n";
5926 pr " guestfs_free_int_bool (r);\n";
5929 generate_ruby_lvm_code "pv" pv_cols
5931 generate_ruby_lvm_code "vg" vg_cols
5933 generate_ruby_lvm_code "lv" lv_cols
5935 pr " VALUE rv = rb_hash_new ();\n";
5939 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
5944 pr " VALUE rv = rb_hash_new ();\n";
5948 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
5953 pr " VALUE rv = rb_hash_new ();\n";
5955 pr " for (i = 0; r[i] != NULL; i+=2) {\n";
5956 pr " rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
5957 pr " free (r[i]);\n";
5958 pr " free (r[i+1]);\n";
5969 /* Initialize the module. */
5970 void Init__guestfs ()
5972 m_guestfs = rb_define_module (\"Guestfs\");
5973 c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
5974 e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
5976 rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
5977 rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
5980 (* Define the rest of the methods. *)
5982 fun (name, style, _, _, _, _, _) ->
5983 pr " rb_define_method (c_guestfs, \"%s\",\n" name;
5984 pr " ruby_guestfs_%s, %d);\n" name (List.length (snd style))
5989 (* Ruby code to return an LVM struct list. *)
5990 and generate_ruby_lvm_code typ cols =
5991 pr " VALUE rv = rb_ary_new2 (r->len);\n";
5993 pr " for (i = 0; i < r->len; ++i) {\n";
5994 pr " VALUE hv = rb_hash_new ();\n";
5998 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
6000 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
6003 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
6004 | name, `OptPercent ->
6005 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
6007 pr " rb_ary_push (rv, hv);\n";
6009 pr " guestfs_free_lvm_%s_list (r);\n" typ;
6012 (* Generate Java bindings GuestFS.java file. *)
6013 and generate_java_java () =
6014 generate_header CStyle LGPLv2;
6017 package com.redhat.et.libguestfs;
6019 import java.util.HashMap;
6020 import com.redhat.et.libguestfs.LibGuestFSException;
6021 import com.redhat.et.libguestfs.PV;
6022 import com.redhat.et.libguestfs.VG;
6023 import com.redhat.et.libguestfs.LV;
6024 import com.redhat.et.libguestfs.Stat;
6025 import com.redhat.et.libguestfs.StatVFS;
6026 import com.redhat.et.libguestfs.IntBool;
6029 * The GuestFS object is a libguestfs handle.
6033 public class GuestFS {
6034 // Load the native code.
6036 System.loadLibrary (\"guestfs_jni\");
6040 * The native guestfs_h pointer.
6045 * Create a libguestfs handle.
6047 * @throws LibGuestFSException
6049 public GuestFS () throws LibGuestFSException
6053 private native long _create () throws LibGuestFSException;
6056 * Close a libguestfs handle.
6058 * You can also leave handles to be collected by the garbage
6059 * collector, but this method ensures that the resources used
6060 * by the handle are freed up immediately. If you call any
6061 * other methods after closing the handle, you will get an
6064 * @throws LibGuestFSException
6066 public void close () throws LibGuestFSException
6072 private native void _close (long g) throws LibGuestFSException;
6074 public void finalize () throws LibGuestFSException
6082 fun (name, style, _, flags, _, shortdesc, longdesc) ->
6083 let doc = replace_str longdesc "C<guestfs_" "C<g." in
6085 if List.mem ProtocolLimitWarning flags then
6086 doc ^ "\n\n" ^ protocol_limit_warning
6089 if List.mem DangerWillRobinson flags then
6090 doc ^ "\n\n" ^ danger_will_robinson
6092 let doc = pod2text ~width:60 name doc in
6093 let doc = String.concat "\n * " doc in
6096 pr " * %s\n" shortdesc;
6099 pr " * @throws LibGuestFSException\n";
6102 generate_java_prototype ~public:true ~semicolon:false name style;
6105 pr " if (g == 0)\n";
6106 pr " throw new LibGuestFSException (\"%s: handle is closed\");\n"
6109 if fst style <> RErr then pr "return ";
6111 generate_call_args ~handle:"g" (snd style);
6115 generate_java_prototype ~privat:true ~native:true name style;
6122 and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
6123 ?(semicolon=true) name style =
6124 if privat then pr "private ";
6125 if public then pr "public ";
6126 if native then pr "native ";
6129 (match fst style with
6130 | RErr -> pr "void ";
6131 | RInt _ -> pr "int ";
6132 | RInt64 _ -> pr "long ";
6133 | RBool _ -> pr "boolean ";
6134 | RConstString _ | RString _ -> pr "String ";
6135 | RStringList _ -> pr "String[] ";
6136 | RIntBool _ -> pr "IntBool ";
6137 | RPVList _ -> pr "PV[] ";
6138 | RVGList _ -> pr "VG[] ";
6139 | RLVList _ -> pr "LV[] ";
6140 | RStat _ -> pr "Stat ";
6141 | RStatVFS _ -> pr "StatVFS ";
6142 | RHashtable _ -> pr "HashMap<String,String> ";
6145 if native then pr "_%s " name else pr "%s " name;
6147 let needs_comma = ref false in
6156 if !needs_comma then pr ", ";
6157 needs_comma := true;
6174 pr " throws LibGuestFSException";
6175 if semicolon then pr ";"
6177 and generate_java_struct typ cols =
6178 generate_header CStyle LGPLv2;
6181 package com.redhat.et.libguestfs;
6184 * Libguestfs %s structure.
6195 | name, `UUID -> pr " public String %s;\n" name
6197 | name, `Int -> pr " public long %s;\n" name
6198 | name, `OptPercent ->
6199 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
6200 pr " public float %s;\n" name
6205 and generate_java_c () =
6206 generate_header CStyle LGPLv2;
6213 #include \"com_redhat_et_libguestfs_GuestFS.h\"
6214 #include \"guestfs.h\"
6216 /* Note that this function returns. The exception is not thrown
6217 * until after the wrapper function returns.
6220 throw_exception (JNIEnv *env, const char *msg)
6223 cl = (*env)->FindClass (env,
6224 \"com/redhat/et/libguestfs/LibGuestFSException\");
6225 (*env)->ThrowNew (env, cl, msg);
6228 JNIEXPORT jlong JNICALL
6229 Java_com_redhat_et_libguestfs_GuestFS__1create
6230 (JNIEnv *env, jobject obj)
6234 g = guestfs_create ();
6236 throw_exception (env, \"GuestFS.create: failed to allocate handle\");
6239 guestfs_set_error_handler (g, NULL, NULL);
6240 return (jlong) (long) g;
6243 JNIEXPORT void JNICALL
6244 Java_com_redhat_et_libguestfs_GuestFS__1close
6245 (JNIEnv *env, jobject obj, jlong jg)
6247 guestfs_h *g = (guestfs_h *) (long) jg;
6254 fun (name, style, _, _, _, _, _) ->
6256 (match fst style with
6257 | RErr -> pr "void ";
6258 | RInt _ -> pr "jint ";
6259 | RInt64 _ -> pr "jlong ";
6260 | RBool _ -> pr "jboolean ";
6261 | RConstString _ | RString _ -> pr "jstring ";
6262 | RIntBool _ | RStat _ | RStatVFS _ | RHashtable _ ->
6264 | RStringList _ | RPVList _ | RVGList _ | RLVList _ ->
6268 pr "Java_com_redhat_et_libguestfs_GuestFS_";
6269 pr "%s" (replace_str ("_" ^ name) "_" "_1");
6271 pr " (JNIEnv *env, jobject obj, jlong jg";
6278 pr ", jstring j%s" n
6280 pr ", jobjectArray j%s" n
6282 pr ", jboolean j%s" n
6288 pr " guestfs_h *g = (guestfs_h *) (long) jg;\n";
6289 let error_code, no_ret =
6290 match fst style with
6291 | RErr -> pr " int r;\n"; "-1", ""
6293 | RInt _ -> pr " int r;\n"; "-1", "0"
6294 | RInt64 _ -> pr " int64_t r;\n"; "-1", "0"
6295 | RConstString _ -> pr " const char *r;\n"; "NULL", "NULL"
6297 pr " jstring jr;\n";
6298 pr " char *r;\n"; "NULL", "NULL"
6300 pr " jobjectArray jr;\n";
6303 pr " jstring jstr;\n";
6304 pr " char **r;\n"; "NULL", "NULL"
6306 pr " jobject jr;\n";
6308 pr " jfieldID fl;\n";
6309 pr " struct guestfs_int_bool *r;\n"; "NULL", "NULL"
6311 pr " jobject jr;\n";
6313 pr " jfieldID fl;\n";
6314 pr " struct guestfs_stat *r;\n"; "NULL", "NULL"
6316 pr " jobject jr;\n";
6318 pr " jfieldID fl;\n";
6319 pr " struct guestfs_statvfs *r;\n"; "NULL", "NULL"
6321 pr " jobjectArray jr;\n";
6323 pr " jfieldID fl;\n";
6324 pr " jobject jfl;\n";
6325 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL", "NULL"
6327 pr " jobjectArray jr;\n";
6329 pr " jfieldID fl;\n";
6330 pr " jobject jfl;\n";
6331 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL", "NULL"
6333 pr " jobjectArray jr;\n";
6335 pr " jfieldID fl;\n";
6336 pr " jobject jfl;\n";
6337 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL", "NULL"
6338 | RHashtable _ -> pr " char **r;\n"; "NULL", "NULL" in
6345 pr " const char *%s;\n" n
6347 pr " int %s_len;\n" n;
6348 pr " const char **%s;\n" n
6355 (match fst style with
6356 | RStringList _ | RPVList _ | RVGList _ | RLVList _ -> true
6357 | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
6358 | RString _ | RIntBool _ | RStat _ | RStatVFS _
6359 | RHashtable _ -> false) ||
6360 List.exists (function StringList _ -> true | _ -> false) (snd style) in
6366 (* Get the parameters. *)
6373 pr " %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
6375 pr " %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
6376 pr " %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
6377 pr " for (i = 0; i < %s_len; ++i) {\n" n;
6378 pr " jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
6380 pr " %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
6382 pr " %s[%s_len] = NULL;\n" n n;
6385 pr " %s = j%s;\n" n n
6388 (* Make the call. *)
6389 pr " r = guestfs_%s " name;
6390 generate_call_args ~handle:"g" (snd style);
6393 (* Release the parameters. *)
6400 pr " (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
6402 pr " for (i = 0; i < %s_len; ++i) {\n" n;
6403 pr " jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
6405 pr " (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
6407 pr " free (%s);\n" n
6412 (* Check for errors. *)
6413 pr " if (r == %s) {\n" error_code;
6414 pr " throw_exception (env, guestfs_last_error (g));\n";
6415 pr " return %s;\n" no_ret;
6419 (match fst style with
6421 | RInt _ -> pr " return (jint) r;\n"
6422 | RBool _ -> pr " return (jboolean) r;\n"
6423 | RInt64 _ -> pr " return (jlong) r;\n"
6424 | RConstString _ -> pr " return (*env)->NewStringUTF (env, r);\n"
6426 pr " jr = (*env)->NewStringUTF (env, r);\n";
6430 pr " for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
6431 pr " cl = (*env)->FindClass (env, \"java/lang/String\");\n";
6432 pr " jstr = (*env)->NewStringUTF (env, \"\");\n";
6433 pr " jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n";
6434 pr " for (i = 0; i < r_len; ++i) {\n";
6435 pr " jstr = (*env)->NewStringUTF (env, r[i]);\n";
6436 pr " (*env)->SetObjectArrayElement (env, jr, i, jstr);\n";
6437 pr " free (r[i]);\n";
6442 pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/IntBool\");\n";
6443 pr " jr = (*env)->AllocObject (env, cl);\n";
6444 pr " fl = (*env)->GetFieldID (env, cl, \"i\", \"I\");\n";
6445 pr " (*env)->SetIntField (env, jr, fl, r->i);\n";
6446 pr " fl = (*env)->GetFieldID (env, cl, \"i\", \"Z\");\n";
6447 pr " (*env)->SetBooleanField (env, jr, fl, r->b);\n";
6448 pr " guestfs_free_int_bool (r);\n";
6451 pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/Stat\");\n";
6452 pr " jr = (*env)->AllocObject (env, cl);\n";
6456 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n"
6458 pr " (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
6463 pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/StatVFS\");\n";
6464 pr " jr = (*env)->AllocObject (env, cl);\n";
6468 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n"
6470 pr " (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
6475 generate_java_lvm_return "pv" "PV" pv_cols
6477 generate_java_lvm_return "vg" "VG" vg_cols
6479 generate_java_lvm_return "lv" "LV" lv_cols
6482 pr " throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
6483 pr " return NULL;\n"
6490 and generate_java_lvm_return typ jtyp cols =
6491 pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
6492 pr " jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n";
6493 pr " for (i = 0; i < r->len; ++i) {\n";
6494 pr " jfl = (*env)->AllocObject (env, cl);\n";
6498 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
6499 pr " (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name;
6502 pr " char s[33];\n";
6503 pr " memcpy (s, r->val[i].%s, 32);\n" name;
6505 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
6506 pr " (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
6508 | name, (`Bytes|`Int) ->
6509 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
6510 pr " (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
6511 | name, `OptPercent ->
6512 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
6513 pr " (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\n" name;
6515 pr " (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n";
6517 pr " guestfs_free_lvm_%s_list (r);\n" typ;
6520 let output_to filename =
6521 let filename_new = filename ^ ".new" in
6522 chan := open_out filename_new;
6527 (* Is the new file different from the current file? *)
6528 if Sys.file_exists filename && files_equal filename filename_new then
6529 Unix.unlink filename_new (* same, so skip it *)
6531 (* different, overwrite old one *)
6532 (try Unix.chmod filename 0o644 with Unix.Unix_error _ -> ());
6533 Unix.rename filename_new filename;
6534 Unix.chmod filename 0o444;
6535 printf "written %s\n%!" filename;
6544 if not (Sys.file_exists "configure.ac") then (
6546 You are probably running this from the wrong directory.
6547 Run it from the top source directory using the command
6553 let close = output_to "src/guestfs_protocol.x" in
6557 let close = output_to "src/guestfs-structs.h" in
6558 generate_structs_h ();
6561 let close = output_to "src/guestfs-actions.h" in
6562 generate_actions_h ();
6565 let close = output_to "src/guestfs-actions.c" in
6566 generate_client_actions ();
6569 let close = output_to "daemon/actions.h" in
6570 generate_daemon_actions_h ();
6573 let close = output_to "daemon/stubs.c" in
6574 generate_daemon_actions ();
6577 let close = output_to "tests.c" in
6581 let close = output_to "fish/cmds.c" in
6582 generate_fish_cmds ();
6585 let close = output_to "fish/completion.c" in
6586 generate_fish_completion ();
6589 let close = output_to "guestfs-structs.pod" in
6590 generate_structs_pod ();
6593 let close = output_to "guestfs-actions.pod" in
6594 generate_actions_pod ();
6597 let close = output_to "guestfish-actions.pod" in
6598 generate_fish_actions_pod ();
6601 let close = output_to "ocaml/guestfs.mli" in
6602 generate_ocaml_mli ();
6605 let close = output_to "ocaml/guestfs.ml" in
6606 generate_ocaml_ml ();
6609 let close = output_to "ocaml/guestfs_c_actions.c" in
6610 generate_ocaml_c ();
6613 let close = output_to "perl/Guestfs.xs" in
6614 generate_perl_xs ();
6617 let close = output_to "perl/lib/Sys/Guestfs.pm" in
6618 generate_perl_pm ();
6621 let close = output_to "python/guestfs-py.c" in
6622 generate_python_c ();
6625 let close = output_to "python/guestfs.py" in
6626 generate_python_py ();
6629 let close = output_to "ruby/ext/guestfs/_guestfs.c" in
6633 let close = output_to "java/com/redhat/et/libguestfs/GuestFS.java" in
6634 generate_java_java ();
6637 let close = output_to "java/com/redhat/et/libguestfs/PV.java" in
6638 generate_java_struct "PV" pv_cols;
6641 let close = output_to "java/com/redhat/et/libguestfs/VG.java" in
6642 generate_java_struct "VG" vg_cols;
6645 let close = output_to "java/com/redhat/et/libguestfs/LV.java" in
6646 generate_java_struct "LV" lv_cols;
6649 let close = output_to "java/com/redhat/et/libguestfs/Stat.java" in
6650 generate_java_struct "Stat" stat_cols;
6653 let close = output_to "java/com/redhat/et/libguestfs/StatVFS.java" in
6654 generate_java_struct "StatVFS" statvfs_cols;
6657 let close = output_to "java/com_redhat_et_libguestfs_GuestFS.c" in