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 * You can add a prerequisite clause to any individual test. This
153 * is a run-time check, which, if it fails, causes the test to be
154 * skipped. Useful if testing a command which might not work on
155 * all variations of libguestfs builds. A test that has prerequisite
156 * of 'Always' is run unconditionally.
158 type tests = (test_init * test_prereq * test) list
160 (* Run the command sequence and just expect nothing to fail. *)
162 (* Run the command sequence and expect the output of the final
163 * command to be the string.
165 | TestOutput of seq * string
166 (* Run the command sequence and expect the output of the final
167 * command to be the list of strings.
169 | TestOutputList of seq * string list
170 (* Run the command sequence and expect the output of the final
171 * command to be the integer.
173 | TestOutputInt of seq * int
174 (* Run the command sequence and expect the output of the final
175 * command to be a true value (!= 0 or != NULL).
177 | TestOutputTrue of seq
178 (* Run the command sequence and expect the output of the final
179 * command to be a false value (== 0 or == NULL, but not an error).
181 | TestOutputFalse of seq
182 (* Run the command sequence and expect the output of the final
183 * command to be a list of the given length (but don't care about
186 | TestOutputLength of seq * int
187 (* Run the command sequence and expect the output of the final
188 * command to be a structure.
190 | TestOutputStruct of seq * test_field_compare list
191 (* Run the command sequence and expect the final command (only)
194 | TestLastFail of seq
196 and test_field_compare =
197 | CompareWithInt of string * int
198 | CompareWithString of string * string
199 | CompareFieldsIntEq of string * string
200 | CompareFieldsStrEq of string * string
202 (* Test prerequisites. *)
204 (* Test always runs. *)
206 (* Test is currently disabled - eg. it fails, or it tests some
207 * unimplemented feature.
210 (* 'string' is some C code (a function body) that should return
211 * true or false. The test will run if the code returns true.
214 (* As for 'If' but the test runs _unless_ the code returns true. *)
217 (* Some initial scenarios for testing. *)
219 (* Do nothing, block devices could contain random stuff including
220 * LVM PVs, and some filesystems might be mounted. This is usually
224 (* Block devices are empty and no filesystems are mounted. *)
226 (* /dev/sda contains a single partition /dev/sda1, which is formatted
227 * as ext2, empty [except for lost+found] and mounted on /.
228 * /dev/sdb and /dev/sdc may have random content.
233 * /dev/sda1 (is a PV):
234 * /dev/VG/LV (size 8MB):
235 * formatted as ext2, empty [except for lost+found], mounted on /
236 * /dev/sdb and /dev/sdc may have random content.
240 (* Sequence of commands for testing. *)
242 and cmd = string list
244 (* Canned test prerequisites. *)
245 let env_is_true env =
246 sprintf "const char *str = getenv (\"%s\");
247 return str && strcmp (str, \"1\") == 0;" env
249 (* Note about long descriptions: When referring to another
250 * action, use the format C<guestfs_other> (ie. the full name of
251 * the C function). This will be replaced as appropriate in other
254 * Apart from that, long descriptions are just perldoc paragraphs.
257 let non_daemon_functions = [
258 ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
260 "launch the qemu subprocess",
262 Internally libguestfs is implemented by running a virtual machine
265 You should call this after configuring the handle
266 (eg. adding drives) but before performing any actions.");
268 ("wait_ready", (RErr, []), -1, [NotInFish],
270 "wait until the qemu subprocess launches",
272 Internally libguestfs is implemented by running a virtual machine
275 You should call this after C<guestfs_launch> to wait for the launch
278 ("kill_subprocess", (RErr, []), -1, [],
280 "kill the qemu subprocess",
282 This kills the qemu subprocess. You should never need to call this.");
284 ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
286 "add an image to examine or modify",
288 This function adds a virtual machine disk image C<filename> to the
289 guest. The first time you call this function, the disk appears as IDE
290 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
293 You don't necessarily need to be root when using libguestfs. However
294 you obviously do need sufficient permissions to access the filename
295 for whatever operations you want to perform (ie. read access if you
296 just want to read the image or write access if you want to modify the
299 This is equivalent to the qemu parameter C<-drive file=filename>.");
301 ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
303 "add a CD-ROM disk image to examine",
305 This function adds a virtual CD-ROM disk image to the guest.
307 This is equivalent to the qemu parameter C<-cdrom filename>.");
309 ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
311 "add qemu parameters",
313 This can be used to add arbitrary qemu command line parameters
314 of the form C<-param value>. Actually it's not quite arbitrary - we
315 prevent you from setting some parameters which would interfere with
316 parameters that we use.
318 The first character of C<param> string must be a C<-> (dash).
320 C<value> can be NULL.");
322 ("set_qemu", (RErr, [String "qemu"]), -1, [FishAlias "qemu"],
324 "set the qemu binary",
326 Set the qemu binary that we will use.
328 The default is chosen when the library was compiled by the
331 You can also override this by setting the C<LIBGUESTFS_QEMU>
332 environment variable.
334 Setting C<qemu> to C<NULL> restores the default qemu binary.");
336 ("get_qemu", (RConstString "qemu", []), -1, [],
338 "get the qemu binary",
340 Return the current qemu binary.
342 This is always non-NULL. If it wasn't set already, then this will
343 return the default qemu binary name.");
345 ("set_path", (RErr, [String "path"]), -1, [FishAlias "path"],
347 "set the search path",
349 Set the path that libguestfs searches for kernel and initrd.img.
351 The default is C<$libdir/guestfs> unless overridden by setting
352 C<LIBGUESTFS_PATH> environment variable.
354 Setting C<path> to C<NULL> restores the default path.");
356 ("get_path", (RConstString "path", []), -1, [],
358 "get the search path",
360 Return the current search path.
362 This is always non-NULL. If it wasn't set already, then this will
363 return the default path.");
365 ("set_append", (RErr, [String "append"]), -1, [FishAlias "append"],
367 "add options to kernel command line",
369 This function is used to add additional options to the
370 guest kernel command line.
372 The default is C<NULL> unless overridden by setting
373 C<LIBGUESTFS_APPEND> environment variable.
375 Setting C<append> to C<NULL> means I<no> additional options
376 are passed (libguestfs always adds a few of its own).");
378 ("get_append", (RConstString "append", []), -1, [],
380 "get the additional kernel options",
382 Return the additional kernel options which are added to the
383 guest kernel command line.
385 If C<NULL> then no options are added.");
387 ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
391 If C<autosync> is true, this enables autosync. Libguestfs will make a
392 best effort attempt to run C<guestfs_umount_all> followed by
393 C<guestfs_sync> when the handle is closed
394 (also if the program exits without closing handles).
396 This is disabled by default (except in guestfish where it is
397 enabled by default).");
399 ("get_autosync", (RBool "autosync", []), -1, [],
403 Get the autosync flag.");
405 ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
409 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
411 Verbose messages are disabled unless the environment variable
412 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
414 ("get_verbose", (RBool "verbose", []), -1, [],
418 This returns the verbose messages flag.");
420 ("is_ready", (RBool "ready", []), -1, [],
422 "is ready to accept commands",
424 This returns true iff this handle is ready to accept commands
425 (in the C<READY> state).
427 For more information on states, see L<guestfs(3)>.");
429 ("is_config", (RBool "config", []), -1, [],
431 "is in configuration state",
433 This returns true iff this handle is being configured
434 (in the C<CONFIG> state).
436 For more information on states, see L<guestfs(3)>.");
438 ("is_launching", (RBool "launching", []), -1, [],
440 "is launching subprocess",
442 This returns true iff this handle is launching the subprocess
443 (in the C<LAUNCHING> state).
445 For more information on states, see L<guestfs(3)>.");
447 ("is_busy", (RBool "busy", []), -1, [],
449 "is busy processing a command",
451 This returns true iff this handle is busy processing a command
452 (in the C<BUSY> state).
454 For more information on states, see L<guestfs(3)>.");
456 ("get_state", (RInt "state", []), -1, [],
458 "get the current state",
460 This returns the current state as an opaque integer. This is
461 only useful for printing debug and internal error messages.
463 For more information on states, see L<guestfs(3)>.");
465 ("set_busy", (RErr, []), -1, [NotInFish],
469 This sets the state to C<BUSY>. This is only used when implementing
470 actions using the low-level API.
472 For more information on states, see L<guestfs(3)>.");
474 ("set_ready", (RErr, []), -1, [NotInFish],
476 "set state to ready",
478 This sets the state to C<READY>. This is only used when implementing
479 actions using the low-level API.
481 For more information on states, see L<guestfs(3)>.");
483 ("end_busy", (RErr, []), -1, [NotInFish],
485 "leave the busy state",
487 This sets the state to C<READY>, or if in C<CONFIG> then it leaves the
488 state as is. This is only used when implementing
489 actions using the low-level API.
491 For more information on states, see L<guestfs(3)>.");
495 let daemon_functions = [
496 ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
497 [InitEmpty, Always, TestOutput (
498 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
499 ["mkfs"; "ext2"; "/dev/sda1"];
500 ["mount"; "/dev/sda1"; "/"];
501 ["write_file"; "/new"; "new file contents"; "0"];
502 ["cat"; "/new"]], "new file contents")],
503 "mount a guest disk at a position in the filesystem",
505 Mount a guest disk at a position in the filesystem. Block devices
506 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
507 the guest. If those block devices contain partitions, they will have
508 the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
511 The rules are the same as for L<mount(2)>: A filesystem must
512 first be mounted on C</> before others can be mounted. Other
513 filesystems can only be mounted on directories which already
516 The mounted filesystem is writable, if we have sufficient permissions
517 on the underlying device.
519 The filesystem options C<sync> and C<noatime> are set with this
520 call, in order to improve reliability.");
522 ("sync", (RErr, []), 2, [],
523 [ InitEmpty, Always, TestRun [["sync"]]],
524 "sync disks, writes are flushed through to the disk image",
526 This syncs the disk, so that any writes are flushed through to the
527 underlying disk image.
529 You should always call this if you have modified a disk image, before
530 closing the handle.");
532 ("touch", (RErr, [String "path"]), 3, [],
533 [InitBasicFS, Always, TestOutputTrue (
535 ["exists"; "/new"]])],
536 "update file timestamps or create a new file",
538 Touch acts like the L<touch(1)> command. It can be used to
539 update the timestamps on a file, or, if the file does not exist,
540 to create a new zero-length file.");
542 ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
543 [InitBasicFS, Always, TestOutput (
544 [["write_file"; "/new"; "new file contents"; "0"];
545 ["cat"; "/new"]], "new file contents")],
546 "list the contents of a file",
548 Return the contents of the file named C<path>.
550 Note that this function cannot correctly handle binary files
551 (specifically, files containing C<\\0> character which is treated
552 as end of string). For those you need to use the C<guestfs_download>
553 function which has a more complex interface.");
555 ("ll", (RString "listing", [String "directory"]), 5, [],
556 [], (* XXX Tricky to test because it depends on the exact format
557 * of the 'ls -l' command, which changes between F10 and F11.
559 "list the files in a directory (long format)",
561 List the files in C<directory> (relative to the root directory,
562 there is no cwd) in the format of 'ls -la'.
564 This command is mostly useful for interactive sessions. It
565 is I<not> intended that you try to parse the output string.");
567 ("ls", (RStringList "listing", [String "directory"]), 6, [],
568 [InitBasicFS, Always, TestOutputList (
571 ["touch"; "/newest"];
572 ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
573 "list the files in a directory",
575 List the files in C<directory> (relative to the root directory,
576 there is no cwd). The '.' and '..' entries are not returned, but
577 hidden files are shown.
579 This command is mostly useful for interactive sessions. Programs
580 should probably use C<guestfs_readdir> instead.");
582 ("list_devices", (RStringList "devices", []), 7, [],
583 [InitEmpty, Always, TestOutputList (
584 [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"])],
585 "list the block devices",
587 List all the block devices.
589 The full block device names are returned, eg. C</dev/sda>");
591 ("list_partitions", (RStringList "partitions", []), 8, [],
592 [InitBasicFS, Always, TestOutputList (
593 [["list_partitions"]], ["/dev/sda1"]);
594 InitEmpty, Always, TestOutputList (
595 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
596 ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
597 "list the partitions",
599 List all the partitions detected on all block devices.
601 The full partition device names are returned, eg. C</dev/sda1>
603 This does not return logical volumes. For that you will need to
604 call C<guestfs_lvs>.");
606 ("pvs", (RStringList "physvols", []), 9, [],
607 [InitBasicFSonLVM, Always, TestOutputList (
608 [["pvs"]], ["/dev/sda1"]);
609 InitEmpty, Always, TestOutputList (
610 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
611 ["pvcreate"; "/dev/sda1"];
612 ["pvcreate"; "/dev/sda2"];
613 ["pvcreate"; "/dev/sda3"];
614 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
615 "list the LVM physical volumes (PVs)",
617 List all the physical volumes detected. This is the equivalent
618 of the L<pvs(8)> command.
620 This returns a list of just the device names that contain
621 PVs (eg. C</dev/sda2>).
623 See also C<guestfs_pvs_full>.");
625 ("vgs", (RStringList "volgroups", []), 10, [],
626 [InitBasicFSonLVM, Always, TestOutputList (
628 InitEmpty, Always, TestOutputList (
629 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
630 ["pvcreate"; "/dev/sda1"];
631 ["pvcreate"; "/dev/sda2"];
632 ["pvcreate"; "/dev/sda3"];
633 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
634 ["vgcreate"; "VG2"; "/dev/sda3"];
635 ["vgs"]], ["VG1"; "VG2"])],
636 "list the LVM volume groups (VGs)",
638 List all the volumes groups detected. This is the equivalent
639 of the L<vgs(8)> command.
641 This returns a list of just the volume group names that were
642 detected (eg. C<VolGroup00>).
644 See also C<guestfs_vgs_full>.");
646 ("lvs", (RStringList "logvols", []), 11, [],
647 [InitBasicFSonLVM, Always, TestOutputList (
648 [["lvs"]], ["/dev/VG/LV"]);
649 InitEmpty, Always, TestOutputList (
650 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
651 ["pvcreate"; "/dev/sda1"];
652 ["pvcreate"; "/dev/sda2"];
653 ["pvcreate"; "/dev/sda3"];
654 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
655 ["vgcreate"; "VG2"; "/dev/sda3"];
656 ["lvcreate"; "LV1"; "VG1"; "50"];
657 ["lvcreate"; "LV2"; "VG1"; "50"];
658 ["lvcreate"; "LV3"; "VG2"; "50"];
659 ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
660 "list the LVM logical volumes (LVs)",
662 List all the logical volumes detected. This is the equivalent
663 of the L<lvs(8)> command.
665 This returns a list of the logical volume device names
666 (eg. C</dev/VolGroup00/LogVol00>).
668 See also C<guestfs_lvs_full>.");
670 ("pvs_full", (RPVList "physvols", []), 12, [],
671 [], (* XXX how to test? *)
672 "list the LVM physical volumes (PVs)",
674 List all the physical volumes detected. This is the equivalent
675 of the L<pvs(8)> command. The \"full\" version includes all fields.");
677 ("vgs_full", (RVGList "volgroups", []), 13, [],
678 [], (* XXX how to test? *)
679 "list the LVM volume groups (VGs)",
681 List all the volumes groups detected. This is the equivalent
682 of the L<vgs(8)> command. The \"full\" version includes all fields.");
684 ("lvs_full", (RLVList "logvols", []), 14, [],
685 [], (* XXX how to test? *)
686 "list the LVM logical volumes (LVs)",
688 List all the logical volumes detected. This is the equivalent
689 of the L<lvs(8)> command. The \"full\" version includes all fields.");
691 ("read_lines", (RStringList "lines", [String "path"]), 15, [],
692 [InitBasicFS, Always, TestOutputList (
693 [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
694 ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);
695 InitBasicFS, Always, TestOutputList (
696 [["write_file"; "/new"; ""; "0"];
697 ["read_lines"; "/new"]], [])],
698 "read file as lines",
700 Return the contents of the file named C<path>.
702 The file contents are returned as a list of lines. Trailing
703 C<LF> and C<CRLF> character sequences are I<not> returned.
705 Note that this function cannot correctly handle binary files
706 (specifically, files containing C<\\0> character which is treated
707 as end of line). For those you need to use the C<guestfs_read_file>
708 function which has a more complex interface.");
710 ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [],
711 [], (* XXX Augeas code needs tests. *)
712 "create a new Augeas handle",
714 Create a new Augeas handle for editing configuration files.
715 If there was any previous Augeas handle associated with this
716 guestfs session, then it is closed.
718 You must call this before using any other C<guestfs_aug_*>
721 C<root> is the filesystem root. C<root> must not be NULL,
724 The flags are the same as the flags defined in
725 E<lt>augeas.hE<gt>, the logical I<or> of the following
730 =item C<AUG_SAVE_BACKUP> = 1
732 Keep the original file with a C<.augsave> extension.
734 =item C<AUG_SAVE_NEWFILE> = 2
736 Save changes into a file with extension C<.augnew>, and
737 do not overwrite original. Overrides C<AUG_SAVE_BACKUP>.
739 =item C<AUG_TYPE_CHECK> = 4
741 Typecheck lenses (can be expensive).
743 =item C<AUG_NO_STDINC> = 8
745 Do not use standard load path for modules.
747 =item C<AUG_SAVE_NOOP> = 16
749 Make save a no-op, just record what would have been changed.
751 =item C<AUG_NO_LOAD> = 32
753 Do not load the tree in C<guestfs_aug_init>.
757 To close the handle, you can call C<guestfs_aug_close>.
759 To find out more about Augeas, see L<http://augeas.net/>.");
761 ("aug_close", (RErr, []), 26, [],
762 [], (* XXX Augeas code needs tests. *)
763 "close the current Augeas handle",
765 Close the current Augeas handle and free up any resources
766 used by it. After calling this, you have to call
767 C<guestfs_aug_init> again before you can use any other
770 ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
771 [], (* XXX Augeas code needs tests. *)
772 "define an Augeas variable",
774 Defines an Augeas variable C<name> whose value is the result
775 of evaluating C<expr>. If C<expr> is NULL, then C<name> is
778 On success this returns the number of nodes in C<expr>, or
779 C<0> if C<expr> evaluates to something which is not a nodeset.");
781 ("aug_defnode", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [],
782 [], (* XXX Augeas code needs tests. *)
783 "define an Augeas node",
785 Defines a variable C<name> whose value is the result of
788 If C<expr> evaluates to an empty nodeset, a node is created,
789 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
790 C<name> will be the nodeset containing that single node.
792 On success this returns a pair containing the
793 number of nodes in the nodeset, and a boolean flag
794 if a node was created.");
796 ("aug_get", (RString "val", [String "path"]), 19, [],
797 [], (* XXX Augeas code needs tests. *)
798 "look up the value of an Augeas path",
800 Look up the value associated with C<path>. If C<path>
801 matches exactly one node, the C<value> is returned.");
803 ("aug_set", (RErr, [String "path"; String "val"]), 20, [],
804 [], (* XXX Augeas code needs tests. *)
805 "set Augeas path to value",
807 Set the value associated with C<path> to C<value>.");
809 ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [],
810 [], (* XXX Augeas code needs tests. *)
811 "insert a sibling Augeas node",
813 Create a new sibling C<label> for C<path>, inserting it into
814 the tree before or after C<path> (depending on the boolean
817 C<path> must match exactly one existing node in the tree, and
818 C<label> must be a label, ie. not contain C</>, C<*> or end
819 with a bracketed index C<[N]>.");
821 ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
822 [], (* XXX Augeas code needs tests. *)
823 "remove an Augeas path",
825 Remove C<path> and all of its children.
827 On success this returns the number of entries which were removed.");
829 ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [],
830 [], (* XXX Augeas code needs tests. *)
833 Move the node C<src> to C<dest>. C<src> must match exactly
834 one node. C<dest> is overwritten if it exists.");
836 ("aug_match", (RStringList "matches", [String "path"]), 24, [],
837 [], (* XXX Augeas code needs tests. *)
838 "return Augeas nodes which match path",
840 Returns a list of paths which match the path expression C<path>.
841 The returned paths are sufficiently qualified so that they match
842 exactly one node in the current tree.");
844 ("aug_save", (RErr, []), 25, [],
845 [], (* XXX Augeas code needs tests. *)
846 "write all pending Augeas changes to disk",
848 This writes all pending changes to disk.
850 The flags which were passed to C<guestfs_aug_init> affect exactly
851 how files are saved.");
853 ("aug_load", (RErr, []), 27, [],
854 [], (* XXX Augeas code needs tests. *)
855 "load files into the tree",
857 Load files into the tree.
859 See C<aug_load> in the Augeas documentation for the full gory
862 ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
863 [], (* XXX Augeas code needs tests. *)
864 "list Augeas nodes under a path",
866 This is just a shortcut for listing C<guestfs_aug_match>
867 C<path/*> and sorting the resulting nodes into alphabetical order.");
869 ("rm", (RErr, [String "path"]), 29, [],
870 [InitBasicFS, Always, TestRun
873 InitBasicFS, Always, TestLastFail
875 InitBasicFS, Always, TestLastFail
880 Remove the single file C<path>.");
882 ("rmdir", (RErr, [String "path"]), 30, [],
883 [InitBasicFS, Always, TestRun
886 InitBasicFS, Always, TestLastFail
888 InitBasicFS, Always, TestLastFail
891 "remove a directory",
893 Remove the single directory C<path>.");
895 ("rm_rf", (RErr, [String "path"]), 31, [],
896 [InitBasicFS, Always, TestOutputFalse
898 ["mkdir"; "/new/foo"];
899 ["touch"; "/new/foo/bar"];
901 ["exists"; "/new"]]],
902 "remove a file or directory recursively",
904 Remove the file or directory C<path>, recursively removing the
905 contents if its a directory. This is like the C<rm -rf> shell
908 ("mkdir", (RErr, [String "path"]), 32, [],
909 [InitBasicFS, Always, TestOutputTrue
912 InitBasicFS, Always, TestLastFail
913 [["mkdir"; "/new/foo/bar"]]],
914 "create a directory",
916 Create a directory named C<path>.");
918 ("mkdir_p", (RErr, [String "path"]), 33, [],
919 [InitBasicFS, Always, TestOutputTrue
920 [["mkdir_p"; "/new/foo/bar"];
921 ["is_dir"; "/new/foo/bar"]];
922 InitBasicFS, Always, TestOutputTrue
923 [["mkdir_p"; "/new/foo/bar"];
924 ["is_dir"; "/new/foo"]];
925 InitBasicFS, Always, TestOutputTrue
926 [["mkdir_p"; "/new/foo/bar"];
927 ["is_dir"; "/new"]]],
928 "create a directory and parents",
930 Create a directory named C<path>, creating any parent directories
931 as necessary. This is like the C<mkdir -p> shell command.");
933 ("chmod", (RErr, [Int "mode"; String "path"]), 34, [],
934 [], (* XXX Need stat command to test *)
937 Change the mode (permissions) of C<path> to C<mode>. Only
938 numeric modes are supported.");
940 ("chown", (RErr, [Int "owner"; Int "group"; String "path"]), 35, [],
941 [], (* XXX Need stat command to test *)
942 "change file owner and group",
944 Change the file owner to C<owner> and group to C<group>.
946 Only numeric uid and gid are supported. If you want to use
947 names, you will need to locate and parse the password file
948 yourself (Augeas support makes this relatively easy).");
950 ("exists", (RBool "existsflag", [String "path"]), 36, [],
951 [InitBasicFS, Always, TestOutputTrue (
953 ["exists"; "/new"]]);
954 InitBasicFS, Always, TestOutputTrue (
956 ["exists"; "/new"]])],
957 "test if file or directory exists",
959 This returns C<true> if and only if there is a file, directory
960 (or anything) with the given C<path> name.
962 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
964 ("is_file", (RBool "fileflag", [String "path"]), 37, [],
965 [InitBasicFS, Always, TestOutputTrue (
967 ["is_file"; "/new"]]);
968 InitBasicFS, Always, TestOutputFalse (
970 ["is_file"; "/new"]])],
971 "test if file exists",
973 This returns C<true> if and only if there is a file
974 with the given C<path> name. Note that it returns false for
975 other objects like directories.
977 See also C<guestfs_stat>.");
979 ("is_dir", (RBool "dirflag", [String "path"]), 38, [],
980 [InitBasicFS, Always, TestOutputFalse (
982 ["is_dir"; "/new"]]);
983 InitBasicFS, Always, TestOutputTrue (
985 ["is_dir"; "/new"]])],
986 "test if file exists",
988 This returns C<true> if and only if there is a directory
989 with the given C<path> name. Note that it returns false for
990 other objects like files.
992 See also C<guestfs_stat>.");
994 ("pvcreate", (RErr, [String "device"]), 39, [],
995 [InitEmpty, Always, TestOutputList (
996 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
997 ["pvcreate"; "/dev/sda1"];
998 ["pvcreate"; "/dev/sda2"];
999 ["pvcreate"; "/dev/sda3"];
1000 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1001 "create an LVM physical volume",
1003 This creates an LVM physical volume on the named C<device>,
1004 where C<device> should usually be a partition name such
1007 ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
1008 [InitEmpty, Always, TestOutputList (
1009 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
1010 ["pvcreate"; "/dev/sda1"];
1011 ["pvcreate"; "/dev/sda2"];
1012 ["pvcreate"; "/dev/sda3"];
1013 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1014 ["vgcreate"; "VG2"; "/dev/sda3"];
1015 ["vgs"]], ["VG1"; "VG2"])],
1016 "create an LVM volume group",
1018 This creates an LVM volume group called C<volgroup>
1019 from the non-empty list of physical volumes C<physvols>.");
1021 ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [],
1022 [InitEmpty, Always, TestOutputList (
1023 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
1024 ["pvcreate"; "/dev/sda1"];
1025 ["pvcreate"; "/dev/sda2"];
1026 ["pvcreate"; "/dev/sda3"];
1027 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1028 ["vgcreate"; "VG2"; "/dev/sda3"];
1029 ["lvcreate"; "LV1"; "VG1"; "50"];
1030 ["lvcreate"; "LV2"; "VG1"; "50"];
1031 ["lvcreate"; "LV3"; "VG2"; "50"];
1032 ["lvcreate"; "LV4"; "VG2"; "50"];
1033 ["lvcreate"; "LV5"; "VG2"; "50"];
1035 ["/dev/VG1/LV1"; "/dev/VG1/LV2";
1036 "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
1037 "create an LVM volume group",
1039 This creates an LVM volume group called C<logvol>
1040 on the volume group C<volgroup>, with C<size> megabytes.");
1042 ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [],
1043 [InitEmpty, Always, TestOutput (
1044 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1045 ["mkfs"; "ext2"; "/dev/sda1"];
1046 ["mount"; "/dev/sda1"; "/"];
1047 ["write_file"; "/new"; "new file contents"; "0"];
1048 ["cat"; "/new"]], "new file contents")],
1049 "make a filesystem",
1051 This creates a filesystem on C<device> (usually a partition
1052 or LVM logical volume). The filesystem type is C<fstype>, for
1055 ("sfdisk", (RErr, [String "device";
1056 Int "cyls"; Int "heads"; Int "sectors";
1057 StringList "lines"]), 43, [DangerWillRobinson],
1059 "create partitions on a block device",
1061 This is a direct interface to the L<sfdisk(8)> program for creating
1062 partitions on block devices.
1064 C<device> should be a block device, for example C</dev/sda>.
1066 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
1067 and sectors on the device, which are passed directly to sfdisk as
1068 the I<-C>, I<-H> and I<-S> parameters. If you pass C<0> for any
1069 of these, then the corresponding parameter is omitted. Usually for
1070 'large' disks, you can just pass C<0> for these, but for small
1071 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
1072 out the right geometry and you will need to tell it.
1074 C<lines> is a list of lines that we feed to C<sfdisk>. For more
1075 information refer to the L<sfdisk(8)> manpage.
1077 To create a single partition occupying the whole disk, you would
1078 pass C<lines> as a single element list, when the single element being
1079 the string C<,> (comma).
1081 See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>");
1083 ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
1084 [InitBasicFS, Always, TestOutput (
1085 [["write_file"; "/new"; "new file contents"; "0"];
1086 ["cat"; "/new"]], "new file contents");
1087 InitBasicFS, Always, TestOutput (
1088 [["write_file"; "/new"; "\nnew file contents\n"; "0"];
1089 ["cat"; "/new"]], "\nnew file contents\n");
1090 InitBasicFS, Always, TestOutput (
1091 [["write_file"; "/new"; "\n\n"; "0"];
1092 ["cat"; "/new"]], "\n\n");
1093 InitBasicFS, Always, TestOutput (
1094 [["write_file"; "/new"; ""; "0"];
1095 ["cat"; "/new"]], "");
1096 InitBasicFS, Always, TestOutput (
1097 [["write_file"; "/new"; "\n\n\n"; "0"];
1098 ["cat"; "/new"]], "\n\n\n");
1099 InitBasicFS, Always, TestOutput (
1100 [["write_file"; "/new"; "\n"; "0"];
1101 ["cat"; "/new"]], "\n")],
1104 This call creates a file called C<path>. The contents of the
1105 file is the string C<content> (which can contain any 8 bit data),
1106 with length C<size>.
1108 As a special case, if C<size> is C<0>
1109 then the length is calculated using C<strlen> (so in this case
1110 the content cannot contain embedded ASCII NULs).
1112 I<NB.> Owing to a bug, writing content containing ASCII NUL
1113 characters does I<not> work, even if the length is specified.
1114 We hope to resolve this bug in a future version. In the meantime
1115 use C<guestfs_upload>.");
1117 ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
1118 [InitEmpty, Always, TestOutputList (
1119 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1120 ["mkfs"; "ext2"; "/dev/sda1"];
1121 ["mount"; "/dev/sda1"; "/"];
1122 ["mounts"]], ["/dev/sda1"]);
1123 InitEmpty, Always, TestOutputList (
1124 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1125 ["mkfs"; "ext2"; "/dev/sda1"];
1126 ["mount"; "/dev/sda1"; "/"];
1129 "unmount a filesystem",
1131 This unmounts the given filesystem. The filesystem may be
1132 specified either by its mountpoint (path) or the device which
1133 contains the filesystem.");
1135 ("mounts", (RStringList "devices", []), 46, [],
1136 [InitBasicFS, Always, TestOutputList (
1137 [["mounts"]], ["/dev/sda1"])],
1138 "show mounted filesystems",
1140 This returns the list of currently mounted filesystems. It returns
1141 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
1143 Some internal mounts are not shown.");
1145 ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
1146 [InitBasicFS, Always, TestOutputList (
1149 (* check that umount_all can unmount nested mounts correctly: *)
1150 InitEmpty, Always, TestOutputList (
1151 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
1152 ["mkfs"; "ext2"; "/dev/sda1"];
1153 ["mkfs"; "ext2"; "/dev/sda2"];
1154 ["mkfs"; "ext2"; "/dev/sda3"];
1155 ["mount"; "/dev/sda1"; "/"];
1157 ["mount"; "/dev/sda2"; "/mp1"];
1158 ["mkdir"; "/mp1/mp2"];
1159 ["mount"; "/dev/sda3"; "/mp1/mp2"];
1160 ["mkdir"; "/mp1/mp2/mp3"];
1163 "unmount all filesystems",
1165 This unmounts all mounted filesystems.
1167 Some internal mounts are not unmounted by this call.");
1169 ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson],
1171 "remove all LVM LVs, VGs and PVs",
1173 This command removes all LVM logical volumes, volume groups
1174 and physical volumes.");
1176 ("file", (RString "description", [String "path"]), 49, [],
1177 [InitBasicFS, Always, TestOutput (
1179 ["file"; "/new"]], "empty");
1180 InitBasicFS, Always, TestOutput (
1181 [["write_file"; "/new"; "some content\n"; "0"];
1182 ["file"; "/new"]], "ASCII text");
1183 InitBasicFS, Always, TestLastFail (
1184 [["file"; "/nofile"]])],
1185 "determine file type",
1187 This call uses the standard L<file(1)> command to determine
1188 the type or contents of the file. This also works on devices,
1189 for example to find out whether a partition contains a filesystem.
1191 The exact command which runs is C<file -bsL path>. Note in
1192 particular that the filename is not prepended to the output
1193 (the C<-b> option).");
1195 ("command", (RString "output", [StringList "arguments"]), 50, [ProtocolLimitWarning],
1196 [InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutput (
1197 [["upload"; "test-command"; "/test-command"];
1198 ["chmod"; "493"; "/test-command"];
1199 ["command"; "/test-command 1"]], "Result1");
1200 InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutput (
1201 [["upload"; "test-command"; "/test-command"];
1202 ["chmod"; "493"; "/test-command"];
1203 ["command"; "/test-command 2"]], "Result2\n");
1204 InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutput (
1205 [["upload"; "test-command"; "/test-command"];
1206 ["chmod"; "493"; "/test-command"];
1207 ["command"; "/test-command 3"]], "\nResult3");
1208 InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutput (
1209 [["upload"; "test-command"; "/test-command"];
1210 ["chmod"; "493"; "/test-command"];
1211 ["command"; "/test-command 4"]], "\nResult4\n");
1212 InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutput (
1213 [["upload"; "test-command"; "/test-command"];
1214 ["chmod"; "493"; "/test-command"];
1215 ["command"; "/test-command 5"]], "\nResult5\n\n");
1216 InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutput (
1217 [["upload"; "test-command"; "/test-command"];
1218 ["chmod"; "493"; "/test-command"];
1219 ["command"; "/test-command 6"]], "\n\nResult6\n\n");
1220 InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutput (
1221 [["upload"; "test-command"; "/test-command"];
1222 ["chmod"; "493"; "/test-command"];
1223 ["command"; "/test-command 7"]], "");
1224 InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutput (
1225 [["upload"; "test-command"; "/test-command"];
1226 ["chmod"; "493"; "/test-command"];
1227 ["command"; "/test-command 8"]], "\n");
1228 InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutput (
1229 [["upload"; "test-command"; "/test-command"];
1230 ["chmod"; "493"; "/test-command"];
1231 ["command"; "/test-command 9"]], "\n\n");
1232 InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutput (
1233 [["upload"; "test-command"; "/test-command"];
1234 ["chmod"; "493"; "/test-command"];
1235 ["command"; "/test-command 10"]], "Result10-1\nResult10-2\n");
1236 InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutput (
1237 [["upload"; "test-command"; "/test-command"];
1238 ["chmod"; "493"; "/test-command"];
1239 ["command"; "/test-command 11"]], "Result11-1\nResult11-2");
1240 InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestLastFail (
1241 [["upload"; "test-command"; "/test-command"];
1242 ["chmod"; "493"; "/test-command"];
1243 ["command"; "/test-command"]])],
1244 "run a command from the guest filesystem",
1246 This call runs a command from the guest filesystem. The
1247 filesystem must be mounted, and must contain a compatible
1248 operating system (ie. something Linux, with the same
1249 or compatible processor architecture).
1251 The single parameter is an argv-style list of arguments.
1252 The first element is the name of the program to run.
1253 Subsequent elements are parameters. The list must be
1254 non-empty (ie. must contain a program name).
1256 The return value is anything printed to I<stdout> by
1259 If the command returns a non-zero exit status, then
1260 this function returns an error message. The error message
1261 string is the content of I<stderr> from the command.
1263 The C<$PATH> environment variable will contain at least
1264 C</usr/bin> and C</bin>. If you require a program from
1265 another location, you should provide the full path in the
1268 Shared libraries and data files required by the program
1269 must be available on filesystems which are mounted in the
1270 correct places. It is the caller's responsibility to ensure
1271 all filesystems that are needed are mounted at the right
1274 ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [ProtocolLimitWarning],
1275 [InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutputList (
1276 [["upload"; "test-command"; "/test-command"];
1277 ["chmod"; "493"; "/test-command"];
1278 ["command_lines"; "/test-command 1"]], ["Result1"]);
1279 InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutputList (
1280 [["upload"; "test-command"; "/test-command"];
1281 ["chmod"; "493"; "/test-command"];
1282 ["command_lines"; "/test-command 2"]], ["Result2"]);
1283 InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutputList (
1284 [["upload"; "test-command"; "/test-command"];
1285 ["chmod"; "493"; "/test-command"];
1286 ["command_lines"; "/test-command 3"]], ["";"Result3"]);
1287 InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutputList (
1288 [["upload"; "test-command"; "/test-command"];
1289 ["chmod"; "493"; "/test-command"];
1290 ["command_lines"; "/test-command 4"]], ["";"Result4"]);
1291 InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutputList (
1292 [["upload"; "test-command"; "/test-command"];
1293 ["chmod"; "493"; "/test-command"];
1294 ["command_lines"; "/test-command 5"]], ["";"Result5";""]);
1295 InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutputList (
1296 [["upload"; "test-command"; "/test-command"];
1297 ["chmod"; "493"; "/test-command"];
1298 ["command_lines"; "/test-command 6"]], ["";"";"Result6";""]);
1299 InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutputList (
1300 [["upload"; "test-command"; "/test-command"];
1301 ["chmod"; "493"; "/test-command"];
1302 ["command_lines"; "/test-command 7"]], []);
1303 InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutputList (
1304 [["upload"; "test-command"; "/test-command"];
1305 ["chmod"; "493"; "/test-command"];
1306 ["command_lines"; "/test-command 8"]], [""]);
1307 InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutputList (
1308 [["upload"; "test-command"; "/test-command"];
1309 ["chmod"; "493"; "/test-command"];
1310 ["command_lines"; "/test-command 9"]], ["";""]);
1311 InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutputList (
1312 [["upload"; "test-command"; "/test-command"];
1313 ["chmod"; "493"; "/test-command"];
1314 ["command_lines"; "/test-command 10"]], ["Result10-1";"Result10-2"]);
1315 InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutputList (
1316 [["upload"; "test-command"; "/test-command"];
1317 ["chmod"; "493"; "/test-command"];
1318 ["command_lines"; "/test-command 11"]], ["Result11-1";"Result11-2"])],
1319 "run a command, returning lines",
1321 This is the same as C<guestfs_command>, but splits the
1322 result into a list of lines.");
1324 ("stat", (RStat "statbuf", [String "path"]), 52, [],
1325 [InitBasicFS, Always, TestOutputStruct (
1327 ["stat"; "/new"]], [CompareWithInt ("size", 0)])],
1328 "get file information",
1330 Returns file information for the given C<path>.
1332 This is the same as the C<stat(2)> system call.");
1334 ("lstat", (RStat "statbuf", [String "path"]), 53, [],
1335 [InitBasicFS, Always, TestOutputStruct (
1337 ["lstat"; "/new"]], [CompareWithInt ("size", 0)])],
1338 "get file information for a symbolic link",
1340 Returns file information for the given C<path>.
1342 This is the same as C<guestfs_stat> except that if C<path>
1343 is a symbolic link, then the link is stat-ed, not the file it
1346 This is the same as the C<lstat(2)> system call.");
1348 ("statvfs", (RStatVFS "statbuf", [String "path"]), 54, [],
1349 [InitBasicFS, Always, TestOutputStruct (
1350 [["statvfs"; "/"]], [CompareWithInt ("bfree", 487702);
1351 CompareWithInt ("blocks", 490020);
1352 CompareWithInt ("bsize", 1024)])],
1353 "get file system statistics",
1355 Returns file system statistics for any mounted file system.
1356 C<path> should be a file or directory in the mounted file system
1357 (typically it is the mount point itself, but it doesn't need to be).
1359 This is the same as the C<statvfs(2)> system call.");
1361 ("tune2fs_l", (RHashtable "superblock", [String "device"]), 55, [],
1363 "get ext2/ext3/ext4 superblock details",
1365 This returns the contents of the ext2, ext3 or ext4 filesystem
1366 superblock on C<device>.
1368 It is the same as running C<tune2fs -l device>. See L<tune2fs(8)>
1369 manpage for more details. The list of fields returned isn't
1370 clearly defined, and depends on both the version of C<tune2fs>
1371 that libguestfs was built against, and the filesystem itself.");
1373 ("blockdev_setro", (RErr, [String "device"]), 56, [],
1374 [InitEmpty, Always, TestOutputTrue (
1375 [["blockdev_setro"; "/dev/sda"];
1376 ["blockdev_getro"; "/dev/sda"]])],
1377 "set block device to read-only",
1379 Sets the block device named C<device> to read-only.
1381 This uses the L<blockdev(8)> command.");
1383 ("blockdev_setrw", (RErr, [String "device"]), 57, [],
1384 [InitEmpty, Always, TestOutputFalse (
1385 [["blockdev_setrw"; "/dev/sda"];
1386 ["blockdev_getro"; "/dev/sda"]])],
1387 "set block device to read-write",
1389 Sets the block device named C<device> to read-write.
1391 This uses the L<blockdev(8)> command.");
1393 ("blockdev_getro", (RBool "ro", [String "device"]), 58, [],
1394 [InitEmpty, Always, TestOutputTrue (
1395 [["blockdev_setro"; "/dev/sda"];
1396 ["blockdev_getro"; "/dev/sda"]])],
1397 "is block device set to read-only",
1399 Returns a boolean indicating if the block device is read-only
1400 (true if read-only, false if not).
1402 This uses the L<blockdev(8)> command.");
1404 ("blockdev_getss", (RInt "sectorsize", [String "device"]), 59, [],
1405 [InitEmpty, Always, TestOutputInt (
1406 [["blockdev_getss"; "/dev/sda"]], 512)],
1407 "get sectorsize of block device",
1409 This returns the size of sectors on a block device.
1410 Usually 512, but can be larger for modern devices.
1412 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
1415 This uses the L<blockdev(8)> command.");
1417 ("blockdev_getbsz", (RInt "blocksize", [String "device"]), 60, [],
1418 [InitEmpty, Always, TestOutputInt (
1419 [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1420 "get blocksize of block device",
1422 This returns the block size of a device.
1424 (Note this is different from both I<size in blocks> and
1425 I<filesystem block size>).
1427 This uses the L<blockdev(8)> command.");
1429 ("blockdev_setbsz", (RErr, [String "device"; Int "blocksize"]), 61, [],
1431 "set blocksize of block device",
1433 This sets the block size of a device.
1435 (Note this is different from both I<size in blocks> and
1436 I<filesystem block size>).
1438 This uses the L<blockdev(8)> command.");
1440 ("blockdev_getsz", (RInt64 "sizeinsectors", [String "device"]), 62, [],
1441 [InitEmpty, Always, TestOutputInt (
1442 [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1443 "get total size of device in 512-byte sectors",
1445 This returns the size of the device in units of 512-byte sectors
1446 (even if the sectorsize isn't 512 bytes ... weird).
1448 See also C<guestfs_blockdev_getss> for the real sector size of
1449 the device, and C<guestfs_blockdev_getsize64> for the more
1450 useful I<size in bytes>.
1452 This uses the L<blockdev(8)> command.");
1454 ("blockdev_getsize64", (RInt64 "sizeinbytes", [String "device"]), 63, [],
1455 [InitEmpty, Always, TestOutputInt (
1456 [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1457 "get total size of device in bytes",
1459 This returns the size of the device in bytes.
1461 See also C<guestfs_blockdev_getsz>.
1463 This uses the L<blockdev(8)> command.");
1465 ("blockdev_flushbufs", (RErr, [String "device"]), 64, [],
1466 [InitEmpty, Always, TestRun
1467 [["blockdev_flushbufs"; "/dev/sda"]]],
1468 "flush device buffers",
1470 This tells the kernel to flush internal buffers associated
1473 This uses the L<blockdev(8)> command.");
1475 ("blockdev_rereadpt", (RErr, [String "device"]), 65, [],
1476 [InitEmpty, Always, TestRun
1477 [["blockdev_rereadpt"; "/dev/sda"]]],
1478 "reread partition table",
1480 Reread the partition table on C<device>.
1482 This uses the L<blockdev(8)> command.");
1484 ("upload", (RErr, [FileIn "filename"; String "remotefilename"]), 66, [],
1485 [InitBasicFS, Always, TestOutput (
1486 (* Pick a file from cwd which isn't likely to change. *)
1487 [["upload"; "COPYING.LIB"; "/COPYING.LIB"];
1488 ["checksum"; "md5"; "/COPYING.LIB"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
1489 "upload a file from the local machine",
1491 Upload local file C<filename> to C<remotefilename> on the
1494 C<filename> can also be a named pipe.
1496 See also C<guestfs_download>.");
1498 ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [],
1499 [InitBasicFS, Always, TestOutput (
1500 (* Pick a file from cwd which isn't likely to change. *)
1501 [["upload"; "COPYING.LIB"; "/COPYING.LIB"];
1502 ["download"; "/COPYING.LIB"; "testdownload.tmp"];
1503 ["upload"; "testdownload.tmp"; "/upload"];
1504 ["checksum"; "md5"; "/upload"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
1505 "download a file to the local machine",
1507 Download file C<remotefilename> and save it as C<filename>
1508 on the local machine.
1510 C<filename> can also be a named pipe.
1512 See also C<guestfs_upload>, C<guestfs_cat>.");
1514 ("checksum", (RString "checksum", [String "csumtype"; String "path"]), 68, [],
1515 [InitBasicFS, Always, TestOutput (
1516 [["write_file"; "/new"; "test\n"; "0"];
1517 ["checksum"; "crc"; "/new"]], "935282863");
1518 InitBasicFS, Always, TestLastFail (
1519 [["checksum"; "crc"; "/new"]]);
1520 InitBasicFS, Always, TestOutput (
1521 [["write_file"; "/new"; "test\n"; "0"];
1522 ["checksum"; "md5"; "/new"]], "d8e8fca2dc0f896fd7cb4cb0031ba249");
1523 InitBasicFS, Always, TestOutput (
1524 [["write_file"; "/new"; "test\n"; "0"];
1525 ["checksum"; "sha1"; "/new"]], "4e1243bd22c66e76c2ba9eddc1f91394e57f9f83");
1526 InitBasicFS, Always, TestOutput (
1527 [["write_file"; "/new"; "test\n"; "0"];
1528 ["checksum"; "sha224"; "/new"]], "52f1bf093f4b7588726035c176c0cdb4376cfea53819f1395ac9e6ec");
1529 InitBasicFS, Always, TestOutput (
1530 [["write_file"; "/new"; "test\n"; "0"];
1531 ["checksum"; "sha256"; "/new"]], "f2ca1bb6c7e907d06dafe4687e579fce76b37e4e93b7605022da52e6ccc26fd2");
1532 InitBasicFS, Always, TestOutput (
1533 [["write_file"; "/new"; "test\n"; "0"];
1534 ["checksum"; "sha384"; "/new"]], "109bb6b5b6d5547c1ce03c7a8bd7d8f80c1cb0957f50c4f7fda04692079917e4f9cad52b878f3d8234e1a170b154b72d");
1535 InitBasicFS, Always, TestOutput (
1536 [["write_file"; "/new"; "test\n"; "0"];
1537 ["checksum"; "sha512"; "/new"]], "0e3e75234abc68f4378a86b3f4b32a198ba301845b0cd6e50106e874345700cc6663a86c1ea125dc5e92be17c98f9a0f85ca9d5f595db2012f7cc3571945c123")],
1538 "compute MD5, SHAx or CRC checksum of file",
1540 This call computes the MD5, SHAx or CRC checksum of the
1543 The type of checksum to compute is given by the C<csumtype>
1544 parameter which must have one of the following values:
1550 Compute the cyclic redundancy check (CRC) specified by POSIX
1551 for the C<cksum> command.
1555 Compute the MD5 hash (using the C<md5sum> program).
1559 Compute the SHA1 hash (using the C<sha1sum> program).
1563 Compute the SHA224 hash (using the C<sha224sum> program).
1567 Compute the SHA256 hash (using the C<sha256sum> program).
1571 Compute the SHA384 hash (using the C<sha384sum> program).
1575 Compute the SHA512 hash (using the C<sha512sum> program).
1579 The checksum is returned as a printable string.");
1581 ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [],
1582 [InitBasicFS, Always, TestOutput (
1583 [["tar_in"; "images/helloworld.tar"; "/"];
1584 ["cat"; "/hello"]], "hello\n")],
1585 "unpack tarfile to directory",
1587 This command uploads and unpacks local file C<tarfile> (an
1588 I<uncompressed> tar file) into C<directory>.
1590 To upload a compressed tarball, use C<guestfs_tgz_in>.");
1592 ("tar_out", (RErr, [String "directory"; FileOut "tarfile"]), 70, [],
1594 "pack directory into tarfile",
1596 This command packs the contents of C<directory> and downloads
1597 it to local file C<tarfile>.
1599 To download a compressed tarball, use C<guestfs_tgz_out>.");
1601 ("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [],
1602 [InitBasicFS, Always, TestOutput (
1603 [["tgz_in"; "images/helloworld.tar.gz"; "/"];
1604 ["cat"; "/hello"]], "hello\n")],
1605 "unpack compressed tarball to directory",
1607 This command uploads and unpacks local file C<tarball> (a
1608 I<gzip compressed> tar file) into C<directory>.
1610 To upload an uncompressed tarball, use C<guestfs_tar_in>.");
1612 ("tgz_out", (RErr, [String "directory"; FileOut "tarball"]), 72, [],
1614 "pack directory into compressed tarball",
1616 This command packs the contents of C<directory> and downloads
1617 it to local file C<tarball>.
1619 To download an uncompressed tarball, use C<guestfs_tar_out>.");
1621 ("mount_ro", (RErr, [String "device"; String "mountpoint"]), 73, [],
1622 [InitBasicFS, Always, TestLastFail (
1624 ["mount_ro"; "/dev/sda1"; "/"];
1625 ["touch"; "/new"]]);
1626 InitBasicFS, Always, TestOutput (
1627 [["write_file"; "/new"; "data"; "0"];
1629 ["mount_ro"; "/dev/sda1"; "/"];
1630 ["cat"; "/new"]], "data")],
1631 "mount a guest disk, read-only",
1633 This is the same as the C<guestfs_mount> command, but it
1634 mounts the filesystem with the read-only (I<-o ro>) flag.");
1636 ("mount_options", (RErr, [String "options"; String "device"; String "mountpoint"]), 74, [],
1638 "mount a guest disk with mount options",
1640 This is the same as the C<guestfs_mount> command, but it
1641 allows you to set the mount options as for the
1642 L<mount(8)> I<-o> flag.");
1644 ("mount_vfs", (RErr, [String "options"; String "vfstype"; String "device"; String "mountpoint"]), 75, [],
1646 "mount a guest disk with mount options and vfstype",
1648 This is the same as the C<guestfs_mount> command, but it
1649 allows you to set both the mount options and the vfstype
1650 as for the L<mount(8)> I<-o> and I<-t> flags.");
1652 ("debug", (RString "result", [String "subcmd"; StringList "extraargs"]), 76, [],
1654 "debugging and internals",
1656 The C<guestfs_debug> command exposes some internals of
1657 C<guestfsd> (the guestfs daemon) that runs inside the
1660 There is no comprehensive help for this command. You have
1661 to look at the file C<daemon/debug.c> in the libguestfs source
1662 to find out what you can do.");
1664 ("lvremove", (RErr, [String "device"]), 77, [],
1665 [InitEmpty, Always, TestOutputList (
1666 [["pvcreate"; "/dev/sda"];
1667 ["vgcreate"; "VG"; "/dev/sda"];
1668 ["lvcreate"; "LV1"; "VG"; "50"];
1669 ["lvcreate"; "LV2"; "VG"; "50"];
1670 ["lvremove"; "/dev/VG/LV1"];
1671 ["lvs"]], ["/dev/VG/LV2"]);
1672 InitEmpty, Always, TestOutputList (
1673 [["pvcreate"; "/dev/sda"];
1674 ["vgcreate"; "VG"; "/dev/sda"];
1675 ["lvcreate"; "LV1"; "VG"; "50"];
1676 ["lvcreate"; "LV2"; "VG"; "50"];
1677 ["lvremove"; "/dev/VG"];
1679 InitEmpty, Always, TestOutputList (
1680 [["pvcreate"; "/dev/sda"];
1681 ["vgcreate"; "VG"; "/dev/sda"];
1682 ["lvcreate"; "LV1"; "VG"; "50"];
1683 ["lvcreate"; "LV2"; "VG"; "50"];
1684 ["lvremove"; "/dev/VG"];
1686 "remove an LVM logical volume",
1688 Remove an LVM logical volume C<device>, where C<device> is
1689 the path to the LV, such as C</dev/VG/LV>.
1691 You can also remove all LVs in a volume group by specifying
1692 the VG name, C</dev/VG>.");
1694 ("vgremove", (RErr, [String "vgname"]), 78, [],
1695 [InitEmpty, Always, TestOutputList (
1696 [["pvcreate"; "/dev/sda"];
1697 ["vgcreate"; "VG"; "/dev/sda"];
1698 ["lvcreate"; "LV1"; "VG"; "50"];
1699 ["lvcreate"; "LV2"; "VG"; "50"];
1702 InitEmpty, Always, TestOutputList (
1703 [["pvcreate"; "/dev/sda"];
1704 ["vgcreate"; "VG"; "/dev/sda"];
1705 ["lvcreate"; "LV1"; "VG"; "50"];
1706 ["lvcreate"; "LV2"; "VG"; "50"];
1709 "remove an LVM volume group",
1711 Remove an LVM volume group C<vgname>, (for example C<VG>).
1713 This also forcibly removes all logical volumes in the volume
1716 ("pvremove", (RErr, [String "device"]), 79, [],
1717 [InitEmpty, Always, TestOutputList (
1718 [["pvcreate"; "/dev/sda"];
1719 ["vgcreate"; "VG"; "/dev/sda"];
1720 ["lvcreate"; "LV1"; "VG"; "50"];
1721 ["lvcreate"; "LV2"; "VG"; "50"];
1723 ["pvremove"; "/dev/sda"];
1725 InitEmpty, Always, TestOutputList (
1726 [["pvcreate"; "/dev/sda"];
1727 ["vgcreate"; "VG"; "/dev/sda"];
1728 ["lvcreate"; "LV1"; "VG"; "50"];
1729 ["lvcreate"; "LV2"; "VG"; "50"];
1731 ["pvremove"; "/dev/sda"];
1733 InitEmpty, Always, TestOutputList (
1734 [["pvcreate"; "/dev/sda"];
1735 ["vgcreate"; "VG"; "/dev/sda"];
1736 ["lvcreate"; "LV1"; "VG"; "50"];
1737 ["lvcreate"; "LV2"; "VG"; "50"];
1739 ["pvremove"; "/dev/sda"];
1741 "remove an LVM physical volume",
1743 This wipes a physical volume C<device> so that LVM will no longer
1746 The implementation uses the C<pvremove> command which refuses to
1747 wipe physical volumes that contain any volume groups, so you have
1748 to remove those first.");
1750 ("set_e2label", (RErr, [String "device"; String "label"]), 80, [],
1751 [InitBasicFS, Always, TestOutput (
1752 [["set_e2label"; "/dev/sda1"; "testlabel"];
1753 ["get_e2label"; "/dev/sda1"]], "testlabel")],
1754 "set the ext2/3/4 filesystem label",
1756 This sets the ext2/3/4 filesystem label of the filesystem on
1757 C<device> to C<label>. Filesystem labels are limited to
1760 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2label>
1761 to return the existing label on a filesystem.");
1763 ("get_e2label", (RString "label", [String "device"]), 81, [],
1765 "get the ext2/3/4 filesystem label",
1767 This returns the ext2/3/4 filesystem label of the filesystem on
1770 ("set_e2uuid", (RErr, [String "device"; String "uuid"]), 82, [],
1771 [InitBasicFS, Always, TestOutput (
1772 [["set_e2uuid"; "/dev/sda1"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"];
1773 ["get_e2uuid"; "/dev/sda1"]], "a3a61220-882b-4f61-89f4-cf24dcc7297d");
1774 InitBasicFS, Always, TestOutput (
1775 [["set_e2uuid"; "/dev/sda1"; "clear"];
1776 ["get_e2uuid"; "/dev/sda1"]], "");
1777 (* We can't predict what UUIDs will be, so just check the commands run. *)
1778 InitBasicFS, Always, TestRun (
1779 [["set_e2uuid"; "/dev/sda1"; "random"]]);
1780 InitBasicFS, Always, TestRun (
1781 [["set_e2uuid"; "/dev/sda1"; "time"]])],
1782 "set the ext2/3/4 filesystem UUID",
1784 This sets the ext2/3/4 filesystem UUID of the filesystem on
1785 C<device> to C<uuid>. The format of the UUID and alternatives
1786 such as C<clear>, C<random> and C<time> are described in the
1787 L<tune2fs(8)> manpage.
1789 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2uuid>
1790 to return the existing UUID of a filesystem.");
1792 ("get_e2uuid", (RString "uuid", [String "device"]), 83, [],
1794 "get the ext2/3/4 filesystem UUID",
1796 This returns the ext2/3/4 filesystem UUID of the filesystem on
1799 ("fsck", (RInt "status", [String "fstype"; String "device"]), 84, [],
1800 [InitBasicFS, Always, TestOutputInt (
1801 [["umount"; "/dev/sda1"];
1802 ["fsck"; "ext2"; "/dev/sda1"]], 0);
1803 InitBasicFS, Always, TestOutputInt (
1804 [["umount"; "/dev/sda1"];
1805 ["zero"; "/dev/sda1"];
1806 ["fsck"; "ext2"; "/dev/sda1"]], 8)],
1807 "run the filesystem checker",
1809 This runs the filesystem checker (fsck) on C<device> which
1810 should have filesystem type C<fstype>.
1812 The returned integer is the status. See L<fsck(8)> for the
1813 list of status codes from C<fsck>.
1821 Multiple status codes can be summed together.
1825 A non-zero return code can mean \"success\", for example if
1826 errors have been corrected on the filesystem.
1830 Checking or repairing NTFS volumes is not supported
1835 This command is entirely equivalent to running C<fsck -a -t fstype device>.");
1837 ("zero", (RErr, [String "device"]), 85, [],
1838 [InitBasicFS, Always, TestOutput (
1839 [["umount"; "/dev/sda1"];
1840 ["zero"; "/dev/sda1"];
1841 ["file"; "/dev/sda1"]], "data")],
1842 "write zeroes to the device",
1844 This command writes zeroes over the first few blocks of C<device>.
1846 How many blocks are zeroed isn't specified (but it's I<not> enough
1847 to securely wipe the device). It should be sufficient to remove
1848 any partition tables, filesystem superblocks and so on.");
1850 ("grub_install", (RErr, [String "root"; String "device"]), 86, [],
1851 [InitBasicFS, Always, TestOutputTrue (
1852 [["grub_install"; "/"; "/dev/sda1"];
1853 ["is_dir"; "/boot"]])],
1856 This command installs GRUB (the Grand Unified Bootloader) on
1857 C<device>, with the root directory being C<root>.");
1859 ("cp", (RErr, [String "src"; String "dest"]), 87, [],
1860 [InitBasicFS, Always, TestOutput (
1861 [["write_file"; "/old"; "file content"; "0"];
1862 ["cp"; "/old"; "/new"];
1863 ["cat"; "/new"]], "file content");
1864 InitBasicFS, Always, TestOutputTrue (
1865 [["write_file"; "/old"; "file content"; "0"];
1866 ["cp"; "/old"; "/new"];
1867 ["is_file"; "/old"]]);
1868 InitBasicFS, Always, TestOutput (
1869 [["write_file"; "/old"; "file content"; "0"];
1871 ["cp"; "/old"; "/dir/new"];
1872 ["cat"; "/dir/new"]], "file content")],
1875 This copies a file from C<src> to C<dest> where C<dest> is
1876 either a destination filename or destination directory.");
1878 ("cp_a", (RErr, [String "src"; String "dest"]), 88, [],
1879 [InitBasicFS, Always, TestOutput (
1880 [["mkdir"; "/olddir"];
1881 ["mkdir"; "/newdir"];
1882 ["write_file"; "/olddir/file"; "file content"; "0"];
1883 ["cp_a"; "/olddir"; "/newdir"];
1884 ["cat"; "/newdir/olddir/file"]], "file content")],
1885 "copy a file or directory recursively",
1887 This copies a file or directory from C<src> to C<dest>
1888 recursively using the C<cp -a> command.");
1890 ("mv", (RErr, [String "src"; String "dest"]), 89, [],
1891 [InitBasicFS, Always, TestOutput (
1892 [["write_file"; "/old"; "file content"; "0"];
1893 ["mv"; "/old"; "/new"];
1894 ["cat"; "/new"]], "file content");
1895 InitBasicFS, Always, TestOutputFalse (
1896 [["write_file"; "/old"; "file content"; "0"];
1897 ["mv"; "/old"; "/new"];
1898 ["is_file"; "/old"]])],
1901 This moves a file from C<src> to C<dest> where C<dest> is
1902 either a destination filename or destination directory.");
1904 ("drop_caches", (RErr, [Int "whattodrop"]), 90, [],
1905 [InitEmpty, Always, TestRun (
1906 [["drop_caches"; "3"]])],
1907 "drop kernel page cache, dentries and inodes",
1909 This instructs the guest kernel to drop its page cache,
1910 and/or dentries and inode caches. The parameter C<whattodrop>
1911 tells the kernel what precisely to drop, see
1912 L<http://linux-mm.org/Drop_Caches>
1914 Setting C<whattodrop> to 3 should drop everything.
1916 This automatically calls L<sync(2)> before the operation,
1917 so that the maximum guest memory is freed.");
1919 ("dmesg", (RString "kmsgs", []), 91, [],
1920 [InitEmpty, Always, TestRun (
1922 "return kernel messages",
1924 This returns the kernel messages (C<dmesg> output) from
1925 the guest kernel. This is sometimes useful for extended
1926 debugging of problems.
1928 Another way to get the same information is to enable
1929 verbose messages with C<guestfs_set_verbose> or by setting
1930 the environment variable C<LIBGUESTFS_DEBUG=1> before
1931 running the program.");
1933 ("ping_daemon", (RErr, []), 92, [],
1934 [InitEmpty, Always, TestRun (
1935 [["ping_daemon"]])],
1936 "ping the guest daemon",
1938 This is a test probe into the guestfs daemon running inside
1939 the qemu subprocess. Calling this function checks that the
1940 daemon responds to the ping message, without affecting the daemon
1941 or attached block device(s) in any other way.");
1943 ("equal", (RBool "equality", [String "file1"; String "file2"]), 93, [],
1944 [InitBasicFS, Always, TestOutputTrue (
1945 [["write_file"; "/file1"; "contents of a file"; "0"];
1946 ["cp"; "/file1"; "/file2"];
1947 ["equal"; "/file1"; "/file2"]]);
1948 InitBasicFS, Always, TestOutputFalse (
1949 [["write_file"; "/file1"; "contents of a file"; "0"];
1950 ["write_file"; "/file2"; "contents of another file"; "0"];
1951 ["equal"; "/file1"; "/file2"]]);
1952 InitBasicFS, Always, TestLastFail (
1953 [["equal"; "/file1"; "/file2"]])],
1954 "test if two files have equal contents",
1956 This compares the two files C<file1> and C<file2> and returns
1957 true if their content is exactly equal, or false otherwise.
1959 The external L<cmp(1)> program is used for the comparison.");
1961 ("strings", (RStringList "stringsout", [String "path"]), 94, [ProtocolLimitWarning],
1962 [InitBasicFS, Always, TestOutputList (
1963 [["write_file"; "/new"; "hello\nworld\n"; "0"];
1964 ["strings"; "/new"]], ["hello"; "world"]);
1965 InitBasicFS, Always, TestOutputList (
1967 ["strings"; "/new"]], [])],
1968 "print the printable strings in a file",
1970 This runs the L<strings(1)> command on a file and returns
1971 the list of printable strings found.");
1973 ("strings_e", (RStringList "stringsout", [String "encoding"; String "path"]), 95, [ProtocolLimitWarning],
1974 [InitBasicFS, Always, TestOutputList (
1975 [["write_file"; "/new"; "hello\nworld\n"; "0"];
1976 ["strings_e"; "b"; "/new"]], []);
1977 InitBasicFS, Disabled, TestOutputList (
1978 [["write_file"; "/new"; "\000h\000e\000l\000l\000o\000\n\000w\000o\000r\000l\000d\000\n"; "24"];
1979 ["strings_e"; "b"; "/new"]], ["hello"; "world"])],
1980 "print the printable strings in a file",
1982 This is like the C<guestfs_strings> command, but allows you to
1983 specify the encoding.
1985 See the L<strings(1)> manpage for the full list of encodings.
1987 Commonly useful encodings are C<l> (lower case L) which will
1988 show strings inside Windows/x86 files.
1990 The returned strings are transcoded to UTF-8.");
1992 ("hexdump", (RString "dump", [String "path"]), 96, [ProtocolLimitWarning],
1993 [InitBasicFS, Always, TestOutput (
1994 [["write_file"; "/new"; "hello\nworld\n"; "12"];
1995 ["hexdump"; "/new"]], "00000000 68 65 6c 6c 6f 0a 77 6f 72 6c 64 0a |hello.world.|\n0000000c\n")],
1996 "dump a file in hexadecimal",
1998 This runs C<hexdump -C> on the given C<path>. The result is
1999 the human-readable, canonical hex dump of the file.");
2001 ("zerofree", (RErr, [String "device"]), 97, [],
2002 [InitNone, Always, TestOutput (
2003 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2004 ["mkfs"; "ext3"; "/dev/sda1"];
2005 ["mount"; "/dev/sda1"; "/"];
2006 ["write_file"; "/new"; "test file"; "0"];
2007 ["umount"; "/dev/sda1"];
2008 ["zerofree"; "/dev/sda1"];
2009 ["mount"; "/dev/sda1"; "/"];
2010 ["cat"; "/new"]], "test file")],
2011 "zero unused inodes and disk blocks on ext2/3 filesystem",
2013 This runs the I<zerofree> program on C<device>. This program
2014 claims to zero unused inodes and disk blocks on an ext2/3
2015 filesystem, thus making it possible to compress the filesystem
2018 You should B<not> run this program if the filesystem is
2021 It is possible that using this program can damage the filesystem
2022 or data on the filesystem.");
2024 ("pvresize", (RErr, [String "device"]), 98, [],
2026 "resize an LVM physical volume",
2028 This resizes (expands or shrinks) an existing LVM physical
2029 volume to match the new size of the underlying device.");
2031 ("sfdisk_N", (RErr, [String "device"; Int "n";
2032 Int "cyls"; Int "heads"; Int "sectors";
2033 String "line"]), 99, [DangerWillRobinson],
2035 "modify a single partition on a block device",
2037 This runs L<sfdisk(8)> option to modify just the single
2038 partition C<n> (note: C<n> counts from 1).
2040 For other parameters, see C<guestfs_sfdisk>. You should usually
2041 pass C<0> for the cyls/heads/sectors parameters.");
2043 ("sfdisk_l", (RString "partitions", [String "device"]), 100, [],
2045 "display the partition table",
2047 This displays the partition table on C<device>, in the
2048 human-readable output of the L<sfdisk(8)> command. It is
2049 not intended to be parsed.");
2051 ("sfdisk_kernel_geometry", (RString "partitions", [String "device"]), 101, [],
2053 "display the kernel geometry",
2055 This displays the kernel's idea of the geometry of C<device>.
2057 The result is in human-readable format, and not designed to
2060 ("sfdisk_disk_geometry", (RString "partitions", [String "device"]), 102, [],
2062 "display the disk geometry from the partition table",
2064 This displays the disk geometry of C<device> read from the
2065 partition table. Especially in the case where the underlying
2066 block device has been resized, this can be different from the
2067 kernel's idea of the geometry (see C<guestfs_sfdisk_kernel_geometry>).
2069 The result is in human-readable format, and not designed to
2074 let all_functions = non_daemon_functions @ daemon_functions
2076 (* In some places we want the functions to be displayed sorted
2077 * alphabetically, so this is useful:
2079 let all_functions_sorted =
2080 List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
2081 compare n1 n2) all_functions
2083 (* Column names and types from LVM PVs/VGs/LVs. *)
2092 "pv_attr", `String (* XXX *);
2093 "pv_pe_count", `Int;
2094 "pv_pe_alloc_count", `Int;
2097 "pv_mda_count", `Int;
2098 "pv_mda_free", `Bytes;
2099 (* Not in Fedora 10:
2100 "pv_mda_size", `Bytes;
2107 "vg_attr", `String (* XXX *);
2110 "vg_sysid", `String;
2111 "vg_extent_size", `Bytes;
2112 "vg_extent_count", `Int;
2113 "vg_free_count", `Int;
2121 "vg_mda_count", `Int;
2122 "vg_mda_free", `Bytes;
2123 (* Not in Fedora 10:
2124 "vg_mda_size", `Bytes;
2130 "lv_attr", `String (* XXX *);
2133 "lv_kernel_major", `Int;
2134 "lv_kernel_minor", `Int;
2138 "snap_percent", `OptPercent;
2139 "copy_percent", `OptPercent;
2142 "mirror_log", `String;
2146 (* Column names and types from stat structures.
2147 * NB. Can't use things like 'st_atime' because glibc header files
2148 * define some of these as macros. Ugh.
2165 let statvfs_cols = [
2179 (* Useful functions.
2180 * Note we don't want to use any external OCaml libraries which
2181 * makes this a bit harder than it should be.
2183 let failwithf fs = ksprintf failwith fs
2185 let replace_char s c1 c2 =
2186 let s2 = String.copy s in
2187 let r = ref false in
2188 for i = 0 to String.length s2 - 1 do
2189 if String.unsafe_get s2 i = c1 then (
2190 String.unsafe_set s2 i c2;
2194 if not !r then s else s2
2198 (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
2200 let triml ?(test = isspace) str =
2202 let n = ref (String.length str) in
2203 while !n > 0 && test str.[!i]; do
2208 else String.sub str !i !n
2210 let trimr ?(test = isspace) str =
2211 let n = ref (String.length str) in
2212 while !n > 0 && test str.[!n-1]; do
2215 if !n = String.length str then str
2216 else String.sub str 0 !n
2218 let trim ?(test = isspace) str =
2219 trimr ~test (triml ~test str)
2221 let rec find s sub =
2222 let len = String.length s in
2223 let sublen = String.length sub in
2225 if i <= len-sublen then (
2227 if j < sublen then (
2228 if s.[i+j] = sub.[j] then loop2 (j+1)
2234 if r = -1 then loop (i+1) else r
2240 let rec replace_str s s1 s2 =
2241 let len = String.length s in
2242 let sublen = String.length s1 in
2243 let i = find s s1 in
2246 let s' = String.sub s 0 i in
2247 let s'' = String.sub s (i+sublen) (len-i-sublen) in
2248 s' ^ s2 ^ replace_str s'' s1 s2
2251 let rec string_split sep str =
2252 let len = String.length str in
2253 let seplen = String.length sep in
2254 let i = find str sep in
2255 if i = -1 then [str]
2257 let s' = String.sub str 0 i in
2258 let s'' = String.sub str (i+seplen) (len-i-seplen) in
2259 s' :: string_split sep s''
2262 let files_equal n1 n2 =
2263 let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
2264 match Sys.command cmd with
2267 | i -> failwithf "%s: failed with error code %d" cmd i
2269 let rec find_map f = function
2270 | [] -> raise Not_found
2274 | None -> find_map f xs
2277 let rec loop i = function
2279 | x :: xs -> f i x; loop (i+1) xs
2284 let rec loop i = function
2286 | x :: xs -> let r = f i x in r :: loop (i+1) xs
2290 let name_of_argt = function
2291 | String n | OptString n | StringList n | Bool n | Int n
2292 | FileIn n | FileOut n -> n
2294 let seq_of_test = function
2295 | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
2296 | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s
2297 | TestOutputLength (s, _) | TestOutputStruct (s, _)
2298 | TestLastFail s -> s
2300 (* Check function names etc. for consistency. *)
2301 let check_functions () =
2302 let contains_uppercase str =
2303 let len = String.length str in
2305 if i >= len then false
2308 if c >= 'A' && c <= 'Z' then true
2315 (* Check function names. *)
2317 fun (name, _, _, _, _, _, _) ->
2318 if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
2319 failwithf "function name %s does not need 'guestfs' prefix" name;
2321 failwithf "function name is empty";
2322 if name.[0] < 'a' || name.[0] > 'z' then
2323 failwithf "function name %s must start with lowercase a-z" name;
2324 if String.contains name '-' then
2325 failwithf "function name %s should not contain '-', use '_' instead."
2329 (* Check function parameter/return names. *)
2331 fun (name, style, _, _, _, _, _) ->
2332 let check_arg_ret_name n =
2333 if contains_uppercase n then
2334 failwithf "%s param/ret %s should not contain uppercase chars"
2336 if String.contains n '-' || String.contains n '_' then
2337 failwithf "%s param/ret %s should not contain '-' or '_'"
2340 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;
2341 if n = "argv" || n = "args" then
2342 failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" n
2345 (match fst style with
2347 | RInt n | RInt64 n | RBool n | RConstString n | RString n
2348 | RStringList n | RPVList n | RVGList n | RLVList n
2349 | RStat n | RStatVFS n
2351 check_arg_ret_name n
2353 check_arg_ret_name n;
2354 check_arg_ret_name m
2356 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
2359 (* Check short descriptions. *)
2361 fun (name, _, _, _, _, shortdesc, _) ->
2362 if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
2363 failwithf "short description of %s should begin with lowercase." name;
2364 let c = shortdesc.[String.length shortdesc-1] in
2365 if c = '\n' || c = '.' then
2366 failwithf "short description of %s should not end with . or \\n." name
2369 (* Check long dscriptions. *)
2371 fun (name, _, _, _, _, _, longdesc) ->
2372 if longdesc.[String.length longdesc-1] = '\n' then
2373 failwithf "long description of %s should not end with \\n." name
2376 (* Check proc_nrs. *)
2378 fun (name, _, proc_nr, _, _, _, _) ->
2379 if proc_nr <= 0 then
2380 failwithf "daemon function %s should have proc_nr > 0" name
2384 fun (name, _, proc_nr, _, _, _, _) ->
2385 if proc_nr <> -1 then
2386 failwithf "non-daemon function %s should have proc_nr -1" name
2387 ) non_daemon_functions;
2390 List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
2393 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
2394 let rec loop = function
2397 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
2399 | (name1,nr1) :: (name2,nr2) :: _ ->
2400 failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
2408 (* Ignore functions that have no tests. We generate a
2409 * warning when the user does 'make check' instead.
2411 | name, _, _, _, [], _, _ -> ()
2412 | name, _, _, _, tests, _, _ ->
2416 match seq_of_test test with
2418 failwithf "%s has a test containing an empty sequence" name
2419 | cmds -> List.map List.hd cmds
2421 let funcs = List.flatten funcs in
2423 let tested = List.mem name funcs in
2426 failwithf "function %s has tests but does not test itself" name
2429 (* 'pr' prints to the current output file. *)
2430 let chan = ref stdout
2431 let pr fs = ksprintf (output_string !chan) fs
2433 (* Generate a header block in a number of standard styles. *)
2434 type comment_style = CStyle | HashStyle | OCamlStyle | HaskellStyle
2435 type license = GPLv2 | LGPLv2
2437 let generate_header comment license =
2438 let c = match comment with
2439 | CStyle -> pr "/* "; " *"
2440 | HashStyle -> pr "# "; "#"
2441 | OCamlStyle -> pr "(* "; " *"
2442 | HaskellStyle -> pr "{- "; " " in
2443 pr "libguestfs generated file\n";
2444 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
2445 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
2447 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
2451 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
2452 pr "%s it under the terms of the GNU General Public License as published by\n" c;
2453 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
2454 pr "%s (at your option) any later version.\n" c;
2456 pr "%s This program is distributed in the hope that it will be useful,\n" c;
2457 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
2458 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
2459 pr "%s GNU General Public License for more details.\n" c;
2461 pr "%s You should have received a copy of the GNU General Public License along\n" c;
2462 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
2463 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
2466 pr "%s This library is free software; you can redistribute it and/or\n" c;
2467 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
2468 pr "%s License as published by the Free Software Foundation; either\n" c;
2469 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
2471 pr "%s This library is distributed in the hope that it will be useful,\n" c;
2472 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
2473 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
2474 pr "%s Lesser General Public License for more details.\n" c;
2476 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
2477 pr "%s License along with this library; if not, write to the Free Software\n" c;
2478 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
2481 | CStyle -> pr " */\n"
2483 | OCamlStyle -> pr " *)\n"
2484 | HaskellStyle -> pr "-}\n"
2488 (* Start of main code generation functions below this line. *)
2490 (* Generate the pod documentation for the C API. *)
2491 let rec generate_actions_pod () =
2493 fun (shortname, style, _, flags, _, _, longdesc) ->
2494 let name = "guestfs_" ^ shortname in
2495 pr "=head2 %s\n\n" name;
2497 generate_prototype ~extern:false ~handle:"handle" name style;
2499 pr "%s\n\n" longdesc;
2500 (match fst style with
2502 pr "This function returns 0 on success or -1 on error.\n\n"
2504 pr "On error this function returns -1.\n\n"
2506 pr "On error this function returns -1.\n\n"
2508 pr "This function returns a C truth value on success or -1 on error.\n\n"
2510 pr "This function returns a string, or NULL on error.
2511 The string is owned by the guest handle and must I<not> be freed.\n\n"
2513 pr "This function returns a string, or NULL on error.
2514 I<The caller must free the returned string after use>.\n\n"
2516 pr "This function returns a NULL-terminated array of strings
2517 (like L<environ(3)>), or NULL if there was an error.
2518 I<The caller must free the strings and the array after use>.\n\n"
2520 pr "This function returns a C<struct guestfs_int_bool *>,
2521 or NULL if there was an error.
2522 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
2524 pr "This function returns a C<struct guestfs_lvm_pv_list *>
2525 (see E<lt>guestfs-structs.hE<gt>),
2526 or NULL if there was an error.
2527 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
2529 pr "This function returns a C<struct guestfs_lvm_vg_list *>
2530 (see E<lt>guestfs-structs.hE<gt>),
2531 or NULL if there was an error.
2532 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
2534 pr "This function returns a C<struct guestfs_lvm_lv_list *>
2535 (see E<lt>guestfs-structs.hE<gt>),
2536 or NULL if there was an error.
2537 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
2539 pr "This function returns a C<struct guestfs_stat *>
2540 (see L<stat(2)> and E<lt>guestfs-structs.hE<gt>),
2541 or NULL if there was an error.
2542 I<The caller must call C<free> after use>.\n\n"
2544 pr "This function returns a C<struct guestfs_statvfs *>
2545 (see L<statvfs(2)> and E<lt>guestfs-structs.hE<gt>),
2546 or NULL if there was an error.
2547 I<The caller must call C<free> after use>.\n\n"
2549 pr "This function returns a NULL-terminated array of
2550 strings, or NULL if there was an error.
2551 The array of strings will always have length C<2n+1>, where
2552 C<n> keys and values alternate, followed by the trailing NULL entry.
2553 I<The caller must free the strings and the array after use>.\n\n"
2555 if List.mem ProtocolLimitWarning flags then
2556 pr "%s\n\n" protocol_limit_warning;
2557 if List.mem DangerWillRobinson flags then
2558 pr "%s\n\n" danger_will_robinson;
2559 ) all_functions_sorted
2561 and generate_structs_pod () =
2562 (* LVM structs documentation. *)
2565 pr "=head2 guestfs_lvm_%s\n" typ;
2567 pr " struct guestfs_lvm_%s {\n" typ;
2570 | name, `String -> pr " char *%s;\n" name
2572 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
2573 pr " char %s[32];\n" name
2574 | name, `Bytes -> pr " uint64_t %s;\n" name
2575 | name, `Int -> pr " int64_t %s;\n" name
2576 | name, `OptPercent ->
2577 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
2578 pr " float %s;\n" name
2581 pr " struct guestfs_lvm_%s_list {\n" typ;
2582 pr " uint32_t len; /* Number of elements in list. */\n";
2583 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
2586 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
2589 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2591 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
2592 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
2594 * We have to use an underscore instead of a dash because otherwise
2595 * rpcgen generates incorrect code.
2597 * This header is NOT exported to clients, but see also generate_structs_h.
2599 and generate_xdr () =
2600 generate_header CStyle LGPLv2;
2602 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
2603 pr "typedef string str<>;\n";
2606 (* LVM internal structures. *)
2610 pr "struct guestfs_lvm_int_%s {\n" typ;
2612 | name, `String -> pr " string %s<>;\n" name
2613 | name, `UUID -> pr " opaque %s[32];\n" name
2614 | name, `Bytes -> pr " hyper %s;\n" name
2615 | name, `Int -> pr " hyper %s;\n" name
2616 | name, `OptPercent -> pr " float %s;\n" name
2620 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
2622 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2624 (* Stat internal structures. *)
2628 pr "struct guestfs_int_%s {\n" typ;
2630 | name, `Int -> pr " hyper %s;\n" name
2634 ) ["stat", stat_cols; "statvfs", statvfs_cols];
2637 fun (shortname, style, _, _, _, _, _) ->
2638 let name = "guestfs_" ^ shortname in
2640 (match snd style with
2643 pr "struct %s_args {\n" name;
2646 | String n -> pr " string %s<>;\n" n
2647 | OptString n -> pr " str *%s;\n" n
2648 | StringList n -> pr " str %s<>;\n" n
2649 | Bool n -> pr " bool %s;\n" n
2650 | Int n -> pr " int %s;\n" n
2651 | FileIn _ | FileOut _ -> ()
2655 (match fst style with
2658 pr "struct %s_ret {\n" name;
2662 pr "struct %s_ret {\n" name;
2663 pr " hyper %s;\n" n;
2666 pr "struct %s_ret {\n" name;
2670 failwithf "RConstString cannot be returned from a daemon function"
2672 pr "struct %s_ret {\n" name;
2673 pr " string %s<>;\n" n;
2676 pr "struct %s_ret {\n" name;
2677 pr " str %s<>;\n" n;
2680 pr "struct %s_ret {\n" name;
2685 pr "struct %s_ret {\n" name;
2686 pr " guestfs_lvm_int_pv_list %s;\n" n;
2689 pr "struct %s_ret {\n" name;
2690 pr " guestfs_lvm_int_vg_list %s;\n" n;
2693 pr "struct %s_ret {\n" name;
2694 pr " guestfs_lvm_int_lv_list %s;\n" n;
2697 pr "struct %s_ret {\n" name;
2698 pr " guestfs_int_stat %s;\n" n;
2701 pr "struct %s_ret {\n" name;
2702 pr " guestfs_int_statvfs %s;\n" n;
2705 pr "struct %s_ret {\n" name;
2706 pr " str %s<>;\n" n;
2711 (* Table of procedure numbers. *)
2712 pr "enum guestfs_procedure {\n";
2714 fun (shortname, _, proc_nr, _, _, _, _) ->
2715 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
2717 pr " GUESTFS_PROC_NR_PROCS\n";
2721 (* Having to choose a maximum message size is annoying for several
2722 * reasons (it limits what we can do in the API), but it (a) makes
2723 * the protocol a lot simpler, and (b) provides a bound on the size
2724 * of the daemon which operates in limited memory space. For large
2725 * file transfers you should use FTP.
2727 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
2730 (* Message header, etc. *)
2732 /* The communication protocol is now documented in the guestfs(3)
2736 const GUESTFS_PROGRAM = 0x2000F5F5;
2737 const GUESTFS_PROTOCOL_VERSION = 1;
2739 /* These constants must be larger than any possible message length. */
2740 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
2741 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
2743 enum guestfs_message_direction {
2744 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
2745 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
2748 enum guestfs_message_status {
2749 GUESTFS_STATUS_OK = 0,
2750 GUESTFS_STATUS_ERROR = 1
2753 const GUESTFS_ERROR_LEN = 256;
2755 struct guestfs_message_error {
2756 string error_message<GUESTFS_ERROR_LEN>;
2759 struct guestfs_message_header {
2760 unsigned prog; /* GUESTFS_PROGRAM */
2761 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
2762 guestfs_procedure proc; /* GUESTFS_PROC_x */
2763 guestfs_message_direction direction;
2764 unsigned serial; /* message serial number */
2765 guestfs_message_status status;
2768 const GUESTFS_MAX_CHUNK_SIZE = 8192;
2770 struct guestfs_chunk {
2771 int cancel; /* if non-zero, transfer is cancelled */
2772 /* data size is 0 bytes if the transfer has finished successfully */
2773 opaque data<GUESTFS_MAX_CHUNK_SIZE>;
2777 (* Generate the guestfs-structs.h file. *)
2778 and generate_structs_h () =
2779 generate_header CStyle LGPLv2;
2781 (* This is a public exported header file containing various
2782 * structures. The structures are carefully written to have
2783 * exactly the same in-memory format as the XDR structures that
2784 * we use on the wire to the daemon. The reason for creating
2785 * copies of these structures here is just so we don't have to
2786 * export the whole of guestfs_protocol.h (which includes much
2787 * unrelated and XDR-dependent stuff that we don't want to be
2788 * public, or required by clients).
2790 * To reiterate, we will pass these structures to and from the
2791 * client with a simple assignment or memcpy, so the format
2792 * must be identical to what rpcgen / the RFC defines.
2795 (* guestfs_int_bool structure. *)
2796 pr "struct guestfs_int_bool {\n";
2802 (* LVM public structures. *)
2806 pr "struct guestfs_lvm_%s {\n" typ;
2809 | name, `String -> pr " char *%s;\n" name
2810 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
2811 | name, `Bytes -> pr " uint64_t %s;\n" name
2812 | name, `Int -> pr " int64_t %s;\n" name
2813 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
2817 pr "struct guestfs_lvm_%s_list {\n" typ;
2818 pr " uint32_t len;\n";
2819 pr " struct guestfs_lvm_%s *val;\n" typ;
2822 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2824 (* Stat structures. *)
2828 pr "struct guestfs_%s {\n" typ;
2831 | name, `Int -> pr " int64_t %s;\n" name
2835 ) ["stat", stat_cols; "statvfs", statvfs_cols]
2837 (* Generate the guestfs-actions.h file. *)
2838 and generate_actions_h () =
2839 generate_header CStyle LGPLv2;
2841 fun (shortname, style, _, _, _, _, _) ->
2842 let name = "guestfs_" ^ shortname in
2843 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
2847 (* Generate the client-side dispatch stubs. *)
2848 and generate_client_actions () =
2849 generate_header CStyle LGPLv2;
2855 #include \"guestfs.h\"
2856 #include \"guestfs_protocol.h\"
2858 #define error guestfs_error
2859 #define perrorf guestfs_perrorf
2860 #define safe_malloc guestfs_safe_malloc
2861 #define safe_realloc guestfs_safe_realloc
2862 #define safe_strdup guestfs_safe_strdup
2863 #define safe_memdup guestfs_safe_memdup
2865 /* Check the return message from a call for validity. */
2867 check_reply_header (guestfs_h *g,
2868 const struct guestfs_message_header *hdr,
2869 int proc_nr, int serial)
2871 if (hdr->prog != GUESTFS_PROGRAM) {
2872 error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
2875 if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
2876 error (g, \"wrong protocol version (%%d/%%d)\",
2877 hdr->vers, GUESTFS_PROTOCOL_VERSION);
2880 if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
2881 error (g, \"unexpected message direction (%%d/%%d)\",
2882 hdr->direction, GUESTFS_DIRECTION_REPLY);
2885 if (hdr->proc != proc_nr) {
2886 error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
2889 if (hdr->serial != serial) {
2890 error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
2897 /* Check we are in the right state to run a high-level action. */
2899 check_state (guestfs_h *g, const char *caller)
2901 if (!guestfs_is_ready (g)) {
2902 if (guestfs_is_config (g))
2903 error (g, \"%%s: call launch() before using this function\",
2905 else if (guestfs_is_launching (g))
2906 error (g, \"%%s: call wait_ready() before using this function\",
2909 error (g, \"%%s called from the wrong state, %%d != READY\",
2910 caller, guestfs_get_state (g));
2918 (* Client-side stubs for each function. *)
2920 fun (shortname, style, _, _, _, _, _) ->
2921 let name = "guestfs_" ^ shortname in
2923 (* Generate the context struct which stores the high-level
2924 * state between callback functions.
2926 pr "struct %s_ctx {\n" shortname;
2927 pr " /* This flag is set by the callbacks, so we know we've done\n";
2928 pr " * the callbacks as expected, and in the right sequence.\n";
2929 pr " * 0 = not called, 1 = reply_cb called.\n";
2931 pr " int cb_sequence;\n";
2932 pr " struct guestfs_message_header hdr;\n";
2933 pr " struct guestfs_message_error err;\n";
2934 (match fst style with
2937 failwithf "RConstString cannot be returned from a daemon function"
2939 | RBool _ | RString _ | RStringList _
2941 | RPVList _ | RVGList _ | RLVList _
2942 | RStat _ | RStatVFS _
2944 pr " struct %s_ret ret;\n" name
2949 (* Generate the reply callback function. *)
2950 pr "static void %s_reply_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
2952 pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
2953 pr " struct %s_ctx *ctx = (struct %s_ctx *) data;\n" shortname shortname;
2955 pr " /* This should definitely not happen. */\n";
2956 pr " if (ctx->cb_sequence != 0) {\n";
2957 pr " ctx->cb_sequence = 9999;\n";
2958 pr " error (g, \"%%s: internal error: reply callback called twice\", \"%s\");\n" name;
2962 pr " ml->main_loop_quit (ml, g);\n";
2964 pr " if (!xdr_guestfs_message_header (xdr, &ctx->hdr)) {\n";
2965 pr " error (g, \"%%s: failed to parse reply header\", \"%s\");\n" name;
2968 pr " if (ctx->hdr.status == GUESTFS_STATUS_ERROR) {\n";
2969 pr " if (!xdr_guestfs_message_error (xdr, &ctx->err)) {\n";
2970 pr " error (g, \"%%s: failed to parse reply error\", \"%s\");\n"
2977 (match fst style with
2980 failwithf "RConstString cannot be returned from a daemon function"
2982 | RBool _ | RString _ | RStringList _
2984 | RPVList _ | RVGList _ | RLVList _
2985 | RStat _ | RStatVFS _
2987 pr " if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name;
2988 pr " error (g, \"%%s: failed to parse reply\", \"%s\");\n" name;
2994 pr " ctx->cb_sequence = 1;\n";
2997 (* Generate the action stub. *)
2998 generate_prototype ~extern:false ~semicolon:false ~newline:true
2999 ~handle:"g" name style;
3002 match fst style with
3003 | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
3005 failwithf "RConstString cannot be returned from a daemon function"
3006 | RString _ | RStringList _ | RIntBool _
3007 | RPVList _ | RVGList _ | RLVList _
3008 | RStat _ | RStatVFS _
3014 (match snd style with
3016 | _ -> pr " struct %s_args args;\n" name
3019 pr " struct %s_ctx ctx;\n" shortname;
3020 pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
3021 pr " int serial;\n";
3023 pr " if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
3024 pr " guestfs_set_busy (g);\n";
3026 pr " memset (&ctx, 0, sizeof ctx);\n";
3029 (* Send the main header and arguments. *)
3030 (match snd style with
3032 pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s, NULL, NULL);\n"
3033 (String.uppercase shortname)
3038 pr " args.%s = (char *) %s;\n" n n
3040 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
3042 pr " args.%s.%s_val = (char **) %s;\n" n n n;
3043 pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
3045 pr " args.%s = %s;\n" n n
3047 pr " args.%s = %s;\n" n n
3048 | FileIn _ | FileOut _ -> ()
3050 pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s,\n"
3051 (String.uppercase shortname);
3052 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
3055 pr " if (serial == -1) {\n";
3056 pr " guestfs_end_busy (g);\n";
3057 pr " return %s;\n" error_code;
3061 (* Send any additional files (FileIn) requested. *)
3062 let need_read_reply_label = ref false in
3069 pr " r = guestfs__send_file_sync (g, %s);\n" n;
3070 pr " if (r == -1) {\n";
3071 pr " guestfs_end_busy (g);\n";
3072 pr " return %s;\n" error_code;
3074 pr " if (r == -2) /* daemon cancelled */\n";
3075 pr " goto read_reply;\n";
3076 need_read_reply_label := true;
3082 (* Wait for the reply from the remote end. *)
3083 if !need_read_reply_label then pr " read_reply:\n";
3084 pr " guestfs__switch_to_receiving (g);\n";
3085 pr " ctx.cb_sequence = 0;\n";
3086 pr " guestfs_set_reply_callback (g, %s_reply_cb, &ctx);\n" shortname;
3087 pr " (void) ml->main_loop_run (ml, g);\n";
3088 pr " guestfs_set_reply_callback (g, NULL, NULL);\n";
3089 pr " if (ctx.cb_sequence != 1) {\n";
3090 pr " error (g, \"%%s reply failed, see earlier error messages\", \"%s\");\n" name;
3091 pr " guestfs_end_busy (g);\n";
3092 pr " return %s;\n" error_code;
3096 pr " if (check_reply_header (g, &ctx.hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
3097 (String.uppercase shortname);
3098 pr " guestfs_end_busy (g);\n";
3099 pr " return %s;\n" error_code;
3103 pr " if (ctx.hdr.status == GUESTFS_STATUS_ERROR) {\n";
3104 pr " error (g, \"%%s\", ctx.err.error_message);\n";
3105 pr " free (ctx.err.error_message);\n";
3106 pr " guestfs_end_busy (g);\n";
3107 pr " return %s;\n" error_code;
3111 (* Expecting to receive further files (FileOut)? *)
3115 pr " if (guestfs__receive_file_sync (g, %s) == -1) {\n" n;
3116 pr " guestfs_end_busy (g);\n";
3117 pr " return %s;\n" error_code;
3123 pr " guestfs_end_busy (g);\n";
3125 (match fst style with
3126 | RErr -> pr " return 0;\n"
3127 | RInt n | RInt64 n | RBool n ->
3128 pr " return ctx.ret.%s;\n" n
3130 failwithf "RConstString cannot be returned from a daemon function"
3132 pr " return ctx.ret.%s; /* caller will free */\n" n
3133 | RStringList n | RHashtable n ->
3134 pr " /* caller will free this, but we need to add a NULL entry */\n";
3135 pr " ctx.ret.%s.%s_val =\n" n n;
3136 pr " safe_realloc (g, ctx.ret.%s.%s_val,\n" n n;
3137 pr " sizeof (char *) * (ctx.ret.%s.%s_len + 1));\n"
3139 pr " ctx.ret.%s.%s_val[ctx.ret.%s.%s_len] = NULL;\n" n n n n;
3140 pr " return ctx.ret.%s.%s_val;\n" n n
3142 pr " /* caller with free this */\n";
3143 pr " return safe_memdup (g, &ctx.ret, sizeof (ctx.ret));\n"
3144 | RPVList n | RVGList n | RLVList n
3145 | RStat n | RStatVFS n ->
3146 pr " /* caller will free this */\n";
3147 pr " return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n
3153 (* Generate daemon/actions.h. *)
3154 and generate_daemon_actions_h () =
3155 generate_header CStyle GPLv2;
3157 pr "#include \"../src/guestfs_protocol.h\"\n";
3161 fun (name, style, _, _, _, _, _) ->
3163 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
3167 (* Generate the server-side stubs. *)
3168 and generate_daemon_actions () =
3169 generate_header CStyle GPLv2;
3171 pr "#include <config.h>\n";
3173 pr "#include <stdio.h>\n";
3174 pr "#include <stdlib.h>\n";
3175 pr "#include <string.h>\n";
3176 pr "#include <inttypes.h>\n";
3177 pr "#include <ctype.h>\n";
3178 pr "#include <rpc/types.h>\n";
3179 pr "#include <rpc/xdr.h>\n";
3181 pr "#include \"daemon.h\"\n";
3182 pr "#include \"../src/guestfs_protocol.h\"\n";
3183 pr "#include \"actions.h\"\n";
3187 fun (name, style, _, _, _, _, _) ->
3188 (* Generate server-side stubs. *)
3189 pr "static void %s_stub (XDR *xdr_in)\n" name;
3192 match fst style with
3193 | RErr | RInt _ -> pr " int r;\n"; "-1"
3194 | RInt64 _ -> pr " int64_t r;\n"; "-1"
3195 | RBool _ -> pr " int r;\n"; "-1"
3197 failwithf "RConstString cannot be returned from a daemon function"
3198 | RString _ -> pr " char *r;\n"; "NULL"
3199 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
3200 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
3201 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
3202 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
3203 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL"
3204 | RStat _ -> pr " guestfs_int_stat *r;\n"; "NULL"
3205 | RStatVFS _ -> pr " guestfs_int_statvfs *r;\n"; "NULL" in
3207 (match snd style with
3210 pr " struct guestfs_%s_args args;\n" name;
3214 | OptString n -> pr " const char *%s;\n" n
3215 | StringList n -> pr " char **%s;\n" n
3216 | Bool n -> pr " int %s;\n" n
3217 | Int n -> pr " int %s;\n" n
3218 | FileIn _ | FileOut _ -> ()
3223 (match snd style with
3226 pr " memset (&args, 0, sizeof args);\n";
3228 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
3229 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
3234 | String n -> pr " %s = args.%s;\n" n n
3235 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
3237 pr " %s = realloc (args.%s.%s_val,\n" n n n;
3238 pr " sizeof (char *) * (args.%s.%s_len+1));\n" n n;
3239 pr " if (%s == NULL) {\n" n;
3240 pr " reply_with_perror (\"realloc\");\n";
3243 pr " %s[args.%s.%s_len] = NULL;\n" n n n;
3244 pr " args.%s.%s_val = %s;\n" n n n;
3245 | Bool n -> pr " %s = args.%s;\n" n n
3246 | Int n -> pr " %s = args.%s;\n" n n
3247 | FileIn _ | FileOut _ -> ()
3252 (* Don't want to call the impl with any FileIn or FileOut
3253 * parameters, since these go "outside" the RPC protocol.
3256 List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
3258 pr " r = do_%s " name;
3259 generate_call_args argsnofile;
3262 pr " if (r == %s)\n" error_code;
3263 pr " /* do_%s has already called reply_with_error */\n" name;
3267 (* If there are any FileOut parameters, then the impl must
3268 * send its own reply.
3271 List.exists (function FileOut _ -> true | _ -> false) (snd style) in
3273 pr " /* do_%s has already sent a reply */\n" name
3275 match fst style with
3276 | RErr -> pr " reply (NULL, NULL);\n"
3277 | RInt n | RInt64 n | RBool n ->
3278 pr " struct guestfs_%s_ret ret;\n" name;
3279 pr " ret.%s = r;\n" n;
3280 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
3283 failwithf "RConstString cannot be returned from a daemon function"
3285 pr " struct guestfs_%s_ret ret;\n" name;
3286 pr " ret.%s = r;\n" n;
3287 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
3290 | RStringList n | RHashtable n ->
3291 pr " struct guestfs_%s_ret ret;\n" name;
3292 pr " ret.%s.%s_len = count_strings (r);\n" n n;
3293 pr " ret.%s.%s_val = r;\n" n n;
3294 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
3296 pr " free_strings (r);\n"
3298 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n"
3300 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
3301 | RPVList n | RVGList n | RLVList n
3302 | RStat n | RStatVFS n ->
3303 pr " struct guestfs_%s_ret ret;\n" name;
3304 pr " ret.%s = *r;\n" n;
3305 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
3307 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
3311 (* Free the args. *)
3312 (match snd style with
3317 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
3324 (* Dispatch function. *)
3325 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
3327 pr " switch (proc_nr) {\n";
3330 fun (name, style, _, _, _, _, _) ->
3331 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
3332 pr " %s_stub (xdr_in);\n" name;
3337 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
3342 (* LVM columns and tokenization functions. *)
3343 (* XXX This generates crap code. We should rethink how we
3349 pr "static const char *lvm_%s_cols = \"%s\";\n"
3350 typ (String.concat "," (List.map fst cols));
3353 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
3355 pr " char *tok, *p, *next;\n";
3359 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
3362 pr " if (!str) {\n";
3363 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
3366 pr " if (!*str || isspace (*str)) {\n";
3367 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
3372 fun (name, coltype) ->
3373 pr " if (!tok) {\n";
3374 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
3377 pr " p = strchrnul (tok, ',');\n";
3378 pr " if (*p) next = p+1; else next = NULL;\n";
3379 pr " *p = '\\0';\n";
3382 pr " r->%s = strdup (tok);\n" name;
3383 pr " if (r->%s == NULL) {\n" name;
3384 pr " perror (\"strdup\");\n";
3388 pr " for (i = j = 0; i < 32; ++j) {\n";
3389 pr " if (tok[j] == '\\0') {\n";
3390 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
3392 pr " } else if (tok[j] != '-')\n";
3393 pr " r->%s[i++] = tok[j];\n" name;
3396 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
3397 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
3401 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
3402 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
3406 pr " if (tok[0] == '\\0')\n";
3407 pr " r->%s = -1;\n" name;
3408 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
3409 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
3413 pr " tok = next;\n";
3416 pr " if (tok != NULL) {\n";
3417 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
3424 pr "guestfs_lvm_int_%s_list *\n" typ;
3425 pr "parse_command_line_%ss (void)\n" typ;
3427 pr " char *out, *err;\n";
3428 pr " char *p, *pend;\n";
3430 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
3431 pr " void *newp;\n";
3433 pr " ret = malloc (sizeof *ret);\n";
3434 pr " if (!ret) {\n";
3435 pr " reply_with_perror (\"malloc\");\n";
3436 pr " return NULL;\n";
3439 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
3440 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
3442 pr " r = command (&out, &err,\n";
3443 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
3444 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
3445 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
3446 pr " if (r == -1) {\n";
3447 pr " reply_with_error (\"%%s\", err);\n";
3448 pr " free (out);\n";
3449 pr " free (err);\n";
3450 pr " free (ret);\n";
3451 pr " return NULL;\n";
3454 pr " free (err);\n";
3456 pr " /* Tokenize each line of the output. */\n";
3459 pr " while (p) {\n";
3460 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
3461 pr " if (pend) {\n";
3462 pr " *pend = '\\0';\n";
3466 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
3469 pr " if (!*p) { /* Empty line? Skip it. */\n";
3474 pr " /* Allocate some space to store this next entry. */\n";
3475 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
3476 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
3477 pr " if (newp == NULL) {\n";
3478 pr " reply_with_perror (\"realloc\");\n";
3479 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
3480 pr " free (ret);\n";
3481 pr " free (out);\n";
3482 pr " return NULL;\n";
3484 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
3486 pr " /* Tokenize the next entry. */\n";
3487 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
3488 pr " if (r == -1) {\n";
3489 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
3490 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
3491 pr " free (ret);\n";
3492 pr " free (out);\n";
3493 pr " return NULL;\n";
3500 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
3502 pr " free (out);\n";
3503 pr " return ret;\n";
3506 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
3508 (* Generate the tests. *)
3509 and generate_tests () =
3510 generate_header CStyle GPLv2;
3517 #include <sys/types.h>
3520 #include \"guestfs.h\"
3522 static guestfs_h *g;
3523 static int suppress_error = 0;
3525 /* This will be 's' or 'h' depending on whether the guest kernel
3526 * names IDE devices /dev/sd* or /dev/hd*.
3528 static char devchar = 's';
3530 static void print_error (guestfs_h *g, void *data, const char *msg)
3532 if (!suppress_error)
3533 fprintf (stderr, \"%%s\\n\", msg);
3536 static void print_strings (char * const * const argv)
3540 for (argc = 0; argv[argc] != NULL; ++argc)
3541 printf (\"\\t%%s\\n\", argv[argc]);
3545 static void print_table (char * const * const argv)
3549 for (i = 0; argv[i] != NULL; i += 2)
3550 printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
3554 static void no_test_warnings (void)
3560 | name, _, _, _, [], _, _ ->
3561 pr " fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
3562 | name, _, _, _, tests, _, _ -> ()
3568 (* Generate the actual tests. Note that we generate the tests
3569 * in reverse order, deliberately, so that (in general) the
3570 * newest tests run first. This makes it quicker and easier to
3575 fun (name, _, _, _, tests, _, _) ->
3576 mapi (generate_one_test name) tests
3577 ) (List.rev all_functions) in
3578 let test_names = List.concat test_names in
3579 let nr_tests = List.length test_names in
3582 int main (int argc, char *argv[])
3587 const char *filename;
3589 int nr_tests, test_num = 0;
3592 no_test_warnings ();
3594 g = guestfs_create ();
3596 printf (\"guestfs_create FAILED\\n\");
3600 guestfs_set_error_handler (g, print_error, NULL);
3602 srcdir = getenv (\"srcdir\");
3603 if (!srcdir) srcdir = \".\";
3605 guestfs_set_path (g, \".\");
3607 filename = \"test1.img\";
3608 fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
3613 if (lseek (fd, %d, SEEK_SET) == -1) {
3619 if (write (fd, &c, 1) == -1) {
3625 if (close (fd) == -1) {
3630 if (guestfs_add_drive (g, filename) == -1) {
3631 printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
3635 filename = \"test2.img\";
3636 fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
3641 if (lseek (fd, %d, SEEK_SET) == -1) {
3647 if (write (fd, &c, 1) == -1) {
3653 if (close (fd) == -1) {
3658 if (guestfs_add_drive (g, filename) == -1) {
3659 printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
3663 filename = \"test3.img\";
3664 fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
3669 if (lseek (fd, %d, SEEK_SET) == -1) {
3675 if (write (fd, &c, 1) == -1) {
3681 if (close (fd) == -1) {
3686 if (guestfs_add_drive (g, filename) == -1) {
3687 printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
3691 if (guestfs_launch (g) == -1) {
3692 printf (\"guestfs_launch FAILED\\n\");
3695 if (guestfs_wait_ready (g) == -1) {
3696 printf (\"guestfs_wait_ready FAILED\\n\");
3700 /* Detect if the appliance uses /dev/sd* or /dev/hd* in device
3701 * names. This changed between RHEL 5 and RHEL 6 so we have to
3704 devs = guestfs_list_devices (g);
3705 if (devs == NULL || devs[0] == NULL) {
3706 printf (\"guestfs_list_devices FAILED\\n\");
3709 if (strncmp (devs[0], \"/dev/sd\", 7) == 0)
3711 else if (strncmp (devs[0], \"/dev/hd\", 7) == 0)
3714 printf (\"guestfs_list_devices returned unexpected string '%%s'\\n\",
3718 for (i = 0; devs[i] != NULL; ++i)
3724 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
3728 pr " test_num++;\n";
3729 pr " printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
3730 pr " if (%s () == -1) {\n" test_name;
3731 pr " printf (\"%s FAILED\\n\");\n" test_name;
3737 pr " guestfs_close (g);\n";
3738 pr " unlink (\"test1.img\");\n";
3739 pr " unlink (\"test2.img\");\n";
3740 pr " unlink (\"test3.img\");\n";
3743 pr " if (failed > 0) {\n";
3744 pr " printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n";
3752 and generate_one_test name i (init, prereq, test) =
3753 let test_name = sprintf "test_%s_%d" name i in
3756 | Disabled | Always -> ()
3757 | If code | Unless code ->
3758 pr "static int %s_prereq (void)\n" test_name;
3765 pr "static int %s (void)\n" test_name;
3770 pr " printf (\"%%s skipped (reason: test disabled in generator)\\n\", \"%s\");\n" test_name
3772 pr " if (%s_prereq ()) {\n" test_name;
3773 generate_one_test_body name i test_name init test;
3775 pr " printf (\"%%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name
3777 pr " if (! %s_prereq ()) {\n" test_name;
3778 generate_one_test_body name i test_name init test;
3780 pr " printf (\"%%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name
3782 generate_one_test_body name i test_name init test
3790 and generate_one_test_body name i test_name init test =
3794 pr " /* InitEmpty for %s (%d) */\n" name i;
3795 List.iter (generate_test_command_call test_name)
3796 [["blockdev_setrw"; "/dev/sda"];
3800 pr " /* InitBasicFS for %s (%d): create ext2 on /dev/sda1 */\n" name i;
3801 List.iter (generate_test_command_call test_name)
3802 [["blockdev_setrw"; "/dev/sda"];
3805 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
3806 ["mkfs"; "ext2"; "/dev/sda1"];
3807 ["mount"; "/dev/sda1"; "/"]]
3808 | InitBasicFSonLVM ->
3809 pr " /* InitBasicFSonLVM for %s (%d): create ext2 on /dev/VG/LV */\n"
3811 List.iter (generate_test_command_call test_name)
3812 [["blockdev_setrw"; "/dev/sda"];
3815 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
3816 ["pvcreate"; "/dev/sda1"];
3817 ["vgcreate"; "VG"; "/dev/sda1"];
3818 ["lvcreate"; "LV"; "VG"; "8"];
3819 ["mkfs"; "ext2"; "/dev/VG/LV"];
3820 ["mount"; "/dev/VG/LV"; "/"]]
3823 let get_seq_last = function
3825 failwithf "%s: you cannot use [] (empty list) when expecting a command"
3828 let seq = List.rev seq in
3829 List.rev (List.tl seq), List.hd seq
3834 pr " /* TestRun for %s (%d) */\n" name i;
3835 List.iter (generate_test_command_call test_name) seq
3836 | TestOutput (seq, expected) ->
3837 pr " /* TestOutput for %s (%d) */\n" name i;
3838 pr " char expected[] = \"%s\";\n" (c_quote expected);
3839 if String.length expected > 7 &&
3840 String.sub expected 0 7 = "/dev/sd" then
3841 pr " expected[5] = devchar;\n";
3842 let seq, last = get_seq_last seq in
3844 pr " if (strcmp (r, expected) != 0) {\n";
3845 pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
3849 List.iter (generate_test_command_call test_name) seq;
3850 generate_test_command_call ~test test_name last
3851 | TestOutputList (seq, expected) ->
3852 pr " /* TestOutputList for %s (%d) */\n" name i;
3853 let seq, last = get_seq_last seq in
3857 pr " if (!r[%d]) {\n" i;
3858 pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
3859 pr " print_strings (r);\n";
3863 pr " char expected[] = \"%s\";\n" (c_quote str);
3864 if String.length str > 7 && String.sub str 0 7 = "/dev/sd" then
3865 pr " expected[5] = devchar;\n";
3866 pr " if (strcmp (r[%d], expected) != 0) {\n" i;
3867 pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
3872 pr " if (r[%d] != NULL) {\n" (List.length expected);
3873 pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
3875 pr " print_strings (r);\n";
3879 List.iter (generate_test_command_call test_name) seq;
3880 generate_test_command_call ~test test_name last
3881 | TestOutputInt (seq, expected) ->
3882 pr " /* TestOutputInt for %s (%d) */\n" name i;
3883 let seq, last = get_seq_last seq in
3885 pr " if (r != %d) {\n" expected;
3886 pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\","
3892 List.iter (generate_test_command_call test_name) seq;
3893 generate_test_command_call ~test test_name last
3894 | TestOutputTrue seq ->
3895 pr " /* TestOutputTrue for %s (%d) */\n" name i;
3896 let seq, last = get_seq_last seq in
3899 pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n"
3904 List.iter (generate_test_command_call test_name) seq;
3905 generate_test_command_call ~test test_name last
3906 | TestOutputFalse seq ->
3907 pr " /* TestOutputFalse for %s (%d) */\n" name i;
3908 let seq, last = get_seq_last seq in
3911 pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n"
3916 List.iter (generate_test_command_call test_name) seq;
3917 generate_test_command_call ~test test_name last
3918 | TestOutputLength (seq, expected) ->
3919 pr " /* TestOutputLength for %s (%d) */\n" name i;
3920 let seq, last = get_seq_last seq in
3923 pr " for (j = 0; j < %d; ++j)\n" expected;
3924 pr " if (r[j] == NULL) {\n";
3925 pr " fprintf (stderr, \"%s: short list returned\\n\");\n"
3927 pr " print_strings (r);\n";
3930 pr " if (r[j] != NULL) {\n";
3931 pr " fprintf (stderr, \"%s: long list returned\\n\");\n"
3933 pr " print_strings (r);\n";
3937 List.iter (generate_test_command_call test_name) seq;
3938 generate_test_command_call ~test test_name last
3939 | TestOutputStruct (seq, checks) ->
3940 pr " /* TestOutputStruct for %s (%d) */\n" name i;
3941 let seq, last = get_seq_last seq in
3945 | CompareWithInt (field, expected) ->
3946 pr " if (r->%s != %d) {\n" field expected;
3947 pr " fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
3948 test_name field expected;
3949 pr " (int) r->%s);\n" field;
3952 | CompareWithString (field, expected) ->
3953 pr " if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
3954 pr " fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
3955 test_name field expected;
3956 pr " r->%s);\n" field;
3959 | CompareFieldsIntEq (field1, field2) ->
3960 pr " if (r->%s != r->%s) {\n" field1 field2;
3961 pr " fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
3962 test_name field1 field2;
3963 pr " (int) r->%s, (int) r->%s);\n" field1 field2;
3966 | CompareFieldsStrEq (field1, field2) ->
3967 pr " if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
3968 pr " fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
3969 test_name field1 field2;
3970 pr " r->%s, r->%s);\n" field1 field2;
3975 List.iter (generate_test_command_call test_name) seq;
3976 generate_test_command_call ~test test_name last
3977 | TestLastFail seq ->
3978 pr " /* TestLastFail for %s (%d) */\n" name i;
3979 let seq, last = get_seq_last seq in
3980 List.iter (generate_test_command_call test_name) seq;
3981 generate_test_command_call test_name ~expect_error:true last
3983 (* Generate the code to run a command, leaving the result in 'r'.
3984 * If you expect to get an error then you should set expect_error:true.
3986 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
3988 | [] -> assert false
3990 (* Look up the command to find out what args/ret it has. *)
3993 let _, style, _, _, _, _, _ =
3994 List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
3997 failwithf "%s: in test, command %s was not found" test_name name in
3999 if List.length (snd style) <> List.length args then
4000 failwithf "%s: in test, wrong number of args given to %s"
4007 | OptString n, "NULL" -> ()
4009 | OptString n, arg ->
4010 pr " char %s[] = \"%s\";\n" n (c_quote arg);
4011 if String.length arg > 7 && String.sub arg 0 7 = "/dev/sd" then
4012 pr " %s[5] = devchar;\n" n
4015 | FileIn _, _ | FileOut _, _ -> ()
4016 | StringList n, arg ->
4017 let strs = string_split " " arg in
4020 pr " char %s_%d[] = \"%s\";\n" n i (c_quote str);
4021 if String.length str > 7 && String.sub str 0 7 = "/dev/sd" then
4022 pr " %s_%d[5] = devchar;\n" n i
4024 pr " char *%s[] = {\n" n;
4026 fun i _ -> pr " %s_%d,\n" n i
4030 ) (List.combine (snd style) args);
4033 match fst style with
4034 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
4035 | RInt64 _ -> pr " int64_t r;\n"; "-1"
4036 | RConstString _ -> pr " const char *r;\n"; "NULL"
4037 | RString _ -> pr " char *r;\n"; "NULL"
4038 | RStringList _ | RHashtable _ ->
4043 pr " struct guestfs_int_bool *r;\n"; "NULL"
4045 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
4047 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
4049 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
4051 pr " struct guestfs_stat *r;\n"; "NULL"
4053 pr " struct guestfs_statvfs *r;\n"; "NULL" in
4055 pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
4056 pr " r = guestfs_%s (g" name;
4058 (* Generate the parameters. *)
4061 | OptString _, "NULL" -> pr ", NULL"
4065 | FileIn _, arg | FileOut _, arg ->
4066 pr ", \"%s\"" (c_quote arg)
4067 | StringList n, _ ->
4071 try int_of_string arg
4072 with Failure "int_of_string" ->
4073 failwithf "%s: expecting an int, but got '%s'" test_name arg in
4076 let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
4077 ) (List.combine (snd style) args);
4080 if not expect_error then
4081 pr " if (r == %s)\n" error_code
4083 pr " if (r != %s)\n" error_code;
4086 (* Insert the test code. *)
4092 (match fst style with
4093 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ -> ()
4094 | RString _ -> pr " free (r);\n"
4095 | RStringList _ | RHashtable _ ->
4096 pr " for (i = 0; r[i] != NULL; ++i)\n";
4097 pr " free (r[i]);\n";
4100 pr " guestfs_free_int_bool (r);\n"
4102 pr " guestfs_free_lvm_pv_list (r);\n"
4104 pr " guestfs_free_lvm_vg_list (r);\n"
4106 pr " guestfs_free_lvm_lv_list (r);\n"
4107 | RStat _ | RStatVFS _ ->
4114 let str = replace_str str "\r" "\\r" in
4115 let str = replace_str str "\n" "\\n" in
4116 let str = replace_str str "\t" "\\t" in
4117 let str = replace_str str "\000" "\\0" in
4120 (* Generate a lot of different functions for guestfish. *)
4121 and generate_fish_cmds () =
4122 generate_header CStyle GPLv2;
4126 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
4128 let all_functions_sorted =
4130 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
4131 ) all_functions_sorted in
4133 pr "#include <stdio.h>\n";
4134 pr "#include <stdlib.h>\n";
4135 pr "#include <string.h>\n";
4136 pr "#include <inttypes.h>\n";
4138 pr "#include <guestfs.h>\n";
4139 pr "#include \"fish.h\"\n";
4142 (* list_commands function, which implements guestfish -h *)
4143 pr "void list_commands (void)\n";
4145 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
4146 pr " list_builtin_commands ();\n";
4148 fun (name, _, _, flags, _, shortdesc, _) ->
4149 let name = replace_char name '_' '-' in
4150 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
4152 ) all_functions_sorted;
4153 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
4157 (* display_command function, which implements guestfish -h cmd *)
4158 pr "void display_command (const char *cmd)\n";
4161 fun (name, style, _, flags, _, shortdesc, longdesc) ->
4162 let name2 = replace_char name '_' '-' in
4164 try find_map (function FishAlias n -> Some n | _ -> None) flags
4165 with Not_found -> name in
4166 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
4168 match snd style with
4172 name2 (String.concat "> <" (List.map name_of_argt args)) in
4175 if List.mem ProtocolLimitWarning flags then
4176 ("\n\n" ^ protocol_limit_warning)
4179 (* For DangerWillRobinson commands, we should probably have
4180 * guestfish prompt before allowing you to use them (especially
4181 * in interactive mode). XXX
4185 if List.mem DangerWillRobinson flags then
4186 ("\n\n" ^ danger_will_robinson)
4189 let describe_alias =
4190 if name <> alias then
4191 sprintf "\n\nYou can use '%s' as an alias for this command." alias
4195 pr "strcasecmp (cmd, \"%s\") == 0" name;
4196 if name <> name2 then
4197 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
4198 if name <> alias then
4199 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
4201 pr " pod2text (\"%s - %s\", %S);\n"
4203 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
4206 pr " display_builtin_command (cmd);\n";
4210 (* print_{pv,vg,lv}_list functions *)
4214 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
4221 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
4223 pr " printf (\"%s: \");\n" name;
4224 pr " for (i = 0; i < 32; ++i)\n";
4225 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
4226 pr " printf (\"\\n\");\n"
4228 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
4230 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
4231 | name, `OptPercent ->
4232 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
4233 typ name name typ name;
4234 pr " else printf (\"%s: \\n\");\n" name
4238 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
4243 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
4244 pr " print_%s (&%ss->val[i]);\n" typ typ;
4247 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
4249 (* print_{stat,statvfs} functions *)
4253 pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
4258 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
4262 ) ["stat", stat_cols; "statvfs", statvfs_cols];
4264 (* run_<action> actions *)
4266 fun (name, style, _, flags, _, _, _) ->
4267 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
4269 (match fst style with
4272 | RBool _ -> pr " int r;\n"
4273 | RInt64 _ -> pr " int64_t r;\n"
4274 | RConstString _ -> pr " const char *r;\n"
4275 | RString _ -> pr " char *r;\n"
4276 | RStringList _ | RHashtable _ -> pr " char **r;\n"
4277 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
4278 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
4279 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
4280 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
4281 | RStat _ -> pr " struct guestfs_stat *r;\n"
4282 | RStatVFS _ -> pr " struct guestfs_statvfs *r;\n"
4289 | FileOut n -> pr " const char *%s;\n" n
4290 | StringList n -> pr " char **%s;\n" n
4291 | Bool n -> pr " int %s;\n" n
4292 | Int n -> pr " int %s;\n" n
4295 (* Check and convert parameters. *)
4296 let argc_expected = List.length (snd style) in
4297 pr " if (argc != %d) {\n" argc_expected;
4298 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
4300 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
4306 | String name -> pr " %s = argv[%d];\n" name i
4308 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
4311 pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdin\";\n"
4314 pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n"
4316 | StringList name ->
4317 pr " %s = parse_string_list (argv[%d]);\n" name i
4319 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
4321 pr " %s = atoi (argv[%d]);\n" name i
4324 (* Call C API function. *)
4326 try find_map (function FishAction n -> Some n | _ -> None) flags
4327 with Not_found -> sprintf "guestfs_%s" name in
4329 generate_call_args ~handle:"g" (snd style);
4332 (* Check return value for errors and display command results. *)
4333 (match fst style with
4334 | RErr -> pr " return r;\n"
4336 pr " if (r == -1) return -1;\n";
4337 pr " printf (\"%%d\\n\", r);\n";
4340 pr " if (r == -1) return -1;\n";
4341 pr " printf (\"%%\" PRIi64 \"\\n\", r);\n";
4344 pr " if (r == -1) return -1;\n";
4345 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
4348 pr " if (r == NULL) return -1;\n";
4349 pr " printf (\"%%s\\n\", r);\n";
4352 pr " if (r == NULL) return -1;\n";
4353 pr " printf (\"%%s\\n\", r);\n";
4357 pr " if (r == NULL) return -1;\n";
4358 pr " print_strings (r);\n";
4359 pr " free_strings (r);\n";
4362 pr " if (r == NULL) return -1;\n";
4363 pr " printf (\"%%d, %%s\\n\", r->i,\n";
4364 pr " r->b ? \"true\" : \"false\");\n";
4365 pr " guestfs_free_int_bool (r);\n";
4368 pr " if (r == NULL) return -1;\n";
4369 pr " print_pv_list (r);\n";
4370 pr " guestfs_free_lvm_pv_list (r);\n";
4373 pr " if (r == NULL) return -1;\n";
4374 pr " print_vg_list (r);\n";
4375 pr " guestfs_free_lvm_vg_list (r);\n";
4378 pr " if (r == NULL) return -1;\n";
4379 pr " print_lv_list (r);\n";
4380 pr " guestfs_free_lvm_lv_list (r);\n";
4383 pr " if (r == NULL) return -1;\n";
4384 pr " print_stat (r);\n";
4388 pr " if (r == NULL) return -1;\n";
4389 pr " print_statvfs (r);\n";
4393 pr " if (r == NULL) return -1;\n";
4394 pr " print_table (r);\n";
4395 pr " free_strings (r);\n";
4402 (* run_action function *)
4403 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
4406 fun (name, _, _, flags, _, _, _) ->
4407 let name2 = replace_char name '_' '-' in
4409 try find_map (function FishAlias n -> Some n | _ -> None) flags
4410 with Not_found -> name in
4412 pr "strcasecmp (cmd, \"%s\") == 0" name;
4413 if name <> name2 then
4414 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
4415 if name <> alias then
4416 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
4418 pr " return run_%s (cmd, argc, argv);\n" name;
4422 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
4429 (* Readline completion for guestfish. *)
4430 and generate_fish_completion () =
4431 generate_header CStyle GPLv2;
4435 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
4445 #ifdef HAVE_LIBREADLINE
4446 #include <readline/readline.h>
4451 #ifdef HAVE_LIBREADLINE
4453 static const char *const commands[] = {
4456 (* Get the commands and sort them, including the aliases. *)
4459 fun (name, _, _, flags, _, _, _) ->
4460 let name2 = replace_char name '_' '-' in
4462 try find_map (function FishAlias n -> Some n | _ -> None) flags
4463 with Not_found -> name in
4465 if name <> alias then [name2; alias] else [name2]
4467 let commands = List.flatten commands in
4468 let commands = List.sort compare commands in
4470 List.iter (pr " \"%s\",\n") commands;
4476 generator (const char *text, int state)
4478 static int index, len;
4483 len = strlen (text);
4486 while ((name = commands[index]) != NULL) {
4488 if (strncasecmp (name, text, len) == 0)
4489 return strdup (name);
4495 #endif /* HAVE_LIBREADLINE */
4497 char **do_completion (const char *text, int start, int end)
4499 char **matches = NULL;
4501 #ifdef HAVE_LIBREADLINE
4503 matches = rl_completion_matches (text, generator);
4510 (* Generate the POD documentation for guestfish. *)
4511 and generate_fish_actions_pod () =
4512 let all_functions_sorted =
4514 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
4515 ) all_functions_sorted in
4517 let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
4520 fun (name, style, _, flags, _, _, longdesc) ->
4522 Str.global_substitute rex (
4525 try Str.matched_group 1 s
4527 failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
4528 "C<" ^ replace_char sub '_' '-' ^ ">"
4530 let name = replace_char name '_' '-' in
4532 try find_map (function FishAlias n -> Some n | _ -> None) flags
4533 with Not_found -> name in
4535 pr "=head2 %s" name;
4536 if name <> alias then
4543 | String n -> pr " %s" n
4544 | OptString n -> pr " %s" n
4545 | StringList n -> pr " '%s ...'" n
4546 | Bool _ -> pr " true|false"
4547 | Int n -> pr " %s" n
4548 | FileIn n | FileOut n -> pr " (%s|-)" n
4552 pr "%s\n\n" longdesc;
4554 if List.exists (function FileIn _ | FileOut _ -> true
4555 | _ -> false) (snd style) then
4556 pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
4558 if List.mem ProtocolLimitWarning flags then
4559 pr "%s\n\n" protocol_limit_warning;
4561 if List.mem DangerWillRobinson flags then
4562 pr "%s\n\n" danger_will_robinson
4563 ) all_functions_sorted
4565 (* Generate a C function prototype. *)
4566 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
4567 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
4569 ?handle name style =
4570 if extern then pr "extern ";
4571 if static then pr "static ";
4572 (match fst style with
4574 | RInt _ -> pr "int "
4575 | RInt64 _ -> pr "int64_t "
4576 | RBool _ -> pr "int "
4577 | RConstString _ -> pr "const char *"
4578 | RString _ -> pr "char *"
4579 | RStringList _ | RHashtable _ -> pr "char **"
4581 if not in_daemon then pr "struct guestfs_int_bool *"
4582 else pr "guestfs_%s_ret *" name
4584 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
4585 else pr "guestfs_lvm_int_pv_list *"
4587 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
4588 else pr "guestfs_lvm_int_vg_list *"
4590 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
4591 else pr "guestfs_lvm_int_lv_list *"
4593 if not in_daemon then pr "struct guestfs_stat *"
4594 else pr "guestfs_int_stat *"
4596 if not in_daemon then pr "struct guestfs_statvfs *"
4597 else pr "guestfs_int_statvfs *"
4599 pr "%s%s (" prefix name;
4600 if handle = None && List.length (snd style) = 0 then
4603 let comma = ref false in
4606 | Some handle -> pr "guestfs_h *%s" handle; comma := true
4610 if single_line then pr ", " else pr ",\n\t\t"
4617 | OptString n -> next (); pr "const char *%s" n
4618 | StringList n -> next (); pr "char * const* const %s" n
4619 | Bool n -> next (); pr "int %s" n
4620 | Int n -> next (); pr "int %s" n
4623 if not in_daemon then (next (); pr "const char *%s" n)
4627 if semicolon then pr ";";
4628 if newline then pr "\n"
4630 (* Generate C call arguments, eg "(handle, foo, bar)" *)
4631 and generate_call_args ?handle args =
4633 let comma = ref false in
4636 | Some handle -> pr "%s" handle; comma := true
4640 if !comma then pr ", ";
4642 pr "%s" (name_of_argt arg)
4646 (* Generate the OCaml bindings interface. *)
4647 and generate_ocaml_mli () =
4648 generate_header OCamlStyle LGPLv2;
4651 (** For API documentation you should refer to the C API
4652 in the guestfs(3) manual page. The OCaml API uses almost
4653 exactly the same calls. *)
4656 (** A [guestfs_h] handle. *)
4658 exception Error of string
4659 (** This exception is raised when there is an error. *)
4661 val create : unit -> t
4663 val close : t -> unit
4664 (** Handles are closed by the garbage collector when they become
4665 unreferenced, but callers can also call this in order to
4666 provide predictable cleanup. *)
4669 generate_ocaml_lvm_structure_decls ();
4671 generate_ocaml_stat_structure_decls ();
4675 fun (name, style, _, _, _, shortdesc, _) ->
4676 generate_ocaml_prototype name style;
4677 pr "(** %s *)\n" shortdesc;
4681 (* Generate the OCaml bindings implementation. *)
4682 and generate_ocaml_ml () =
4683 generate_header OCamlStyle LGPLv2;
4687 exception Error of string
4688 external create : unit -> t = \"ocaml_guestfs_create\"
4689 external close : t -> unit = \"ocaml_guestfs_close\"
4692 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
4696 generate_ocaml_lvm_structure_decls ();
4698 generate_ocaml_stat_structure_decls ();
4702 fun (name, style, _, _, _, shortdesc, _) ->
4703 generate_ocaml_prototype ~is_external:true name style;
4706 (* Generate the OCaml bindings C implementation. *)
4707 and generate_ocaml_c () =
4708 generate_header CStyle LGPLv2;
4715 #include <caml/config.h>
4716 #include <caml/alloc.h>
4717 #include <caml/callback.h>
4718 #include <caml/fail.h>
4719 #include <caml/memory.h>
4720 #include <caml/mlvalues.h>
4721 #include <caml/signals.h>
4723 #include <guestfs.h>
4725 #include \"guestfs_c.h\"
4727 /* Copy a hashtable of string pairs into an assoc-list. We return
4728 * the list in reverse order, but hashtables aren't supposed to be
4731 static CAMLprim value
4732 copy_table (char * const * argv)
4735 CAMLlocal5 (rv, pairv, kv, vv, cons);
4739 for (i = 0; argv[i] != NULL; i += 2) {
4740 kv = caml_copy_string (argv[i]);
4741 vv = caml_copy_string (argv[i+1]);
4742 pairv = caml_alloc (2, 0);
4743 Store_field (pairv, 0, kv);
4744 Store_field (pairv, 1, vv);
4745 cons = caml_alloc (2, 0);
4746 Store_field (cons, 1, rv);
4748 Store_field (cons, 0, pairv);
4756 (* LVM struct copy functions. *)
4759 let has_optpercent_col =
4760 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
4762 pr "static CAMLprim value\n";
4763 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
4765 pr " CAMLparam0 ();\n";
4766 if has_optpercent_col then
4767 pr " CAMLlocal3 (rv, v, v2);\n"
4769 pr " CAMLlocal2 (rv, v);\n";
4771 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
4776 pr " v = caml_copy_string (%s->%s);\n" typ name
4778 pr " v = caml_alloc_string (32);\n";
4779 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
4782 pr " v = caml_copy_int64 (%s->%s);\n" typ name
4783 | name, `OptPercent ->
4784 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
4785 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
4786 pr " v = caml_alloc (1, 0);\n";
4787 pr " Store_field (v, 0, v2);\n";
4788 pr " } else /* None */\n";
4789 pr " v = Val_int (0);\n";
4791 pr " Store_field (rv, %d, v);\n" i
4793 pr " CAMLreturn (rv);\n";
4797 pr "static CAMLprim value\n";
4798 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
4801 pr " CAMLparam0 ();\n";
4802 pr " CAMLlocal2 (rv, v);\n";
4805 pr " if (%ss->len == 0)\n" typ;
4806 pr " CAMLreturn (Atom (0));\n";
4808 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
4809 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
4810 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
4811 pr " caml_modify (&Field (rv, i), v);\n";
4813 pr " CAMLreturn (rv);\n";
4817 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
4819 (* Stat copy functions. *)
4822 pr "static CAMLprim value\n";
4823 pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
4825 pr " CAMLparam0 ();\n";
4826 pr " CAMLlocal2 (rv, v);\n";
4828 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
4833 pr " v = caml_copy_int64 (%s->%s);\n" typ name
4835 pr " Store_field (rv, %d, v);\n" i
4837 pr " CAMLreturn (rv);\n";
4840 ) ["stat", stat_cols; "statvfs", statvfs_cols];
4844 fun (name, style, _, _, _, _, _) ->
4846 "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
4848 pr "CAMLprim value\n";
4849 pr "ocaml_guestfs_%s (value %s" name (List.hd params);
4850 List.iter (pr ", value %s") (List.tl params);
4855 | [p1; p2; p3; p4; p5] ->
4856 pr " CAMLparam5 (%s);\n" (String.concat ", " params)
4857 | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
4858 pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
4859 pr " CAMLxparam%d (%s);\n"
4860 (List.length rest) (String.concat ", " rest)
4862 pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
4864 pr " CAMLlocal1 (rv);\n";
4867 pr " guestfs_h *g = Guestfs_val (gv);\n";
4868 pr " if (g == NULL)\n";
4869 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
4877 pr " const char *%s = String_val (%sv);\n" n n
4879 pr " const char *%s =\n" n;
4880 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
4883 pr " char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
4885 pr " int %s = Bool_val (%sv);\n" n n
4887 pr " int %s = Int_val (%sv);\n" n n
4890 match fst style with
4891 | RErr -> pr " int r;\n"; "-1"
4892 | RInt _ -> pr " int r;\n"; "-1"
4893 | RInt64 _ -> pr " int64_t r;\n"; "-1"
4894 | RBool _ -> pr " int r;\n"; "-1"
4895 | RConstString _ -> pr " const char *r;\n"; "NULL"
4896 | RString _ -> pr " char *r;\n"; "NULL"
4902 pr " struct guestfs_int_bool *r;\n"; "NULL"
4904 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
4906 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
4908 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
4910 pr " struct guestfs_stat *r;\n"; "NULL"
4912 pr " struct guestfs_statvfs *r;\n"; "NULL"
4919 pr " caml_enter_blocking_section ();\n";
4920 pr " r = guestfs_%s " name;
4921 generate_call_args ~handle:"g" (snd style);
4923 pr " caml_leave_blocking_section ();\n";
4928 pr " ocaml_guestfs_free_strings (%s);\n" n;
4929 | String _ | OptString _ | Bool _ | Int _ | FileIn _ | FileOut _ -> ()
4932 pr " if (r == %s)\n" error_code;
4933 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
4936 (match fst style with
4937 | RErr -> pr " rv = Val_unit;\n"
4938 | RInt _ -> pr " rv = Val_int (r);\n"
4940 pr " rv = caml_copy_int64 (r);\n"
4941 | RBool _ -> pr " rv = Val_bool (r);\n"
4942 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
4944 pr " rv = caml_copy_string (r);\n";
4947 pr " rv = caml_copy_string_array ((const char **) r);\n";
4948 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
4951 pr " rv = caml_alloc (2, 0);\n";
4952 pr " Store_field (rv, 0, Val_int (r->i));\n";
4953 pr " Store_field (rv, 1, Val_bool (r->b));\n";
4954 pr " guestfs_free_int_bool (r);\n";
4956 pr " rv = copy_lvm_pv_list (r);\n";
4957 pr " guestfs_free_lvm_pv_list (r);\n";
4959 pr " rv = copy_lvm_vg_list (r);\n";
4960 pr " guestfs_free_lvm_vg_list (r);\n";
4962 pr " rv = copy_lvm_lv_list (r);\n";
4963 pr " guestfs_free_lvm_lv_list (r);\n";
4965 pr " rv = copy_stat (r);\n";
4968 pr " rv = copy_statvfs (r);\n";
4971 pr " rv = copy_table (r);\n";
4972 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
4976 pr " CAMLreturn (rv);\n";
4980 if List.length params > 5 then (
4981 pr "CAMLprim value\n";
4982 pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
4984 pr " return ocaml_guestfs_%s (argv[0]" name;
4985 iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
4992 and generate_ocaml_lvm_structure_decls () =
4995 pr "type lvm_%s = {\n" typ;
4998 | name, `String -> pr " %s : string;\n" name
4999 | name, `UUID -> pr " %s : string;\n" name
5000 | name, `Bytes -> pr " %s : int64;\n" name
5001 | name, `Int -> pr " %s : int64;\n" name
5002 | name, `OptPercent -> pr " %s : float option;\n" name
5006 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
5008 and generate_ocaml_stat_structure_decls () =
5011 pr "type %s = {\n" typ;
5014 | name, `Int -> pr " %s : int64;\n" name
5018 ) ["stat", stat_cols; "statvfs", statvfs_cols]
5020 and generate_ocaml_prototype ?(is_external = false) name style =
5021 if is_external then pr "external " else pr "val ";
5022 pr "%s : t -> " name;
5025 | String _ | FileIn _ | FileOut _ -> pr "string -> "
5026 | OptString _ -> pr "string option -> "
5027 | StringList _ -> pr "string array -> "
5028 | Bool _ -> pr "bool -> "
5029 | Int _ -> pr "int -> "
5031 (match fst style with
5032 | RErr -> pr "unit" (* all errors are turned into exceptions *)
5033 | RInt _ -> pr "int"
5034 | RInt64 _ -> pr "int64"
5035 | RBool _ -> pr "bool"
5036 | RConstString _ -> pr "string"
5037 | RString _ -> pr "string"
5038 | RStringList _ -> pr "string array"
5039 | RIntBool _ -> pr "int * bool"
5040 | RPVList _ -> pr "lvm_pv array"
5041 | RVGList _ -> pr "lvm_vg array"
5042 | RLVList _ -> pr "lvm_lv array"
5043 | RStat _ -> pr "stat"
5044 | RStatVFS _ -> pr "statvfs"
5045 | RHashtable _ -> pr "(string * string) list"
5047 if is_external then (
5049 if List.length (snd style) + 1 > 5 then
5050 pr "\"ocaml_guestfs_%s_byte\" " name;
5051 pr "\"ocaml_guestfs_%s\"" name
5055 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
5056 and generate_perl_xs () =
5057 generate_header CStyle LGPLv2;
5060 #include \"EXTERN.h\"
5064 #include <guestfs.h>
5067 #define PRId64 \"lld\"
5071 my_newSVll(long long val) {
5072 #ifdef USE_64_BIT_ALL
5073 return newSViv(val);
5077 len = snprintf(buf, 100, \"%%\" PRId64, val);
5078 return newSVpv(buf, len);
5083 #define PRIu64 \"llu\"
5087 my_newSVull(unsigned long long val) {
5088 #ifdef USE_64_BIT_ALL
5089 return newSVuv(val);
5093 len = snprintf(buf, 100, \"%%\" PRIu64, val);
5094 return newSVpv(buf, len);
5098 /* http://www.perlmonks.org/?node_id=680842 */
5100 XS_unpack_charPtrPtr (SV *arg) {
5105 if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
5106 croak (\"array reference expected\");
5108 av = (AV *)SvRV (arg);
5109 ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
5111 croak (\"malloc failed\");
5113 for (i = 0; i <= av_len (av); i++) {
5114 SV **elem = av_fetch (av, i, 0);
5116 if (!elem || !*elem)
5117 croak (\"missing element in list\");
5119 ret[i] = SvPV_nolen (*elem);
5127 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
5134 RETVAL = guestfs_create ();
5136 croak (\"could not create guestfs handle\");
5137 guestfs_set_error_handler (RETVAL, NULL, NULL);
5150 fun (name, style, _, _, _, _, _) ->
5151 (match fst style with
5152 | RErr -> pr "void\n"
5153 | RInt _ -> pr "SV *\n"
5154 | RInt64 _ -> pr "SV *\n"
5155 | RBool _ -> pr "SV *\n"
5156 | RConstString _ -> pr "SV *\n"
5157 | RString _ -> pr "SV *\n"
5160 | RPVList _ | RVGList _ | RLVList _
5161 | RStat _ | RStatVFS _
5163 pr "void\n" (* all lists returned implictly on the stack *)
5165 (* Call and arguments. *)
5167 generate_call_args ~handle:"g" (snd style);
5169 pr " guestfs_h *g;\n";
5172 | String n | FileIn n | FileOut n -> pr " char *%s;\n" n
5173 | OptString n -> pr " char *%s;\n" n
5174 | StringList n -> pr " char **%s;\n" n
5175 | Bool n -> pr " int %s;\n" n
5176 | Int n -> pr " int %s;\n" n
5179 let do_cleanups () =
5182 | String _ | OptString _ | Bool _ | Int _
5183 | FileIn _ | FileOut _ -> ()
5184 | StringList n -> pr " free (%s);\n" n
5189 (match fst style with
5194 pr " r = guestfs_%s " name;
5195 generate_call_args ~handle:"g" (snd style);
5198 pr " if (r == -1)\n";
5199 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5205 pr " %s = guestfs_%s " n name;
5206 generate_call_args ~handle:"g" (snd style);
5209 pr " if (%s == -1)\n" n;
5210 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5211 pr " RETVAL = newSViv (%s);\n" n;
5216 pr " int64_t %s;\n" n;
5218 pr " %s = guestfs_%s " n name;
5219 generate_call_args ~handle:"g" (snd style);
5222 pr " if (%s == -1)\n" n;
5223 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5224 pr " RETVAL = my_newSVll (%s);\n" n;
5229 pr " const char *%s;\n" n;
5231 pr " %s = guestfs_%s " n name;
5232 generate_call_args ~handle:"g" (snd style);
5235 pr " if (%s == NULL)\n" n;
5236 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5237 pr " RETVAL = newSVpv (%s, 0);\n" n;
5242 pr " char *%s;\n" n;
5244 pr " %s = guestfs_%s " n name;
5245 generate_call_args ~handle:"g" (snd style);
5248 pr " if (%s == NULL)\n" n;
5249 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5250 pr " RETVAL = newSVpv (%s, 0);\n" n;
5251 pr " free (%s);\n" n;
5254 | RStringList n | RHashtable n ->
5256 pr " char **%s;\n" n;
5259 pr " %s = guestfs_%s " n name;
5260 generate_call_args ~handle:"g" (snd style);
5263 pr " if (%s == NULL)\n" n;
5264 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5265 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
5266 pr " EXTEND (SP, n);\n";
5267 pr " for (i = 0; i < n; ++i) {\n";
5268 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
5269 pr " free (%s[i]);\n" n;
5271 pr " free (%s);\n" n;
5274 pr " struct guestfs_int_bool *r;\n";
5276 pr " r = guestfs_%s " name;
5277 generate_call_args ~handle:"g" (snd style);
5280 pr " if (r == NULL)\n";
5281 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5282 pr " EXTEND (SP, 2);\n";
5283 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
5284 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
5285 pr " guestfs_free_int_bool (r);\n";
5287 generate_perl_lvm_code "pv" pv_cols name style n do_cleanups
5289 generate_perl_lvm_code "vg" vg_cols name style n do_cleanups
5291 generate_perl_lvm_code "lv" lv_cols name style n do_cleanups
5293 generate_perl_stat_code "stat" stat_cols name style n do_cleanups
5295 generate_perl_stat_code
5296 "statvfs" statvfs_cols name style n do_cleanups
5302 and generate_perl_lvm_code typ cols name style n do_cleanups =
5304 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
5308 pr " %s = guestfs_%s " n name;
5309 generate_call_args ~handle:"g" (snd style);
5312 pr " if (%s == NULL)\n" n;
5313 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5314 pr " EXTEND (SP, %s->len);\n" n;
5315 pr " for (i = 0; i < %s->len; ++i) {\n" n;
5316 pr " hv = newHV ();\n";
5320 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
5321 name (String.length name) n name
5323 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
5324 name (String.length name) n name
5326 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
5327 name (String.length name) n name
5329 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
5330 name (String.length name) n name
5331 | name, `OptPercent ->
5332 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
5333 name (String.length name) n name
5335 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
5337 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
5339 and generate_perl_stat_code typ cols name style n do_cleanups =
5341 pr " struct guestfs_%s *%s;\n" typ n;
5343 pr " %s = guestfs_%s " n name;
5344 generate_call_args ~handle:"g" (snd style);
5347 pr " if (%s == NULL)\n" n;
5348 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5349 pr " EXTEND (SP, %d);\n" (List.length cols);
5353 pr " PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n" n name
5355 pr " free (%s);\n" n
5357 (* Generate Sys/Guestfs.pm. *)
5358 and generate_perl_pm () =
5359 generate_header HashStyle LGPLv2;
5366 Sys::Guestfs - Perl bindings for libguestfs
5372 my $h = Sys::Guestfs->new ();
5373 $h->add_drive ('guest.img');
5376 $h->mount ('/dev/sda1', '/');
5377 $h->touch ('/hello');
5382 The C<Sys::Guestfs> module provides a Perl XS binding to the
5383 libguestfs API for examining and modifying virtual machine
5386 Amongst the things this is good for: making batch configuration
5387 changes to guests, getting disk used/free statistics (see also:
5388 virt-df), migrating between virtualization systems (see also:
5389 virt-p2v), performing partial backups, performing partial guest
5390 clones, cloning guests and changing registry/UUID/hostname info, and
5393 Libguestfs uses Linux kernel and qemu code, and can access any type of
5394 guest filesystem that Linux and qemu can, including but not limited
5395 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
5396 schemes, qcow, qcow2, vmdk.
5398 Libguestfs provides ways to enumerate guest storage (eg. partitions,
5399 LVs, what filesystem is in each LV, etc.). It can also run commands
5400 in the context of the guest. Also you can access filesystems over FTP.
5404 All errors turn into calls to C<croak> (see L<Carp(3)>).
5412 package Sys::Guestfs;
5418 XSLoader::load ('Sys::Guestfs');
5420 =item $h = Sys::Guestfs->new ();
5422 Create a new guestfs handle.
5428 my $class = ref ($proto) || $proto;
5430 my $self = Sys::Guestfs::_create ();
5431 bless $self, $class;
5437 (* Actions. We only need to print documentation for these as
5438 * they are pulled in from the XS code automatically.
5441 fun (name, style, _, flags, _, _, longdesc) ->
5442 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
5444 generate_perl_prototype name style;
5446 pr "%s\n\n" longdesc;
5447 if List.mem ProtocolLimitWarning flags then
5448 pr "%s\n\n" protocol_limit_warning;
5449 if List.mem DangerWillRobinson flags then
5450 pr "%s\n\n" danger_will_robinson
5451 ) all_functions_sorted;
5463 Copyright (C) 2009 Red Hat Inc.
5467 Please see the file COPYING.LIB for the full license.
5471 L<guestfs(3)>, L<guestfish(1)>.
5476 and generate_perl_prototype name style =
5477 (match fst style with
5483 | RString n -> pr "$%s = " n
5484 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
5488 | RLVList n -> pr "@%s = " n
5491 | RHashtable n -> pr "%%%s = " n
5494 let comma = ref false in
5497 if !comma then pr ", ";
5500 | String n | OptString n | Bool n | Int n | FileIn n | FileOut n ->
5507 (* Generate Python C module. *)
5508 and generate_python_c () =
5509 generate_header CStyle LGPLv2;
5518 #include \"guestfs.h\"
5526 get_handle (PyObject *obj)
5529 assert (obj != Py_None);
5530 return ((Pyguestfs_Object *) obj)->g;
5534 put_handle (guestfs_h *g)
5538 PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
5541 /* This list should be freed (but not the strings) after use. */
5542 static const char **
5543 get_string_list (PyObject *obj)
5550 if (!PyList_Check (obj)) {
5551 PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
5555 len = PyList_Size (obj);
5556 r = malloc (sizeof (char *) * (len+1));
5558 PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
5562 for (i = 0; i < len; ++i)
5563 r[i] = PyString_AsString (PyList_GetItem (obj, i));
5570 put_string_list (char * const * const argv)
5575 for (argc = 0; argv[argc] != NULL; ++argc)
5578 list = PyList_New (argc);
5579 for (i = 0; i < argc; ++i)
5580 PyList_SetItem (list, i, PyString_FromString (argv[i]));
5586 put_table (char * const * const argv)
5588 PyObject *list, *item;
5591 for (argc = 0; argv[argc] != NULL; ++argc)
5594 list = PyList_New (argc >> 1);
5595 for (i = 0; i < argc; i += 2) {
5596 item = PyTuple_New (2);
5597 PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
5598 PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
5599 PyList_SetItem (list, i >> 1, item);
5606 free_strings (char **argv)
5610 for (argc = 0; argv[argc] != NULL; ++argc)
5616 py_guestfs_create (PyObject *self, PyObject *args)
5620 g = guestfs_create ();
5622 PyErr_SetString (PyExc_RuntimeError,
5623 \"guestfs.create: failed to allocate handle\");
5626 guestfs_set_error_handler (g, NULL, NULL);
5627 return put_handle (g);
5631 py_guestfs_close (PyObject *self, PyObject *args)
5636 if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
5638 g = get_handle (py_g);
5642 Py_INCREF (Py_None);
5648 (* LVM structures, turned into Python dictionaries. *)
5651 pr "static PyObject *\n";
5652 pr "put_lvm_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
5654 pr " PyObject *dict;\n";
5656 pr " dict = PyDict_New ();\n";
5660 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
5661 pr " PyString_FromString (%s->%s));\n"
5664 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
5665 pr " PyString_FromStringAndSize (%s->%s, 32));\n"
5668 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
5669 pr " PyLong_FromUnsignedLongLong (%s->%s));\n"
5672 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
5673 pr " PyLong_FromLongLong (%s->%s));\n"
5675 | name, `OptPercent ->
5676 pr " if (%s->%s >= 0)\n" typ name;
5677 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
5678 pr " PyFloat_FromDouble ((double) %s->%s));\n"
5681 pr " Py_INCREF (Py_None);\n";
5682 pr " PyDict_SetItemString (dict, \"%s\", Py_None);" name;
5685 pr " return dict;\n";
5689 pr "static PyObject *\n";
5690 pr "put_lvm_%s_list (struct guestfs_lvm_%s_list *%ss)\n" typ typ typ;
5692 pr " PyObject *list;\n";
5695 pr " list = PyList_New (%ss->len);\n" typ;
5696 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
5697 pr " PyList_SetItem (list, i, put_lvm_%s (&%ss->val[i]));\n" typ typ;
5698 pr " return list;\n";
5701 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
5703 (* Stat structures, turned into Python dictionaries. *)
5706 pr "static PyObject *\n";
5707 pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
5709 pr " PyObject *dict;\n";
5711 pr " dict = PyDict_New ();\n";
5715 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
5716 pr " PyLong_FromLongLong (%s->%s));\n"
5719 pr " return dict;\n";
5722 ) ["stat", stat_cols; "statvfs", statvfs_cols];
5724 (* Python wrapper functions. *)
5726 fun (name, style, _, _, _, _, _) ->
5727 pr "static PyObject *\n";
5728 pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
5731 pr " PyObject *py_g;\n";
5732 pr " guestfs_h *g;\n";
5733 pr " PyObject *py_r;\n";
5736 match fst style with
5737 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
5738 | RInt64 _ -> pr " int64_t r;\n"; "-1"
5739 | RConstString _ -> pr " const char *r;\n"; "NULL"
5740 | RString _ -> pr " char *r;\n"; "NULL"
5741 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
5742 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
5743 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
5744 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
5745 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
5746 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
5747 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
5751 | String n | FileIn n | FileOut n -> pr " const char *%s;\n" n
5752 | OptString n -> pr " const char *%s;\n" n
5754 pr " PyObject *py_%s;\n" n;
5755 pr " const char **%s;\n" n
5756 | Bool n -> pr " int %s;\n" n
5757 | Int n -> pr " int %s;\n" n
5762 (* Convert the parameters. *)
5763 pr " if (!PyArg_ParseTuple (args, (char *) \"O";
5766 | String _ | FileIn _ | FileOut _ -> pr "s"
5767 | OptString _ -> pr "z"
5768 | StringList _ -> pr "O"
5769 | Bool _ -> pr "i" (* XXX Python has booleans? *)
5772 pr ":guestfs_%s\",\n" name;
5776 | String n | FileIn n | FileOut n -> pr ", &%s" n
5777 | OptString n -> pr ", &%s" n
5778 | StringList n -> pr ", &py_%s" n
5779 | Bool n -> pr ", &%s" n
5780 | Int n -> pr ", &%s" n
5784 pr " return NULL;\n";
5786 pr " g = get_handle (py_g);\n";
5789 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
5791 pr " %s = get_string_list (py_%s);\n" n n;
5792 pr " if (!%s) return NULL;\n" n
5797 pr " r = guestfs_%s " name;
5798 generate_call_args ~handle:"g" (snd style);
5803 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
5805 pr " free (%s);\n" n
5808 pr " if (r == %s) {\n" error_code;
5809 pr " PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
5810 pr " return NULL;\n";
5814 (match fst style with
5816 pr " Py_INCREF (Py_None);\n";
5817 pr " py_r = Py_None;\n"
5819 | RBool _ -> pr " py_r = PyInt_FromLong ((long) r);\n"
5820 | RInt64 _ -> pr " py_r = PyLong_FromLongLong (r);\n"
5821 | RConstString _ -> pr " py_r = PyString_FromString (r);\n"
5823 pr " py_r = PyString_FromString (r);\n";
5826 pr " py_r = put_string_list (r);\n";
5827 pr " free_strings (r);\n"
5829 pr " py_r = PyTuple_New (2);\n";
5830 pr " PyTuple_SetItem (py_r, 0, PyInt_FromLong ((long) r->i));\n";
5831 pr " PyTuple_SetItem (py_r, 1, PyInt_FromLong ((long) r->b));\n";
5832 pr " guestfs_free_int_bool (r);\n"
5834 pr " py_r = put_lvm_pv_list (r);\n";
5835 pr " guestfs_free_lvm_pv_list (r);\n"
5837 pr " py_r = put_lvm_vg_list (r);\n";
5838 pr " guestfs_free_lvm_vg_list (r);\n"
5840 pr " py_r = put_lvm_lv_list (r);\n";
5841 pr " guestfs_free_lvm_lv_list (r);\n"
5843 pr " py_r = put_stat (r);\n";
5846 pr " py_r = put_statvfs (r);\n";
5849 pr " py_r = put_table (r);\n";
5850 pr " free_strings (r);\n"
5853 pr " return py_r;\n";
5858 (* Table of functions. *)
5859 pr "static PyMethodDef methods[] = {\n";
5860 pr " { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
5861 pr " { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
5863 fun (name, _, _, _, _, _, _) ->
5864 pr " { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
5867 pr " { NULL, NULL, 0, NULL }\n";
5871 (* Init function. *)
5874 initlibguestfsmod (void)
5876 static int initialized = 0;
5878 if (initialized) return;
5879 Py_InitModule ((char *) \"libguestfsmod\", methods);
5884 (* Generate Python module. *)
5885 and generate_python_py () =
5886 generate_header HashStyle LGPLv2;
5889 u\"\"\"Python bindings for libguestfs
5892 g = guestfs.GuestFS ()
5893 g.add_drive (\"guest.img\")
5896 parts = g.list_partitions ()
5898 The guestfs module provides a Python binding to the libguestfs API
5899 for examining and modifying virtual machine disk images.
5901 Amongst the things this is good for: making batch configuration
5902 changes to guests, getting disk used/free statistics (see also:
5903 virt-df), migrating between virtualization systems (see also:
5904 virt-p2v), performing partial backups, performing partial guest
5905 clones, cloning guests and changing registry/UUID/hostname info, and
5908 Libguestfs uses Linux kernel and qemu code, and can access any type of
5909 guest filesystem that Linux and qemu can, including but not limited
5910 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
5911 schemes, qcow, qcow2, vmdk.
5913 Libguestfs provides ways to enumerate guest storage (eg. partitions,
5914 LVs, what filesystem is in each LV, etc.). It can also run commands
5915 in the context of the guest. Also you can access filesystems over FTP.
5917 Errors which happen while using the API are turned into Python
5918 RuntimeError exceptions.
5920 To create a guestfs handle you usually have to perform the following
5923 # Create the handle, call add_drive at least once, and possibly
5924 # several times if the guest has multiple block devices:
5925 g = guestfs.GuestFS ()
5926 g.add_drive (\"guest.img\")
5928 # Launch the qemu subprocess and wait for it to become ready:
5932 # Now you can issue commands, for example:
5937 import libguestfsmod
5940 \"\"\"Instances of this class are libguestfs API handles.\"\"\"
5942 def __init__ (self):
5943 \"\"\"Create a new libguestfs handle.\"\"\"
5944 self._o = libguestfsmod.create ()
5947 libguestfsmod.close (self._o)
5952 fun (name, style, _, flags, _, _, longdesc) ->
5953 let doc = replace_str longdesc "C<guestfs_" "C<g." in
5955 match fst style with
5956 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _
5959 doc ^ "\n\nThis function returns a list of strings."
5961 doc ^ "\n\nThis function returns a tuple (int, bool).\n"
5963 doc ^ "\n\nThis function returns a list of PVs. Each PV is represented as a dictionary."
5965 doc ^ "\n\nThis function returns a list of VGs. Each VG is represented as a dictionary."
5967 doc ^ "\n\nThis function returns a list of LVs. Each LV is represented as a dictionary."
5969 doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the stat structure."
5971 doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the statvfs structure."
5973 doc ^ "\n\nThis function returns a dictionary." in
5975 if List.mem ProtocolLimitWarning flags then
5976 doc ^ "\n\n" ^ protocol_limit_warning
5979 if List.mem DangerWillRobinson flags then
5980 doc ^ "\n\n" ^ danger_will_robinson
5982 let doc = pod2text ~width:60 name doc in
5983 let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
5984 let doc = String.concat "\n " doc in
5987 generate_call_args ~handle:"self" (snd style);
5989 pr " u\"\"\"%s\"\"\"\n" doc;
5990 pr " return libguestfsmod.%s " name;
5991 generate_call_args ~handle:"self._o" (snd style);
5996 (* Useful if you need the longdesc POD text as plain text. Returns a
5999 * This is the slowest thing about autogeneration.
6001 and pod2text ~width name longdesc =
6002 let filename, chan = Filename.open_temp_file "gen" ".tmp" in
6003 fprintf chan "=head1 %s\n\n%s\n" name longdesc;
6005 let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
6006 let chan = Unix.open_process_in cmd in
6007 let lines = ref [] in
6009 let line = input_line chan in
6010 if i = 1 then (* discard the first line of output *)
6013 let line = triml line in
6014 lines := line :: !lines;
6017 let lines = try loop 1 with End_of_file -> List.rev !lines in
6018 Unix.unlink filename;
6019 match Unix.close_process_in chan with
6020 | Unix.WEXITED 0 -> lines
6022 failwithf "pod2text: process exited with non-zero status (%d)" i
6023 | Unix.WSIGNALED i | Unix.WSTOPPED i ->
6024 failwithf "pod2text: process signalled or stopped by signal %d" i
6026 (* Generate ruby bindings. *)
6027 and generate_ruby_c () =
6028 generate_header CStyle LGPLv2;
6036 #include \"guestfs.h\"
6038 #include \"extconf.h\"
6040 /* For Ruby < 1.9 */
6042 #define RARRAY_LEN(r) (RARRAY((r))->len)
6045 static VALUE m_guestfs; /* guestfs module */
6046 static VALUE c_guestfs; /* guestfs_h handle */
6047 static VALUE e_Error; /* used for all errors */
6049 static void ruby_guestfs_free (void *p)
6052 guestfs_close ((guestfs_h *) p);
6055 static VALUE ruby_guestfs_create (VALUE m)
6059 g = guestfs_create ();
6061 rb_raise (e_Error, \"failed to create guestfs handle\");
6063 /* Don't print error messages to stderr by default. */
6064 guestfs_set_error_handler (g, NULL, NULL);
6066 /* Wrap it, and make sure the close function is called when the
6069 return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
6072 static VALUE ruby_guestfs_close (VALUE gv)
6075 Data_Get_Struct (gv, guestfs_h, g);
6077 ruby_guestfs_free (g);
6078 DATA_PTR (gv) = NULL;
6086 fun (name, style, _, _, _, _, _) ->
6087 pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
6088 List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
6091 pr " guestfs_h *g;\n";
6092 pr " Data_Get_Struct (gv, guestfs_h, g);\n";
6094 pr " rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
6100 | String n | FileIn n | FileOut n ->
6101 pr " const char *%s = StringValueCStr (%sv);\n" n n;
6103 pr " rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
6104 pr " \"%s\", \"%s\");\n" n name
6106 pr " const char *%s = StringValueCStr (%sv);\n" n n
6110 pr " int i, len;\n";
6111 pr " len = RARRAY_LEN (%sv);\n" n;
6112 pr " %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
6114 pr " for (i = 0; i < len; ++i) {\n";
6115 pr " VALUE v = rb_ary_entry (%sv, i);\n" n;
6116 pr " %s[i] = StringValueCStr (v);\n" n;
6118 pr " %s[len] = NULL;\n" n;
6122 pr " int %s = NUM2INT (%sv);\n" n n
6127 match fst style with
6128 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
6129 | RInt64 _ -> pr " int64_t r;\n"; "-1"
6130 | RConstString _ -> pr " const char *r;\n"; "NULL"
6131 | RString _ -> pr " char *r;\n"; "NULL"
6132 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
6133 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
6134 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
6135 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
6136 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
6137 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
6138 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
6141 pr " r = guestfs_%s " name;
6142 generate_call_args ~handle:"g" (snd style);
6147 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
6149 pr " free (%s);\n" n
6152 pr " if (r == %s)\n" error_code;
6153 pr " rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
6156 (match fst style with
6158 pr " return Qnil;\n"
6159 | RInt _ | RBool _ ->
6160 pr " return INT2NUM (r);\n"
6162 pr " return ULL2NUM (r);\n"
6164 pr " return rb_str_new2 (r);\n";
6166 pr " VALUE rv = rb_str_new2 (r);\n";
6170 pr " int i, len = 0;\n";
6171 pr " for (i = 0; r[i] != NULL; ++i) len++;\n";
6172 pr " VALUE rv = rb_ary_new2 (len);\n";
6173 pr " for (i = 0; r[i] != NULL; ++i) {\n";
6174 pr " rb_ary_push (rv, rb_str_new2 (r[i]));\n";
6175 pr " free (r[i]);\n";
6180 pr " VALUE rv = rb_ary_new2 (2);\n";
6181 pr " rb_ary_push (rv, INT2NUM (r->i));\n";
6182 pr " rb_ary_push (rv, INT2NUM (r->b));\n";
6183 pr " guestfs_free_int_bool (r);\n";
6186 generate_ruby_lvm_code "pv" pv_cols
6188 generate_ruby_lvm_code "vg" vg_cols
6190 generate_ruby_lvm_code "lv" lv_cols
6192 pr " VALUE rv = rb_hash_new ();\n";
6196 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
6201 pr " VALUE rv = rb_hash_new ();\n";
6205 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
6210 pr " VALUE rv = rb_hash_new ();\n";
6212 pr " for (i = 0; r[i] != NULL; i+=2) {\n";
6213 pr " rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
6214 pr " free (r[i]);\n";
6215 pr " free (r[i+1]);\n";
6226 /* Initialize the module. */
6227 void Init__guestfs ()
6229 m_guestfs = rb_define_module (\"Guestfs\");
6230 c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
6231 e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
6233 rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
6234 rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
6237 (* Define the rest of the methods. *)
6239 fun (name, style, _, _, _, _, _) ->
6240 pr " rb_define_method (c_guestfs, \"%s\",\n" name;
6241 pr " ruby_guestfs_%s, %d);\n" name (List.length (snd style))
6246 (* Ruby code to return an LVM struct list. *)
6247 and generate_ruby_lvm_code typ cols =
6248 pr " VALUE rv = rb_ary_new2 (r->len);\n";
6250 pr " for (i = 0; i < r->len; ++i) {\n";
6251 pr " VALUE hv = rb_hash_new ();\n";
6255 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
6257 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
6260 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
6261 | name, `OptPercent ->
6262 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
6264 pr " rb_ary_push (rv, hv);\n";
6266 pr " guestfs_free_lvm_%s_list (r);\n" typ;
6269 (* Generate Java bindings GuestFS.java file. *)
6270 and generate_java_java () =
6271 generate_header CStyle LGPLv2;
6274 package com.redhat.et.libguestfs;
6276 import java.util.HashMap;
6277 import com.redhat.et.libguestfs.LibGuestFSException;
6278 import com.redhat.et.libguestfs.PV;
6279 import com.redhat.et.libguestfs.VG;
6280 import com.redhat.et.libguestfs.LV;
6281 import com.redhat.et.libguestfs.Stat;
6282 import com.redhat.et.libguestfs.StatVFS;
6283 import com.redhat.et.libguestfs.IntBool;
6286 * The GuestFS object is a libguestfs handle.
6290 public class GuestFS {
6291 // Load the native code.
6293 System.loadLibrary (\"guestfs_jni\");
6297 * The native guestfs_h pointer.
6302 * Create a libguestfs handle.
6304 * @throws LibGuestFSException
6306 public GuestFS () throws LibGuestFSException
6310 private native long _create () throws LibGuestFSException;
6313 * Close a libguestfs handle.
6315 * You can also leave handles to be collected by the garbage
6316 * collector, but this method ensures that the resources used
6317 * by the handle are freed up immediately. If you call any
6318 * other methods after closing the handle, you will get an
6321 * @throws LibGuestFSException
6323 public void close () throws LibGuestFSException
6329 private native void _close (long g) throws LibGuestFSException;
6331 public void finalize () throws LibGuestFSException
6339 fun (name, style, _, flags, _, shortdesc, longdesc) ->
6340 let doc = replace_str longdesc "C<guestfs_" "C<g." in
6342 if List.mem ProtocolLimitWarning flags then
6343 doc ^ "\n\n" ^ protocol_limit_warning
6346 if List.mem DangerWillRobinson flags then
6347 doc ^ "\n\n" ^ danger_will_robinson
6349 let doc = pod2text ~width:60 name doc in
6350 let doc = String.concat "\n * " doc in
6353 pr " * %s\n" shortdesc;
6356 pr " * @throws LibGuestFSException\n";
6359 generate_java_prototype ~public:true ~semicolon:false name style;
6362 pr " if (g == 0)\n";
6363 pr " throw new LibGuestFSException (\"%s: handle is closed\");\n"
6366 if fst style <> RErr then pr "return ";
6368 generate_call_args ~handle:"g" (snd style);
6372 generate_java_prototype ~privat:true ~native:true name style;
6379 and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
6380 ?(semicolon=true) name style =
6381 if privat then pr "private ";
6382 if public then pr "public ";
6383 if native then pr "native ";
6386 (match fst style with
6387 | RErr -> pr "void ";
6388 | RInt _ -> pr "int ";
6389 | RInt64 _ -> pr "long ";
6390 | RBool _ -> pr "boolean ";
6391 | RConstString _ | RString _ -> pr "String ";
6392 | RStringList _ -> pr "String[] ";
6393 | RIntBool _ -> pr "IntBool ";
6394 | RPVList _ -> pr "PV[] ";
6395 | RVGList _ -> pr "VG[] ";
6396 | RLVList _ -> pr "LV[] ";
6397 | RStat _ -> pr "Stat ";
6398 | RStatVFS _ -> pr "StatVFS ";
6399 | RHashtable _ -> pr "HashMap<String,String> ";
6402 if native then pr "_%s " name else pr "%s " name;
6404 let needs_comma = ref false in
6413 if !needs_comma then pr ", ";
6414 needs_comma := true;
6431 pr " throws LibGuestFSException";
6432 if semicolon then pr ";"
6434 and generate_java_struct typ cols =
6435 generate_header CStyle LGPLv2;
6438 package com.redhat.et.libguestfs;
6441 * Libguestfs %s structure.
6452 | name, `UUID -> pr " public String %s;\n" name
6454 | name, `Int -> pr " public long %s;\n" name
6455 | name, `OptPercent ->
6456 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
6457 pr " public float %s;\n" name
6462 and generate_java_c () =
6463 generate_header CStyle LGPLv2;
6470 #include \"com_redhat_et_libguestfs_GuestFS.h\"
6471 #include \"guestfs.h\"
6473 /* Note that this function returns. The exception is not thrown
6474 * until after the wrapper function returns.
6477 throw_exception (JNIEnv *env, const char *msg)
6480 cl = (*env)->FindClass (env,
6481 \"com/redhat/et/libguestfs/LibGuestFSException\");
6482 (*env)->ThrowNew (env, cl, msg);
6485 JNIEXPORT jlong JNICALL
6486 Java_com_redhat_et_libguestfs_GuestFS__1create
6487 (JNIEnv *env, jobject obj)
6491 g = guestfs_create ();
6493 throw_exception (env, \"GuestFS.create: failed to allocate handle\");
6496 guestfs_set_error_handler (g, NULL, NULL);
6497 return (jlong) (long) g;
6500 JNIEXPORT void JNICALL
6501 Java_com_redhat_et_libguestfs_GuestFS__1close
6502 (JNIEnv *env, jobject obj, jlong jg)
6504 guestfs_h *g = (guestfs_h *) (long) jg;
6511 fun (name, style, _, _, _, _, _) ->
6513 (match fst style with
6514 | RErr -> pr "void ";
6515 | RInt _ -> pr "jint ";
6516 | RInt64 _ -> pr "jlong ";
6517 | RBool _ -> pr "jboolean ";
6518 | RConstString _ | RString _ -> pr "jstring ";
6519 | RIntBool _ | RStat _ | RStatVFS _ | RHashtable _ ->
6521 | RStringList _ | RPVList _ | RVGList _ | RLVList _ ->
6525 pr "Java_com_redhat_et_libguestfs_GuestFS_";
6526 pr "%s" (replace_str ("_" ^ name) "_" "_1");
6528 pr " (JNIEnv *env, jobject obj, jlong jg";
6535 pr ", jstring j%s" n
6537 pr ", jobjectArray j%s" n
6539 pr ", jboolean j%s" n
6545 pr " guestfs_h *g = (guestfs_h *) (long) jg;\n";
6546 let error_code, no_ret =
6547 match fst style with
6548 | RErr -> pr " int r;\n"; "-1", ""
6550 | RInt _ -> pr " int r;\n"; "-1", "0"
6551 | RInt64 _ -> pr " int64_t r;\n"; "-1", "0"
6552 | RConstString _ -> pr " const char *r;\n"; "NULL", "NULL"
6554 pr " jstring jr;\n";
6555 pr " char *r;\n"; "NULL", "NULL"
6557 pr " jobjectArray jr;\n";
6560 pr " jstring jstr;\n";
6561 pr " char **r;\n"; "NULL", "NULL"
6563 pr " jobject jr;\n";
6565 pr " jfieldID fl;\n";
6566 pr " struct guestfs_int_bool *r;\n"; "NULL", "NULL"
6568 pr " jobject jr;\n";
6570 pr " jfieldID fl;\n";
6571 pr " struct guestfs_stat *r;\n"; "NULL", "NULL"
6573 pr " jobject jr;\n";
6575 pr " jfieldID fl;\n";
6576 pr " struct guestfs_statvfs *r;\n"; "NULL", "NULL"
6578 pr " jobjectArray jr;\n";
6580 pr " jfieldID fl;\n";
6581 pr " jobject jfl;\n";
6582 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL", "NULL"
6584 pr " jobjectArray jr;\n";
6586 pr " jfieldID fl;\n";
6587 pr " jobject jfl;\n";
6588 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL", "NULL"
6590 pr " jobjectArray jr;\n";
6592 pr " jfieldID fl;\n";
6593 pr " jobject jfl;\n";
6594 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL", "NULL"
6595 | RHashtable _ -> pr " char **r;\n"; "NULL", "NULL" in
6602 pr " const char *%s;\n" n
6604 pr " int %s_len;\n" n;
6605 pr " const char **%s;\n" n
6612 (match fst style with
6613 | RStringList _ | RPVList _ | RVGList _ | RLVList _ -> true
6614 | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
6615 | RString _ | RIntBool _ | RStat _ | RStatVFS _
6616 | RHashtable _ -> false) ||
6617 List.exists (function StringList _ -> true | _ -> false) (snd style) in
6623 (* Get the parameters. *)
6630 pr " %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
6632 pr " %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
6633 pr " %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
6634 pr " for (i = 0; i < %s_len; ++i) {\n" n;
6635 pr " jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
6637 pr " %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
6639 pr " %s[%s_len] = NULL;\n" n n;
6642 pr " %s = j%s;\n" n n
6645 (* Make the call. *)
6646 pr " r = guestfs_%s " name;
6647 generate_call_args ~handle:"g" (snd style);
6650 (* Release the parameters. *)
6657 pr " (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
6659 pr " for (i = 0; i < %s_len; ++i) {\n" n;
6660 pr " jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
6662 pr " (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
6664 pr " free (%s);\n" n
6669 (* Check for errors. *)
6670 pr " if (r == %s) {\n" error_code;
6671 pr " throw_exception (env, guestfs_last_error (g));\n";
6672 pr " return %s;\n" no_ret;
6676 (match fst style with
6678 | RInt _ -> pr " return (jint) r;\n"
6679 | RBool _ -> pr " return (jboolean) r;\n"
6680 | RInt64 _ -> pr " return (jlong) r;\n"
6681 | RConstString _ -> pr " return (*env)->NewStringUTF (env, r);\n"
6683 pr " jr = (*env)->NewStringUTF (env, r);\n";
6687 pr " for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
6688 pr " cl = (*env)->FindClass (env, \"java/lang/String\");\n";
6689 pr " jstr = (*env)->NewStringUTF (env, \"\");\n";
6690 pr " jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n";
6691 pr " for (i = 0; i < r_len; ++i) {\n";
6692 pr " jstr = (*env)->NewStringUTF (env, r[i]);\n";
6693 pr " (*env)->SetObjectArrayElement (env, jr, i, jstr);\n";
6694 pr " free (r[i]);\n";
6699 pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/IntBool\");\n";
6700 pr " jr = (*env)->AllocObject (env, cl);\n";
6701 pr " fl = (*env)->GetFieldID (env, cl, \"i\", \"I\");\n";
6702 pr " (*env)->SetIntField (env, jr, fl, r->i);\n";
6703 pr " fl = (*env)->GetFieldID (env, cl, \"i\", \"Z\");\n";
6704 pr " (*env)->SetBooleanField (env, jr, fl, r->b);\n";
6705 pr " guestfs_free_int_bool (r);\n";
6708 pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/Stat\");\n";
6709 pr " jr = (*env)->AllocObject (env, cl);\n";
6713 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n"
6715 pr " (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
6720 pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/StatVFS\");\n";
6721 pr " jr = (*env)->AllocObject (env, cl);\n";
6725 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n"
6727 pr " (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
6732 generate_java_lvm_return "pv" "PV" pv_cols
6734 generate_java_lvm_return "vg" "VG" vg_cols
6736 generate_java_lvm_return "lv" "LV" lv_cols
6739 pr " throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
6740 pr " return NULL;\n"
6747 and generate_java_lvm_return typ jtyp cols =
6748 pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
6749 pr " jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n";
6750 pr " for (i = 0; i < r->len; ++i) {\n";
6751 pr " jfl = (*env)->AllocObject (env, cl);\n";
6755 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
6756 pr " (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name;
6759 pr " char s[33];\n";
6760 pr " memcpy (s, r->val[i].%s, 32);\n" name;
6762 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
6763 pr " (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
6765 | name, (`Bytes|`Int) ->
6766 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
6767 pr " (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
6768 | name, `OptPercent ->
6769 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
6770 pr " (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\n" name;
6772 pr " (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n";
6774 pr " guestfs_free_lvm_%s_list (r);\n" typ;
6777 and generate_haskell_hs () =
6778 generate_header HaskellStyle LGPLv2;
6780 (* XXX We only know how to generate partial FFI for Haskell
6781 * at the moment. Please help out!
6783 let can_generate style =
6784 let check_no_bad_args =
6785 List.for_all (function Bool _ | Int _ -> false | _ -> true)
6788 | RErr, args -> check_no_bad_args args
6801 | RHashtable _, _ -> false in
6804 {-# INCLUDE <guestfs.h> #-}
6805 {-# LANGUAGE ForeignFunctionInterface #-}
6810 (* List out the names of the actions we want to export. *)
6812 fun (name, style, _, _, _, _, _) ->
6813 if can_generate style then pr ",\n %s" name
6821 import Control.Exception
6822 import Data.Typeable
6824 data GuestfsS = GuestfsS -- represents the opaque C struct
6825 type GuestfsP = Ptr GuestfsS -- guestfs_h *
6826 type GuestfsH = ForeignPtr GuestfsS -- guestfs_h * with attached finalizer
6828 -- XXX define properly later XXX
6832 data IntBool = IntBool
6834 data StatVFS = StatVFS
6835 data Hashtable = Hashtable
6837 foreign import ccall unsafe \"guestfs_create\" c_create
6839 foreign import ccall unsafe \"&guestfs_close\" c_close
6840 :: FunPtr (GuestfsP -> IO ())
6841 foreign import ccall unsafe \"guestfs_set_error_handler\" c_set_error_handler
6842 :: GuestfsP -> Ptr CInt -> Ptr CInt -> IO ()
6844 create :: IO GuestfsH
6847 c_set_error_handler p nullPtr nullPtr
6848 h <- newForeignPtr c_close p
6851 foreign import ccall unsafe \"guestfs_last_error\" c_last_error
6852 :: GuestfsP -> IO CString
6854 -- last_error :: GuestfsH -> IO (Maybe String)
6855 -- last_error h = do
6856 -- str <- withForeignPtr h (\\p -> c_last_error p)
6857 -- maybePeek peekCString str
6859 last_error :: GuestfsH -> IO (String)
6861 str <- withForeignPtr h (\\p -> c_last_error p)
6863 then return \"no error\"
6864 else peekCString str
6868 (* Generate wrappers for each foreign function. *)
6870 fun (name, style, _, _, _, _, _) ->
6871 if can_generate style then (
6872 pr "foreign import ccall unsafe \"guestfs_%s\" c_%s\n" name name;
6874 generate_haskell_prototype ~handle:"GuestfsP" style;
6878 generate_haskell_prototype ~handle:"GuestfsH" ~hs:true style;
6880 pr "%s %s = do\n" name
6881 (String.concat " " ("h" :: List.map name_of_argt (snd style)));
6887 | String n -> pr "withCString %s $ \\%s -> " n n
6888 | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
6889 | StringList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
6891 (* XXX this doesn't work *)
6893 pr " %s = case %s of\n" n n;
6896 pr " in fromIntegral %s $ \\%s ->\n" n n
6897 | Int n -> pr "fromIntegral %s $ \\%s -> " n n
6899 pr "withForeignPtr h (\\p -> c_%s %s)\n" name
6900 (String.concat " " ("p" :: List.map name_of_argt (snd style)));
6901 (match fst style with
6902 | RErr | RInt _ | RInt64 _ | RBool _ ->
6903 pr " if (r == -1)\n";
6905 pr " err <- last_error h\n";
6907 | RConstString _ | RString _ | RStringList _ | RIntBool _
6908 | RPVList _ | RVGList _ | RLVList _ | RStat _ | RStatVFS _
6910 pr " if (r == nullPtr)\n";
6912 pr " err <- last_error h\n";
6915 (match fst style with
6917 pr " else return ()\n"
6919 pr " else return (fromIntegral r)\n"
6921 pr " else return (fromIntegral r)\n"
6923 pr " else return (toBool r)\n"
6934 pr " else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *)
6940 and generate_haskell_prototype ~handle ?(hs = false) style =
6942 let string = if hs then "String" else "CString" in
6943 let int = if hs then "Int" else "CInt" in
6944 let bool = if hs then "Bool" else "CInt" in
6945 let int64 = if hs then "Integer" else "Int64" in
6949 | String _ -> pr "%s" string
6950 | OptString _ -> if hs then pr "Maybe String" else pr "CString"
6951 | StringList _ -> if hs then pr "[String]" else pr "Ptr CString"
6952 | Bool _ -> pr "%s" bool
6953 | Int _ -> pr "%s" int
6954 | FileIn _ -> pr "%s" string
6955 | FileOut _ -> pr "%s" string
6960 (match fst style with
6961 | RErr -> if not hs then pr "CInt"
6962 | RInt _ -> pr "%s" int
6963 | RInt64 _ -> pr "%s" int64
6964 | RBool _ -> pr "%s" bool
6965 | RConstString _ -> pr "%s" string
6966 | RString _ -> pr "%s" string
6967 | RStringList _ -> pr "[%s]" string
6968 | RIntBool _ -> pr "IntBool"
6969 | RPVList _ -> pr "[PV]"
6970 | RVGList _ -> pr "[VG]"
6971 | RLVList _ -> pr "[LV]"
6972 | RStat _ -> pr "Stat"
6973 | RStatVFS _ -> pr "StatVFS"
6974 | RHashtable _ -> pr "Hashtable"
6978 let output_to filename =
6979 let filename_new = filename ^ ".new" in
6980 chan := open_out filename_new;
6985 (* Is the new file different from the current file? *)
6986 if Sys.file_exists filename && files_equal filename filename_new then
6987 Unix.unlink filename_new (* same, so skip it *)
6989 (* different, overwrite old one *)
6990 (try Unix.chmod filename 0o644 with Unix.Unix_error _ -> ());
6991 Unix.rename filename_new filename;
6992 Unix.chmod filename 0o444;
6993 printf "written %s\n%!" filename;
7002 if not (Sys.file_exists "configure.ac") then (
7004 You are probably running this from the wrong directory.
7005 Run it from the top source directory using the command
7011 let close = output_to "src/guestfs_protocol.x" in
7015 let close = output_to "src/guestfs-structs.h" in
7016 generate_structs_h ();
7019 let close = output_to "src/guestfs-actions.h" in
7020 generate_actions_h ();
7023 let close = output_to "src/guestfs-actions.c" in
7024 generate_client_actions ();
7027 let close = output_to "daemon/actions.h" in
7028 generate_daemon_actions_h ();
7031 let close = output_to "daemon/stubs.c" in
7032 generate_daemon_actions ();
7035 let close = output_to "tests.c" in
7039 let close = output_to "fish/cmds.c" in
7040 generate_fish_cmds ();
7043 let close = output_to "fish/completion.c" in
7044 generate_fish_completion ();
7047 let close = output_to "guestfs-structs.pod" in
7048 generate_structs_pod ();
7051 let close = output_to "guestfs-actions.pod" in
7052 generate_actions_pod ();
7055 let close = output_to "guestfish-actions.pod" in
7056 generate_fish_actions_pod ();
7059 let close = output_to "ocaml/guestfs.mli" in
7060 generate_ocaml_mli ();
7063 let close = output_to "ocaml/guestfs.ml" in
7064 generate_ocaml_ml ();
7067 let close = output_to "ocaml/guestfs_c_actions.c" in
7068 generate_ocaml_c ();
7071 let close = output_to "perl/Guestfs.xs" in
7072 generate_perl_xs ();
7075 let close = output_to "perl/lib/Sys/Guestfs.pm" in
7076 generate_perl_pm ();
7079 let close = output_to "python/guestfs-py.c" in
7080 generate_python_c ();
7083 let close = output_to "python/guestfs.py" in
7084 generate_python_py ();
7087 let close = output_to "ruby/ext/guestfs/_guestfs.c" in
7091 let close = output_to "java/com/redhat/et/libguestfs/GuestFS.java" in
7092 generate_java_java ();
7095 let close = output_to "java/com/redhat/et/libguestfs/PV.java" in
7096 generate_java_struct "PV" pv_cols;
7099 let close = output_to "java/com/redhat/et/libguestfs/VG.java" in
7100 generate_java_struct "VG" vg_cols;
7103 let close = output_to "java/com/redhat/et/libguestfs/LV.java" in
7104 generate_java_struct "LV" lv_cols;
7107 let close = output_to "java/com/redhat/et/libguestfs/Stat.java" in
7108 generate_java_struct "Stat" stat_cols;
7111 let close = output_to "java/com/redhat/et/libguestfs/StatVFS.java" in
7112 generate_java_struct "StatVFS" statvfs_cols;
7115 let close = output_to "java/com_redhat_et_libguestfs_GuestFS.c" in
7119 let close = output_to "haskell/Guestfs.hs" in
7120 generate_haskell_hs ();