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.");
1812 let all_functions = non_daemon_functions @ daemon_functions
1814 (* In some places we want the functions to be displayed sorted
1815 * alphabetically, so this is useful:
1817 let all_functions_sorted =
1818 List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
1819 compare n1 n2) all_functions
1821 (* Column names and types from LVM PVs/VGs/LVs. *)
1830 "pv_attr", `String (* XXX *);
1831 "pv_pe_count", `Int;
1832 "pv_pe_alloc_count", `Int;
1835 "pv_mda_count", `Int;
1836 "pv_mda_free", `Bytes;
1837 (* Not in Fedora 10:
1838 "pv_mda_size", `Bytes;
1845 "vg_attr", `String (* XXX *);
1848 "vg_sysid", `String;
1849 "vg_extent_size", `Bytes;
1850 "vg_extent_count", `Int;
1851 "vg_free_count", `Int;
1859 "vg_mda_count", `Int;
1860 "vg_mda_free", `Bytes;
1861 (* Not in Fedora 10:
1862 "vg_mda_size", `Bytes;
1868 "lv_attr", `String (* XXX *);
1871 "lv_kernel_major", `Int;
1872 "lv_kernel_minor", `Int;
1876 "snap_percent", `OptPercent;
1877 "copy_percent", `OptPercent;
1880 "mirror_log", `String;
1884 (* Column names and types from stat structures.
1885 * NB. Can't use things like 'st_atime' because glibc header files
1886 * define some of these as macros. Ugh.
1903 let statvfs_cols = [
1917 (* Useful functions.
1918 * Note we don't want to use any external OCaml libraries which
1919 * makes this a bit harder than it should be.
1921 let failwithf fs = ksprintf failwith fs
1923 let replace_char s c1 c2 =
1924 let s2 = String.copy s in
1925 let r = ref false in
1926 for i = 0 to String.length s2 - 1 do
1927 if String.unsafe_get s2 i = c1 then (
1928 String.unsafe_set s2 i c2;
1932 if not !r then s else s2
1936 (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
1938 let triml ?(test = isspace) str =
1940 let n = ref (String.length str) in
1941 while !n > 0 && test str.[!i]; do
1946 else String.sub str !i !n
1948 let trimr ?(test = isspace) str =
1949 let n = ref (String.length str) in
1950 while !n > 0 && test str.[!n-1]; do
1953 if !n = String.length str then str
1954 else String.sub str 0 !n
1956 let trim ?(test = isspace) str =
1957 trimr ~test (triml ~test str)
1959 let rec find s sub =
1960 let len = String.length s in
1961 let sublen = String.length sub in
1963 if i <= len-sublen then (
1965 if j < sublen then (
1966 if s.[i+j] = sub.[j] then loop2 (j+1)
1972 if r = -1 then loop (i+1) else r
1978 let rec replace_str s s1 s2 =
1979 let len = String.length s in
1980 let sublen = String.length s1 in
1981 let i = find s s1 in
1984 let s' = String.sub s 0 i in
1985 let s'' = String.sub s (i+sublen) (len-i-sublen) in
1986 s' ^ s2 ^ replace_str s'' s1 s2
1989 let rec string_split sep str =
1990 let len = String.length str in
1991 let seplen = String.length sep in
1992 let i = find str sep in
1993 if i = -1 then [str]
1995 let s' = String.sub str 0 i in
1996 let s'' = String.sub str (i+seplen) (len-i-seplen) in
1997 s' :: string_split sep s''
2000 let files_equal n1 n2 =
2001 let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
2002 match Sys.command cmd with
2005 | i -> failwithf "%s: failed with error code %d" cmd i
2007 let rec find_map f = function
2008 | [] -> raise Not_found
2012 | None -> find_map f xs
2015 let rec loop i = function
2017 | x :: xs -> f i x; loop (i+1) xs
2022 let rec loop i = function
2024 | x :: xs -> let r = f i x in r :: loop (i+1) xs
2028 let name_of_argt = function
2029 | String n | OptString n | StringList n | Bool n | Int n
2030 | FileIn n | FileOut n -> n
2032 let seq_of_test = function
2033 | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
2034 | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s
2035 | TestOutputLength (s, _) | TestOutputStruct (s, _)
2036 | TestLastFail s -> s
2038 (* Check function names etc. for consistency. *)
2039 let check_functions () =
2040 let contains_uppercase str =
2041 let len = String.length str in
2043 if i >= len then false
2046 if c >= 'A' && c <= 'Z' then true
2053 (* Check function names. *)
2055 fun (name, _, _, _, _, _, _) ->
2056 if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
2057 failwithf "function name %s does not need 'guestfs' prefix" name;
2058 if contains_uppercase name then
2059 failwithf "function name %s should not contain uppercase chars" name;
2060 if String.contains name '-' then
2061 failwithf "function name %s should not contain '-', use '_' instead."
2065 (* Check function parameter/return names. *)
2067 fun (name, style, _, _, _, _, _) ->
2068 let check_arg_ret_name n =
2069 if contains_uppercase n then
2070 failwithf "%s param/ret %s should not contain uppercase chars"
2072 if String.contains n '-' || String.contains n '_' then
2073 failwithf "%s param/ret %s should not contain '-' or '_'"
2076 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;
2077 if n = "argv" || n = "args" then
2078 failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" n
2081 (match fst style with
2083 | RInt n | RInt64 n | RBool n | RConstString n | RString n
2084 | RStringList n | RPVList n | RVGList n | RLVList n
2085 | RStat n | RStatVFS n
2087 check_arg_ret_name n
2089 check_arg_ret_name n;
2090 check_arg_ret_name m
2092 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
2095 (* Check short descriptions. *)
2097 fun (name, _, _, _, _, shortdesc, _) ->
2098 if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
2099 failwithf "short description of %s should begin with lowercase." name;
2100 let c = shortdesc.[String.length shortdesc-1] in
2101 if c = '\n' || c = '.' then
2102 failwithf "short description of %s should not end with . or \\n." name
2105 (* Check long dscriptions. *)
2107 fun (name, _, _, _, _, _, longdesc) ->
2108 if longdesc.[String.length longdesc-1] = '\n' then
2109 failwithf "long description of %s should not end with \\n." name
2112 (* Check proc_nrs. *)
2114 fun (name, _, proc_nr, _, _, _, _) ->
2115 if proc_nr <= 0 then
2116 failwithf "daemon function %s should have proc_nr > 0" name
2120 fun (name, _, proc_nr, _, _, _, _) ->
2121 if proc_nr <> -1 then
2122 failwithf "non-daemon function %s should have proc_nr -1" name
2123 ) non_daemon_functions;
2126 List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
2129 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
2130 let rec loop = function
2133 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
2135 | (name1,nr1) :: (name2,nr2) :: _ ->
2136 failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
2144 (* Ignore functions that have no tests. We generate a
2145 * warning when the user does 'make check' instead.
2147 | name, _, _, _, [], _, _ -> ()
2148 | name, _, _, _, tests, _, _ ->
2152 match seq_of_test test with
2154 failwithf "%s has a test containing an empty sequence" name
2155 | cmds -> List.map List.hd cmds
2157 let funcs = List.flatten funcs in
2159 let tested = List.mem name funcs in
2162 failwithf "function %s has tests but does not test itself" name
2165 (* 'pr' prints to the current output file. *)
2166 let chan = ref stdout
2167 let pr fs = ksprintf (output_string !chan) fs
2169 (* Generate a header block in a number of standard styles. *)
2170 type comment_style = CStyle | HashStyle | OCamlStyle
2171 type license = GPLv2 | LGPLv2
2173 let generate_header comment license =
2174 let c = match comment with
2175 | CStyle -> pr "/* "; " *"
2176 | HashStyle -> pr "# "; "#"
2177 | OCamlStyle -> pr "(* "; " *" in
2178 pr "libguestfs generated file\n";
2179 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
2180 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
2182 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
2186 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
2187 pr "%s it under the terms of the GNU General Public License as published by\n" c;
2188 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
2189 pr "%s (at your option) any later version.\n" c;
2191 pr "%s This program is distributed in the hope that it will be useful,\n" c;
2192 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
2193 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
2194 pr "%s GNU General Public License for more details.\n" c;
2196 pr "%s You should have received a copy of the GNU General Public License along\n" c;
2197 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
2198 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
2201 pr "%s This library is free software; you can redistribute it and/or\n" c;
2202 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
2203 pr "%s License as published by the Free Software Foundation; either\n" c;
2204 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
2206 pr "%s This library is distributed in the hope that it will be useful,\n" c;
2207 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
2208 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
2209 pr "%s Lesser General Public License for more details.\n" c;
2211 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
2212 pr "%s License along with this library; if not, write to the Free Software\n" c;
2213 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
2216 | CStyle -> pr " */\n"
2218 | OCamlStyle -> pr " *)\n"
2222 (* Start of main code generation functions below this line. *)
2224 (* Generate the pod documentation for the C API. *)
2225 let rec generate_actions_pod () =
2227 fun (shortname, style, _, flags, _, _, longdesc) ->
2228 let name = "guestfs_" ^ shortname in
2229 pr "=head2 %s\n\n" name;
2231 generate_prototype ~extern:false ~handle:"handle" name style;
2233 pr "%s\n\n" longdesc;
2234 (match fst style with
2236 pr "This function returns 0 on success or -1 on error.\n\n"
2238 pr "On error this function returns -1.\n\n"
2240 pr "On error this function returns -1.\n\n"
2242 pr "This function returns a C truth value on success or -1 on error.\n\n"
2244 pr "This function returns a string, or NULL on error.
2245 The string is owned by the guest handle and must I<not> be freed.\n\n"
2247 pr "This function returns a string, or NULL on error.
2248 I<The caller must free the returned string after use>.\n\n"
2250 pr "This function returns a NULL-terminated array of strings
2251 (like L<environ(3)>), or NULL if there was an error.
2252 I<The caller must free the strings and the array after use>.\n\n"
2254 pr "This function returns a C<struct guestfs_int_bool *>,
2255 or NULL if there was an error.
2256 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
2258 pr "This function returns a C<struct guestfs_lvm_pv_list *>
2259 (see E<lt>guestfs-structs.hE<gt>),
2260 or NULL if there was an error.
2261 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
2263 pr "This function returns a C<struct guestfs_lvm_vg_list *>
2264 (see E<lt>guestfs-structs.hE<gt>),
2265 or NULL if there was an error.
2266 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
2268 pr "This function returns a C<struct guestfs_lvm_lv_list *>
2269 (see E<lt>guestfs-structs.hE<gt>),
2270 or NULL if there was an error.
2271 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
2273 pr "This function returns a C<struct guestfs_stat *>
2274 (see L<stat(2)> and E<lt>guestfs-structs.hE<gt>),
2275 or NULL if there was an error.
2276 I<The caller must call C<free> after use>.\n\n"
2278 pr "This function returns a C<struct guestfs_statvfs *>
2279 (see L<statvfs(2)> and E<lt>guestfs-structs.hE<gt>),
2280 or NULL if there was an error.
2281 I<The caller must call C<free> after use>.\n\n"
2283 pr "This function returns a NULL-terminated array of
2284 strings, or NULL if there was an error.
2285 The array of strings will always have length C<2n+1>, where
2286 C<n> keys and values alternate, followed by the trailing NULL entry.
2287 I<The caller must free the strings and the array after use>.\n\n"
2289 if List.mem ProtocolLimitWarning flags then
2290 pr "%s\n\n" protocol_limit_warning;
2291 if List.mem DangerWillRobinson flags then
2292 pr "%s\n\n" danger_will_robinson;
2293 ) all_functions_sorted
2295 and generate_structs_pod () =
2296 (* LVM structs documentation. *)
2299 pr "=head2 guestfs_lvm_%s\n" typ;
2301 pr " struct guestfs_lvm_%s {\n" typ;
2304 | name, `String -> pr " char *%s;\n" name
2306 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
2307 pr " char %s[32];\n" name
2308 | name, `Bytes -> pr " uint64_t %s;\n" name
2309 | name, `Int -> pr " int64_t %s;\n" name
2310 | name, `OptPercent ->
2311 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
2312 pr " float %s;\n" name
2315 pr " struct guestfs_lvm_%s_list {\n" typ;
2316 pr " uint32_t len; /* Number of elements in list. */\n";
2317 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
2320 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
2323 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2325 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
2326 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
2328 * We have to use an underscore instead of a dash because otherwise
2329 * rpcgen generates incorrect code.
2331 * This header is NOT exported to clients, but see also generate_structs_h.
2333 and generate_xdr () =
2334 generate_header CStyle LGPLv2;
2336 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
2337 pr "typedef string str<>;\n";
2340 (* LVM internal structures. *)
2344 pr "struct guestfs_lvm_int_%s {\n" typ;
2346 | name, `String -> pr " string %s<>;\n" name
2347 | name, `UUID -> pr " opaque %s[32];\n" name
2348 | name, `Bytes -> pr " hyper %s;\n" name
2349 | name, `Int -> pr " hyper %s;\n" name
2350 | name, `OptPercent -> pr " float %s;\n" name
2354 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
2356 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2358 (* Stat internal structures. *)
2362 pr "struct guestfs_int_%s {\n" typ;
2364 | name, `Int -> pr " hyper %s;\n" name
2368 ) ["stat", stat_cols; "statvfs", statvfs_cols];
2371 fun (shortname, style, _, _, _, _, _) ->
2372 let name = "guestfs_" ^ shortname in
2374 (match snd style with
2377 pr "struct %s_args {\n" name;
2380 | String n -> pr " string %s<>;\n" n
2381 | OptString n -> pr " str *%s;\n" n
2382 | StringList n -> pr " str %s<>;\n" n
2383 | Bool n -> pr " bool %s;\n" n
2384 | Int n -> pr " int %s;\n" n
2385 | FileIn _ | FileOut _ -> ()
2389 (match fst style with
2392 pr "struct %s_ret {\n" name;
2396 pr "struct %s_ret {\n" name;
2397 pr " hyper %s;\n" n;
2400 pr "struct %s_ret {\n" name;
2404 failwithf "RConstString cannot be returned from a daemon function"
2406 pr "struct %s_ret {\n" name;
2407 pr " string %s<>;\n" n;
2410 pr "struct %s_ret {\n" name;
2411 pr " str %s<>;\n" n;
2414 pr "struct %s_ret {\n" name;
2419 pr "struct %s_ret {\n" name;
2420 pr " guestfs_lvm_int_pv_list %s;\n" n;
2423 pr "struct %s_ret {\n" name;
2424 pr " guestfs_lvm_int_vg_list %s;\n" n;
2427 pr "struct %s_ret {\n" name;
2428 pr " guestfs_lvm_int_lv_list %s;\n" n;
2431 pr "struct %s_ret {\n" name;
2432 pr " guestfs_int_stat %s;\n" n;
2435 pr "struct %s_ret {\n" name;
2436 pr " guestfs_int_statvfs %s;\n" n;
2439 pr "struct %s_ret {\n" name;
2440 pr " str %s<>;\n" n;
2445 (* Table of procedure numbers. *)
2446 pr "enum guestfs_procedure {\n";
2448 fun (shortname, _, proc_nr, _, _, _, _) ->
2449 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
2451 pr " GUESTFS_PROC_NR_PROCS\n";
2455 (* Having to choose a maximum message size is annoying for several
2456 * reasons (it limits what we can do in the API), but it (a) makes
2457 * the protocol a lot simpler, and (b) provides a bound on the size
2458 * of the daemon which operates in limited memory space. For large
2459 * file transfers you should use FTP.
2461 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
2464 (* Message header, etc. *)
2466 /* The communication protocol is now documented in the guestfs(3)
2470 const GUESTFS_PROGRAM = 0x2000F5F5;
2471 const GUESTFS_PROTOCOL_VERSION = 1;
2473 /* These constants must be larger than any possible message length. */
2474 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
2475 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
2477 enum guestfs_message_direction {
2478 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
2479 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
2482 enum guestfs_message_status {
2483 GUESTFS_STATUS_OK = 0,
2484 GUESTFS_STATUS_ERROR = 1
2487 const GUESTFS_ERROR_LEN = 256;
2489 struct guestfs_message_error {
2490 string error_message<GUESTFS_ERROR_LEN>;
2493 struct guestfs_message_header {
2494 unsigned prog; /* GUESTFS_PROGRAM */
2495 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
2496 guestfs_procedure proc; /* GUESTFS_PROC_x */
2497 guestfs_message_direction direction;
2498 unsigned serial; /* message serial number */
2499 guestfs_message_status status;
2502 const GUESTFS_MAX_CHUNK_SIZE = 8192;
2504 struct guestfs_chunk {
2505 int cancel; /* if non-zero, transfer is cancelled */
2506 /* data size is 0 bytes if the transfer has finished successfully */
2507 opaque data<GUESTFS_MAX_CHUNK_SIZE>;
2511 (* Generate the guestfs-structs.h file. *)
2512 and generate_structs_h () =
2513 generate_header CStyle LGPLv2;
2515 (* This is a public exported header file containing various
2516 * structures. The structures are carefully written to have
2517 * exactly the same in-memory format as the XDR structures that
2518 * we use on the wire to the daemon. The reason for creating
2519 * copies of these structures here is just so we don't have to
2520 * export the whole of guestfs_protocol.h (which includes much
2521 * unrelated and XDR-dependent stuff that we don't want to be
2522 * public, or required by clients).
2524 * To reiterate, we will pass these structures to and from the
2525 * client with a simple assignment or memcpy, so the format
2526 * must be identical to what rpcgen / the RFC defines.
2529 (* guestfs_int_bool structure. *)
2530 pr "struct guestfs_int_bool {\n";
2536 (* LVM public structures. *)
2540 pr "struct guestfs_lvm_%s {\n" typ;
2543 | name, `String -> pr " char *%s;\n" name
2544 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
2545 | name, `Bytes -> pr " uint64_t %s;\n" name
2546 | name, `Int -> pr " int64_t %s;\n" name
2547 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
2551 pr "struct guestfs_lvm_%s_list {\n" typ;
2552 pr " uint32_t len;\n";
2553 pr " struct guestfs_lvm_%s *val;\n" typ;
2556 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2558 (* Stat structures. *)
2562 pr "struct guestfs_%s {\n" typ;
2565 | name, `Int -> pr " int64_t %s;\n" name
2569 ) ["stat", stat_cols; "statvfs", statvfs_cols]
2571 (* Generate the guestfs-actions.h file. *)
2572 and generate_actions_h () =
2573 generate_header CStyle LGPLv2;
2575 fun (shortname, style, _, _, _, _, _) ->
2576 let name = "guestfs_" ^ shortname in
2577 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
2581 (* Generate the client-side dispatch stubs. *)
2582 and generate_client_actions () =
2583 generate_header CStyle LGPLv2;
2589 #include \"guestfs.h\"
2590 #include \"guestfs_protocol.h\"
2592 #define error guestfs_error
2593 #define perrorf guestfs_perrorf
2594 #define safe_malloc guestfs_safe_malloc
2595 #define safe_realloc guestfs_safe_realloc
2596 #define safe_strdup guestfs_safe_strdup
2597 #define safe_memdup guestfs_safe_memdup
2599 /* Check the return message from a call for validity. */
2601 check_reply_header (guestfs_h *g,
2602 const struct guestfs_message_header *hdr,
2603 int proc_nr, int serial)
2605 if (hdr->prog != GUESTFS_PROGRAM) {
2606 error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
2609 if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
2610 error (g, \"wrong protocol version (%%d/%%d)\",
2611 hdr->vers, GUESTFS_PROTOCOL_VERSION);
2614 if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
2615 error (g, \"unexpected message direction (%%d/%%d)\",
2616 hdr->direction, GUESTFS_DIRECTION_REPLY);
2619 if (hdr->proc != proc_nr) {
2620 error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
2623 if (hdr->serial != serial) {
2624 error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
2631 /* Check we are in the right state to run a high-level action. */
2633 check_state (guestfs_h *g, const char *caller)
2635 if (!guestfs_is_ready (g)) {
2636 if (guestfs_is_config (g))
2637 error (g, \"%%s: call launch() before using this function\",
2639 else if (guestfs_is_launching (g))
2640 error (g, \"%%s: call wait_ready() before using this function\",
2643 error (g, \"%%s called from the wrong state, %%d != READY\",
2644 caller, guestfs_get_state (g));
2652 (* Client-side stubs for each function. *)
2654 fun (shortname, style, _, _, _, _, _) ->
2655 let name = "guestfs_" ^ shortname in
2657 (* Generate the context struct which stores the high-level
2658 * state between callback functions.
2660 pr "struct %s_ctx {\n" shortname;
2661 pr " /* This flag is set by the callbacks, so we know we've done\n";
2662 pr " * the callbacks as expected, and in the right sequence.\n";
2663 pr " * 0 = not called, 1 = reply_cb called.\n";
2665 pr " int cb_sequence;\n";
2666 pr " struct guestfs_message_header hdr;\n";
2667 pr " struct guestfs_message_error err;\n";
2668 (match fst style with
2671 failwithf "RConstString cannot be returned from a daemon function"
2673 | RBool _ | RString _ | RStringList _
2675 | RPVList _ | RVGList _ | RLVList _
2676 | RStat _ | RStatVFS _
2678 pr " struct %s_ret ret;\n" name
2683 (* Generate the reply callback function. *)
2684 pr "static void %s_reply_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
2686 pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
2687 pr " struct %s_ctx *ctx = (struct %s_ctx *) data;\n" shortname shortname;
2689 pr " /* This should definitely not happen. */\n";
2690 pr " if (ctx->cb_sequence != 0) {\n";
2691 pr " ctx->cb_sequence = 9999;\n";
2692 pr " error (g, \"%%s: internal error: reply callback called twice\", \"%s\");\n" name;
2696 pr " ml->main_loop_quit (ml, g);\n";
2698 pr " if (!xdr_guestfs_message_header (xdr, &ctx->hdr)) {\n";
2699 pr " error (g, \"%%s: failed to parse reply header\", \"%s\");\n" name;
2702 pr " if (ctx->hdr.status == GUESTFS_STATUS_ERROR) {\n";
2703 pr " if (!xdr_guestfs_message_error (xdr, &ctx->err)) {\n";
2704 pr " error (g, \"%%s: failed to parse reply error\", \"%s\");\n"
2711 (match fst style with
2714 failwithf "RConstString cannot be returned from a daemon function"
2716 | RBool _ | RString _ | RStringList _
2718 | RPVList _ | RVGList _ | RLVList _
2719 | RStat _ | RStatVFS _
2721 pr " if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name;
2722 pr " error (g, \"%%s: failed to parse reply\", \"%s\");\n" name;
2728 pr " ctx->cb_sequence = 1;\n";
2731 (* Generate the action stub. *)
2732 generate_prototype ~extern:false ~semicolon:false ~newline:true
2733 ~handle:"g" name style;
2736 match fst style with
2737 | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
2739 failwithf "RConstString cannot be returned from a daemon function"
2740 | RString _ | RStringList _ | RIntBool _
2741 | RPVList _ | RVGList _ | RLVList _
2742 | RStat _ | RStatVFS _
2748 (match snd style with
2750 | _ -> pr " struct %s_args args;\n" name
2753 pr " struct %s_ctx ctx;\n" shortname;
2754 pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
2755 pr " int serial;\n";
2757 pr " if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
2758 pr " guestfs_set_busy (g);\n";
2760 pr " memset (&ctx, 0, sizeof ctx);\n";
2763 (* Send the main header and arguments. *)
2764 (match snd style with
2766 pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s, NULL, NULL);\n"
2767 (String.uppercase shortname)
2772 pr " args.%s = (char *) %s;\n" n n
2774 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
2776 pr " args.%s.%s_val = (char **) %s;\n" n n n;
2777 pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
2779 pr " args.%s = %s;\n" n n
2781 pr " args.%s = %s;\n" n n
2782 | FileIn _ | FileOut _ -> ()
2784 pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s,\n"
2785 (String.uppercase shortname);
2786 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
2789 pr " if (serial == -1) {\n";
2790 pr " guestfs_set_ready (g);\n";
2791 pr " return %s;\n" error_code;
2795 (* Send any additional files (FileIn) requested. *)
2796 let need_read_reply_label = ref false in
2803 pr " r = guestfs__send_file_sync (g, %s);\n" n;
2804 pr " if (r == -1) {\n";
2805 pr " guestfs_set_ready (g);\n";
2806 pr " return %s;\n" error_code;
2808 pr " if (r == -2) /* daemon cancelled */\n";
2809 pr " goto read_reply;\n";
2810 need_read_reply_label := true;
2816 (* Wait for the reply from the remote end. *)
2817 if !need_read_reply_label then pr " read_reply:\n";
2818 pr " guestfs__switch_to_receiving (g);\n";
2819 pr " ctx.cb_sequence = 0;\n";
2820 pr " guestfs_set_reply_callback (g, %s_reply_cb, &ctx);\n" shortname;
2821 pr " (void) ml->main_loop_run (ml, g);\n";
2822 pr " guestfs_set_reply_callback (g, NULL, NULL);\n";
2823 pr " if (ctx.cb_sequence != 1) {\n";
2824 pr " error (g, \"%%s reply failed, see earlier error messages\", \"%s\");\n" name;
2825 pr " guestfs_set_ready (g);\n";
2826 pr " return %s;\n" error_code;
2830 pr " if (check_reply_header (g, &ctx.hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
2831 (String.uppercase shortname);
2832 pr " guestfs_set_ready (g);\n";
2833 pr " return %s;\n" error_code;
2837 pr " if (ctx.hdr.status == GUESTFS_STATUS_ERROR) {\n";
2838 pr " error (g, \"%%s\", ctx.err.error_message);\n";
2839 pr " guestfs_set_ready (g);\n";
2840 pr " return %s;\n" error_code;
2844 (* Expecting to receive further files (FileOut)? *)
2848 pr " if (guestfs__receive_file_sync (g, %s) == -1) {\n" n;
2849 pr " guestfs_set_ready (g);\n";
2850 pr " return %s;\n" error_code;
2856 pr " guestfs_set_ready (g);\n";
2858 (match fst style with
2859 | RErr -> pr " return 0;\n"
2860 | RInt n | RInt64 n | RBool n ->
2861 pr " return ctx.ret.%s;\n" n
2863 failwithf "RConstString cannot be returned from a daemon function"
2865 pr " return ctx.ret.%s; /* caller will free */\n" n
2866 | RStringList n | RHashtable n ->
2867 pr " /* caller will free this, but we need to add a NULL entry */\n";
2868 pr " ctx.ret.%s.%s_val =\n" n n;
2869 pr " safe_realloc (g, ctx.ret.%s.%s_val,\n" n n;
2870 pr " sizeof (char *) * (ctx.ret.%s.%s_len + 1));\n"
2872 pr " ctx.ret.%s.%s_val[ctx.ret.%s.%s_len] = NULL;\n" n n n n;
2873 pr " return ctx.ret.%s.%s_val;\n" n n
2875 pr " /* caller with free this */\n";
2876 pr " return safe_memdup (g, &ctx.ret, sizeof (ctx.ret));\n"
2877 | RPVList n | RVGList n | RLVList n
2878 | RStat n | RStatVFS n ->
2879 pr " /* caller will free this */\n";
2880 pr " return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n
2886 (* Generate daemon/actions.h. *)
2887 and generate_daemon_actions_h () =
2888 generate_header CStyle GPLv2;
2890 pr "#include \"../src/guestfs_protocol.h\"\n";
2894 fun (name, style, _, _, _, _, _) ->
2896 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
2900 (* Generate the server-side stubs. *)
2901 and generate_daemon_actions () =
2902 generate_header CStyle GPLv2;
2904 pr "#include <config.h>\n";
2906 pr "#include <stdio.h>\n";
2907 pr "#include <stdlib.h>\n";
2908 pr "#include <string.h>\n";
2909 pr "#include <inttypes.h>\n";
2910 pr "#include <ctype.h>\n";
2911 pr "#include <rpc/types.h>\n";
2912 pr "#include <rpc/xdr.h>\n";
2914 pr "#include \"daemon.h\"\n";
2915 pr "#include \"../src/guestfs_protocol.h\"\n";
2916 pr "#include \"actions.h\"\n";
2920 fun (name, style, _, _, _, _, _) ->
2921 (* Generate server-side stubs. *)
2922 pr "static void %s_stub (XDR *xdr_in)\n" name;
2925 match fst style with
2926 | RErr | RInt _ -> pr " int r;\n"; "-1"
2927 | RInt64 _ -> pr " int64_t r;\n"; "-1"
2928 | RBool _ -> pr " int r;\n"; "-1"
2930 failwithf "RConstString cannot be returned from a daemon function"
2931 | RString _ -> pr " char *r;\n"; "NULL"
2932 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
2933 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
2934 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
2935 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
2936 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL"
2937 | RStat _ -> pr " guestfs_int_stat *r;\n"; "NULL"
2938 | RStatVFS _ -> pr " guestfs_int_statvfs *r;\n"; "NULL" in
2940 (match snd style with
2943 pr " struct guestfs_%s_args args;\n" name;
2947 | OptString n -> pr " const char *%s;\n" n
2948 | StringList n -> pr " char **%s;\n" n
2949 | Bool n -> pr " int %s;\n" n
2950 | Int n -> pr " int %s;\n" n
2951 | FileIn _ | FileOut _ -> ()
2956 (match snd style with
2959 pr " memset (&args, 0, sizeof args);\n";
2961 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
2962 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
2967 | String n -> pr " %s = args.%s;\n" n n
2968 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
2970 pr " %s = realloc (args.%s.%s_val,\n" n n n;
2971 pr " sizeof (char *) * (args.%s.%s_len+1));\n" n n;
2972 pr " if (%s == NULL) {\n" n;
2973 pr " reply_with_perror (\"realloc\");\n";
2976 pr " %s[args.%s.%s_len] = NULL;\n" n n n;
2977 pr " args.%s.%s_val = %s;\n" n n n;
2978 | Bool n -> pr " %s = args.%s;\n" n n
2979 | Int n -> pr " %s = args.%s;\n" n n
2980 | FileIn _ | FileOut _ -> ()
2985 (* Don't want to call the impl with any FileIn or FileOut
2986 * parameters, since these go "outside" the RPC protocol.
2989 List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
2991 pr " r = do_%s " name;
2992 generate_call_args argsnofile;
2995 pr " if (r == %s)\n" error_code;
2996 pr " /* do_%s has already called reply_with_error */\n" name;
3000 (* If there are any FileOut parameters, then the impl must
3001 * send its own reply.
3004 List.exists (function FileOut _ -> true | _ -> false) (snd style) in
3006 pr " /* do_%s has already sent a reply */\n" name
3008 match fst style with
3009 | RErr -> pr " reply (NULL, NULL);\n"
3010 | RInt n | RInt64 n | RBool n ->
3011 pr " struct guestfs_%s_ret ret;\n" name;
3012 pr " ret.%s = r;\n" n;
3013 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
3016 failwithf "RConstString cannot be returned from a daemon function"
3018 pr " struct guestfs_%s_ret ret;\n" name;
3019 pr " ret.%s = r;\n" n;
3020 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
3023 | RStringList n | RHashtable n ->
3024 pr " struct guestfs_%s_ret ret;\n" name;
3025 pr " ret.%s.%s_len = count_strings (r);\n" n n;
3026 pr " ret.%s.%s_val = r;\n" n n;
3027 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
3029 pr " free_strings (r);\n"
3031 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n"
3033 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
3034 | RPVList n | RVGList n | RLVList n
3035 | RStat n | RStatVFS n ->
3036 pr " struct guestfs_%s_ret ret;\n" name;
3037 pr " ret.%s = *r;\n" n;
3038 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
3040 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
3044 (* Free the args. *)
3045 (match snd style with
3050 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
3057 (* Dispatch function. *)
3058 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
3060 pr " switch (proc_nr) {\n";
3063 fun (name, style, _, _, _, _, _) ->
3064 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
3065 pr " %s_stub (xdr_in);\n" name;
3070 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
3075 (* LVM columns and tokenization functions. *)
3076 (* XXX This generates crap code. We should rethink how we
3082 pr "static const char *lvm_%s_cols = \"%s\";\n"
3083 typ (String.concat "," (List.map fst cols));
3086 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
3088 pr " char *tok, *p, *next;\n";
3092 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
3095 pr " if (!str) {\n";
3096 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
3099 pr " if (!*str || isspace (*str)) {\n";
3100 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
3105 fun (name, coltype) ->
3106 pr " if (!tok) {\n";
3107 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
3110 pr " p = strchrnul (tok, ',');\n";
3111 pr " if (*p) next = p+1; else next = NULL;\n";
3112 pr " *p = '\\0';\n";
3115 pr " r->%s = strdup (tok);\n" name;
3116 pr " if (r->%s == NULL) {\n" name;
3117 pr " perror (\"strdup\");\n";
3121 pr " for (i = j = 0; i < 32; ++j) {\n";
3122 pr " if (tok[j] == '\\0') {\n";
3123 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
3125 pr " } else if (tok[j] != '-')\n";
3126 pr " r->%s[i++] = tok[j];\n" name;
3129 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
3130 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
3134 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
3135 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
3139 pr " if (tok[0] == '\\0')\n";
3140 pr " r->%s = -1;\n" name;
3141 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
3142 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
3146 pr " tok = next;\n";
3149 pr " if (tok != NULL) {\n";
3150 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
3157 pr "guestfs_lvm_int_%s_list *\n" typ;
3158 pr "parse_command_line_%ss (void)\n" typ;
3160 pr " char *out, *err;\n";
3161 pr " char *p, *pend;\n";
3163 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
3164 pr " void *newp;\n";
3166 pr " ret = malloc (sizeof *ret);\n";
3167 pr " if (!ret) {\n";
3168 pr " reply_with_perror (\"malloc\");\n";
3169 pr " return NULL;\n";
3172 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
3173 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
3175 pr " r = command (&out, &err,\n";
3176 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
3177 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
3178 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
3179 pr " if (r == -1) {\n";
3180 pr " reply_with_error (\"%%s\", err);\n";
3181 pr " free (out);\n";
3182 pr " free (err);\n";
3183 pr " free (ret);\n";
3184 pr " return NULL;\n";
3187 pr " free (err);\n";
3189 pr " /* Tokenize each line of the output. */\n";
3192 pr " while (p) {\n";
3193 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
3194 pr " if (pend) {\n";
3195 pr " *pend = '\\0';\n";
3199 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
3202 pr " if (!*p) { /* Empty line? Skip it. */\n";
3207 pr " /* Allocate some space to store this next entry. */\n";
3208 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
3209 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
3210 pr " if (newp == NULL) {\n";
3211 pr " reply_with_perror (\"realloc\");\n";
3212 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
3213 pr " free (ret);\n";
3214 pr " free (out);\n";
3215 pr " return NULL;\n";
3217 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
3219 pr " /* Tokenize the next entry. */\n";
3220 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
3221 pr " if (r == -1) {\n";
3222 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
3223 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
3224 pr " free (ret);\n";
3225 pr " free (out);\n";
3226 pr " return NULL;\n";
3233 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
3235 pr " free (out);\n";
3236 pr " return ret;\n";
3239 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
3241 (* Generate the tests. *)
3242 and generate_tests () =
3243 generate_header CStyle GPLv2;
3250 #include <sys/types.h>
3253 #include \"guestfs.h\"
3255 static guestfs_h *g;
3256 static int suppress_error = 0;
3258 /* This will be 's' or 'h' depending on whether the guest kernel
3259 * names IDE devices /dev/sd* or /dev/hd*.
3261 static char devchar = 's';
3263 static void print_error (guestfs_h *g, void *data, const char *msg)
3265 if (!suppress_error)
3266 fprintf (stderr, \"%%s\\n\", msg);
3269 static void print_strings (char * const * const argv)
3273 for (argc = 0; argv[argc] != NULL; ++argc)
3274 printf (\"\\t%%s\\n\", argv[argc]);
3278 static void print_table (char * const * const argv)
3282 for (i = 0; argv[i] != NULL; i += 2)
3283 printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
3287 static void no_test_warnings (void)
3293 | name, _, _, _, [], _, _ ->
3294 pr " fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
3295 | name, _, _, _, tests, _, _ -> ()
3301 (* Generate the actual tests. Note that we generate the tests
3302 * in reverse order, deliberately, so that (in general) the
3303 * newest tests run first. This makes it quicker and easier to
3308 fun (name, _, _, _, tests, _, _) ->
3309 mapi (generate_one_test name) tests
3310 ) (List.rev all_functions) in
3311 let test_names = List.concat test_names in
3312 let nr_tests = List.length test_names in
3315 int main (int argc, char *argv[])
3320 const char *filename;
3322 int nr_tests, test_num = 0;
3325 no_test_warnings ();
3327 g = guestfs_create ();
3329 printf (\"guestfs_create FAILED\\n\");
3333 guestfs_set_error_handler (g, print_error, NULL);
3335 srcdir = getenv (\"srcdir\");
3336 if (!srcdir) srcdir = \".\";
3338 guestfs_set_path (g, \".\");
3340 filename = \"test1.img\";
3341 fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
3346 if (lseek (fd, %d, SEEK_SET) == -1) {
3352 if (write (fd, &c, 1) == -1) {
3358 if (close (fd) == -1) {
3363 if (guestfs_add_drive (g, filename) == -1) {
3364 printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
3368 filename = \"test2.img\";
3369 fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
3374 if (lseek (fd, %d, SEEK_SET) == -1) {
3380 if (write (fd, &c, 1) == -1) {
3386 if (close (fd) == -1) {
3391 if (guestfs_add_drive (g, filename) == -1) {
3392 printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
3396 filename = \"test3.img\";
3397 fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
3402 if (lseek (fd, %d, SEEK_SET) == -1) {
3408 if (write (fd, &c, 1) == -1) {
3414 if (close (fd) == -1) {
3419 if (guestfs_add_drive (g, filename) == -1) {
3420 printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
3424 if (guestfs_launch (g) == -1) {
3425 printf (\"guestfs_launch FAILED\\n\");
3428 if (guestfs_wait_ready (g) == -1) {
3429 printf (\"guestfs_wait_ready FAILED\\n\");
3433 /* Detect if the appliance uses /dev/sd* or /dev/hd* in device
3434 * names. This changed between RHEL 5 and RHEL 6 so we have to
3437 devs = guestfs_list_devices (g);
3438 if (devs == NULL || devs[0] == NULL) {
3439 printf (\"guestfs_list_devices FAILED\\n\");
3442 if (strncmp (devs[0], \"/dev/sd\", 7) == 0)
3444 else if (strncmp (devs[0], \"/dev/hd\", 7) == 0)
3447 printf (\"guestfs_list_devices returned unexpected string '%%s'\\n\",
3451 for (i = 0; devs[i] != NULL; ++i)
3457 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
3461 pr " test_num++;\n";
3462 pr " printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
3463 pr " if (%s () == -1) {\n" test_name;
3464 pr " printf (\"%s FAILED\\n\");\n" test_name;
3470 pr " guestfs_close (g);\n";
3471 pr " unlink (\"test1.img\");\n";
3472 pr " unlink (\"test2.img\");\n";
3473 pr " unlink (\"test3.img\");\n";
3476 pr " if (failed > 0) {\n";
3477 pr " printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n";
3485 and generate_one_test name i (init, test) =
3486 let test_name = sprintf "test_%s_%d" name i in
3488 pr "static int %s (void)\n" test_name;
3494 pr " /* InitEmpty for %s (%d) */\n" name i;
3495 List.iter (generate_test_command_call test_name)
3496 [["blockdev_setrw"; "/dev/sda"];
3500 pr " /* InitBasicFS for %s (%d): create ext2 on /dev/sda1 */\n" name i;
3501 List.iter (generate_test_command_call test_name)
3502 [["blockdev_setrw"; "/dev/sda"];
3505 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
3506 ["mkfs"; "ext2"; "/dev/sda1"];
3507 ["mount"; "/dev/sda1"; "/"]]
3508 | InitBasicFSonLVM ->
3509 pr " /* InitBasicFSonLVM for %s (%d): create ext2 on /dev/VG/LV */\n"
3511 List.iter (generate_test_command_call test_name)
3512 [["blockdev_setrw"; "/dev/sda"];
3515 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
3516 ["pvcreate"; "/dev/sda1"];
3517 ["vgcreate"; "VG"; "/dev/sda1"];
3518 ["lvcreate"; "LV"; "VG"; "8"];
3519 ["mkfs"; "ext2"; "/dev/VG/LV"];
3520 ["mount"; "/dev/VG/LV"; "/"]]
3523 let get_seq_last = function
3525 failwithf "%s: you cannot use [] (empty list) when expecting a command"
3528 let seq = List.rev seq in
3529 List.rev (List.tl seq), List.hd seq
3534 pr " /* TestRun for %s (%d) */\n" name i;
3535 List.iter (generate_test_command_call test_name) seq
3536 | TestOutput (seq, expected) ->
3537 pr " /* TestOutput for %s (%d) */\n" name i;
3538 pr " char expected[] = \"%s\";\n" (c_quote expected);
3539 if String.length expected > 7 &&
3540 String.sub expected 0 7 = "/dev/sd" then
3541 pr " expected[5] = devchar;\n";
3542 let seq, last = get_seq_last seq in
3544 pr " if (strcmp (r, expected) != 0) {\n";
3545 pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
3549 List.iter (generate_test_command_call test_name) seq;
3550 generate_test_command_call ~test test_name last
3551 | TestOutputList (seq, expected) ->
3552 pr " /* TestOutputList for %s (%d) */\n" name i;
3553 let seq, last = get_seq_last seq in
3557 pr " if (!r[%d]) {\n" i;
3558 pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
3559 pr " print_strings (r);\n";
3563 pr " char expected[] = \"%s\";\n" (c_quote str);
3564 if String.length str > 7 && String.sub str 0 7 = "/dev/sd" then
3565 pr " expected[5] = devchar;\n";
3566 pr " if (strcmp (r[%d], expected) != 0) {\n" i;
3567 pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
3572 pr " if (r[%d] != NULL) {\n" (List.length expected);
3573 pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
3575 pr " print_strings (r);\n";
3579 List.iter (generate_test_command_call test_name) seq;
3580 generate_test_command_call ~test test_name last
3581 | TestOutputInt (seq, expected) ->
3582 pr " /* TestOutputInt for %s (%d) */\n" name i;
3583 let seq, last = get_seq_last seq in
3585 pr " if (r != %d) {\n" expected;
3586 pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\","
3592 List.iter (generate_test_command_call test_name) seq;
3593 generate_test_command_call ~test test_name last
3594 | TestOutputTrue seq ->
3595 pr " /* TestOutputTrue for %s (%d) */\n" name i;
3596 let seq, last = get_seq_last seq in
3599 pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n"
3604 List.iter (generate_test_command_call test_name) seq;
3605 generate_test_command_call ~test test_name last
3606 | TestOutputFalse seq ->
3607 pr " /* TestOutputFalse for %s (%d) */\n" name i;
3608 let seq, last = get_seq_last seq in
3611 pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n"
3616 List.iter (generate_test_command_call test_name) seq;
3617 generate_test_command_call ~test test_name last
3618 | TestOutputLength (seq, expected) ->
3619 pr " /* TestOutputLength for %s (%d) */\n" name i;
3620 let seq, last = get_seq_last seq in
3623 pr " for (j = 0; j < %d; ++j)\n" expected;
3624 pr " if (r[j] == NULL) {\n";
3625 pr " fprintf (stderr, \"%s: short list returned\\n\");\n"
3627 pr " print_strings (r);\n";
3630 pr " if (r[j] != NULL) {\n";
3631 pr " fprintf (stderr, \"%s: long list returned\\n\");\n"
3633 pr " print_strings (r);\n";
3637 List.iter (generate_test_command_call test_name) seq;
3638 generate_test_command_call ~test test_name last
3639 | TestOutputStruct (seq, checks) ->
3640 pr " /* TestOutputStruct for %s (%d) */\n" name i;
3641 let seq, last = get_seq_last seq in
3645 | CompareWithInt (field, expected) ->
3646 pr " if (r->%s != %d) {\n" field expected;
3647 pr " fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
3648 test_name field expected;
3649 pr " (int) r->%s);\n" field;
3652 | CompareWithString (field, expected) ->
3653 pr " if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
3654 pr " fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
3655 test_name field expected;
3656 pr " r->%s);\n" field;
3659 | CompareFieldsIntEq (field1, field2) ->
3660 pr " if (r->%s != r->%s) {\n" field1 field2;
3661 pr " fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
3662 test_name field1 field2;
3663 pr " (int) r->%s, (int) r->%s);\n" field1 field2;
3666 | CompareFieldsStrEq (field1, field2) ->
3667 pr " if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
3668 pr " fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
3669 test_name field1 field2;
3670 pr " r->%s, r->%s);\n" field1 field2;
3675 List.iter (generate_test_command_call test_name) seq;
3676 generate_test_command_call ~test test_name last
3677 | TestLastFail seq ->
3678 pr " /* TestLastFail for %s (%d) */\n" name i;
3679 let seq, last = get_seq_last seq in
3680 List.iter (generate_test_command_call test_name) seq;
3681 generate_test_command_call test_name ~expect_error:true last
3689 (* Generate the code to run a command, leaving the result in 'r'.
3690 * If you expect to get an error then you should set expect_error:true.
3692 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
3694 | [] -> assert false
3696 (* Look up the command to find out what args/ret it has. *)
3699 let _, style, _, _, _, _, _ =
3700 List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
3703 failwithf "%s: in test, command %s was not found" test_name name in
3705 if List.length (snd style) <> List.length args then
3706 failwithf "%s: in test, wrong number of args given to %s"
3713 | OptString n, "NULL" -> ()
3715 | OptString n, arg ->
3716 pr " char %s[] = \"%s\";\n" n (c_quote arg);
3717 if String.length arg > 7 && String.sub arg 0 7 = "/dev/sd" then
3718 pr " %s[5] = devchar;\n" n
3721 | FileIn _, _ | FileOut _, _ -> ()
3722 | StringList n, arg ->
3723 let strs = string_split " " arg in
3726 pr " char %s_%d[] = \"%s\";\n" n i (c_quote str);
3727 if String.length str > 7 && String.sub str 0 7 = "/dev/sd" then
3728 pr " %s_%d[5] = devchar;\n" n i
3730 pr " char *%s[] = {\n" n;
3732 fun i _ -> pr " %s_%d,\n" n i
3736 ) (List.combine (snd style) args);
3739 match fst style with
3740 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
3741 | RInt64 _ -> pr " int64_t r;\n"; "-1"
3742 | RConstString _ -> pr " const char *r;\n"; "NULL"
3743 | RString _ -> pr " char *r;\n"; "NULL"
3744 | RStringList _ | RHashtable _ ->
3749 pr " struct guestfs_int_bool *r;\n"; "NULL"
3751 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
3753 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
3755 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
3757 pr " struct guestfs_stat *r;\n"; "NULL"
3759 pr " struct guestfs_statvfs *r;\n"; "NULL" in
3761 pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
3762 pr " r = guestfs_%s (g" name;
3764 (* Generate the parameters. *)
3767 | OptString _, "NULL" -> pr ", NULL"
3771 | FileIn _, arg | FileOut _, arg ->
3772 pr ", \"%s\"" (c_quote arg)
3773 | StringList n, _ ->
3777 try int_of_string arg
3778 with Failure "int_of_string" ->
3779 failwithf "%s: expecting an int, but got '%s'" test_name arg in
3782 let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
3783 ) (List.combine (snd style) args);
3786 if not expect_error then
3787 pr " if (r == %s)\n" error_code
3789 pr " if (r != %s)\n" error_code;
3792 (* Insert the test code. *)
3798 (match fst style with
3799 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ -> ()
3800 | RString _ -> pr " free (r);\n"
3801 | RStringList _ | RHashtable _ ->
3802 pr " for (i = 0; r[i] != NULL; ++i)\n";
3803 pr " free (r[i]);\n";
3806 pr " guestfs_free_int_bool (r);\n"
3808 pr " guestfs_free_lvm_pv_list (r);\n"
3810 pr " guestfs_free_lvm_vg_list (r);\n"
3812 pr " guestfs_free_lvm_lv_list (r);\n"
3813 | RStat _ | RStatVFS _ ->
3820 let str = replace_str str "\r" "\\r" in
3821 let str = replace_str str "\n" "\\n" in
3822 let str = replace_str str "\t" "\\t" in
3823 let str = replace_str str "\000" "\\0" in
3826 (* Generate a lot of different functions for guestfish. *)
3827 and generate_fish_cmds () =
3828 generate_header CStyle GPLv2;
3832 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3834 let all_functions_sorted =
3836 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3837 ) all_functions_sorted in
3839 pr "#include <stdio.h>\n";
3840 pr "#include <stdlib.h>\n";
3841 pr "#include <string.h>\n";
3842 pr "#include <inttypes.h>\n";
3844 pr "#include <guestfs.h>\n";
3845 pr "#include \"fish.h\"\n";
3848 (* list_commands function, which implements guestfish -h *)
3849 pr "void list_commands (void)\n";
3851 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
3852 pr " list_builtin_commands ();\n";
3854 fun (name, _, _, flags, _, shortdesc, _) ->
3855 let name = replace_char name '_' '-' in
3856 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
3858 ) all_functions_sorted;
3859 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
3863 (* display_command function, which implements guestfish -h cmd *)
3864 pr "void display_command (const char *cmd)\n";
3867 fun (name, style, _, flags, _, shortdesc, longdesc) ->
3868 let name2 = replace_char name '_' '-' in
3870 try find_map (function FishAlias n -> Some n | _ -> None) flags
3871 with Not_found -> name in
3872 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
3874 match snd style with
3878 name2 (String.concat "> <" (List.map name_of_argt args)) in
3881 if List.mem ProtocolLimitWarning flags then
3882 ("\n\n" ^ protocol_limit_warning)
3885 (* For DangerWillRobinson commands, we should probably have
3886 * guestfish prompt before allowing you to use them (especially
3887 * in interactive mode). XXX
3891 if List.mem DangerWillRobinson flags then
3892 ("\n\n" ^ danger_will_robinson)
3895 let describe_alias =
3896 if name <> alias then
3897 sprintf "\n\nYou can use '%s' as an alias for this command." alias
3901 pr "strcasecmp (cmd, \"%s\") == 0" name;
3902 if name <> name2 then
3903 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
3904 if name <> alias then
3905 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
3907 pr " pod2text (\"%s - %s\", %S);\n"
3909 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
3912 pr " display_builtin_command (cmd);\n";
3916 (* print_{pv,vg,lv}_list functions *)
3920 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
3927 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
3929 pr " printf (\"%s: \");\n" name;
3930 pr " for (i = 0; i < 32; ++i)\n";
3931 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
3932 pr " printf (\"\\n\");\n"
3934 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
3936 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
3937 | name, `OptPercent ->
3938 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
3939 typ name name typ name;
3940 pr " else printf (\"%s: \\n\");\n" name
3944 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
3949 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
3950 pr " print_%s (&%ss->val[i]);\n" typ typ;
3953 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3955 (* print_{stat,statvfs} functions *)
3959 pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
3964 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
3968 ) ["stat", stat_cols; "statvfs", statvfs_cols];
3970 (* run_<action> actions *)
3972 fun (name, style, _, flags, _, _, _) ->
3973 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
3975 (match fst style with
3978 | RBool _ -> pr " int r;\n"
3979 | RInt64 _ -> pr " int64_t r;\n"
3980 | RConstString _ -> pr " const char *r;\n"
3981 | RString _ -> pr " char *r;\n"
3982 | RStringList _ | RHashtable _ -> pr " char **r;\n"
3983 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
3984 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
3985 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
3986 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
3987 | RStat _ -> pr " struct guestfs_stat *r;\n"
3988 | RStatVFS _ -> pr " struct guestfs_statvfs *r;\n"
3995 | FileOut n -> pr " const char *%s;\n" n
3996 | StringList n -> pr " char **%s;\n" n
3997 | Bool n -> pr " int %s;\n" n
3998 | Int n -> pr " int %s;\n" n
4001 (* Check and convert parameters. *)
4002 let argc_expected = List.length (snd style) in
4003 pr " if (argc != %d) {\n" argc_expected;
4004 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
4006 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
4012 | String name -> pr " %s = argv[%d];\n" name i
4014 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
4017 pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdin\";\n"
4020 pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n"
4022 | StringList name ->
4023 pr " %s = parse_string_list (argv[%d]);\n" name i
4025 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
4027 pr " %s = atoi (argv[%d]);\n" name i
4030 (* Call C API function. *)
4032 try find_map (function FishAction n -> Some n | _ -> None) flags
4033 with Not_found -> sprintf "guestfs_%s" name in
4035 generate_call_args ~handle:"g" (snd style);
4038 (* Check return value for errors and display command results. *)
4039 (match fst style with
4040 | RErr -> pr " return r;\n"
4042 pr " if (r == -1) return -1;\n";
4043 pr " printf (\"%%d\\n\", r);\n";
4046 pr " if (r == -1) return -1;\n";
4047 pr " printf (\"%%\" PRIi64 \"\\n\", r);\n";
4050 pr " if (r == -1) return -1;\n";
4051 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
4054 pr " if (r == NULL) return -1;\n";
4055 pr " printf (\"%%s\\n\", r);\n";
4058 pr " if (r == NULL) return -1;\n";
4059 pr " printf (\"%%s\\n\", r);\n";
4063 pr " if (r == NULL) return -1;\n";
4064 pr " print_strings (r);\n";
4065 pr " free_strings (r);\n";
4068 pr " if (r == NULL) return -1;\n";
4069 pr " printf (\"%%d, %%s\\n\", r->i,\n";
4070 pr " r->b ? \"true\" : \"false\");\n";
4071 pr " guestfs_free_int_bool (r);\n";
4074 pr " if (r == NULL) return -1;\n";
4075 pr " print_pv_list (r);\n";
4076 pr " guestfs_free_lvm_pv_list (r);\n";
4079 pr " if (r == NULL) return -1;\n";
4080 pr " print_vg_list (r);\n";
4081 pr " guestfs_free_lvm_vg_list (r);\n";
4084 pr " if (r == NULL) return -1;\n";
4085 pr " print_lv_list (r);\n";
4086 pr " guestfs_free_lvm_lv_list (r);\n";
4089 pr " if (r == NULL) return -1;\n";
4090 pr " print_stat (r);\n";
4094 pr " if (r == NULL) return -1;\n";
4095 pr " print_statvfs (r);\n";
4099 pr " if (r == NULL) return -1;\n";
4100 pr " print_table (r);\n";
4101 pr " free_strings (r);\n";
4108 (* run_action function *)
4109 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
4112 fun (name, _, _, flags, _, _, _) ->
4113 let name2 = replace_char name '_' '-' in
4115 try find_map (function FishAlias n -> Some n | _ -> None) flags
4116 with Not_found -> name in
4118 pr "strcasecmp (cmd, \"%s\") == 0" name;
4119 if name <> name2 then
4120 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
4121 if name <> alias then
4122 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
4124 pr " return run_%s (cmd, argc, argv);\n" name;
4128 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
4135 (* Readline completion for guestfish. *)
4136 and generate_fish_completion () =
4137 generate_header CStyle GPLv2;
4141 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
4151 #ifdef HAVE_LIBREADLINE
4152 #include <readline/readline.h>
4157 #ifdef HAVE_LIBREADLINE
4159 static const char *const commands[] = {
4162 (* Get the commands and sort them, including the aliases. *)
4165 fun (name, _, _, flags, _, _, _) ->
4166 let name2 = replace_char name '_' '-' in
4168 try find_map (function FishAlias n -> Some n | _ -> None) flags
4169 with Not_found -> name in
4171 if name <> alias then [name2; alias] else [name2]
4173 let commands = List.flatten commands in
4174 let commands = List.sort compare commands in
4176 List.iter (pr " \"%s\",\n") commands;
4182 generator (const char *text, int state)
4184 static int index, len;
4189 len = strlen (text);
4192 while ((name = commands[index]) != NULL) {
4194 if (strncasecmp (name, text, len) == 0)
4195 return strdup (name);
4201 #endif /* HAVE_LIBREADLINE */
4203 char **do_completion (const char *text, int start, int end)
4205 char **matches = NULL;
4207 #ifdef HAVE_LIBREADLINE
4209 matches = rl_completion_matches (text, generator);
4216 (* Generate the POD documentation for guestfish. *)
4217 and generate_fish_actions_pod () =
4218 let all_functions_sorted =
4220 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
4221 ) all_functions_sorted in
4223 let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
4226 fun (name, style, _, flags, _, _, longdesc) ->
4228 Str.global_substitute rex (
4231 try Str.matched_group 1 s
4233 failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
4234 "C<" ^ replace_char sub '_' '-' ^ ">"
4236 let name = replace_char name '_' '-' in
4238 try find_map (function FishAlias n -> Some n | _ -> None) flags
4239 with Not_found -> name in
4241 pr "=head2 %s" name;
4242 if name <> alias then
4249 | String n -> pr " %s" n
4250 | OptString n -> pr " %s" n
4251 | StringList n -> pr " '%s ...'" n
4252 | Bool _ -> pr " true|false"
4253 | Int n -> pr " %s" n
4254 | FileIn n | FileOut n -> pr " (%s|-)" n
4258 pr "%s\n\n" longdesc;
4260 if List.exists (function FileIn _ | FileOut _ -> true
4261 | _ -> false) (snd style) then
4262 pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
4264 if List.mem ProtocolLimitWarning flags then
4265 pr "%s\n\n" protocol_limit_warning;
4267 if List.mem DangerWillRobinson flags then
4268 pr "%s\n\n" danger_will_robinson
4269 ) all_functions_sorted
4271 (* Generate a C function prototype. *)
4272 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
4273 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
4275 ?handle name style =
4276 if extern then pr "extern ";
4277 if static then pr "static ";
4278 (match fst style with
4280 | RInt _ -> pr "int "
4281 | RInt64 _ -> pr "int64_t "
4282 | RBool _ -> pr "int "
4283 | RConstString _ -> pr "const char *"
4284 | RString _ -> pr "char *"
4285 | RStringList _ | RHashtable _ -> pr "char **"
4287 if not in_daemon then pr "struct guestfs_int_bool *"
4288 else pr "guestfs_%s_ret *" name
4290 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
4291 else pr "guestfs_lvm_int_pv_list *"
4293 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
4294 else pr "guestfs_lvm_int_vg_list *"
4296 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
4297 else pr "guestfs_lvm_int_lv_list *"
4299 if not in_daemon then pr "struct guestfs_stat *"
4300 else pr "guestfs_int_stat *"
4302 if not in_daemon then pr "struct guestfs_statvfs *"
4303 else pr "guestfs_int_statvfs *"
4305 pr "%s%s (" prefix name;
4306 if handle = None && List.length (snd style) = 0 then
4309 let comma = ref false in
4312 | Some handle -> pr "guestfs_h *%s" handle; comma := true
4316 if single_line then pr ", " else pr ",\n\t\t"
4323 | OptString n -> next (); pr "const char *%s" n
4324 | StringList n -> next (); pr "char * const* const %s" n
4325 | Bool n -> next (); pr "int %s" n
4326 | Int n -> next (); pr "int %s" n
4329 if not in_daemon then (next (); pr "const char *%s" n)
4333 if semicolon then pr ";";
4334 if newline then pr "\n"
4336 (* Generate C call arguments, eg "(handle, foo, bar)" *)
4337 and generate_call_args ?handle args =
4339 let comma = ref false in
4342 | Some handle -> pr "%s" handle; comma := true
4346 if !comma then pr ", ";
4348 pr "%s" (name_of_argt arg)
4352 (* Generate the OCaml bindings interface. *)
4353 and generate_ocaml_mli () =
4354 generate_header OCamlStyle LGPLv2;
4357 (** For API documentation you should refer to the C API
4358 in the guestfs(3) manual page. The OCaml API uses almost
4359 exactly the same calls. *)
4362 (** A [guestfs_h] handle. *)
4364 exception Error of string
4365 (** This exception is raised when there is an error. *)
4367 val create : unit -> t
4369 val close : t -> unit
4370 (** Handles are closed by the garbage collector when they become
4371 unreferenced, but callers can also call this in order to
4372 provide predictable cleanup. *)
4375 generate_ocaml_lvm_structure_decls ();
4377 generate_ocaml_stat_structure_decls ();
4381 fun (name, style, _, _, _, shortdesc, _) ->
4382 generate_ocaml_prototype name style;
4383 pr "(** %s *)\n" shortdesc;
4387 (* Generate the OCaml bindings implementation. *)
4388 and generate_ocaml_ml () =
4389 generate_header OCamlStyle LGPLv2;
4393 exception Error of string
4394 external create : unit -> t = \"ocaml_guestfs_create\"
4395 external close : t -> unit = \"ocaml_guestfs_close\"
4398 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
4402 generate_ocaml_lvm_structure_decls ();
4404 generate_ocaml_stat_structure_decls ();
4408 fun (name, style, _, _, _, shortdesc, _) ->
4409 generate_ocaml_prototype ~is_external:true name style;
4412 (* Generate the OCaml bindings C implementation. *)
4413 and generate_ocaml_c () =
4414 generate_header CStyle LGPLv2;
4421 #include <caml/config.h>
4422 #include <caml/alloc.h>
4423 #include <caml/callback.h>
4424 #include <caml/fail.h>
4425 #include <caml/memory.h>
4426 #include <caml/mlvalues.h>
4427 #include <caml/signals.h>
4429 #include <guestfs.h>
4431 #include \"guestfs_c.h\"
4433 /* Copy a hashtable of string pairs into an assoc-list. We return
4434 * the list in reverse order, but hashtables aren't supposed to be
4437 static CAMLprim value
4438 copy_table (char * const * argv)
4441 CAMLlocal5 (rv, pairv, kv, vv, cons);
4445 for (i = 0; argv[i] != NULL; i += 2) {
4446 kv = caml_copy_string (argv[i]);
4447 vv = caml_copy_string (argv[i+1]);
4448 pairv = caml_alloc (2, 0);
4449 Store_field (pairv, 0, kv);
4450 Store_field (pairv, 1, vv);
4451 cons = caml_alloc (2, 0);
4452 Store_field (cons, 1, rv);
4454 Store_field (cons, 0, pairv);
4462 (* LVM struct copy functions. *)
4465 let has_optpercent_col =
4466 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
4468 pr "static CAMLprim value\n";
4469 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
4471 pr " CAMLparam0 ();\n";
4472 if has_optpercent_col then
4473 pr " CAMLlocal3 (rv, v, v2);\n"
4475 pr " CAMLlocal2 (rv, v);\n";
4477 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
4482 pr " v = caml_copy_string (%s->%s);\n" typ name
4484 pr " v = caml_alloc_string (32);\n";
4485 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
4488 pr " v = caml_copy_int64 (%s->%s);\n" typ name
4489 | name, `OptPercent ->
4490 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
4491 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
4492 pr " v = caml_alloc (1, 0);\n";
4493 pr " Store_field (v, 0, v2);\n";
4494 pr " } else /* None */\n";
4495 pr " v = Val_int (0);\n";
4497 pr " Store_field (rv, %d, v);\n" i
4499 pr " CAMLreturn (rv);\n";
4503 pr "static CAMLprim value\n";
4504 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
4507 pr " CAMLparam0 ();\n";
4508 pr " CAMLlocal2 (rv, v);\n";
4511 pr " if (%ss->len == 0)\n" typ;
4512 pr " CAMLreturn (Atom (0));\n";
4514 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
4515 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
4516 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
4517 pr " caml_modify (&Field (rv, i), v);\n";
4519 pr " CAMLreturn (rv);\n";
4523 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
4525 (* Stat copy functions. *)
4528 pr "static CAMLprim value\n";
4529 pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
4531 pr " CAMLparam0 ();\n";
4532 pr " CAMLlocal2 (rv, v);\n";
4534 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
4539 pr " v = caml_copy_int64 (%s->%s);\n" typ name
4541 pr " Store_field (rv, %d, v);\n" i
4543 pr " CAMLreturn (rv);\n";
4546 ) ["stat", stat_cols; "statvfs", statvfs_cols];
4550 fun (name, style, _, _, _, _, _) ->
4552 "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
4554 pr "CAMLprim value\n";
4555 pr "ocaml_guestfs_%s (value %s" name (List.hd params);
4556 List.iter (pr ", value %s") (List.tl params);
4561 | [p1; p2; p3; p4; p5] ->
4562 pr " CAMLparam5 (%s);\n" (String.concat ", " params)
4563 | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
4564 pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
4565 pr " CAMLxparam%d (%s);\n"
4566 (List.length rest) (String.concat ", " rest)
4568 pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
4570 pr " CAMLlocal1 (rv);\n";
4573 pr " guestfs_h *g = Guestfs_val (gv);\n";
4574 pr " if (g == NULL)\n";
4575 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
4583 pr " const char *%s = String_val (%sv);\n" n n
4585 pr " const char *%s =\n" n;
4586 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
4589 pr " char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
4591 pr " int %s = Bool_val (%sv);\n" n n
4593 pr " int %s = Int_val (%sv);\n" n n
4596 match fst style with
4597 | RErr -> pr " int r;\n"; "-1"
4598 | RInt _ -> pr " int r;\n"; "-1"
4599 | RInt64 _ -> pr " int64_t r;\n"; "-1"
4600 | RBool _ -> pr " int r;\n"; "-1"
4601 | RConstString _ -> pr " const char *r;\n"; "NULL"
4602 | RString _ -> pr " char *r;\n"; "NULL"
4608 pr " struct guestfs_int_bool *r;\n"; "NULL"
4610 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
4612 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
4614 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
4616 pr " struct guestfs_stat *r;\n"; "NULL"
4618 pr " struct guestfs_statvfs *r;\n"; "NULL"
4625 pr " caml_enter_blocking_section ();\n";
4626 pr " r = guestfs_%s " name;
4627 generate_call_args ~handle:"g" (snd style);
4629 pr " caml_leave_blocking_section ();\n";
4634 pr " ocaml_guestfs_free_strings (%s);\n" n;
4635 | String _ | OptString _ | Bool _ | Int _ | FileIn _ | FileOut _ -> ()
4638 pr " if (r == %s)\n" error_code;
4639 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
4642 (match fst style with
4643 | RErr -> pr " rv = Val_unit;\n"
4644 | RInt _ -> pr " rv = Val_int (r);\n"
4646 pr " rv = caml_copy_int64 (r);\n"
4647 | RBool _ -> pr " rv = Val_bool (r);\n"
4648 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
4650 pr " rv = caml_copy_string (r);\n";
4653 pr " rv = caml_copy_string_array ((const char **) r);\n";
4654 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
4657 pr " rv = caml_alloc (2, 0);\n";
4658 pr " Store_field (rv, 0, Val_int (r->i));\n";
4659 pr " Store_field (rv, 1, Val_bool (r->b));\n";
4660 pr " guestfs_free_int_bool (r);\n";
4662 pr " rv = copy_lvm_pv_list (r);\n";
4663 pr " guestfs_free_lvm_pv_list (r);\n";
4665 pr " rv = copy_lvm_vg_list (r);\n";
4666 pr " guestfs_free_lvm_vg_list (r);\n";
4668 pr " rv = copy_lvm_lv_list (r);\n";
4669 pr " guestfs_free_lvm_lv_list (r);\n";
4671 pr " rv = copy_stat (r);\n";
4674 pr " rv = copy_statvfs (r);\n";
4677 pr " rv = copy_table (r);\n";
4678 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
4682 pr " CAMLreturn (rv);\n";
4686 if List.length params > 5 then (
4687 pr "CAMLprim value\n";
4688 pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
4690 pr " return ocaml_guestfs_%s (argv[0]" name;
4691 iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
4698 and generate_ocaml_lvm_structure_decls () =
4701 pr "type lvm_%s = {\n" typ;
4704 | name, `String -> pr " %s : string;\n" name
4705 | name, `UUID -> pr " %s : string;\n" name
4706 | name, `Bytes -> pr " %s : int64;\n" name
4707 | name, `Int -> pr " %s : int64;\n" name
4708 | name, `OptPercent -> pr " %s : float option;\n" name
4712 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
4714 and generate_ocaml_stat_structure_decls () =
4717 pr "type %s = {\n" typ;
4720 | name, `Int -> pr " %s : int64;\n" name
4724 ) ["stat", stat_cols; "statvfs", statvfs_cols]
4726 and generate_ocaml_prototype ?(is_external = false) name style =
4727 if is_external then pr "external " else pr "val ";
4728 pr "%s : t -> " name;
4731 | String _ | FileIn _ | FileOut _ -> pr "string -> "
4732 | OptString _ -> pr "string option -> "
4733 | StringList _ -> pr "string array -> "
4734 | Bool _ -> pr "bool -> "
4735 | Int _ -> pr "int -> "
4737 (match fst style with
4738 | RErr -> pr "unit" (* all errors are turned into exceptions *)
4739 | RInt _ -> pr "int"
4740 | RInt64 _ -> pr "int64"
4741 | RBool _ -> pr "bool"
4742 | RConstString _ -> pr "string"
4743 | RString _ -> pr "string"
4744 | RStringList _ -> pr "string array"
4745 | RIntBool _ -> pr "int * bool"
4746 | RPVList _ -> pr "lvm_pv array"
4747 | RVGList _ -> pr "lvm_vg array"
4748 | RLVList _ -> pr "lvm_lv array"
4749 | RStat _ -> pr "stat"
4750 | RStatVFS _ -> pr "statvfs"
4751 | RHashtable _ -> pr "(string * string) list"
4753 if is_external then (
4755 if List.length (snd style) + 1 > 5 then
4756 pr "\"ocaml_guestfs_%s_byte\" " name;
4757 pr "\"ocaml_guestfs_%s\"" name
4761 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
4762 and generate_perl_xs () =
4763 generate_header CStyle LGPLv2;
4766 #include \"EXTERN.h\"
4770 #include <guestfs.h>
4773 #define PRId64 \"lld\"
4777 my_newSVll(long long val) {
4778 #ifdef USE_64_BIT_ALL
4779 return newSViv(val);
4783 len = snprintf(buf, 100, \"%%\" PRId64, val);
4784 return newSVpv(buf, len);
4789 #define PRIu64 \"llu\"
4793 my_newSVull(unsigned long long val) {
4794 #ifdef USE_64_BIT_ALL
4795 return newSVuv(val);
4799 len = snprintf(buf, 100, \"%%\" PRIu64, val);
4800 return newSVpv(buf, len);
4804 /* http://www.perlmonks.org/?node_id=680842 */
4806 XS_unpack_charPtrPtr (SV *arg) {
4811 if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
4812 croak (\"array reference expected\");
4814 av = (AV *)SvRV (arg);
4815 ret = malloc (av_len (av) + 1 + 1);
4817 croak (\"malloc failed\");
4819 for (i = 0; i <= av_len (av); i++) {
4820 SV **elem = av_fetch (av, i, 0);
4822 if (!elem || !*elem)
4823 croak (\"missing element in list\");
4825 ret[i] = SvPV_nolen (*elem);
4833 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
4840 RETVAL = guestfs_create ();
4842 croak (\"could not create guestfs handle\");
4843 guestfs_set_error_handler (RETVAL, NULL, NULL);
4856 fun (name, style, _, _, _, _, _) ->
4857 (match fst style with
4858 | RErr -> pr "void\n"
4859 | RInt _ -> pr "SV *\n"
4860 | RInt64 _ -> pr "SV *\n"
4861 | RBool _ -> pr "SV *\n"
4862 | RConstString _ -> pr "SV *\n"
4863 | RString _ -> pr "SV *\n"
4866 | RPVList _ | RVGList _ | RLVList _
4867 | RStat _ | RStatVFS _
4869 pr "void\n" (* all lists returned implictly on the stack *)
4871 (* Call and arguments. *)
4873 generate_call_args ~handle:"g" (snd style);
4875 pr " guestfs_h *g;\n";
4878 | String n | FileIn n | FileOut n -> pr " char *%s;\n" n
4879 | OptString n -> pr " char *%s;\n" n
4880 | StringList n -> pr " char **%s;\n" n
4881 | Bool n -> pr " int %s;\n" n
4882 | Int n -> pr " int %s;\n" n
4885 let do_cleanups () =
4888 | String _ | OptString _ | Bool _ | Int _
4889 | FileIn _ | FileOut _ -> ()
4890 | StringList n -> pr " free (%s);\n" n
4895 (match fst style with
4900 pr " r = guestfs_%s " name;
4901 generate_call_args ~handle:"g" (snd style);
4904 pr " if (r == -1)\n";
4905 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4911 pr " %s = guestfs_%s " n name;
4912 generate_call_args ~handle:"g" (snd style);
4915 pr " if (%s == -1)\n" n;
4916 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4917 pr " RETVAL = newSViv (%s);\n" n;
4922 pr " int64_t %s;\n" n;
4924 pr " %s = guestfs_%s " n name;
4925 generate_call_args ~handle:"g" (snd style);
4928 pr " if (%s == -1)\n" n;
4929 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4930 pr " RETVAL = my_newSVll (%s);\n" n;
4935 pr " const char *%s;\n" n;
4937 pr " %s = guestfs_%s " n name;
4938 generate_call_args ~handle:"g" (snd style);
4941 pr " if (%s == NULL)\n" n;
4942 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4943 pr " RETVAL = newSVpv (%s, 0);\n" n;
4948 pr " char *%s;\n" n;
4950 pr " %s = guestfs_%s " n name;
4951 generate_call_args ~handle:"g" (snd style);
4954 pr " if (%s == NULL)\n" n;
4955 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4956 pr " RETVAL = newSVpv (%s, 0);\n" n;
4957 pr " free (%s);\n" n;
4960 | RStringList n | RHashtable n ->
4962 pr " char **%s;\n" n;
4965 pr " %s = guestfs_%s " n name;
4966 generate_call_args ~handle:"g" (snd style);
4969 pr " if (%s == NULL)\n" n;
4970 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4971 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
4972 pr " EXTEND (SP, n);\n";
4973 pr " for (i = 0; i < n; ++i) {\n";
4974 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
4975 pr " free (%s[i]);\n" n;
4977 pr " free (%s);\n" n;
4980 pr " struct guestfs_int_bool *r;\n";
4982 pr " r = guestfs_%s " name;
4983 generate_call_args ~handle:"g" (snd style);
4986 pr " if (r == NULL)\n";
4987 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4988 pr " EXTEND (SP, 2);\n";
4989 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
4990 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
4991 pr " guestfs_free_int_bool (r);\n";
4993 generate_perl_lvm_code "pv" pv_cols name style n do_cleanups
4995 generate_perl_lvm_code "vg" vg_cols name style n do_cleanups
4997 generate_perl_lvm_code "lv" lv_cols name style n do_cleanups
4999 generate_perl_stat_code "stat" stat_cols name style n do_cleanups
5001 generate_perl_stat_code
5002 "statvfs" statvfs_cols name style n do_cleanups
5008 and generate_perl_lvm_code typ cols name style n do_cleanups =
5010 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
5014 pr " %s = guestfs_%s " n name;
5015 generate_call_args ~handle:"g" (snd style);
5018 pr " if (%s == NULL)\n" n;
5019 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5020 pr " EXTEND (SP, %s->len);\n" n;
5021 pr " for (i = 0; i < %s->len; ++i) {\n" n;
5022 pr " hv = newHV ();\n";
5026 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
5027 name (String.length name) n name
5029 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
5030 name (String.length name) n name
5032 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
5033 name (String.length name) n name
5035 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
5036 name (String.length name) n name
5037 | name, `OptPercent ->
5038 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
5039 name (String.length name) n name
5041 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
5043 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
5045 and generate_perl_stat_code typ cols name style n do_cleanups =
5047 pr " struct guestfs_%s *%s;\n" typ n;
5049 pr " %s = guestfs_%s " n name;
5050 generate_call_args ~handle:"g" (snd style);
5053 pr " if (%s == NULL)\n" n;
5054 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5055 pr " EXTEND (SP, %d);\n" (List.length cols);
5059 pr " PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n" n name
5061 pr " free (%s);\n" n
5063 (* Generate Sys/Guestfs.pm. *)
5064 and generate_perl_pm () =
5065 generate_header HashStyle LGPLv2;
5072 Sys::Guestfs - Perl bindings for libguestfs
5078 my $h = Sys::Guestfs->new ();
5079 $h->add_drive ('guest.img');
5082 $h->mount ('/dev/sda1', '/');
5083 $h->touch ('/hello');
5088 The C<Sys::Guestfs> module provides a Perl XS binding to the
5089 libguestfs API for examining and modifying virtual machine
5092 Amongst the things this is good for: making batch configuration
5093 changes to guests, getting disk used/free statistics (see also:
5094 virt-df), migrating between virtualization systems (see also:
5095 virt-p2v), performing partial backups, performing partial guest
5096 clones, cloning guests and changing registry/UUID/hostname info, and
5099 Libguestfs uses Linux kernel and qemu code, and can access any type of
5100 guest filesystem that Linux and qemu can, including but not limited
5101 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
5102 schemes, qcow, qcow2, vmdk.
5104 Libguestfs provides ways to enumerate guest storage (eg. partitions,
5105 LVs, what filesystem is in each LV, etc.). It can also run commands
5106 in the context of the guest. Also you can access filesystems over FTP.
5110 All errors turn into calls to C<croak> (see L<Carp(3)>).
5118 package Sys::Guestfs;
5124 XSLoader::load ('Sys::Guestfs');
5126 =item $h = Sys::Guestfs->new ();
5128 Create a new guestfs handle.
5134 my $class = ref ($proto) || $proto;
5136 my $self = Sys::Guestfs::_create ();
5137 bless $self, $class;
5143 (* Actions. We only need to print documentation for these as
5144 * they are pulled in from the XS code automatically.
5147 fun (name, style, _, flags, _, _, longdesc) ->
5148 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
5150 generate_perl_prototype name style;
5152 pr "%s\n\n" longdesc;
5153 if List.mem ProtocolLimitWarning flags then
5154 pr "%s\n\n" protocol_limit_warning;
5155 if List.mem DangerWillRobinson flags then
5156 pr "%s\n\n" danger_will_robinson
5157 ) all_functions_sorted;
5169 Copyright (C) 2009 Red Hat Inc.
5173 Please see the file COPYING.LIB for the full license.
5177 L<guestfs(3)>, L<guestfish(1)>.
5182 and generate_perl_prototype name style =
5183 (match fst style with
5189 | RString n -> pr "$%s = " n
5190 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
5194 | RLVList n -> pr "@%s = " n
5197 | RHashtable n -> pr "%%%s = " n
5200 let comma = ref false in
5203 if !comma then pr ", ";
5206 | String n | OptString n | Bool n | Int n | FileIn n | FileOut n ->
5213 (* Generate Python C module. *)
5214 and generate_python_c () =
5215 generate_header CStyle LGPLv2;
5224 #include \"guestfs.h\"
5232 get_handle (PyObject *obj)
5235 assert (obj != Py_None);
5236 return ((Pyguestfs_Object *) obj)->g;
5240 put_handle (guestfs_h *g)
5244 PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
5247 /* This list should be freed (but not the strings) after use. */
5248 static const char **
5249 get_string_list (PyObject *obj)
5256 if (!PyList_Check (obj)) {
5257 PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
5261 len = PyList_Size (obj);
5262 r = malloc (sizeof (char *) * (len+1));
5264 PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
5268 for (i = 0; i < len; ++i)
5269 r[i] = PyString_AsString (PyList_GetItem (obj, i));
5276 put_string_list (char * const * const argv)
5281 for (argc = 0; argv[argc] != NULL; ++argc)
5284 list = PyList_New (argc);
5285 for (i = 0; i < argc; ++i)
5286 PyList_SetItem (list, i, PyString_FromString (argv[i]));
5292 put_table (char * const * const argv)
5294 PyObject *list, *item;
5297 for (argc = 0; argv[argc] != NULL; ++argc)
5300 list = PyList_New (argc >> 1);
5301 for (i = 0; i < argc; i += 2) {
5302 item = PyTuple_New (2);
5303 PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
5304 PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
5305 PyList_SetItem (list, i >> 1, item);
5312 free_strings (char **argv)
5316 for (argc = 0; argv[argc] != NULL; ++argc)
5322 py_guestfs_create (PyObject *self, PyObject *args)
5326 g = guestfs_create ();
5328 PyErr_SetString (PyExc_RuntimeError,
5329 \"guestfs.create: failed to allocate handle\");
5332 guestfs_set_error_handler (g, NULL, NULL);
5333 return put_handle (g);
5337 py_guestfs_close (PyObject *self, PyObject *args)
5342 if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
5344 g = get_handle (py_g);
5348 Py_INCREF (Py_None);
5354 (* LVM structures, turned into Python dictionaries. *)
5357 pr "static PyObject *\n";
5358 pr "put_lvm_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
5360 pr " PyObject *dict;\n";
5362 pr " dict = PyDict_New ();\n";
5366 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
5367 pr " PyString_FromString (%s->%s));\n"
5370 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
5371 pr " PyString_FromStringAndSize (%s->%s, 32));\n"
5374 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
5375 pr " PyLong_FromUnsignedLongLong (%s->%s));\n"
5378 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
5379 pr " PyLong_FromLongLong (%s->%s));\n"
5381 | name, `OptPercent ->
5382 pr " if (%s->%s >= 0)\n" typ name;
5383 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
5384 pr " PyFloat_FromDouble ((double) %s->%s));\n"
5387 pr " Py_INCREF (Py_None);\n";
5388 pr " PyDict_SetItemString (dict, \"%s\", Py_None);" name;
5391 pr " return dict;\n";
5395 pr "static PyObject *\n";
5396 pr "put_lvm_%s_list (struct guestfs_lvm_%s_list *%ss)\n" typ typ typ;
5398 pr " PyObject *list;\n";
5401 pr " list = PyList_New (%ss->len);\n" typ;
5402 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
5403 pr " PyList_SetItem (list, i, put_lvm_%s (&%ss->val[i]));\n" typ typ;
5404 pr " return list;\n";
5407 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
5409 (* Stat structures, turned into Python dictionaries. *)
5412 pr "static PyObject *\n";
5413 pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
5415 pr " PyObject *dict;\n";
5417 pr " dict = PyDict_New ();\n";
5421 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
5422 pr " PyLong_FromLongLong (%s->%s));\n"
5425 pr " return dict;\n";
5428 ) ["stat", stat_cols; "statvfs", statvfs_cols];
5430 (* Python wrapper functions. *)
5432 fun (name, style, _, _, _, _, _) ->
5433 pr "static PyObject *\n";
5434 pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
5437 pr " PyObject *py_g;\n";
5438 pr " guestfs_h *g;\n";
5439 pr " PyObject *py_r;\n";
5442 match fst style with
5443 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
5444 | RInt64 _ -> pr " int64_t r;\n"; "-1"
5445 | RConstString _ -> pr " const char *r;\n"; "NULL"
5446 | RString _ -> pr " char *r;\n"; "NULL"
5447 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
5448 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
5449 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
5450 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
5451 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
5452 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
5453 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
5457 | String n | FileIn n | FileOut n -> pr " const char *%s;\n" n
5458 | OptString n -> pr " const char *%s;\n" n
5460 pr " PyObject *py_%s;\n" n;
5461 pr " const char **%s;\n" n
5462 | Bool n -> pr " int %s;\n" n
5463 | Int n -> pr " int %s;\n" n
5468 (* Convert the parameters. *)
5469 pr " if (!PyArg_ParseTuple (args, (char *) \"O";
5472 | String _ | FileIn _ | FileOut _ -> pr "s"
5473 | OptString _ -> pr "z"
5474 | StringList _ -> pr "O"
5475 | Bool _ -> pr "i" (* XXX Python has booleans? *)
5478 pr ":guestfs_%s\",\n" name;
5482 | String n | FileIn n | FileOut n -> pr ", &%s" n
5483 | OptString n -> pr ", &%s" n
5484 | StringList n -> pr ", &py_%s" n
5485 | Bool n -> pr ", &%s" n
5486 | Int n -> pr ", &%s" n
5490 pr " return NULL;\n";
5492 pr " g = get_handle (py_g);\n";
5495 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
5497 pr " %s = get_string_list (py_%s);\n" n n;
5498 pr " if (!%s) return NULL;\n" n
5503 pr " r = guestfs_%s " name;
5504 generate_call_args ~handle:"g" (snd style);
5509 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
5511 pr " free (%s);\n" n
5514 pr " if (r == %s) {\n" error_code;
5515 pr " PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
5516 pr " return NULL;\n";
5520 (match fst style with
5522 pr " Py_INCREF (Py_None);\n";
5523 pr " py_r = Py_None;\n"
5525 | RBool _ -> pr " py_r = PyInt_FromLong ((long) r);\n"
5526 | RInt64 _ -> pr " py_r = PyLong_FromLongLong (r);\n"
5527 | RConstString _ -> pr " py_r = PyString_FromString (r);\n"
5529 pr " py_r = PyString_FromString (r);\n";
5532 pr " py_r = put_string_list (r);\n";
5533 pr " free_strings (r);\n"
5535 pr " py_r = PyTuple_New (2);\n";
5536 pr " PyTuple_SetItem (py_r, 0, PyInt_FromLong ((long) r->i));\n";
5537 pr " PyTuple_SetItem (py_r, 1, PyInt_FromLong ((long) r->b));\n";
5538 pr " guestfs_free_int_bool (r);\n"
5540 pr " py_r = put_lvm_pv_list (r);\n";
5541 pr " guestfs_free_lvm_pv_list (r);\n"
5543 pr " py_r = put_lvm_vg_list (r);\n";
5544 pr " guestfs_free_lvm_vg_list (r);\n"
5546 pr " py_r = put_lvm_lv_list (r);\n";
5547 pr " guestfs_free_lvm_lv_list (r);\n"
5549 pr " py_r = put_stat (r);\n";
5552 pr " py_r = put_statvfs (r);\n";
5555 pr " py_r = put_table (r);\n";
5556 pr " free_strings (r);\n"
5559 pr " return py_r;\n";
5564 (* Table of functions. *)
5565 pr "static PyMethodDef methods[] = {\n";
5566 pr " { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
5567 pr " { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
5569 fun (name, _, _, _, _, _, _) ->
5570 pr " { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
5573 pr " { NULL, NULL, 0, NULL }\n";
5577 (* Init function. *)
5580 initlibguestfsmod (void)
5582 static int initialized = 0;
5584 if (initialized) return;
5585 Py_InitModule ((char *) \"libguestfsmod\", methods);
5590 (* Generate Python module. *)
5591 and generate_python_py () =
5592 generate_header HashStyle LGPLv2;
5595 u\"\"\"Python bindings for libguestfs
5598 g = guestfs.GuestFS ()
5599 g.add_drive (\"guest.img\")
5602 parts = g.list_partitions ()
5604 The guestfs module provides a Python binding to the libguestfs API
5605 for examining and modifying virtual machine disk images.
5607 Amongst the things this is good for: making batch configuration
5608 changes to guests, getting disk used/free statistics (see also:
5609 virt-df), migrating between virtualization systems (see also:
5610 virt-p2v), performing partial backups, performing partial guest
5611 clones, cloning guests and changing registry/UUID/hostname info, and
5614 Libguestfs uses Linux kernel and qemu code, and can access any type of
5615 guest filesystem that Linux and qemu can, including but not limited
5616 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
5617 schemes, qcow, qcow2, vmdk.
5619 Libguestfs provides ways to enumerate guest storage (eg. partitions,
5620 LVs, what filesystem is in each LV, etc.). It can also run commands
5621 in the context of the guest. Also you can access filesystems over FTP.
5623 Errors which happen while using the API are turned into Python
5624 RuntimeError exceptions.
5626 To create a guestfs handle you usually have to perform the following
5629 # Create the handle, call add_drive at least once, and possibly
5630 # several times if the guest has multiple block devices:
5631 g = guestfs.GuestFS ()
5632 g.add_drive (\"guest.img\")
5634 # Launch the qemu subprocess and wait for it to become ready:
5638 # Now you can issue commands, for example:
5643 import libguestfsmod
5646 \"\"\"Instances of this class are libguestfs API handles.\"\"\"
5648 def __init__ (self):
5649 \"\"\"Create a new libguestfs handle.\"\"\"
5650 self._o = libguestfsmod.create ()
5653 libguestfsmod.close (self._o)
5658 fun (name, style, _, flags, _, _, longdesc) ->
5659 let doc = replace_str longdesc "C<guestfs_" "C<g." in
5661 match fst style with
5662 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _
5665 doc ^ "\n\nThis function returns a list of strings."
5667 doc ^ "\n\nThis function returns a tuple (int, bool).\n"
5669 doc ^ "\n\nThis function returns a list of PVs. Each PV is represented as a dictionary."
5671 doc ^ "\n\nThis function returns a list of VGs. Each VG is represented as a dictionary."
5673 doc ^ "\n\nThis function returns a list of LVs. Each LV is represented as a dictionary."
5675 doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the stat structure."
5677 doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the statvfs structure."
5679 doc ^ "\n\nThis function returns a dictionary." in
5681 if List.mem ProtocolLimitWarning flags then
5682 doc ^ "\n\n" ^ protocol_limit_warning
5685 if List.mem DangerWillRobinson flags then
5686 doc ^ "\n\n" ^ danger_will_robinson
5688 let doc = pod2text ~width:60 name doc in
5689 let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
5690 let doc = String.concat "\n " doc in
5693 generate_call_args ~handle:"self" (snd style);
5695 pr " u\"\"\"%s\"\"\"\n" doc;
5696 pr " return libguestfsmod.%s " name;
5697 generate_call_args ~handle:"self._o" (snd style);
5702 (* Useful if you need the longdesc POD text as plain text. Returns a
5705 * This is the slowest thing about autogeneration.
5707 and pod2text ~width name longdesc =
5708 let filename, chan = Filename.open_temp_file "gen" ".tmp" in
5709 fprintf chan "=head1 %s\n\n%s\n" name longdesc;
5711 let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
5712 let chan = Unix.open_process_in cmd in
5713 let lines = ref [] in
5715 let line = input_line chan in
5716 if i = 1 then (* discard the first line of output *)
5719 let line = triml line in
5720 lines := line :: !lines;
5723 let lines = try loop 1 with End_of_file -> List.rev !lines in
5724 Unix.unlink filename;
5725 match Unix.close_process_in chan with
5726 | Unix.WEXITED 0 -> lines
5728 failwithf "pod2text: process exited with non-zero status (%d)" i
5729 | Unix.WSIGNALED i | Unix.WSTOPPED i ->
5730 failwithf "pod2text: process signalled or stopped by signal %d" i
5732 (* Generate ruby bindings. *)
5733 and generate_ruby_c () =
5734 generate_header CStyle LGPLv2;
5742 #include \"guestfs.h\"
5744 #include \"extconf.h\"
5746 /* For Ruby < 1.9 */
5748 #define RARRAY_LEN(r) (RARRAY((r))->len)
5751 static VALUE m_guestfs; /* guestfs module */
5752 static VALUE c_guestfs; /* guestfs_h handle */
5753 static VALUE e_Error; /* used for all errors */
5755 static void ruby_guestfs_free (void *p)
5758 guestfs_close ((guestfs_h *) p);
5761 static VALUE ruby_guestfs_create (VALUE m)
5765 g = guestfs_create ();
5767 rb_raise (e_Error, \"failed to create guestfs handle\");
5769 /* Don't print error messages to stderr by default. */
5770 guestfs_set_error_handler (g, NULL, NULL);
5772 /* Wrap it, and make sure the close function is called when the
5775 return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
5778 static VALUE ruby_guestfs_close (VALUE gv)
5781 Data_Get_Struct (gv, guestfs_h, g);
5783 ruby_guestfs_free (g);
5784 DATA_PTR (gv) = NULL;
5792 fun (name, style, _, _, _, _, _) ->
5793 pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
5794 List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
5797 pr " guestfs_h *g;\n";
5798 pr " Data_Get_Struct (gv, guestfs_h, g);\n";
5800 pr " rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
5806 | String n | FileIn n | FileOut n ->
5807 pr " const char *%s = StringValueCStr (%sv);\n" n n;
5809 pr " rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
5810 pr " \"%s\", \"%s\");\n" n name
5812 pr " const char *%s = StringValueCStr (%sv);\n" n n
5816 pr " int i, len;\n";
5817 pr " len = RARRAY_LEN (%sv);\n" n;
5818 pr " %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
5820 pr " for (i = 0; i < len; ++i) {\n";
5821 pr " VALUE v = rb_ary_entry (%sv, i);\n" n;
5822 pr " %s[i] = StringValueCStr (v);\n" n;
5824 pr " %s[len] = NULL;\n" n;
5828 pr " int %s = NUM2INT (%sv);\n" n n
5833 match fst style with
5834 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
5835 | RInt64 _ -> pr " int64_t r;\n"; "-1"
5836 | RConstString _ -> pr " const char *r;\n"; "NULL"
5837 | RString _ -> pr " char *r;\n"; "NULL"
5838 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
5839 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
5840 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
5841 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
5842 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
5843 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
5844 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
5847 pr " r = guestfs_%s " name;
5848 generate_call_args ~handle:"g" (snd style);
5853 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
5855 pr " free (%s);\n" n
5858 pr " if (r == %s)\n" error_code;
5859 pr " rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
5862 (match fst style with
5864 pr " return Qnil;\n"
5865 | RInt _ | RBool _ ->
5866 pr " return INT2NUM (r);\n"
5868 pr " return ULL2NUM (r);\n"
5870 pr " return rb_str_new2 (r);\n";
5872 pr " VALUE rv = rb_str_new2 (r);\n";
5876 pr " int i, len = 0;\n";
5877 pr " for (i = 0; r[i] != NULL; ++i) len++;\n";
5878 pr " VALUE rv = rb_ary_new2 (len);\n";
5879 pr " for (i = 0; r[i] != NULL; ++i) {\n";
5880 pr " rb_ary_push (rv, rb_str_new2 (r[i]));\n";
5881 pr " free (r[i]);\n";
5886 pr " VALUE rv = rb_ary_new2 (2);\n";
5887 pr " rb_ary_push (rv, INT2NUM (r->i));\n";
5888 pr " rb_ary_push (rv, INT2NUM (r->b));\n";
5889 pr " guestfs_free_int_bool (r);\n";
5892 generate_ruby_lvm_code "pv" pv_cols
5894 generate_ruby_lvm_code "vg" vg_cols
5896 generate_ruby_lvm_code "lv" lv_cols
5898 pr " VALUE rv = rb_hash_new ();\n";
5902 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
5907 pr " VALUE rv = rb_hash_new ();\n";
5911 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
5916 pr " VALUE rv = rb_hash_new ();\n";
5918 pr " for (i = 0; r[i] != NULL; i+=2) {\n";
5919 pr " rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
5920 pr " free (r[i]);\n";
5921 pr " free (r[i+1]);\n";
5932 /* Initialize the module. */
5933 void Init__guestfs ()
5935 m_guestfs = rb_define_module (\"Guestfs\");
5936 c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
5937 e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
5939 rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
5940 rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
5943 (* Define the rest of the methods. *)
5945 fun (name, style, _, _, _, _, _) ->
5946 pr " rb_define_method (c_guestfs, \"%s\",\n" name;
5947 pr " ruby_guestfs_%s, %d);\n" name (List.length (snd style))
5952 (* Ruby code to return an LVM struct list. *)
5953 and generate_ruby_lvm_code typ cols =
5954 pr " VALUE rv = rb_ary_new2 (r->len);\n";
5956 pr " for (i = 0; i < r->len; ++i) {\n";
5957 pr " VALUE hv = rb_hash_new ();\n";
5961 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
5963 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
5966 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
5967 | name, `OptPercent ->
5968 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
5970 pr " rb_ary_push (rv, hv);\n";
5972 pr " guestfs_free_lvm_%s_list (r);\n" typ;
5975 (* Generate Java bindings GuestFS.java file. *)
5976 and generate_java_java () =
5977 generate_header CStyle LGPLv2;
5980 package com.redhat.et.libguestfs;
5982 import java.util.HashMap;
5983 import com.redhat.et.libguestfs.LibGuestFSException;
5984 import com.redhat.et.libguestfs.PV;
5985 import com.redhat.et.libguestfs.VG;
5986 import com.redhat.et.libguestfs.LV;
5987 import com.redhat.et.libguestfs.Stat;
5988 import com.redhat.et.libguestfs.StatVFS;
5989 import com.redhat.et.libguestfs.IntBool;
5992 * The GuestFS object is a libguestfs handle.
5996 public class GuestFS {
5997 // Load the native code.
5999 System.loadLibrary (\"guestfs_jni\");
6003 * The native guestfs_h pointer.
6008 * Create a libguestfs handle.
6010 * @throws LibGuestFSException
6012 public GuestFS () throws LibGuestFSException
6016 private native long _create () throws LibGuestFSException;
6019 * Close a libguestfs handle.
6021 * You can also leave handles to be collected by the garbage
6022 * collector, but this method ensures that the resources used
6023 * by the handle are freed up immediately. If you call any
6024 * other methods after closing the handle, you will get an
6027 * @throws LibGuestFSException
6029 public void close () throws LibGuestFSException
6035 private native void _close (long g) throws LibGuestFSException;
6037 public void finalize () throws LibGuestFSException
6045 fun (name, style, _, flags, _, shortdesc, longdesc) ->
6046 let doc = replace_str longdesc "C<guestfs_" "C<g." in
6048 if List.mem ProtocolLimitWarning flags then
6049 doc ^ "\n\n" ^ protocol_limit_warning
6052 if List.mem DangerWillRobinson flags then
6053 doc ^ "\n\n" ^ danger_will_robinson
6055 let doc = pod2text ~width:60 name doc in
6056 let doc = String.concat "\n * " doc in
6059 pr " * %s\n" shortdesc;
6062 pr " * @throws LibGuestFSException\n";
6065 generate_java_prototype ~public:true ~semicolon:false name style;
6068 pr " if (g == 0)\n";
6069 pr " throw new LibGuestFSException (\"%s: handle is closed\");\n"
6072 if fst style <> RErr then pr "return ";
6074 generate_call_args ~handle:"g" (snd style);
6078 generate_java_prototype ~privat:true ~native:true name style;
6085 and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
6086 ?(semicolon=true) name style =
6087 if privat then pr "private ";
6088 if public then pr "public ";
6089 if native then pr "native ";
6092 (match fst style with
6093 | RErr -> pr "void ";
6094 | RInt _ -> pr "int ";
6095 | RInt64 _ -> pr "long ";
6096 | RBool _ -> pr "boolean ";
6097 | RConstString _ | RString _ -> pr "String ";
6098 | RStringList _ -> pr "String[] ";
6099 | RIntBool _ -> pr "IntBool ";
6100 | RPVList _ -> pr "PV[] ";
6101 | RVGList _ -> pr "VG[] ";
6102 | RLVList _ -> pr "LV[] ";
6103 | RStat _ -> pr "Stat ";
6104 | RStatVFS _ -> pr "StatVFS ";
6105 | RHashtable _ -> pr "HashMap<String,String> ";
6108 if native then pr "_%s " name else pr "%s " name;
6110 let needs_comma = ref false in
6119 if !needs_comma then pr ", ";
6120 needs_comma := true;
6137 pr " throws LibGuestFSException";
6138 if semicolon then pr ";"
6140 and generate_java_struct typ cols =
6141 generate_header CStyle LGPLv2;
6144 package com.redhat.et.libguestfs;
6147 * Libguestfs %s structure.
6158 | name, `UUID -> pr " public String %s;\n" name
6160 | name, `Int -> pr " public long %s;\n" name
6161 | name, `OptPercent ->
6162 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
6163 pr " public float %s;\n" name
6168 and generate_java_c () =
6169 generate_header CStyle LGPLv2;
6176 #include \"com_redhat_et_libguestfs_GuestFS.h\"
6177 #include \"guestfs.h\"
6179 /* Note that this function returns. The exception is not thrown
6180 * until after the wrapper function returns.
6183 throw_exception (JNIEnv *env, const char *msg)
6186 cl = (*env)->FindClass (env,
6187 \"com/redhat/et/libguestfs/LibGuestFSException\");
6188 (*env)->ThrowNew (env, cl, msg);
6191 JNIEXPORT jlong JNICALL
6192 Java_com_redhat_et_libguestfs_GuestFS__1create
6193 (JNIEnv *env, jobject obj)
6197 g = guestfs_create ();
6199 throw_exception (env, \"GuestFS.create: failed to allocate handle\");
6202 guestfs_set_error_handler (g, NULL, NULL);
6203 return (jlong) (long) g;
6206 JNIEXPORT void JNICALL
6207 Java_com_redhat_et_libguestfs_GuestFS__1close
6208 (JNIEnv *env, jobject obj, jlong jg)
6210 guestfs_h *g = (guestfs_h *) (long) jg;
6217 fun (name, style, _, _, _, _, _) ->
6219 (match fst style with
6220 | RErr -> pr "void ";
6221 | RInt _ -> pr "jint ";
6222 | RInt64 _ -> pr "jlong ";
6223 | RBool _ -> pr "jboolean ";
6224 | RConstString _ | RString _ -> pr "jstring ";
6225 | RIntBool _ | RStat _ | RStatVFS _ | RHashtable _ ->
6227 | RStringList _ | RPVList _ | RVGList _ | RLVList _ ->
6231 pr "Java_com_redhat_et_libguestfs_GuestFS_";
6232 pr "%s" (replace_str ("_" ^ name) "_" "_1");
6234 pr " (JNIEnv *env, jobject obj, jlong jg";
6241 pr ", jstring j%s" n
6243 pr ", jobjectArray j%s" n
6245 pr ", jboolean j%s" n
6251 pr " guestfs_h *g = (guestfs_h *) (long) jg;\n";
6252 let error_code, no_ret =
6253 match fst style with
6254 | RErr -> pr " int r;\n"; "-1", ""
6256 | RInt _ -> pr " int r;\n"; "-1", "0"
6257 | RInt64 _ -> pr " int64_t r;\n"; "-1", "0"
6258 | RConstString _ -> pr " const char *r;\n"; "NULL", "NULL"
6260 pr " jstring jr;\n";
6261 pr " char *r;\n"; "NULL", "NULL"
6263 pr " jobjectArray jr;\n";
6266 pr " jstring jstr;\n";
6267 pr " char **r;\n"; "NULL", "NULL"
6269 pr " jobject jr;\n";
6271 pr " jfieldID fl;\n";
6272 pr " struct guestfs_int_bool *r;\n"; "NULL", "NULL"
6274 pr " jobject jr;\n";
6276 pr " jfieldID fl;\n";
6277 pr " struct guestfs_stat *r;\n"; "NULL", "NULL"
6279 pr " jobject jr;\n";
6281 pr " jfieldID fl;\n";
6282 pr " struct guestfs_statvfs *r;\n"; "NULL", "NULL"
6284 pr " jobjectArray jr;\n";
6286 pr " jfieldID fl;\n";
6287 pr " jobject jfl;\n";
6288 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL", "NULL"
6290 pr " jobjectArray jr;\n";
6292 pr " jfieldID fl;\n";
6293 pr " jobject jfl;\n";
6294 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL", "NULL"
6296 pr " jobjectArray jr;\n";
6298 pr " jfieldID fl;\n";
6299 pr " jobject jfl;\n";
6300 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL", "NULL"
6301 | RHashtable _ -> pr " char **r;\n"; "NULL", "NULL" in
6308 pr " const char *%s;\n" n
6310 pr " int %s_len;\n" n;
6311 pr " const char **%s;\n" n
6318 (match fst style with
6319 | RStringList _ | RPVList _ | RVGList _ | RLVList _ -> true
6320 | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
6321 | RString _ | RIntBool _ | RStat _ | RStatVFS _
6322 | RHashtable _ -> false) ||
6323 List.exists (function StringList _ -> true | _ -> false) (snd style) in
6329 (* Get the parameters. *)
6336 pr " %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
6338 pr " %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
6339 pr " %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
6340 pr " for (i = 0; i < %s_len; ++i) {\n" n;
6341 pr " jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
6343 pr " %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
6345 pr " %s[%s_len] = NULL;\n" n n;
6348 pr " %s = j%s;\n" n n
6351 (* Make the call. *)
6352 pr " r = guestfs_%s " name;
6353 generate_call_args ~handle:"g" (snd style);
6356 (* Release the parameters. *)
6363 pr " (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
6365 pr " for (i = 0; i < %s_len; ++i) {\n" n;
6366 pr " jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
6368 pr " (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
6370 pr " free (%s);\n" n
6375 (* Check for errors. *)
6376 pr " if (r == %s) {\n" error_code;
6377 pr " throw_exception (env, guestfs_last_error (g));\n";
6378 pr " return %s;\n" no_ret;
6382 (match fst style with
6384 | RInt _ -> pr " return (jint) r;\n"
6385 | RBool _ -> pr " return (jboolean) r;\n"
6386 | RInt64 _ -> pr " return (jlong) r;\n"
6387 | RConstString _ -> pr " return (*env)->NewStringUTF (env, r);\n"
6389 pr " jr = (*env)->NewStringUTF (env, r);\n";
6393 pr " for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
6394 pr " cl = (*env)->FindClass (env, \"java/lang/String\");\n";
6395 pr " jstr = (*env)->NewStringUTF (env, \"\");\n";
6396 pr " jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n";
6397 pr " for (i = 0; i < r_len; ++i) {\n";
6398 pr " jstr = (*env)->NewStringUTF (env, r[i]);\n";
6399 pr " (*env)->SetObjectArrayElement (env, jr, i, jstr);\n";
6400 pr " free (r[i]);\n";
6405 pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/IntBool\");\n";
6406 pr " jr = (*env)->AllocObject (env, cl);\n";
6407 pr " fl = (*env)->GetFieldID (env, cl, \"i\", \"I\");\n";
6408 pr " (*env)->SetIntField (env, jr, fl, r->i);\n";
6409 pr " fl = (*env)->GetFieldID (env, cl, \"i\", \"Z\");\n";
6410 pr " (*env)->SetBooleanField (env, jr, fl, r->b);\n";
6411 pr " guestfs_free_int_bool (r);\n";
6414 pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/Stat\");\n";
6415 pr " jr = (*env)->AllocObject (env, cl);\n";
6419 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n"
6421 pr " (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
6426 pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/StatVFS\");\n";
6427 pr " jr = (*env)->AllocObject (env, cl);\n";
6431 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n"
6433 pr " (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
6438 generate_java_lvm_return "pv" "PV" pv_cols
6440 generate_java_lvm_return "vg" "VG" vg_cols
6442 generate_java_lvm_return "lv" "LV" lv_cols
6445 pr " throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
6446 pr " return NULL;\n"
6453 and generate_java_lvm_return typ jtyp cols =
6454 pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
6455 pr " jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n";
6456 pr " for (i = 0; i < r->len; ++i) {\n";
6457 pr " jfl = (*env)->AllocObject (env, cl);\n";
6461 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
6462 pr " (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name;
6465 pr " char s[33];\n";
6466 pr " memcpy (s, r->val[i].%s, 32);\n" name;
6468 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
6469 pr " (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
6471 | name, (`Bytes|`Int) ->
6472 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
6473 pr " (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
6474 | name, `OptPercent ->
6475 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
6476 pr " (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\n" name;
6478 pr " (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n";
6480 pr " guestfs_free_lvm_%s_list (r);\n" typ;
6483 let output_to filename =
6484 let filename_new = filename ^ ".new" in
6485 chan := open_out filename_new;
6490 (* Is the new file different from the current file? *)
6491 if Sys.file_exists filename && files_equal filename filename_new then
6492 Unix.unlink filename_new (* same, so skip it *)
6494 (* different, overwrite old one *)
6495 (try Unix.chmod filename 0o644 with Unix.Unix_error _ -> ());
6496 Unix.rename filename_new filename;
6497 Unix.chmod filename 0o444;
6498 printf "written %s\n%!" filename;
6507 if not (Sys.file_exists "configure.ac") then (
6509 You are probably running this from the wrong directory.
6510 Run it from the top source directory using the command
6516 let close = output_to "src/guestfs_protocol.x" in
6520 let close = output_to "src/guestfs-structs.h" in
6521 generate_structs_h ();
6524 let close = output_to "src/guestfs-actions.h" in
6525 generate_actions_h ();
6528 let close = output_to "src/guestfs-actions.c" in
6529 generate_client_actions ();
6532 let close = output_to "daemon/actions.h" in
6533 generate_daemon_actions_h ();
6536 let close = output_to "daemon/stubs.c" in
6537 generate_daemon_actions ();
6540 let close = output_to "tests.c" in
6544 let close = output_to "fish/cmds.c" in
6545 generate_fish_cmds ();
6548 let close = output_to "fish/completion.c" in
6549 generate_fish_completion ();
6552 let close = output_to "guestfs-structs.pod" in
6553 generate_structs_pod ();
6556 let close = output_to "guestfs-actions.pod" in
6557 generate_actions_pod ();
6560 let close = output_to "guestfish-actions.pod" in
6561 generate_fish_actions_pod ();
6564 let close = output_to "ocaml/guestfs.mli" in
6565 generate_ocaml_mli ();
6568 let close = output_to "ocaml/guestfs.ml" in
6569 generate_ocaml_ml ();
6572 let close = output_to "ocaml/guestfs_c_actions.c" in
6573 generate_ocaml_c ();
6576 let close = output_to "perl/Guestfs.xs" in
6577 generate_perl_xs ();
6580 let close = output_to "perl/lib/Sys/Guestfs.pm" in
6581 generate_perl_pm ();
6584 let close = output_to "python/guestfs-py.c" in
6585 generate_python_c ();
6588 let close = output_to "python/guestfs.py" in
6589 generate_python_py ();
6592 let close = output_to "ruby/ext/guestfs/_guestfs.c" in
6596 let close = output_to "java/com/redhat/et/libguestfs/GuestFS.java" in
6597 generate_java_java ();
6600 let close = output_to "java/com/redhat/et/libguestfs/PV.java" in
6601 generate_java_struct "PV" pv_cols;
6604 let close = output_to "java/com/redhat/et/libguestfs/VG.java" in
6605 generate_java_struct "VG" vg_cols;
6608 let close = output_to "java/com/redhat/et/libguestfs/LV.java" in
6609 generate_java_struct "LV" lv_cols;
6612 let close = output_to "java/com/redhat/et/libguestfs/Stat.java" in
6613 generate_java_struct "Stat" stat_cols;
6616 let close = output_to "java/com/redhat/et/libguestfs/StatVFS.java" in
6617 generate_java_struct "StatVFS" statvfs_cols;
6620 let close = output_to "java/com_redhat_et_libguestfs_GuestFS.c" in