3 * Copyright (C) 2009 Red Hat Inc.
5 * This program is free software; you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation; either version 2 of the License, or
8 * (at your option) any later version.
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
15 * You should have received a copy of the GNU General Public License
16 * along with this program; if not, write to the Free Software
17 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
20 (* This script generates a large amount of code and documentation for
21 * all the daemon actions.
23 * To add a new action there are only two files you need to change,
24 * this one to describe the interface (see the big table below), and
25 * daemon/<somefile>.c to write the implementation.
27 * After editing this file, run it (./src/generator.ml) to regenerate
28 * all the output files.
30 * IMPORTANT: This script should NOT print any warnings. If it prints
31 * warnings, you should treat them as errors.
32 * [Need to add -warn-error to ocaml command line]
39 type style = ret * args
41 (* "RErr" as a return value means an int used as a simple error
42 * indication, ie. 0 or -1.
45 (* "RInt" as a return value means an int which is -1 for error
46 * or any value >= 0 on success. Only use this for smallish
47 * positive ints (0 <= i < 2^30).
50 (* "RInt64" is the same as RInt, but is guaranteed to be able
51 * to return a full 64 bit value, _except_ that -1 means error
52 * (so -1 cannot be a valid, non-error return value).
55 (* "RBool" is a bool return value which can be true/false or
59 (* "RConstString" is a string that refers to a constant value.
60 * Try to avoid using this. In particular you cannot use this
61 * for values returned from the daemon, because there is no
62 * thread-safe way to return them in the C API.
64 | RConstString of string
65 (* "RString" and "RStringList" are caller-frees. *)
67 | RStringList of string
68 (* Some limited tuples are possible: *)
69 | RIntBool of string * string
70 (* LVM PVs, VGs and LVs. *)
77 (* Key-value pairs of untyped strings. Turns into a hashtable or
78 * dictionary in languages which support it. DON'T use this as a
79 * general "bucket" for results. Prefer a stronger typed return
80 * value if one is available, or write a custom struct. Don't use
81 * this if the list could potentially be very long, since it is
82 * inefficient. Keys should be unique. NULLs are not permitted.
84 | RHashtable of string
86 and args = argt list (* Function parameters, guestfs handle is implicit. *)
88 (* Note in future we should allow a "variable args" parameter as
89 * the final parameter, to allow commands like
90 * chmod mode file [file(s)...]
91 * This is not implemented yet, but many commands (such as chmod)
92 * are currently defined with the argument order keeping this future
93 * possibility in mind.
96 | String of string (* const char *name, cannot be NULL *)
97 | OptString of string (* const char *name, may be NULL *)
98 | StringList of string(* list of strings (each string cannot be NULL) *)
99 | Bool of string (* boolean *)
100 | Int of string (* int (smallish ints, signed, <= 31 bits) *)
101 (* These are treated as filenames (simple string parameters) in
102 * the C API and bindings. But in the RPC protocol, we transfer
103 * the actual file content up to or down from the daemon.
104 * FileIn: local machine -> daemon (in request)
105 * FileOut: daemon -> local machine (in reply)
106 * In guestfish (only), the special name "-" means read from
107 * stdin or write to stdout.
113 | ProtocolLimitWarning (* display warning about protocol size limits *)
114 | DangerWillRobinson (* flags particularly dangerous commands *)
115 | FishAlias of string (* provide an alias for this cmd in guestfish *)
116 | FishAction of string (* call this function in guestfish *)
117 | NotInFish (* do not export via guestfish *)
119 let protocol_limit_warning =
120 "Because of the message protocol, there is a transfer limit
121 of somewhere between 2MB and 4MB. To transfer large files you should use
124 let danger_will_robinson =
125 "B<This command is dangerous. Without careful use you
126 can easily destroy all your data>."
128 (* You can supply zero or as many tests as you want per API call.
130 * Note that the test environment has 3 block devices, of size 500MB,
131 * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc).
132 * Note for partitioning purposes, the 500MB device has 63 cylinders.
134 * To be able to run the tests in a reasonable amount of time,
135 * the virtual machine and block devices are reused between tests.
136 * So don't try testing kill_subprocess :-x
138 * Between each test we umount-all and lvm-remove-all (except InitNone).
140 * Don't assume anything about the previous contents of the block
141 * devices. Use 'Init*' to create some initial scenarios.
143 type tests = (test_init * test) list
145 (* Run the command sequence and just expect nothing to fail. *)
147 (* Run the command sequence and expect the output of the final
148 * command to be the string.
150 | TestOutput of seq * string
151 (* Run the command sequence and expect the output of the final
152 * command to be the list of strings.
154 | TestOutputList of seq * string list
155 (* Run the command sequence and expect the output of the final
156 * command to be the integer.
158 | TestOutputInt of seq * int
159 (* Run the command sequence and expect the output of the final
160 * command to be a true value (!= 0 or != NULL).
162 | TestOutputTrue of seq
163 (* Run the command sequence and expect the output of the final
164 * command to be a false value (== 0 or == NULL, but not an error).
166 | TestOutputFalse of seq
167 (* Run the command sequence and expect the output of the final
168 * command to be a list of the given length (but don't care about
171 | TestOutputLength of seq * int
172 (* Run the command sequence and expect the output of the final
173 * command to be a structure.
175 | TestOutputStruct of seq * test_field_compare list
176 (* Run the command sequence and expect the final command (only)
179 | TestLastFail of seq
181 and test_field_compare =
182 | CompareWithInt of string * int
183 | CompareWithString of string * string
184 | CompareFieldsIntEq of string * string
185 | CompareFieldsStrEq of string * string
187 (* Some initial scenarios for testing. *)
189 (* Do nothing, block devices could contain random stuff including
190 * LVM PVs, and some filesystems might be mounted. This is usually
194 (* Block devices are empty and no filesystems are mounted. *)
196 (* /dev/sda contains a single partition /dev/sda1, which is formatted
197 * as ext2, empty [except for lost+found] and mounted on /.
198 * /dev/sdb and /dev/sdc may have random content.
203 * /dev/sda1 (is a PV):
204 * /dev/VG/LV (size 8MB):
205 * formatted as ext2, empty [except for lost+found], mounted on /
206 * /dev/sdb and /dev/sdc may have random content.
210 (* Sequence of commands for testing. *)
212 and cmd = string list
214 (* Note about long descriptions: When referring to another
215 * action, use the format C<guestfs_other> (ie. the full name of
216 * the C function). This will be replaced as appropriate in other
219 * Apart from that, long descriptions are just perldoc paragraphs.
222 let non_daemon_functions = [
223 ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
225 "launch the qemu subprocess",
227 Internally libguestfs is implemented by running a virtual machine
230 You should call this after configuring the handle
231 (eg. adding drives) but before performing any actions.");
233 ("wait_ready", (RErr, []), -1, [NotInFish],
235 "wait until the qemu subprocess launches",
237 Internally libguestfs is implemented by running a virtual machine
240 You should call this after C<guestfs_launch> to wait for the launch
243 ("kill_subprocess", (RErr, []), -1, [],
245 "kill the qemu subprocess",
247 This kills the qemu subprocess. You should never need to call this.");
249 ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
251 "add an image to examine or modify",
253 This function adds a virtual machine disk image C<filename> to the
254 guest. The first time you call this function, the disk appears as IDE
255 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
258 You don't necessarily need to be root when using libguestfs. However
259 you obviously do need sufficient permissions to access the filename
260 for whatever operations you want to perform (ie. read access if you
261 just want to read the image or write access if you want to modify the
264 This is equivalent to the qemu parameter C<-drive file=filename>.");
266 ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
268 "add a CD-ROM disk image to examine",
270 This function adds a virtual CD-ROM disk image to the guest.
272 This is equivalent to the qemu parameter C<-cdrom filename>.");
274 ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
276 "add qemu parameters",
278 This can be used to add arbitrary qemu command line parameters
279 of the form C<-param value>. Actually it's not quite arbitrary - we
280 prevent you from setting some parameters which would interfere with
281 parameters that we use.
283 The first character of C<param> string must be a C<-> (dash).
285 C<value> can be NULL.");
287 ("set_path", (RErr, [String "path"]), -1, [FishAlias "path"],
289 "set the search path",
291 Set the path that libguestfs searches for kernel and initrd.img.
293 The default is C<$libdir/guestfs> unless overridden by setting
294 C<LIBGUESTFS_PATH> environment variable.
296 The string C<path> is stashed in the libguestfs handle, so the caller
297 must make sure it remains valid for the lifetime of the handle.
299 Setting C<path> to C<NULL> restores the default path.");
301 ("get_path", (RConstString "path", []), -1, [],
303 "get the search path",
305 Return the current search path.
307 This is always non-NULL. If it wasn't set already, then this will
308 return the default path.");
310 ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
314 If C<autosync> is true, this enables autosync. Libguestfs will make a
315 best effort attempt to run C<guestfs_sync> when the handle is closed
316 (also if the program exits without closing handles).");
318 ("get_autosync", (RBool "autosync", []), -1, [],
322 Get the autosync flag.");
324 ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
328 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
330 Verbose messages are disabled unless the environment variable
331 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
333 ("get_verbose", (RBool "verbose", []), -1, [],
337 This returns the verbose messages flag.");
339 ("is_ready", (RBool "ready", []), -1, [],
341 "is ready to accept commands",
343 This returns true iff this handle is ready to accept commands
344 (in the C<READY> state).
346 For more information on states, see L<guestfs(3)>.");
348 ("is_config", (RBool "config", []), -1, [],
350 "is in configuration state",
352 This returns true iff this handle is being configured
353 (in the C<CONFIG> state).
355 For more information on states, see L<guestfs(3)>.");
357 ("is_launching", (RBool "launching", []), -1, [],
359 "is launching subprocess",
361 This returns true iff this handle is launching the subprocess
362 (in the C<LAUNCHING> state).
364 For more information on states, see L<guestfs(3)>.");
366 ("is_busy", (RBool "busy", []), -1, [],
368 "is busy processing a command",
370 This returns true iff this handle is busy processing a command
371 (in the C<BUSY> state).
373 For more information on states, see L<guestfs(3)>.");
375 ("get_state", (RInt "state", []), -1, [],
377 "get the current state",
379 This returns the current state as an opaque integer. This is
380 only useful for printing debug and internal error messages.
382 For more information on states, see L<guestfs(3)>.");
384 ("set_busy", (RErr, []), -1, [NotInFish],
388 This sets the state to C<BUSY>. This is only used when implementing
389 actions using the low-level API.
391 For more information on states, see L<guestfs(3)>.");
393 ("set_ready", (RErr, []), -1, [NotInFish],
395 "set state to ready",
397 This sets the state to C<READY>. This is only used when implementing
398 actions using the low-level API.
400 For more information on states, see L<guestfs(3)>.");
404 let daemon_functions = [
405 ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
406 [InitEmpty, TestOutput (
407 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
408 ["mkfs"; "ext2"; "/dev/sda1"];
409 ["mount"; "/dev/sda1"; "/"];
410 ["write_file"; "/new"; "new file contents"; "0"];
411 ["cat"; "/new"]], "new file contents")],
412 "mount a guest disk at a position in the filesystem",
414 Mount a guest disk at a position in the filesystem. Block devices
415 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
416 the guest. If those block devices contain partitions, they will have
417 the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
420 The rules are the same as for L<mount(2)>: A filesystem must
421 first be mounted on C</> before others can be mounted. Other
422 filesystems can only be mounted on directories which already
425 The mounted filesystem is writable, if we have sufficient permissions
426 on the underlying device.
428 The filesystem options C<sync> and C<noatime> are set with this
429 call, in order to improve reliability.");
431 ("sync", (RErr, []), 2, [],
432 [ InitEmpty, TestRun [["sync"]]],
433 "sync disks, writes are flushed through to the disk image",
435 This syncs the disk, so that any writes are flushed through to the
436 underlying disk image.
438 You should always call this if you have modified a disk image, before
439 closing the handle.");
441 ("touch", (RErr, [String "path"]), 3, [],
442 [InitBasicFS, TestOutputTrue (
444 ["exists"; "/new"]])],
445 "update file timestamps or create a new file",
447 Touch acts like the L<touch(1)> command. It can be used to
448 update the timestamps on a file, or, if the file does not exist,
449 to create a new zero-length file.");
451 ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
452 [InitBasicFS, TestOutput (
453 [["write_file"; "/new"; "new file contents"; "0"];
454 ["cat"; "/new"]], "new file contents")],
455 "list the contents of a file",
457 Return the contents of the file named C<path>.
459 Note that this function cannot correctly handle binary files
460 (specifically, files containing C<\\0> character which is treated
461 as end of string). For those you need to use the C<guestfs_download>
462 function which has a more complex interface.");
464 ("ll", (RString "listing", [String "directory"]), 5, [],
465 [], (* XXX Tricky to test because it depends on the exact format
466 * of the 'ls -l' command, which changes between F10 and F11.
468 "list the files in a directory (long format)",
470 List the files in C<directory> (relative to the root directory,
471 there is no cwd) in the format of 'ls -la'.
473 This command is mostly useful for interactive sessions. It
474 is I<not> intended that you try to parse the output string.");
476 ("ls", (RStringList "listing", [String "directory"]), 6, [],
477 [InitBasicFS, TestOutputList (
480 ["touch"; "/newest"];
481 ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
482 "list the files in a directory",
484 List the files in C<directory> (relative to the root directory,
485 there is no cwd). The '.' and '..' entries are not returned, but
486 hidden files are shown.
488 This command is mostly useful for interactive sessions. Programs
489 should probably use C<guestfs_readdir> instead.");
491 ("list_devices", (RStringList "devices", []), 7, [],
492 [InitEmpty, TestOutputList (
493 [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"])],
494 "list the block devices",
496 List all the block devices.
498 The full block device names are returned, eg. C</dev/sda>");
500 ("list_partitions", (RStringList "partitions", []), 8, [],
501 [InitBasicFS, TestOutputList (
502 [["list_partitions"]], ["/dev/sda1"]);
503 InitEmpty, TestOutputList (
504 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
505 ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
506 "list the partitions",
508 List all the partitions detected on all block devices.
510 The full partition device names are returned, eg. C</dev/sda1>
512 This does not return logical volumes. For that you will need to
513 call C<guestfs_lvs>.");
515 ("pvs", (RStringList "physvols", []), 9, [],
516 [InitBasicFSonLVM, TestOutputList (
517 [["pvs"]], ["/dev/sda1"]);
518 InitEmpty, TestOutputList (
519 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
520 ["pvcreate"; "/dev/sda1"];
521 ["pvcreate"; "/dev/sda2"];
522 ["pvcreate"; "/dev/sda3"];
523 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
524 "list the LVM physical volumes (PVs)",
526 List all the physical volumes detected. This is the equivalent
527 of the L<pvs(8)> command.
529 This returns a list of just the device names that contain
530 PVs (eg. C</dev/sda2>).
532 See also C<guestfs_pvs_full>.");
534 ("vgs", (RStringList "volgroups", []), 10, [],
535 [InitBasicFSonLVM, TestOutputList (
537 InitEmpty, TestOutputList (
538 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
539 ["pvcreate"; "/dev/sda1"];
540 ["pvcreate"; "/dev/sda2"];
541 ["pvcreate"; "/dev/sda3"];
542 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
543 ["vgcreate"; "VG2"; "/dev/sda3"];
544 ["vgs"]], ["VG1"; "VG2"])],
545 "list the LVM volume groups (VGs)",
547 List all the volumes groups detected. This is the equivalent
548 of the L<vgs(8)> command.
550 This returns a list of just the volume group names that were
551 detected (eg. C<VolGroup00>).
553 See also C<guestfs_vgs_full>.");
555 ("lvs", (RStringList "logvols", []), 11, [],
556 [InitBasicFSonLVM, TestOutputList (
557 [["lvs"]], ["/dev/VG/LV"]);
558 InitEmpty, TestOutputList (
559 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
560 ["pvcreate"; "/dev/sda1"];
561 ["pvcreate"; "/dev/sda2"];
562 ["pvcreate"; "/dev/sda3"];
563 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
564 ["vgcreate"; "VG2"; "/dev/sda3"];
565 ["lvcreate"; "LV1"; "VG1"; "50"];
566 ["lvcreate"; "LV2"; "VG1"; "50"];
567 ["lvcreate"; "LV3"; "VG2"; "50"];
568 ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
569 "list the LVM logical volumes (LVs)",
571 List all the logical volumes detected. This is the equivalent
572 of the L<lvs(8)> command.
574 This returns a list of the logical volume device names
575 (eg. C</dev/VolGroup00/LogVol00>).
577 See also C<guestfs_lvs_full>.");
579 ("pvs_full", (RPVList "physvols", []), 12, [],
580 [], (* XXX how to test? *)
581 "list the LVM physical volumes (PVs)",
583 List all the physical volumes detected. This is the equivalent
584 of the L<pvs(8)> command. The \"full\" version includes all fields.");
586 ("vgs_full", (RVGList "volgroups", []), 13, [],
587 [], (* XXX how to test? *)
588 "list the LVM volume groups (VGs)",
590 List all the volumes groups detected. This is the equivalent
591 of the L<vgs(8)> command. The \"full\" version includes all fields.");
593 ("lvs_full", (RLVList "logvols", []), 14, [],
594 [], (* XXX how to test? *)
595 "list the LVM logical volumes (LVs)",
597 List all the logical volumes detected. This is the equivalent
598 of the L<lvs(8)> command. The \"full\" version includes all fields.");
600 ("read_lines", (RStringList "lines", [String "path"]), 15, [],
601 [InitBasicFS, TestOutputList (
602 [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
603 ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);
604 InitBasicFS, TestOutputList (
605 [["write_file"; "/new"; ""; "0"];
606 ["read_lines"; "/new"]], [])],
607 "read file as lines",
609 Return the contents of the file named C<path>.
611 The file contents are returned as a list of lines. Trailing
612 C<LF> and C<CRLF> character sequences are I<not> returned.
614 Note that this function cannot correctly handle binary files
615 (specifically, files containing C<\\0> character which is treated
616 as end of line). For those you need to use the C<guestfs_read_file>
617 function which has a more complex interface.");
619 ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [],
620 [], (* XXX Augeas code needs tests. *)
621 "create a new Augeas handle",
623 Create a new Augeas handle for editing configuration files.
624 If there was any previous Augeas handle associated with this
625 guestfs session, then it is closed.
627 You must call this before using any other C<guestfs_aug_*>
630 C<root> is the filesystem root. C<root> must not be NULL,
633 The flags are the same as the flags defined in
634 E<lt>augeas.hE<gt>, the logical I<or> of the following
639 =item C<AUG_SAVE_BACKUP> = 1
641 Keep the original file with a C<.augsave> extension.
643 =item C<AUG_SAVE_NEWFILE> = 2
645 Save changes into a file with extension C<.augnew>, and
646 do not overwrite original. Overrides C<AUG_SAVE_BACKUP>.
648 =item C<AUG_TYPE_CHECK> = 4
650 Typecheck lenses (can be expensive).
652 =item C<AUG_NO_STDINC> = 8
654 Do not use standard load path for modules.
656 =item C<AUG_SAVE_NOOP> = 16
658 Make save a no-op, just record what would have been changed.
660 =item C<AUG_NO_LOAD> = 32
662 Do not load the tree in C<guestfs_aug_init>.
666 To close the handle, you can call C<guestfs_aug_close>.
668 To find out more about Augeas, see L<http://augeas.net/>.");
670 ("aug_close", (RErr, []), 26, [],
671 [], (* XXX Augeas code needs tests. *)
672 "close the current Augeas handle",
674 Close the current Augeas handle and free up any resources
675 used by it. After calling this, you have to call
676 C<guestfs_aug_init> again before you can use any other
679 ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
680 [], (* XXX Augeas code needs tests. *)
681 "define an Augeas variable",
683 Defines an Augeas variable C<name> whose value is the result
684 of evaluating C<expr>. If C<expr> is NULL, then C<name> is
687 On success this returns the number of nodes in C<expr>, or
688 C<0> if C<expr> evaluates to something which is not a nodeset.");
690 ("aug_defnode", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [],
691 [], (* XXX Augeas code needs tests. *)
692 "define an Augeas node",
694 Defines a variable C<name> whose value is the result of
697 If C<expr> evaluates to an empty nodeset, a node is created,
698 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
699 C<name> will be the nodeset containing that single node.
701 On success this returns a pair containing the
702 number of nodes in the nodeset, and a boolean flag
703 if a node was created.");
705 ("aug_get", (RString "val", [String "path"]), 19, [],
706 [], (* XXX Augeas code needs tests. *)
707 "look up the value of an Augeas path",
709 Look up the value associated with C<path>. If C<path>
710 matches exactly one node, the C<value> is returned.");
712 ("aug_set", (RErr, [String "path"; String "val"]), 20, [],
713 [], (* XXX Augeas code needs tests. *)
714 "set Augeas path to value",
716 Set the value associated with C<path> to C<value>.");
718 ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [],
719 [], (* XXX Augeas code needs tests. *)
720 "insert a sibling Augeas node",
722 Create a new sibling C<label> for C<path>, inserting it into
723 the tree before or after C<path> (depending on the boolean
726 C<path> must match exactly one existing node in the tree, and
727 C<label> must be a label, ie. not contain C</>, C<*> or end
728 with a bracketed index C<[N]>.");
730 ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
731 [], (* XXX Augeas code needs tests. *)
732 "remove an Augeas path",
734 Remove C<path> and all of its children.
736 On success this returns the number of entries which were removed.");
738 ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [],
739 [], (* XXX Augeas code needs tests. *)
742 Move the node C<src> to C<dest>. C<src> must match exactly
743 one node. C<dest> is overwritten if it exists.");
745 ("aug_match", (RStringList "matches", [String "path"]), 24, [],
746 [], (* XXX Augeas code needs tests. *)
747 "return Augeas nodes which match path",
749 Returns a list of paths which match the path expression C<path>.
750 The returned paths are sufficiently qualified so that they match
751 exactly one node in the current tree.");
753 ("aug_save", (RErr, []), 25, [],
754 [], (* XXX Augeas code needs tests. *)
755 "write all pending Augeas changes to disk",
757 This writes all pending changes to disk.
759 The flags which were passed to C<guestfs_aug_init> affect exactly
760 how files are saved.");
762 ("aug_load", (RErr, []), 27, [],
763 [], (* XXX Augeas code needs tests. *)
764 "load files into the tree",
766 Load files into the tree.
768 See C<aug_load> in the Augeas documentation for the full gory
771 ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
772 [], (* XXX Augeas code needs tests. *)
773 "list Augeas nodes under a path",
775 This is just a shortcut for listing C<guestfs_aug_match>
776 C<path/*> and sorting the resulting nodes into alphabetical order.");
778 ("rm", (RErr, [String "path"]), 29, [],
779 [InitBasicFS, TestRun
782 InitBasicFS, TestLastFail
784 InitBasicFS, TestLastFail
789 Remove the single file C<path>.");
791 ("rmdir", (RErr, [String "path"]), 30, [],
792 [InitBasicFS, TestRun
795 InitBasicFS, TestLastFail
797 InitBasicFS, TestLastFail
800 "remove a directory",
802 Remove the single directory C<path>.");
804 ("rm_rf", (RErr, [String "path"]), 31, [],
805 [InitBasicFS, TestOutputFalse
807 ["mkdir"; "/new/foo"];
808 ["touch"; "/new/foo/bar"];
810 ["exists"; "/new"]]],
811 "remove a file or directory recursively",
813 Remove the file or directory C<path>, recursively removing the
814 contents if its a directory. This is like the C<rm -rf> shell
817 ("mkdir", (RErr, [String "path"]), 32, [],
818 [InitBasicFS, TestOutputTrue
821 InitBasicFS, TestLastFail
822 [["mkdir"; "/new/foo/bar"]]],
823 "create a directory",
825 Create a directory named C<path>.");
827 ("mkdir_p", (RErr, [String "path"]), 33, [],
828 [InitBasicFS, TestOutputTrue
829 [["mkdir_p"; "/new/foo/bar"];
830 ["is_dir"; "/new/foo/bar"]];
831 InitBasicFS, TestOutputTrue
832 [["mkdir_p"; "/new/foo/bar"];
833 ["is_dir"; "/new/foo"]];
834 InitBasicFS, TestOutputTrue
835 [["mkdir_p"; "/new/foo/bar"];
836 ["is_dir"; "/new"]]],
837 "create a directory and parents",
839 Create a directory named C<path>, creating any parent directories
840 as necessary. This is like the C<mkdir -p> shell command.");
842 ("chmod", (RErr, [Int "mode"; String "path"]), 34, [],
843 [], (* XXX Need stat command to test *)
846 Change the mode (permissions) of C<path> to C<mode>. Only
847 numeric modes are supported.");
849 ("chown", (RErr, [Int "owner"; Int "group"; String "path"]), 35, [],
850 [], (* XXX Need stat command to test *)
851 "change file owner and group",
853 Change the file owner to C<owner> and group to C<group>.
855 Only numeric uid and gid are supported. If you want to use
856 names, you will need to locate and parse the password file
857 yourself (Augeas support makes this relatively easy).");
859 ("exists", (RBool "existsflag", [String "path"]), 36, [],
860 [InitBasicFS, TestOutputTrue (
862 ["exists"; "/new"]]);
863 InitBasicFS, TestOutputTrue (
865 ["exists"; "/new"]])],
866 "test if file or directory exists",
868 This returns C<true> if and only if there is a file, directory
869 (or anything) with the given C<path> name.
871 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
873 ("is_file", (RBool "fileflag", [String "path"]), 37, [],
874 [InitBasicFS, TestOutputTrue (
876 ["is_file"; "/new"]]);
877 InitBasicFS, TestOutputFalse (
879 ["is_file"; "/new"]])],
880 "test if file exists",
882 This returns C<true> if and only if there is a file
883 with the given C<path> name. Note that it returns false for
884 other objects like directories.
886 See also C<guestfs_stat>.");
888 ("is_dir", (RBool "dirflag", [String "path"]), 38, [],
889 [InitBasicFS, TestOutputFalse (
891 ["is_dir"; "/new"]]);
892 InitBasicFS, TestOutputTrue (
894 ["is_dir"; "/new"]])],
895 "test if file exists",
897 This returns C<true> if and only if there is a directory
898 with the given C<path> name. Note that it returns false for
899 other objects like files.
901 See also C<guestfs_stat>.");
903 ("pvcreate", (RErr, [String "device"]), 39, [],
904 [InitEmpty, TestOutputList (
905 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
906 ["pvcreate"; "/dev/sda1"];
907 ["pvcreate"; "/dev/sda2"];
908 ["pvcreate"; "/dev/sda3"];
909 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
910 "create an LVM physical volume",
912 This creates an LVM physical volume on the named C<device>,
913 where C<device> should usually be a partition name such
916 ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
917 [InitEmpty, TestOutputList (
918 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
919 ["pvcreate"; "/dev/sda1"];
920 ["pvcreate"; "/dev/sda2"];
921 ["pvcreate"; "/dev/sda3"];
922 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
923 ["vgcreate"; "VG2"; "/dev/sda3"];
924 ["vgs"]], ["VG1"; "VG2"])],
925 "create an LVM volume group",
927 This creates an LVM volume group called C<volgroup>
928 from the non-empty list of physical volumes C<physvols>.");
930 ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [],
931 [InitEmpty, TestOutputList (
932 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
933 ["pvcreate"; "/dev/sda1"];
934 ["pvcreate"; "/dev/sda2"];
935 ["pvcreate"; "/dev/sda3"];
936 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
937 ["vgcreate"; "VG2"; "/dev/sda3"];
938 ["lvcreate"; "LV1"; "VG1"; "50"];
939 ["lvcreate"; "LV2"; "VG1"; "50"];
940 ["lvcreate"; "LV3"; "VG2"; "50"];
941 ["lvcreate"; "LV4"; "VG2"; "50"];
942 ["lvcreate"; "LV5"; "VG2"; "50"];
944 ["/dev/VG1/LV1"; "/dev/VG1/LV2";
945 "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
946 "create an LVM volume group",
948 This creates an LVM volume group called C<logvol>
949 on the volume group C<volgroup>, with C<size> megabytes.");
951 ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [],
952 [InitEmpty, TestOutput (
953 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
954 ["mkfs"; "ext2"; "/dev/sda1"];
955 ["mount"; "/dev/sda1"; "/"];
956 ["write_file"; "/new"; "new file contents"; "0"];
957 ["cat"; "/new"]], "new file contents")],
960 This creates a filesystem on C<device> (usually a partition
961 of LVM logical volume). The filesystem type is C<fstype>, for
964 ("sfdisk", (RErr, [String "device";
965 Int "cyls"; Int "heads"; Int "sectors";
966 StringList "lines"]), 43, [DangerWillRobinson],
968 "create partitions on a block device",
970 This is a direct interface to the L<sfdisk(8)> program for creating
971 partitions on block devices.
973 C<device> should be a block device, for example C</dev/sda>.
975 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
976 and sectors on the device, which are passed directly to sfdisk as
977 the I<-C>, I<-H> and I<-S> parameters. If you pass C<0> for any
978 of these, then the corresponding parameter is omitted. Usually for
979 'large' disks, you can just pass C<0> for these, but for small
980 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
981 out the right geometry and you will need to tell it.
983 C<lines> is a list of lines that we feed to C<sfdisk>. For more
984 information refer to the L<sfdisk(8)> manpage.
986 To create a single partition occupying the whole disk, you would
987 pass C<lines> as a single element list, when the single element being
988 the string C<,> (comma).");
990 ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
991 [InitBasicFS, TestOutput (
992 [["write_file"; "/new"; "new file contents"; "0"];
993 ["cat"; "/new"]], "new file contents");
994 InitBasicFS, TestOutput (
995 [["write_file"; "/new"; "\nnew file contents\n"; "0"];
996 ["cat"; "/new"]], "\nnew file contents\n");
997 InitBasicFS, TestOutput (
998 [["write_file"; "/new"; "\n\n"; "0"];
999 ["cat"; "/new"]], "\n\n");
1000 InitBasicFS, TestOutput (
1001 [["write_file"; "/new"; ""; "0"];
1002 ["cat"; "/new"]], "");
1003 InitBasicFS, TestOutput (
1004 [["write_file"; "/new"; "\n\n\n"; "0"];
1005 ["cat"; "/new"]], "\n\n\n");
1006 InitBasicFS, TestOutput (
1007 [["write_file"; "/new"; "\n"; "0"];
1008 ["cat"; "/new"]], "\n")],
1011 This call creates a file called C<path>. The contents of the
1012 file is the string C<content> (which can contain any 8 bit data),
1013 with length C<size>.
1015 As a special case, if C<size> is C<0>
1016 then the length is calculated using C<strlen> (so in this case
1017 the content cannot contain embedded ASCII NULs).");
1019 ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
1020 [InitEmpty, TestOutputList (
1021 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1022 ["mkfs"; "ext2"; "/dev/sda1"];
1023 ["mount"; "/dev/sda1"; "/"];
1024 ["mounts"]], ["/dev/sda1"]);
1025 InitEmpty, TestOutputList (
1026 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1027 ["mkfs"; "ext2"; "/dev/sda1"];
1028 ["mount"; "/dev/sda1"; "/"];
1031 "unmount a filesystem",
1033 This unmounts the given filesystem. The filesystem may be
1034 specified either by its mountpoint (path) or the device which
1035 contains the filesystem.");
1037 ("mounts", (RStringList "devices", []), 46, [],
1038 [InitBasicFS, TestOutputList (
1039 [["mounts"]], ["/dev/sda1"])],
1040 "show mounted filesystems",
1042 This returns the list of currently mounted filesystems. It returns
1043 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
1045 Some internal mounts are not shown.");
1047 ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
1048 [InitBasicFS, TestOutputList (
1051 "unmount all filesystems",
1053 This unmounts all mounted filesystems.
1055 Some internal mounts are not unmounted by this call.");
1057 ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson],
1059 "remove all LVM LVs, VGs and PVs",
1061 This command removes all LVM logical volumes, volume groups
1062 and physical volumes.");
1064 ("file", (RString "description", [String "path"]), 49, [],
1065 [InitBasicFS, TestOutput (
1067 ["file"; "/new"]], "empty");
1068 InitBasicFS, TestOutput (
1069 [["write_file"; "/new"; "some content\n"; "0"];
1070 ["file"; "/new"]], "ASCII text");
1071 InitBasicFS, TestLastFail (
1072 [["file"; "/nofile"]])],
1073 "determine file type",
1075 This call uses the standard L<file(1)> command to determine
1076 the type or contents of the file. This also works on devices,
1077 for example to find out whether a partition contains a filesystem.
1079 The exact command which runs is C<file -bsL path>. Note in
1080 particular that the filename is not prepended to the output
1081 (the C<-b> option).");
1083 ("command", (RString "output", [StringList "arguments"]), 50, [],
1084 [], (* XXX how to test? *)
1085 "run a command from the guest filesystem",
1087 This call runs a command from the guest filesystem. The
1088 filesystem must be mounted, and must contain a compatible
1089 operating system (ie. something Linux, with the same
1090 or compatible processor architecture).
1092 The single parameter is an argv-style list of arguments.
1093 The first element is the name of the program to run.
1094 Subsequent elements are parameters. The list must be
1095 non-empty (ie. must contain a program name).
1097 The C<$PATH> environment variable will contain at least
1098 C</usr/bin> and C</bin>. If you require a program from
1099 another location, you should provide the full path in the
1102 Shared libraries and data files required by the program
1103 must be available on filesystems which are mounted in the
1104 correct places. It is the caller's responsibility to ensure
1105 all filesystems that are needed are mounted at the right
1108 ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [],
1109 [], (* XXX how to test? *)
1110 "run a command, returning lines",
1112 This is the same as C<guestfs_command>, but splits the
1113 result into a list of lines.");
1115 ("stat", (RStat "statbuf", [String "path"]), 52, [],
1116 [InitBasicFS, TestOutputStruct (
1118 ["stat"; "/new"]], [CompareWithInt ("size", 0)])],
1119 "get file information",
1121 Returns file information for the given C<path>.
1123 This is the same as the C<stat(2)> system call.");
1125 ("lstat", (RStat "statbuf", [String "path"]), 53, [],
1126 [InitBasicFS, TestOutputStruct (
1128 ["lstat"; "/new"]], [CompareWithInt ("size", 0)])],
1129 "get file information for a symbolic link",
1131 Returns file information for the given C<path>.
1133 This is the same as C<guestfs_stat> except that if C<path>
1134 is a symbolic link, then the link is stat-ed, not the file it
1137 This is the same as the C<lstat(2)> system call.");
1139 ("statvfs", (RStatVFS "statbuf", [String "path"]), 54, [],
1140 [InitBasicFS, TestOutputStruct (
1141 [["statvfs"; "/"]], [CompareWithInt ("bfree", 487702);
1142 CompareWithInt ("blocks", 490020);
1143 CompareWithInt ("bsize", 1024)])],
1144 "get file system statistics",
1146 Returns file system statistics for any mounted file system.
1147 C<path> should be a file or directory in the mounted file system
1148 (typically it is the mount point itself, but it doesn't need to be).
1150 This is the same as the C<statvfs(2)> system call.");
1152 ("tune2fs_l", (RHashtable "superblock", [String "device"]), 55, [],
1154 "get ext2/ext3 superblock details",
1156 This returns the contents of the ext2 or ext3 filesystem superblock
1159 It is the same as running C<tune2fs -l device>. See L<tune2fs(8)>
1160 manpage for more details. The list of fields returned isn't
1161 clearly defined, and depends on both the version of C<tune2fs>
1162 that libguestfs was built against, and the filesystem itself.");
1164 ("blockdev_setro", (RErr, [String "device"]), 56, [],
1165 [InitEmpty, TestOutputTrue (
1166 [["blockdev_setro"; "/dev/sda"];
1167 ["blockdev_getro"; "/dev/sda"]])],
1168 "set block device to read-only",
1170 Sets the block device named C<device> to read-only.
1172 This uses the L<blockdev(8)> command.");
1174 ("blockdev_setrw", (RErr, [String "device"]), 57, [],
1175 [InitEmpty, TestOutputFalse (
1176 [["blockdev_setrw"; "/dev/sda"];
1177 ["blockdev_getro"; "/dev/sda"]])],
1178 "set block device to read-write",
1180 Sets the block device named C<device> to read-write.
1182 This uses the L<blockdev(8)> command.");
1184 ("blockdev_getro", (RBool "ro", [String "device"]), 58, [],
1185 [InitEmpty, TestOutputTrue (
1186 [["blockdev_setro"; "/dev/sda"];
1187 ["blockdev_getro"; "/dev/sda"]])],
1188 "is block device set to read-only",
1190 Returns a boolean indicating if the block device is read-only
1191 (true if read-only, false if not).
1193 This uses the L<blockdev(8)> command.");
1195 ("blockdev_getss", (RInt "sectorsize", [String "device"]), 59, [],
1196 [InitEmpty, TestOutputInt (
1197 [["blockdev_getss"; "/dev/sda"]], 512)],
1198 "get sectorsize of block device",
1200 This returns the size of sectors on a block device.
1201 Usually 512, but can be larger for modern devices.
1203 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
1206 This uses the L<blockdev(8)> command.");
1208 ("blockdev_getbsz", (RInt "blocksize", [String "device"]), 60, [],
1209 [InitEmpty, TestOutputInt (
1210 [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1211 "get blocksize of block device",
1213 This returns the block size of a device.
1215 (Note this is different from both I<size in blocks> and
1216 I<filesystem block size>).
1218 This uses the L<blockdev(8)> command.");
1220 ("blockdev_setbsz", (RErr, [String "device"; Int "blocksize"]), 61, [],
1222 "set blocksize of block device",
1224 This sets the block size of a device.
1226 (Note this is different from both I<size in blocks> and
1227 I<filesystem block size>).
1229 This uses the L<blockdev(8)> command.");
1231 ("blockdev_getsz", (RInt64 "sizeinsectors", [String "device"]), 62, [],
1232 [InitEmpty, TestOutputInt (
1233 [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1234 "get total size of device in 512-byte sectors",
1236 This returns the size of the device in units of 512-byte sectors
1237 (even if the sectorsize isn't 512 bytes ... weird).
1239 See also C<guestfs_blockdev_getss> for the real sector size of
1240 the device, and C<guestfs_blockdev_getsize64> for the more
1241 useful I<size in bytes>.
1243 This uses the L<blockdev(8)> command.");
1245 ("blockdev_getsize64", (RInt64 "sizeinbytes", [String "device"]), 63, [],
1246 [InitEmpty, TestOutputInt (
1247 [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1248 "get total size of device in bytes",
1250 This returns the size of the device in bytes.
1252 See also C<guestfs_blockdev_getsz>.
1254 This uses the L<blockdev(8)> command.");
1256 ("blockdev_flushbufs", (RErr, [String "device"]), 64, [],
1258 [["blockdev_flushbufs"; "/dev/sda"]]],
1259 "flush device buffers",
1261 This tells the kernel to flush internal buffers associated
1264 This uses the L<blockdev(8)> command.");
1266 ("blockdev_rereadpt", (RErr, [String "device"]), 65, [],
1268 [["blockdev_rereadpt"; "/dev/sda"]]],
1269 "reread partition table",
1271 Reread the partition table on C<device>.
1273 This uses the L<blockdev(8)> command.");
1275 ("upload", (RErr, [FileIn "filename"; String "remotefilename"]), 66, [],
1277 "upload a file from the local machine",
1279 Upload local file C<filename> to C<remotefilename> on the
1282 C<filename> can also be a named pipe.
1284 See also C<guestfs_download>.");
1286 ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [],
1288 "download a file to the local machine",
1290 Download file C<remotefilename> and save it as C<filename>
1291 on the local machine.
1293 C<filename> can also be a named pipe.
1295 See also C<guestfs_upload>, C<guestfs_cat>.");
1297 ("checksum", (RString "checksum", [String "csumtype"; String "path"]), 68, [],
1298 [InitBasicFS, TestOutput (
1299 [["write_file"; "/new"; "test\n"; "0"];
1300 ["checksum"; "crc"; "/new"]], "935282863");
1301 InitBasicFS, TestLastFail (
1302 [["checksum"; "crc"; "/new"]]);
1303 InitBasicFS, TestOutput (
1304 [["write_file"; "/new"; "test\n"; "0"];
1305 ["checksum"; "md5"; "/new"]], "d8e8fca2dc0f896fd7cb4cb0031ba249");
1306 InitBasicFS, TestOutput (
1307 [["write_file"; "/new"; "test\n"; "0"];
1308 ["checksum"; "sha1"; "/new"]], "4e1243bd22c66e76c2ba9eddc1f91394e57f9f83");
1309 InitBasicFS, TestOutput (
1310 [["write_file"; "/new"; "test\n"; "0"];
1311 ["checksum"; "sha224"; "/new"]], "52f1bf093f4b7588726035c176c0cdb4376cfea53819f1395ac9e6ec");
1312 InitBasicFS, TestOutput (
1313 [["write_file"; "/new"; "test\n"; "0"];
1314 ["checksum"; "sha256"; "/new"]], "f2ca1bb6c7e907d06dafe4687e579fce76b37e4e93b7605022da52e6ccc26fd2");
1315 InitBasicFS, TestOutput (
1316 [["write_file"; "/new"; "test\n"; "0"];
1317 ["checksum"; "sha384"; "/new"]], "109bb6b5b6d5547c1ce03c7a8bd7d8f80c1cb0957f50c4f7fda04692079917e4f9cad52b878f3d8234e1a170b154b72d");
1318 InitBasicFS, TestOutput (
1319 [["write_file"; "/new"; "test\n"; "0"];
1320 ["checksum"; "sha512"; "/new"]], "0e3e75234abc68f4378a86b3f4b32a198ba301845b0cd6e50106e874345700cc6663a86c1ea125dc5e92be17c98f9a0f85ca9d5f595db2012f7cc3571945c123")],
1321 "compute MD5, SHAx or CRC checksum of file",
1323 This call computes the MD5, SHAx or CRC checksum of the
1326 The type of checksum to compute is given by the C<csumtype>
1327 parameter which must have one of the following values:
1333 Compute the cyclic redundancy check (CRC) specified by POSIX
1334 for the C<cksum> command.
1338 Compute the MD5 hash (using the C<md5sum> program).
1342 Compute the SHA1 hash (using the C<sha1sum> program).
1346 Compute the SHA224 hash (using the C<sha224sum> program).
1350 Compute the SHA256 hash (using the C<sha256sum> program).
1354 Compute the SHA384 hash (using the C<sha384sum> program).
1358 Compute the SHA512 hash (using the C<sha512sum> program).
1362 The checksum is returned as a printable string.");
1366 let all_functions = non_daemon_functions @ daemon_functions
1368 (* In some places we want the functions to be displayed sorted
1369 * alphabetically, so this is useful:
1371 let all_functions_sorted =
1372 List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
1373 compare n1 n2) all_functions
1375 (* Column names and types from LVM PVs/VGs/LVs. *)
1384 "pv_attr", `String (* XXX *);
1385 "pv_pe_count", `Int;
1386 "pv_pe_alloc_count", `Int;
1389 "pv_mda_count", `Int;
1390 "pv_mda_free", `Bytes;
1391 (* Not in Fedora 10:
1392 "pv_mda_size", `Bytes;
1399 "vg_attr", `String (* XXX *);
1402 "vg_sysid", `String;
1403 "vg_extent_size", `Bytes;
1404 "vg_extent_count", `Int;
1405 "vg_free_count", `Int;
1413 "vg_mda_count", `Int;
1414 "vg_mda_free", `Bytes;
1415 (* Not in Fedora 10:
1416 "vg_mda_size", `Bytes;
1422 "lv_attr", `String (* XXX *);
1425 "lv_kernel_major", `Int;
1426 "lv_kernel_minor", `Int;
1430 "snap_percent", `OptPercent;
1431 "copy_percent", `OptPercent;
1434 "mirror_log", `String;
1438 (* Column names and types from stat structures.
1439 * NB. Can't use things like 'st_atime' because glibc header files
1440 * define some of these as macros. Ugh.
1457 let statvfs_cols = [
1471 (* Useful functions.
1472 * Note we don't want to use any external OCaml libraries which
1473 * makes this a bit harder than it should be.
1475 let failwithf fs = ksprintf failwith fs
1477 let replace_char s c1 c2 =
1478 let s2 = String.copy s in
1479 let r = ref false in
1480 for i = 0 to String.length s2 - 1 do
1481 if String.unsafe_get s2 i = c1 then (
1482 String.unsafe_set s2 i c2;
1486 if not !r then s else s2
1490 (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
1492 let triml ?(test = isspace) str =
1494 let n = ref (String.length str) in
1495 while !n > 0 && test str.[!i]; do
1500 else String.sub str !i !n
1502 let trimr ?(test = isspace) str =
1503 let n = ref (String.length str) in
1504 while !n > 0 && test str.[!n-1]; do
1507 if !n = String.length str then str
1508 else String.sub str 0 !n
1510 let trim ?(test = isspace) str =
1511 trimr ~test (triml ~test str)
1513 let rec find s sub =
1514 let len = String.length s in
1515 let sublen = String.length sub in
1517 if i <= len-sublen then (
1519 if j < sublen then (
1520 if s.[i+j] = sub.[j] then loop2 (j+1)
1526 if r = -1 then loop (i+1) else r
1532 let rec replace_str s s1 s2 =
1533 let len = String.length s in
1534 let sublen = String.length s1 in
1535 let i = find s s1 in
1538 let s' = String.sub s 0 i in
1539 let s'' = String.sub s (i+sublen) (len-i-sublen) in
1540 s' ^ s2 ^ replace_str s'' s1 s2
1543 let rec string_split sep str =
1544 let len = String.length str in
1545 let seplen = String.length sep in
1546 let i = find str sep in
1547 if i = -1 then [str]
1549 let s' = String.sub str 0 i in
1550 let s'' = String.sub str (i+seplen) (len-i-seplen) in
1551 s' :: string_split sep s''
1554 let rec find_map f = function
1555 | [] -> raise Not_found
1559 | None -> find_map f xs
1562 let rec loop i = function
1564 | x :: xs -> f i x; loop (i+1) xs
1569 let rec loop i = function
1571 | x :: xs -> let r = f i x in r :: loop (i+1) xs
1575 let name_of_argt = function
1576 | String n | OptString n | StringList n | Bool n | Int n
1577 | FileIn n | FileOut n -> n
1579 let seq_of_test = function
1580 | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
1581 | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s
1582 | TestOutputLength (s, _) | TestOutputStruct (s, _)
1583 | TestLastFail s -> s
1585 (* Check function names etc. for consistency. *)
1586 let check_functions () =
1587 let contains_uppercase str =
1588 let len = String.length str in
1590 if i >= len then false
1593 if c >= 'A' && c <= 'Z' then true
1600 (* Check function names. *)
1602 fun (name, _, _, _, _, _, _) ->
1603 if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
1604 failwithf "function name %s does not need 'guestfs' prefix" name;
1605 if contains_uppercase name then
1606 failwithf "function name %s should not contain uppercase chars" name;
1607 if String.contains name '-' then
1608 failwithf "function name %s should not contain '-', use '_' instead."
1612 (* Check function parameter/return names. *)
1614 fun (name, style, _, _, _, _, _) ->
1615 let check_arg_ret_name n =
1616 if contains_uppercase n then
1617 failwithf "%s param/ret %s should not contain uppercase chars"
1619 if String.contains n '-' || String.contains n '_' then
1620 failwithf "%s param/ret %s should not contain '-' or '_'"
1623 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;
1624 if n = "argv" || n = "args" then
1625 failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" n
1628 (match fst style with
1630 | RInt n | RInt64 n | RBool n | RConstString n | RString n
1631 | RStringList n | RPVList n | RVGList n | RLVList n
1632 | RStat n | RStatVFS n
1634 check_arg_ret_name n
1636 check_arg_ret_name n;
1637 check_arg_ret_name m
1639 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
1642 (* Check short descriptions. *)
1644 fun (name, _, _, _, _, shortdesc, _) ->
1645 if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
1646 failwithf "short description of %s should begin with lowercase." name;
1647 let c = shortdesc.[String.length shortdesc-1] in
1648 if c = '\n' || c = '.' then
1649 failwithf "short description of %s should not end with . or \\n." name
1652 (* Check long dscriptions. *)
1654 fun (name, _, _, _, _, _, longdesc) ->
1655 if longdesc.[String.length longdesc-1] = '\n' then
1656 failwithf "long description of %s should not end with \\n." name
1659 (* Check proc_nrs. *)
1661 fun (name, _, proc_nr, _, _, _, _) ->
1662 if proc_nr <= 0 then
1663 failwithf "daemon function %s should have proc_nr > 0" name
1667 fun (name, _, proc_nr, _, _, _, _) ->
1668 if proc_nr <> -1 then
1669 failwithf "non-daemon function %s should have proc_nr -1" name
1670 ) non_daemon_functions;
1673 List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
1676 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
1677 let rec loop = function
1680 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
1682 | (name1,nr1) :: (name2,nr2) :: _ ->
1683 failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
1691 (* Ignore functions that have no tests. We generate a
1692 * warning when the user does 'make check' instead.
1694 | name, _, _, _, [], _, _ -> ()
1695 | name, _, _, _, tests, _, _ ->
1699 match seq_of_test test with
1701 failwithf "%s has a test containing an empty sequence" name
1702 | cmds -> List.map List.hd cmds
1704 let funcs = List.flatten funcs in
1706 let tested = List.mem name funcs in
1709 failwithf "function %s has tests but does not test itself" name
1712 (* 'pr' prints to the current output file. *)
1713 let chan = ref stdout
1714 let pr fs = ksprintf (output_string !chan) fs
1716 (* Generate a header block in a number of standard styles. *)
1717 type comment_style = CStyle | HashStyle | OCamlStyle
1718 type license = GPLv2 | LGPLv2
1720 let generate_header comment license =
1721 let c = match comment with
1722 | CStyle -> pr "/* "; " *"
1723 | HashStyle -> pr "# "; "#"
1724 | OCamlStyle -> pr "(* "; " *" in
1725 pr "libguestfs generated file\n";
1726 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
1727 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
1729 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
1733 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
1734 pr "%s it under the terms of the GNU General Public License as published by\n" c;
1735 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
1736 pr "%s (at your option) any later version.\n" c;
1738 pr "%s This program is distributed in the hope that it will be useful,\n" c;
1739 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1740 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
1741 pr "%s GNU General Public License for more details.\n" c;
1743 pr "%s You should have received a copy of the GNU General Public License along\n" c;
1744 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
1745 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
1748 pr "%s This library is free software; you can redistribute it and/or\n" c;
1749 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
1750 pr "%s License as published by the Free Software Foundation; either\n" c;
1751 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
1753 pr "%s This library is distributed in the hope that it will be useful,\n" c;
1754 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1755 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
1756 pr "%s Lesser General Public License for more details.\n" c;
1758 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
1759 pr "%s License along with this library; if not, write to the Free Software\n" c;
1760 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
1763 | CStyle -> pr " */\n"
1765 | OCamlStyle -> pr " *)\n"
1769 (* Start of main code generation functions below this line. *)
1771 (* Generate the pod documentation for the C API. *)
1772 let rec generate_actions_pod () =
1774 fun (shortname, style, _, flags, _, _, longdesc) ->
1775 let name = "guestfs_" ^ shortname in
1776 pr "=head2 %s\n\n" name;
1778 generate_prototype ~extern:false ~handle:"handle" name style;
1780 pr "%s\n\n" longdesc;
1781 (match fst style with
1783 pr "This function returns 0 on success or -1 on error.\n\n"
1785 pr "On error this function returns -1.\n\n"
1787 pr "On error this function returns -1.\n\n"
1789 pr "This function returns a C truth value on success or -1 on error.\n\n"
1791 pr "This function returns a string, or NULL on error.
1792 The string is owned by the guest handle and must I<not> be freed.\n\n"
1794 pr "This function returns a string, or NULL on error.
1795 I<The caller must free the returned string after use>.\n\n"
1797 pr "This function returns a NULL-terminated array of strings
1798 (like L<environ(3)>), or NULL if there was an error.
1799 I<The caller must free the strings and the array after use>.\n\n"
1801 pr "This function returns a C<struct guestfs_int_bool *>,
1802 or NULL if there was an error.
1803 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
1805 pr "This function returns a C<struct guestfs_lvm_pv_list *>
1806 (see E<lt>guestfs-structs.hE<gt>),
1807 or NULL if there was an error.
1808 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
1810 pr "This function returns a C<struct guestfs_lvm_vg_list *>
1811 (see E<lt>guestfs-structs.hE<gt>),
1812 or NULL if there was an error.
1813 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
1815 pr "This function returns a C<struct guestfs_lvm_lv_list *>
1816 (see E<lt>guestfs-structs.hE<gt>),
1817 or NULL if there was an error.
1818 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
1820 pr "This function returns a C<struct guestfs_stat *>
1821 (see L<stat(2)> and E<lt>guestfs-structs.hE<gt>),
1822 or NULL if there was an error.
1823 I<The caller must call C<free> after use>.\n\n"
1825 pr "This function returns a C<struct guestfs_statvfs *>
1826 (see L<statvfs(2)> and E<lt>guestfs-structs.hE<gt>),
1827 or NULL if there was an error.
1828 I<The caller must call C<free> after use>.\n\n"
1830 pr "This function returns a NULL-terminated array of
1831 strings, or NULL if there was an error.
1832 The array of strings will always have length C<2n+1>, where
1833 C<n> keys and values alternate, followed by the trailing NULL entry.
1834 I<The caller must free the strings and the array after use>.\n\n"
1836 if List.mem ProtocolLimitWarning flags then
1837 pr "%s\n\n" protocol_limit_warning;
1838 if List.mem DangerWillRobinson flags then
1839 pr "%s\n\n" danger_will_robinson;
1840 ) all_functions_sorted
1842 and generate_structs_pod () =
1843 (* LVM structs documentation. *)
1846 pr "=head2 guestfs_lvm_%s\n" typ;
1848 pr " struct guestfs_lvm_%s {\n" typ;
1851 | name, `String -> pr " char *%s;\n" name
1853 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
1854 pr " char %s[32];\n" name
1855 | name, `Bytes -> pr " uint64_t %s;\n" name
1856 | name, `Int -> pr " int64_t %s;\n" name
1857 | name, `OptPercent ->
1858 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
1859 pr " float %s;\n" name
1862 pr " struct guestfs_lvm_%s_list {\n" typ;
1863 pr " uint32_t len; /* Number of elements in list. */\n";
1864 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
1867 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
1870 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1872 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
1873 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
1875 * We have to use an underscore instead of a dash because otherwise
1876 * rpcgen generates incorrect code.
1878 * This header is NOT exported to clients, but see also generate_structs_h.
1880 and generate_xdr () =
1881 generate_header CStyle LGPLv2;
1883 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
1884 pr "typedef string str<>;\n";
1887 (* LVM internal structures. *)
1891 pr "struct guestfs_lvm_int_%s {\n" typ;
1893 | name, `String -> pr " string %s<>;\n" name
1894 | name, `UUID -> pr " opaque %s[32];\n" name
1895 | name, `Bytes -> pr " hyper %s;\n" name
1896 | name, `Int -> pr " hyper %s;\n" name
1897 | name, `OptPercent -> pr " float %s;\n" name
1901 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
1903 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1905 (* Stat internal structures. *)
1909 pr "struct guestfs_int_%s {\n" typ;
1911 | name, `Int -> pr " hyper %s;\n" name
1915 ) ["stat", stat_cols; "statvfs", statvfs_cols];
1918 fun (shortname, style, _, _, _, _, _) ->
1919 let name = "guestfs_" ^ shortname in
1921 (match snd style with
1924 pr "struct %s_args {\n" name;
1927 | String n -> pr " string %s<>;\n" n
1928 | OptString n -> pr " str *%s;\n" n
1929 | StringList n -> pr " str %s<>;\n" n
1930 | Bool n -> pr " bool %s;\n" n
1931 | Int n -> pr " int %s;\n" n
1932 | FileIn _ | FileOut _ -> ()
1936 (match fst style with
1939 pr "struct %s_ret {\n" name;
1943 pr "struct %s_ret {\n" name;
1944 pr " hyper %s;\n" n;
1947 pr "struct %s_ret {\n" name;
1951 failwithf "RConstString cannot be returned from a daemon function"
1953 pr "struct %s_ret {\n" name;
1954 pr " string %s<>;\n" n;
1957 pr "struct %s_ret {\n" name;
1958 pr " str %s<>;\n" n;
1961 pr "struct %s_ret {\n" name;
1966 pr "struct %s_ret {\n" name;
1967 pr " guestfs_lvm_int_pv_list %s;\n" n;
1970 pr "struct %s_ret {\n" name;
1971 pr " guestfs_lvm_int_vg_list %s;\n" n;
1974 pr "struct %s_ret {\n" name;
1975 pr " guestfs_lvm_int_lv_list %s;\n" n;
1978 pr "struct %s_ret {\n" name;
1979 pr " guestfs_int_stat %s;\n" n;
1982 pr "struct %s_ret {\n" name;
1983 pr " guestfs_int_statvfs %s;\n" n;
1986 pr "struct %s_ret {\n" name;
1987 pr " str %s<>;\n" n;
1992 (* Table of procedure numbers. *)
1993 pr "enum guestfs_procedure {\n";
1995 fun (shortname, _, proc_nr, _, _, _, _) ->
1996 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
1998 pr " GUESTFS_PROC_NR_PROCS\n";
2002 (* Having to choose a maximum message size is annoying for several
2003 * reasons (it limits what we can do in the API), but it (a) makes
2004 * the protocol a lot simpler, and (b) provides a bound on the size
2005 * of the daemon which operates in limited memory space. For large
2006 * file transfers you should use FTP.
2008 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
2011 (* Message header, etc. *)
2013 /* The communication protocol is now documented in the guestfs(3)
2017 const GUESTFS_PROGRAM = 0x2000F5F5;
2018 const GUESTFS_PROTOCOL_VERSION = 1;
2020 /* These constants must be larger than any possible message length. */
2021 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
2022 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
2024 enum guestfs_message_direction {
2025 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
2026 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
2029 enum guestfs_message_status {
2030 GUESTFS_STATUS_OK = 0,
2031 GUESTFS_STATUS_ERROR = 1
2034 const GUESTFS_ERROR_LEN = 256;
2036 struct guestfs_message_error {
2037 string error_message<GUESTFS_ERROR_LEN>;
2040 struct guestfs_message_header {
2041 unsigned prog; /* GUESTFS_PROGRAM */
2042 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
2043 guestfs_procedure proc; /* GUESTFS_PROC_x */
2044 guestfs_message_direction direction;
2045 unsigned serial; /* message serial number */
2046 guestfs_message_status status;
2049 const GUESTFS_MAX_CHUNK_SIZE = 8192;
2051 struct guestfs_chunk {
2052 int cancel; /* if non-zero, transfer is cancelled */
2053 /* data size is 0 bytes if the transfer has finished successfully */
2054 opaque data<GUESTFS_MAX_CHUNK_SIZE>;
2058 (* Generate the guestfs-structs.h file. *)
2059 and generate_structs_h () =
2060 generate_header CStyle LGPLv2;
2062 (* This is a public exported header file containing various
2063 * structures. The structures are carefully written to have
2064 * exactly the same in-memory format as the XDR structures that
2065 * we use on the wire to the daemon. The reason for creating
2066 * copies of these structures here is just so we don't have to
2067 * export the whole of guestfs_protocol.h (which includes much
2068 * unrelated and XDR-dependent stuff that we don't want to be
2069 * public, or required by clients).
2071 * To reiterate, we will pass these structures to and from the
2072 * client with a simple assignment or memcpy, so the format
2073 * must be identical to what rpcgen / the RFC defines.
2076 (* guestfs_int_bool structure. *)
2077 pr "struct guestfs_int_bool {\n";
2083 (* LVM public structures. *)
2087 pr "struct guestfs_lvm_%s {\n" typ;
2090 | name, `String -> pr " char *%s;\n" name
2091 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
2092 | name, `Bytes -> pr " uint64_t %s;\n" name
2093 | name, `Int -> pr " int64_t %s;\n" name
2094 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
2098 pr "struct guestfs_lvm_%s_list {\n" typ;
2099 pr " uint32_t len;\n";
2100 pr " struct guestfs_lvm_%s *val;\n" typ;
2103 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2105 (* Stat structures. *)
2109 pr "struct guestfs_%s {\n" typ;
2112 | name, `Int -> pr " int64_t %s;\n" name
2116 ) ["stat", stat_cols; "statvfs", statvfs_cols]
2118 (* Generate the guestfs-actions.h file. *)
2119 and generate_actions_h () =
2120 generate_header CStyle LGPLv2;
2122 fun (shortname, style, _, _, _, _, _) ->
2123 let name = "guestfs_" ^ shortname in
2124 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
2128 (* Generate the client-side dispatch stubs. *)
2129 and generate_client_actions () =
2130 generate_header CStyle LGPLv2;
2136 #include \"guestfs.h\"
2137 #include \"guestfs_protocol.h\"
2139 #define error guestfs_error
2140 #define perrorf guestfs_perrorf
2141 #define safe_malloc guestfs_safe_malloc
2142 #define safe_realloc guestfs_safe_realloc
2143 #define safe_strdup guestfs_safe_strdup
2144 #define safe_memdup guestfs_safe_memdup
2146 /* Check the return message from a call for validity. */
2148 check_reply_header (guestfs_h *g,
2149 const struct guestfs_message_header *hdr,
2150 int proc_nr, int serial)
2152 if (hdr->prog != GUESTFS_PROGRAM) {
2153 error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
2156 if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
2157 error (g, \"wrong protocol version (%%d/%%d)\",
2158 hdr->vers, GUESTFS_PROTOCOL_VERSION);
2161 if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
2162 error (g, \"unexpected message direction (%%d/%%d)\",
2163 hdr->direction, GUESTFS_DIRECTION_REPLY);
2166 if (hdr->proc != proc_nr) {
2167 error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
2170 if (hdr->serial != serial) {
2171 error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
2178 /* Check we are in the right state to run a high-level action. */
2180 check_state (guestfs_h *g, const char *caller)
2182 if (!guestfs_is_ready (g)) {
2183 if (guestfs_is_config (g))
2184 error (g, \"%%s: call launch() before using this function\",
2186 else if (guestfs_is_launching (g))
2187 error (g, \"%%s: call wait_ready() before using this function\",
2190 error (g, \"%%s called from the wrong state, %%d != READY\",
2191 caller, guestfs_get_state (g));
2199 (* Client-side stubs for each function. *)
2201 fun (shortname, style, _, _, _, _, _) ->
2202 let name = "guestfs_" ^ shortname in
2204 (* Generate the context struct which stores the high-level
2205 * state between callback functions.
2207 pr "struct %s_ctx {\n" shortname;
2208 pr " /* This flag is set by the callbacks, so we know we've done\n";
2209 pr " * the callbacks as expected, and in the right sequence.\n";
2210 pr " * 0 = not called, 1 = send called,\n";
2211 pr " * 1001 = reply called.\n";
2213 pr " int cb_sequence;\n";
2214 pr " struct guestfs_message_header hdr;\n";
2215 pr " struct guestfs_message_error err;\n";
2216 (match fst style with
2219 failwithf "RConstString cannot be returned from a daemon function"
2221 | RBool _ | RString _ | RStringList _
2223 | RPVList _ | RVGList _ | RLVList _
2224 | RStat _ | RStatVFS _
2226 pr " struct %s_ret ret;\n" name
2231 (* Generate the reply callback function. *)
2232 pr "static void %s_reply_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
2234 pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
2235 pr " struct %s_ctx *ctx = (struct %s_ctx *) data;\n" shortname shortname;
2237 pr " ml->main_loop_quit (ml, g);\n";
2239 pr " if (!xdr_guestfs_message_header (xdr, &ctx->hdr)) {\n";
2240 pr " error (g, \"%%s: failed to parse reply header\", \"%s\");\n" name;
2243 pr " if (ctx->hdr.status == GUESTFS_STATUS_ERROR) {\n";
2244 pr " if (!xdr_guestfs_message_error (xdr, &ctx->err)) {\n";
2245 pr " error (g, \"%%s: failed to parse reply error\", \"%s\");\n"
2252 (match fst style with
2255 failwithf "RConstString cannot be returned from a daemon function"
2257 | RBool _ | RString _ | RStringList _
2259 | RPVList _ | RVGList _ | RLVList _
2260 | RStat _ | RStatVFS _
2262 pr " if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name;
2263 pr " error (g, \"%%s: failed to parse reply\", \"%s\");\n" name;
2269 pr " ctx->cb_sequence = 1001;\n";
2272 (* Generate the action stub. *)
2273 generate_prototype ~extern:false ~semicolon:false ~newline:true
2274 ~handle:"g" name style;
2277 match fst style with
2278 | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
2280 failwithf "RConstString cannot be returned from a daemon function"
2281 | RString _ | RStringList _ | RIntBool _
2282 | RPVList _ | RVGList _ | RLVList _
2283 | RStat _ | RStatVFS _
2289 (match snd style with
2291 | _ -> pr " struct %s_args args;\n" name
2294 pr " struct %s_ctx ctx;\n" shortname;
2295 pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
2296 pr " int serial;\n";
2298 pr " if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
2299 pr " guestfs_set_busy (g);\n";
2301 pr " memset (&ctx, 0, sizeof ctx);\n";
2304 (* Send the main header and arguments. *)
2305 (match snd style with
2307 pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s, NULL, NULL);\n"
2308 (String.uppercase shortname)
2313 pr " args.%s = (char *) %s;\n" n n
2315 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
2317 pr " args.%s.%s_val = (char **) %s;\n" n n n;
2318 pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
2320 pr " args.%s = %s;\n" n n
2322 pr " args.%s = %s;\n" n n
2323 | FileIn _ | FileOut _ -> ()
2325 pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s,\n"
2326 (String.uppercase shortname);
2327 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
2330 pr " if (serial == -1) {\n";
2331 pr " guestfs_set_ready (g);\n";
2332 pr " return %s;\n" error_code;
2336 (* Send any additional files (FileIn) requested. *)
2337 let need_read_reply_label = ref false in
2344 pr " r = guestfs__send_file_sync (g, %s);\n" n;
2345 pr " if (r == -1) {\n";
2346 pr " guestfs_set_ready (g);\n";
2347 pr " return %s;\n" error_code;
2349 pr " if (r == -2) /* daemon cancelled */\n";
2350 pr " goto read_reply;\n";
2351 need_read_reply_label := true;
2357 (* Wait for the reply from the remote end. *)
2358 if !need_read_reply_label then pr " read_reply:\n";
2359 pr " guestfs__switch_to_receiving (g);\n";
2360 pr " ctx.cb_sequence = 0;\n";
2361 pr " guestfs_set_reply_callback (g, %s_reply_cb, &ctx);\n" shortname;
2362 pr " (void) ml->main_loop_run (ml, g);\n";
2363 pr " guestfs_set_reply_callback (g, NULL, NULL);\n";
2364 pr " if (ctx.cb_sequence != 1001) {\n";
2365 pr " error (g, \"%%s reply failed, see earlier error messages\", \"%s\");\n" name;
2366 pr " guestfs_set_ready (g);\n";
2367 pr " return %s;\n" error_code;
2371 pr " if (check_reply_header (g, &ctx.hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
2372 (String.uppercase shortname);
2373 pr " guestfs_set_ready (g);\n";
2374 pr " return %s;\n" error_code;
2378 pr " if (ctx.hdr.status == GUESTFS_STATUS_ERROR) {\n";
2379 pr " error (g, \"%%s\", ctx.err.error_message);\n";
2380 pr " guestfs_set_ready (g);\n";
2381 pr " return %s;\n" error_code;
2385 (* Expecting to receive further files (FileOut)? *)
2389 pr " if (guestfs__receive_file_sync (g, %s) == -1) {\n" n;
2390 pr " guestfs_set_ready (g);\n";
2391 pr " return %s;\n" error_code;
2397 pr " guestfs_set_ready (g);\n";
2399 (match fst style with
2400 | RErr -> pr " return 0;\n"
2401 | RInt n | RInt64 n | RBool n ->
2402 pr " return ctx.ret.%s;\n" n
2404 failwithf "RConstString cannot be returned from a daemon function"
2406 pr " return ctx.ret.%s; /* caller will free */\n" n
2407 | RStringList n | RHashtable n ->
2408 pr " /* caller will free this, but we need to add a NULL entry */\n";
2409 pr " ctx.ret.%s.%s_val =\n" n n;
2410 pr " safe_realloc (g, ctx.ret.%s.%s_val,\n" n n;
2411 pr " sizeof (char *) * (ctx.ret.%s.%s_len + 1));\n"
2413 pr " ctx.ret.%s.%s_val[ctx.ret.%s.%s_len] = NULL;\n" n n n n;
2414 pr " return ctx.ret.%s.%s_val;\n" n n
2416 pr " /* caller with free this */\n";
2417 pr " return safe_memdup (g, &ctx.ret, sizeof (ctx.ret));\n"
2418 | RPVList n | RVGList n | RLVList n
2419 | RStat n | RStatVFS n ->
2420 pr " /* caller will free this */\n";
2421 pr " return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n
2427 (* Generate daemon/actions.h. *)
2428 and generate_daemon_actions_h () =
2429 generate_header CStyle GPLv2;
2431 pr "#include \"../src/guestfs_protocol.h\"\n";
2435 fun (name, style, _, _, _, _, _) ->
2437 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
2441 (* Generate the server-side stubs. *)
2442 and generate_daemon_actions () =
2443 generate_header CStyle GPLv2;
2445 pr "#define _GNU_SOURCE // for strchrnul\n";
2447 pr "#include <stdio.h>\n";
2448 pr "#include <stdlib.h>\n";
2449 pr "#include <string.h>\n";
2450 pr "#include <inttypes.h>\n";
2451 pr "#include <ctype.h>\n";
2452 pr "#include <rpc/types.h>\n";
2453 pr "#include <rpc/xdr.h>\n";
2455 pr "#include \"daemon.h\"\n";
2456 pr "#include \"../src/guestfs_protocol.h\"\n";
2457 pr "#include \"actions.h\"\n";
2461 fun (name, style, _, _, _, _, _) ->
2462 (* Generate server-side stubs. *)
2463 pr "static void %s_stub (XDR *xdr_in)\n" name;
2466 match fst style with
2467 | RErr | RInt _ -> pr " int r;\n"; "-1"
2468 | RInt64 _ -> pr " int64_t r;\n"; "-1"
2469 | RBool _ -> pr " int r;\n"; "-1"
2471 failwithf "RConstString cannot be returned from a daemon function"
2472 | RString _ -> pr " char *r;\n"; "NULL"
2473 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
2474 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
2475 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
2476 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
2477 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL"
2478 | RStat _ -> pr " guestfs_int_stat *r;\n"; "NULL"
2479 | RStatVFS _ -> pr " guestfs_int_statvfs *r;\n"; "NULL" in
2481 (match snd style with
2484 pr " struct guestfs_%s_args args;\n" name;
2488 | OptString n -> pr " const char *%s;\n" n
2489 | StringList n -> pr " char **%s;\n" n
2490 | Bool n -> pr " int %s;\n" n
2491 | Int n -> pr " int %s;\n" n
2492 | FileIn _ | FileOut _ -> ()
2497 (match snd style with
2500 pr " memset (&args, 0, sizeof args);\n";
2502 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
2503 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
2508 | String n -> pr " %s = args.%s;\n" n n
2509 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
2511 pr " args.%s.%s_val = realloc (args.%s.%s_val, sizeof (char *) * (args.%s.%s_len+1));\n" n n n n n n;
2512 pr " args.%s.%s_val[args.%s.%s_len] = NULL;\n" n n n n;
2513 pr " %s = args.%s.%s_val;\n" n n n
2514 | Bool n -> pr " %s = args.%s;\n" n n
2515 | Int n -> pr " %s = args.%s;\n" n n
2516 | FileIn _ | FileOut _ -> ()
2521 (* Don't want to call the impl with any FileIn or FileOut
2522 * parameters, since these go "outside" the RPC protocol.
2525 List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
2527 pr " r = do_%s " name;
2528 generate_call_args argsnofile;
2531 pr " if (r == %s)\n" error_code;
2532 pr " /* do_%s has already called reply_with_error */\n" name;
2536 (* If there are any FileOut parameters, then the impl must
2537 * send its own reply.
2540 List.exists (function FileOut _ -> true | _ -> false) (snd style) in
2542 pr " /* do_%s has already sent a reply */\n" name
2544 match fst style with
2545 | RErr -> pr " reply (NULL, NULL);\n"
2546 | RInt n | RInt64 n | RBool n ->
2547 pr " struct guestfs_%s_ret ret;\n" name;
2548 pr " ret.%s = r;\n" n;
2549 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2552 failwithf "RConstString cannot be returned from a daemon function"
2554 pr " struct guestfs_%s_ret ret;\n" name;
2555 pr " ret.%s = r;\n" n;
2556 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2559 | RStringList n | RHashtable n ->
2560 pr " struct guestfs_%s_ret ret;\n" name;
2561 pr " ret.%s.%s_len = count_strings (r);\n" n n;
2562 pr " ret.%s.%s_val = r;\n" n n;
2563 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2565 pr " free_strings (r);\n"
2567 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n"
2569 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
2570 | RPVList n | RVGList n | RLVList n
2571 | RStat n | RStatVFS n ->
2572 pr " struct guestfs_%s_ret ret;\n" name;
2573 pr " ret.%s = *r;\n" n;
2574 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
2576 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
2580 (* Free the args. *)
2581 (match snd style with
2586 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
2593 (* Dispatch function. *)
2594 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
2596 pr " switch (proc_nr) {\n";
2599 fun (name, style, _, _, _, _, _) ->
2600 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
2601 pr " %s_stub (xdr_in);\n" name;
2606 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
2611 (* LVM columns and tokenization functions. *)
2612 (* XXX This generates crap code. We should rethink how we
2618 pr "static const char *lvm_%s_cols = \"%s\";\n"
2619 typ (String.concat "," (List.map fst cols));
2622 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
2624 pr " char *tok, *p, *next;\n";
2628 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
2631 pr " if (!str) {\n";
2632 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
2635 pr " if (!*str || isspace (*str)) {\n";
2636 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
2641 fun (name, coltype) ->
2642 pr " if (!tok) {\n";
2643 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
2646 pr " p = strchrnul (tok, ',');\n";
2647 pr " if (*p) next = p+1; else next = NULL;\n";
2648 pr " *p = '\\0';\n";
2651 pr " r->%s = strdup (tok);\n" name;
2652 pr " if (r->%s == NULL) {\n" name;
2653 pr " perror (\"strdup\");\n";
2657 pr " for (i = j = 0; i < 32; ++j) {\n";
2658 pr " if (tok[j] == '\\0') {\n";
2659 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
2661 pr " } else if (tok[j] != '-')\n";
2662 pr " r->%s[i++] = tok[j];\n" name;
2665 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
2666 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2670 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
2671 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2675 pr " if (tok[0] == '\\0')\n";
2676 pr " r->%s = -1;\n" name;
2677 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
2678 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2682 pr " tok = next;\n";
2685 pr " if (tok != NULL) {\n";
2686 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
2693 pr "guestfs_lvm_int_%s_list *\n" typ;
2694 pr "parse_command_line_%ss (void)\n" typ;
2696 pr " char *out, *err;\n";
2697 pr " char *p, *pend;\n";
2699 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
2700 pr " void *newp;\n";
2702 pr " ret = malloc (sizeof *ret);\n";
2703 pr " if (!ret) {\n";
2704 pr " reply_with_perror (\"malloc\");\n";
2705 pr " return NULL;\n";
2708 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
2709 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
2711 pr " r = command (&out, &err,\n";
2712 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
2713 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
2714 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
2715 pr " if (r == -1) {\n";
2716 pr " reply_with_error (\"%%s\", err);\n";
2717 pr " free (out);\n";
2718 pr " free (err);\n";
2719 pr " free (ret);\n";
2720 pr " return NULL;\n";
2723 pr " free (err);\n";
2725 pr " /* Tokenize each line of the output. */\n";
2728 pr " while (p) {\n";
2729 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
2730 pr " if (pend) {\n";
2731 pr " *pend = '\\0';\n";
2735 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
2738 pr " if (!*p) { /* Empty line? Skip it. */\n";
2743 pr " /* Allocate some space to store this next entry. */\n";
2744 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
2745 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
2746 pr " if (newp == NULL) {\n";
2747 pr " reply_with_perror (\"realloc\");\n";
2748 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2749 pr " free (ret);\n";
2750 pr " free (out);\n";
2751 pr " return NULL;\n";
2753 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
2755 pr " /* Tokenize the next entry. */\n";
2756 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
2757 pr " if (r == -1) {\n";
2758 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
2759 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2760 pr " free (ret);\n";
2761 pr " free (out);\n";
2762 pr " return NULL;\n";
2769 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
2771 pr " free (out);\n";
2772 pr " return ret;\n";
2775 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2777 (* Generate the tests. *)
2778 and generate_tests () =
2779 generate_header CStyle GPLv2;
2786 #include <sys/types.h>
2789 #include \"guestfs.h\"
2791 static guestfs_h *g;
2792 static int suppress_error = 0;
2794 static void print_error (guestfs_h *g, void *data, const char *msg)
2796 if (!suppress_error)
2797 fprintf (stderr, \"%%s\\n\", msg);
2800 static void print_strings (char * const * const argv)
2804 for (argc = 0; argv[argc] != NULL; ++argc)
2805 printf (\"\\t%%s\\n\", argv[argc]);
2809 static void print_table (char * const * const argv)
2813 for (i = 0; argv[i] != NULL; i += 2)
2814 printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
2818 static void no_test_warnings (void)
2824 | name, _, _, _, [], _, _ ->
2825 pr " fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
2826 | name, _, _, _, tests, _, _ -> ()
2832 (* Generate the actual tests. Note that we generate the tests
2833 * in reverse order, deliberately, so that (in general) the
2834 * newest tests run first. This makes it quicker and easier to
2839 fun (name, _, _, _, tests, _, _) ->
2840 mapi (generate_one_test name) tests
2841 ) (List.rev all_functions) in
2842 let test_names = List.concat test_names in
2843 let nr_tests = List.length test_names in
2846 int main (int argc, char *argv[])
2853 int nr_tests, test_num = 0;
2855 no_test_warnings ();
2857 g = guestfs_create ();
2859 printf (\"guestfs_create FAILED\\n\");
2863 guestfs_set_error_handler (g, print_error, NULL);
2865 srcdir = getenv (\"srcdir\");
2866 if (!srcdir) srcdir = \".\";
2867 guestfs_set_path (g, srcdir);
2869 snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);
2870 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2875 if (lseek (fd, %d, SEEK_SET) == -1) {
2881 if (write (fd, &c, 1) == -1) {
2887 if (close (fd) == -1) {
2892 if (guestfs_add_drive (g, buf) == -1) {
2893 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2897 snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);
2898 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2903 if (lseek (fd, %d, SEEK_SET) == -1) {
2909 if (write (fd, &c, 1) == -1) {
2915 if (close (fd) == -1) {
2920 if (guestfs_add_drive (g, buf) == -1) {
2921 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2925 snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);
2926 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2931 if (lseek (fd, %d, SEEK_SET) == -1) {
2937 if (write (fd, &c, 1) == -1) {
2943 if (close (fd) == -1) {
2948 if (guestfs_add_drive (g, buf) == -1) {
2949 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2953 if (guestfs_launch (g) == -1) {
2954 printf (\"guestfs_launch FAILED\\n\");
2957 if (guestfs_wait_ready (g) == -1) {
2958 printf (\"guestfs_wait_ready FAILED\\n\");
2964 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
2968 pr " test_num++;\n";
2969 pr " printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
2970 pr " if (%s () == -1) {\n" test_name;
2971 pr " printf (\"%s FAILED\\n\");\n" test_name;
2977 pr " guestfs_close (g);\n";
2978 pr " snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);\n";
2979 pr " unlink (buf);\n";
2980 pr " snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);\n";
2981 pr " unlink (buf);\n";
2982 pr " snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);\n";
2983 pr " unlink (buf);\n";
2986 pr " if (failed > 0) {\n";
2987 pr " printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n";
2995 and generate_one_test name i (init, test) =
2996 let test_name = sprintf "test_%s_%d" name i in
2998 pr "static int %s (void)\n" test_name;
3004 pr " /* InitEmpty for %s (%d) */\n" name i;
3005 List.iter (generate_test_command_call test_name)
3009 pr " /* InitBasicFS for %s (%d): create ext2 on /dev/sda1 */\n" name i;
3010 List.iter (generate_test_command_call test_name)
3013 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
3014 ["mkfs"; "ext2"; "/dev/sda1"];
3015 ["mount"; "/dev/sda1"; "/"]]
3016 | InitBasicFSonLVM ->
3017 pr " /* InitBasicFSonLVM for %s (%d): create ext2 on /dev/VG/LV */\n"
3019 List.iter (generate_test_command_call test_name)
3022 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
3023 ["pvcreate"; "/dev/sda1"];
3024 ["vgcreate"; "VG"; "/dev/sda1"];
3025 ["lvcreate"; "LV"; "VG"; "8"];
3026 ["mkfs"; "ext2"; "/dev/VG/LV"];
3027 ["mount"; "/dev/VG/LV"; "/"]]
3030 let get_seq_last = function
3032 failwithf "%s: you cannot use [] (empty list) when expecting a command"
3035 let seq = List.rev seq in
3036 List.rev (List.tl seq), List.hd seq
3041 pr " /* TestRun for %s (%d) */\n" name i;
3042 List.iter (generate_test_command_call test_name) seq
3043 | TestOutput (seq, expected) ->
3044 pr " /* TestOutput for %s (%d) */\n" name i;
3045 let seq, last = get_seq_last seq in
3047 pr " if (strcmp (r, \"%s\") != 0) {\n" (c_quote expected);
3048 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r);\n" test_name (c_quote expected);
3052 List.iter (generate_test_command_call test_name) seq;
3053 generate_test_command_call ~test test_name last
3054 | TestOutputList (seq, expected) ->
3055 pr " /* TestOutputList for %s (%d) */\n" name i;
3056 let seq, last = get_seq_last seq in
3060 pr " if (!r[%d]) {\n" i;
3061 pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
3062 pr " print_strings (r);\n";
3065 pr " if (strcmp (r[%d], \"%s\") != 0) {\n" i (c_quote str);
3066 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r[%d]);\n" test_name (c_quote str) i;
3070 pr " if (r[%d] != NULL) {\n" (List.length expected);
3071 pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
3073 pr " print_strings (r);\n";
3077 List.iter (generate_test_command_call test_name) seq;
3078 generate_test_command_call ~test test_name last
3079 | TestOutputInt (seq, expected) ->
3080 pr " /* TestOutputInt for %s (%d) */\n" name i;
3081 let seq, last = get_seq_last seq in
3083 pr " if (r != %d) {\n" expected;
3084 pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\","
3090 List.iter (generate_test_command_call test_name) seq;
3091 generate_test_command_call ~test test_name last
3092 | TestOutputTrue seq ->
3093 pr " /* TestOutputTrue for %s (%d) */\n" name i;
3094 let seq, last = get_seq_last seq in
3097 pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n"
3102 List.iter (generate_test_command_call test_name) seq;
3103 generate_test_command_call ~test test_name last
3104 | TestOutputFalse seq ->
3105 pr " /* TestOutputFalse for %s (%d) */\n" name i;
3106 let seq, last = get_seq_last seq in
3109 pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n"
3114 List.iter (generate_test_command_call test_name) seq;
3115 generate_test_command_call ~test test_name last
3116 | TestOutputLength (seq, expected) ->
3117 pr " /* TestOutputLength for %s (%d) */\n" name i;
3118 let seq, last = get_seq_last seq in
3121 pr " for (j = 0; j < %d; ++j)\n" expected;
3122 pr " if (r[j] == NULL) {\n";
3123 pr " fprintf (stderr, \"%s: short list returned\\n\");\n"
3125 pr " print_strings (r);\n";
3128 pr " if (r[j] != NULL) {\n";
3129 pr " fprintf (stderr, \"%s: long list returned\\n\");\n"
3131 pr " print_strings (r);\n";
3135 List.iter (generate_test_command_call test_name) seq;
3136 generate_test_command_call ~test test_name last
3137 | TestOutputStruct (seq, checks) ->
3138 pr " /* TestOutputStruct for %s (%d) */\n" name i;
3139 let seq, last = get_seq_last seq in
3143 | CompareWithInt (field, expected) ->
3144 pr " if (r->%s != %d) {\n" field expected;
3145 pr " fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
3146 test_name field expected;
3147 pr " (int) r->%s);\n" field;
3150 | CompareWithString (field, expected) ->
3151 pr " if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
3152 pr " fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
3153 test_name field expected;
3154 pr " r->%s);\n" field;
3157 | CompareFieldsIntEq (field1, field2) ->
3158 pr " if (r->%s != r->%s) {\n" field1 field2;
3159 pr " fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
3160 test_name field1 field2;
3161 pr " (int) r->%s, (int) r->%s);\n" field1 field2;
3164 | CompareFieldsStrEq (field1, field2) ->
3165 pr " if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
3166 pr " fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
3167 test_name field1 field2;
3168 pr " r->%s, r->%s);\n" field1 field2;
3173 List.iter (generate_test_command_call test_name) seq;
3174 generate_test_command_call ~test test_name last
3175 | TestLastFail seq ->
3176 pr " /* TestLastFail for %s (%d) */\n" name i;
3177 let seq, last = get_seq_last seq in
3178 List.iter (generate_test_command_call test_name) seq;
3179 generate_test_command_call test_name ~expect_error:true last
3187 (* Generate the code to run a command, leaving the result in 'r'.
3188 * If you expect to get an error then you should set expect_error:true.
3190 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
3192 | [] -> assert false
3194 (* Look up the command to find out what args/ret it has. *)
3197 let _, style, _, _, _, _, _ =
3198 List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
3201 failwithf "%s: in test, command %s was not found" test_name name in
3203 if List.length (snd style) <> List.length args then
3204 failwithf "%s: in test, wrong number of args given to %s"
3215 | FileIn _, _ | FileOut _, _ -> ()
3216 | StringList n, arg ->
3217 pr " char *%s[] = {\n" n;
3218 let strs = string_split " " arg in
3220 fun str -> pr " \"%s\",\n" (c_quote str)
3224 ) (List.combine (snd style) args);
3227 match fst style with
3228 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
3229 | RInt64 _ -> pr " int64_t r;\n"; "-1"
3230 | RConstString _ -> pr " const char *r;\n"; "NULL"
3231 | RString _ -> pr " char *r;\n"; "NULL"
3232 | RStringList _ | RHashtable _ ->
3237 pr " struct guestfs_int_bool *r;\n"; "NULL"
3239 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
3241 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
3243 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
3245 pr " struct guestfs_stat *r;\n"; "NULL"
3247 pr " struct guestfs_statvfs *r;\n"; "NULL" in
3249 pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
3250 pr " r = guestfs_%s (g" name;
3252 (* Generate the parameters. *)
3256 | FileIn _, arg | FileOut _, arg ->
3257 pr ", \"%s\"" (c_quote arg)
3258 | OptString _, arg ->
3259 if arg = "NULL" then pr ", NULL" else pr ", \"%s\"" (c_quote arg)
3260 | StringList n, _ ->
3264 try int_of_string arg
3265 with Failure "int_of_string" ->
3266 failwithf "%s: expecting an int, but got '%s'" test_name arg in
3269 let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
3270 ) (List.combine (snd style) args);
3273 if not expect_error then
3274 pr " if (r == %s)\n" error_code
3276 pr " if (r != %s)\n" error_code;
3279 (* Insert the test code. *)
3285 (match fst style with
3286 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ -> ()
3287 | RString _ -> pr " free (r);\n"
3288 | RStringList _ | RHashtable _ ->
3289 pr " for (i = 0; r[i] != NULL; ++i)\n";
3290 pr " free (r[i]);\n";
3293 pr " guestfs_free_int_bool (r);\n"
3295 pr " guestfs_free_lvm_pv_list (r);\n"
3297 pr " guestfs_free_lvm_vg_list (r);\n"
3299 pr " guestfs_free_lvm_lv_list (r);\n"
3300 | RStat _ | RStatVFS _ ->
3307 let str = replace_str str "\r" "\\r" in
3308 let str = replace_str str "\n" "\\n" in
3309 let str = replace_str str "\t" "\\t" in
3312 (* Generate a lot of different functions for guestfish. *)
3313 and generate_fish_cmds () =
3314 generate_header CStyle GPLv2;
3318 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3320 let all_functions_sorted =
3322 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3323 ) all_functions_sorted in
3325 pr "#include <stdio.h>\n";
3326 pr "#include <stdlib.h>\n";
3327 pr "#include <string.h>\n";
3328 pr "#include <inttypes.h>\n";
3330 pr "#include <guestfs.h>\n";
3331 pr "#include \"fish.h\"\n";
3334 (* list_commands function, which implements guestfish -h *)
3335 pr "void list_commands (void)\n";
3337 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
3338 pr " list_builtin_commands ();\n";
3340 fun (name, _, _, flags, _, shortdesc, _) ->
3341 let name = replace_char name '_' '-' in
3342 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
3344 ) all_functions_sorted;
3345 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
3349 (* display_command function, which implements guestfish -h cmd *)
3350 pr "void display_command (const char *cmd)\n";
3353 fun (name, style, _, flags, _, shortdesc, longdesc) ->
3354 let name2 = replace_char name '_' '-' in
3356 try find_map (function FishAlias n -> Some n | _ -> None) flags
3357 with Not_found -> name in
3358 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
3360 match snd style with
3364 name2 (String.concat "> <" (List.map name_of_argt args)) in
3367 if List.mem ProtocolLimitWarning flags then
3368 ("\n\n" ^ protocol_limit_warning)
3371 (* For DangerWillRobinson commands, we should probably have
3372 * guestfish prompt before allowing you to use them (especially
3373 * in interactive mode). XXX
3377 if List.mem DangerWillRobinson flags then
3378 ("\n\n" ^ danger_will_robinson)
3381 let describe_alias =
3382 if name <> alias then
3383 sprintf "\n\nYou can use '%s' as an alias for this command." alias
3387 pr "strcasecmp (cmd, \"%s\") == 0" name;
3388 if name <> name2 then
3389 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
3390 if name <> alias then
3391 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
3393 pr " pod2text (\"%s - %s\", %S);\n"
3395 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
3398 pr " display_builtin_command (cmd);\n";
3402 (* print_{pv,vg,lv}_list functions *)
3406 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
3413 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
3415 pr " printf (\"%s: \");\n" name;
3416 pr " for (i = 0; i < 32; ++i)\n";
3417 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
3418 pr " printf (\"\\n\");\n"
3420 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
3422 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
3423 | name, `OptPercent ->
3424 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
3425 typ name name typ name;
3426 pr " else printf (\"%s: \\n\");\n" name
3430 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
3435 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
3436 pr " print_%s (&%ss->val[i]);\n" typ typ;
3439 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3441 (* print_{stat,statvfs} functions *)
3445 pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
3450 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
3454 ) ["stat", stat_cols; "statvfs", statvfs_cols];
3456 (* run_<action> actions *)
3458 fun (name, style, _, flags, _, _, _) ->
3459 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
3461 (match fst style with
3464 | RBool _ -> pr " int r;\n"
3465 | RInt64 _ -> pr " int64_t r;\n"
3466 | RConstString _ -> pr " const char *r;\n"
3467 | RString _ -> pr " char *r;\n"
3468 | RStringList _ | RHashtable _ -> pr " char **r;\n"
3469 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
3470 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
3471 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
3472 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
3473 | RStat _ -> pr " struct guestfs_stat *r;\n"
3474 | RStatVFS _ -> pr " struct guestfs_statvfs *r;\n"
3481 | FileOut n -> pr " const char *%s;\n" n
3482 | StringList n -> pr " char **%s;\n" n
3483 | Bool n -> pr " int %s;\n" n
3484 | Int n -> pr " int %s;\n" n
3487 (* Check and convert parameters. *)
3488 let argc_expected = List.length (snd style) in
3489 pr " if (argc != %d) {\n" argc_expected;
3490 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
3492 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
3498 | String name -> pr " %s = argv[%d];\n" name i
3500 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
3503 pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdin\";\n"
3506 pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n"
3508 | StringList name ->
3509 pr " %s = parse_string_list (argv[%d]);\n" name i
3511 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
3513 pr " %s = atoi (argv[%d]);\n" name i
3516 (* Call C API function. *)
3518 try find_map (function FishAction n -> Some n | _ -> None) flags
3519 with Not_found -> sprintf "guestfs_%s" name in
3521 generate_call_args ~handle:"g" (snd style);
3524 (* Check return value for errors and display command results. *)
3525 (match fst style with
3526 | RErr -> pr " return r;\n"
3528 pr " if (r == -1) return -1;\n";
3529 pr " printf (\"%%d\\n\", r);\n";
3532 pr " if (r == -1) return -1;\n";
3533 pr " printf (\"%%\" PRIi64 \"\\n\", r);\n";
3536 pr " if (r == -1) return -1;\n";
3537 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
3540 pr " if (r == NULL) return -1;\n";
3541 pr " printf (\"%%s\\n\", r);\n";
3544 pr " if (r == NULL) return -1;\n";
3545 pr " printf (\"%%s\\n\", r);\n";
3549 pr " if (r == NULL) return -1;\n";
3550 pr " print_strings (r);\n";
3551 pr " free_strings (r);\n";
3554 pr " if (r == NULL) return -1;\n";
3555 pr " printf (\"%%d, %%s\\n\", r->i,\n";
3556 pr " r->b ? \"true\" : \"false\");\n";
3557 pr " guestfs_free_int_bool (r);\n";
3560 pr " if (r == NULL) return -1;\n";
3561 pr " print_pv_list (r);\n";
3562 pr " guestfs_free_lvm_pv_list (r);\n";
3565 pr " if (r == NULL) return -1;\n";
3566 pr " print_vg_list (r);\n";
3567 pr " guestfs_free_lvm_vg_list (r);\n";
3570 pr " if (r == NULL) return -1;\n";
3571 pr " print_lv_list (r);\n";
3572 pr " guestfs_free_lvm_lv_list (r);\n";
3575 pr " if (r == NULL) return -1;\n";
3576 pr " print_stat (r);\n";
3580 pr " if (r == NULL) return -1;\n";
3581 pr " print_statvfs (r);\n";
3585 pr " if (r == NULL) return -1;\n";
3586 pr " print_table (r);\n";
3587 pr " free_strings (r);\n";
3594 (* run_action function *)
3595 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
3598 fun (name, _, _, flags, _, _, _) ->
3599 let name2 = replace_char name '_' '-' in
3601 try find_map (function FishAlias n -> Some n | _ -> None) flags
3602 with Not_found -> name in
3604 pr "strcasecmp (cmd, \"%s\") == 0" name;
3605 if name <> name2 then
3606 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
3607 if name <> alias then
3608 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
3610 pr " return run_%s (cmd, argc, argv);\n" name;
3614 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
3621 (* Readline completion for guestfish. *)
3622 and generate_fish_completion () =
3623 generate_header CStyle GPLv2;
3627 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3637 #ifdef HAVE_LIBREADLINE
3638 #include <readline/readline.h>
3643 #ifdef HAVE_LIBREADLINE
3645 static const char *commands[] = {
3648 (* Get the commands and sort them, including the aliases. *)
3651 fun (name, _, _, flags, _, _, _) ->
3652 let name2 = replace_char name '_' '-' in
3654 try find_map (function FishAlias n -> Some n | _ -> None) flags
3655 with Not_found -> name in
3657 if name <> alias then [name2; alias] else [name2]
3659 let commands = List.flatten commands in
3660 let commands = List.sort compare commands in
3662 List.iter (pr " \"%s\",\n") commands;
3668 generator (const char *text, int state)
3670 static int index, len;
3675 len = strlen (text);
3678 while ((name = commands[index]) != NULL) {
3680 if (strncasecmp (name, text, len) == 0)
3681 return strdup (name);
3687 #endif /* HAVE_LIBREADLINE */
3689 char **do_completion (const char *text, int start, int end)
3691 char **matches = NULL;
3693 #ifdef HAVE_LIBREADLINE
3695 matches = rl_completion_matches (text, generator);
3702 (* Generate the POD documentation for guestfish. *)
3703 and generate_fish_actions_pod () =
3704 let all_functions_sorted =
3706 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3707 ) all_functions_sorted in
3710 fun (name, style, _, flags, _, _, longdesc) ->
3711 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
3712 let name = replace_char name '_' '-' in
3714 try find_map (function FishAlias n -> Some n | _ -> None) flags
3715 with Not_found -> name in
3717 pr "=head2 %s" name;
3718 if name <> alias then
3725 | String n -> pr " %s" n
3726 | OptString n -> pr " %s" n
3727 | StringList n -> pr " %s,..." n
3728 | Bool _ -> pr " true|false"
3729 | Int n -> pr " %s" n
3730 | FileIn n | FileOut n -> pr " (%s|-)" n
3734 pr "%s\n\n" longdesc;
3736 if List.exists (function FileIn _ | FileOut _ -> true
3737 | _ -> false) (snd style) then
3738 pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
3740 if List.mem ProtocolLimitWarning flags then
3741 pr "%s\n\n" protocol_limit_warning;
3743 if List.mem DangerWillRobinson flags then
3744 pr "%s\n\n" danger_will_robinson
3745 ) all_functions_sorted
3747 (* Generate a C function prototype. *)
3748 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
3749 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
3751 ?handle name style =
3752 if extern then pr "extern ";
3753 if static then pr "static ";
3754 (match fst style with
3756 | RInt _ -> pr "int "
3757 | RInt64 _ -> pr "int64_t "
3758 | RBool _ -> pr "int "
3759 | RConstString _ -> pr "const char *"
3760 | RString _ -> pr "char *"
3761 | RStringList _ | RHashtable _ -> pr "char **"
3763 if not in_daemon then pr "struct guestfs_int_bool *"
3764 else pr "guestfs_%s_ret *" name
3766 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
3767 else pr "guestfs_lvm_int_pv_list *"
3769 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
3770 else pr "guestfs_lvm_int_vg_list *"
3772 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
3773 else pr "guestfs_lvm_int_lv_list *"
3775 if not in_daemon then pr "struct guestfs_stat *"
3776 else pr "guestfs_int_stat *"
3778 if not in_daemon then pr "struct guestfs_statvfs *"
3779 else pr "guestfs_int_statvfs *"
3781 pr "%s%s (" prefix name;
3782 if handle = None && List.length (snd style) = 0 then
3785 let comma = ref false in
3788 | Some handle -> pr "guestfs_h *%s" handle; comma := true
3792 if single_line then pr ", " else pr ",\n\t\t"
3799 | OptString n -> next (); pr "const char *%s" n
3800 | StringList n -> next (); pr "char * const* const %s" n
3801 | Bool n -> next (); pr "int %s" n
3802 | Int n -> next (); pr "int %s" n
3805 if not in_daemon then (next (); pr "const char *%s" n)
3809 if semicolon then pr ";";
3810 if newline then pr "\n"
3812 (* Generate C call arguments, eg "(handle, foo, bar)" *)
3813 and generate_call_args ?handle args =
3815 let comma = ref false in
3818 | Some handle -> pr "%s" handle; comma := true
3822 if !comma then pr ", ";
3824 pr "%s" (name_of_argt arg)
3828 (* Generate the OCaml bindings interface. *)
3829 and generate_ocaml_mli () =
3830 generate_header OCamlStyle LGPLv2;
3833 (** For API documentation you should refer to the C API
3834 in the guestfs(3) manual page. The OCaml API uses almost
3835 exactly the same calls. *)
3838 (** A [guestfs_h] handle. *)
3840 exception Error of string
3841 (** This exception is raised when there is an error. *)
3843 val create : unit -> t
3845 val close : t -> unit
3846 (** Handles are closed by the garbage collector when they become
3847 unreferenced, but callers can also call this in order to
3848 provide predictable cleanup. *)
3851 generate_ocaml_lvm_structure_decls ();
3853 generate_ocaml_stat_structure_decls ();
3857 fun (name, style, _, _, _, shortdesc, _) ->
3858 generate_ocaml_prototype name style;
3859 pr "(** %s *)\n" shortdesc;
3863 (* Generate the OCaml bindings implementation. *)
3864 and generate_ocaml_ml () =
3865 generate_header OCamlStyle LGPLv2;
3869 exception Error of string
3870 external create : unit -> t = \"ocaml_guestfs_create\"
3871 external close : t -> unit = \"ocaml_guestfs_close\"
3874 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
3878 generate_ocaml_lvm_structure_decls ();
3880 generate_ocaml_stat_structure_decls ();
3884 fun (name, style, _, _, _, shortdesc, _) ->
3885 generate_ocaml_prototype ~is_external:true name style;
3888 (* Generate the OCaml bindings C implementation. *)
3889 and generate_ocaml_c () =
3890 generate_header CStyle LGPLv2;
3897 #include <caml/config.h>
3898 #include <caml/alloc.h>
3899 #include <caml/callback.h>
3900 #include <caml/fail.h>
3901 #include <caml/memory.h>
3902 #include <caml/mlvalues.h>
3903 #include <caml/signals.h>
3905 #include <guestfs.h>
3907 #include \"guestfs_c.h\"
3909 /* Copy a hashtable of string pairs into an assoc-list. We return
3910 * the list in reverse order, but hashtables aren't supposed to be
3913 static CAMLprim value
3914 copy_table (char * const * argv)
3917 CAMLlocal5 (rv, pairv, kv, vv, cons);
3921 for (i = 0; argv[i] != NULL; i += 2) {
3922 kv = caml_copy_string (argv[i]);
3923 vv = caml_copy_string (argv[i+1]);
3924 pairv = caml_alloc (2, 0);
3925 Store_field (pairv, 0, kv);
3926 Store_field (pairv, 1, vv);
3927 cons = caml_alloc (2, 0);
3928 Store_field (cons, 1, rv);
3930 Store_field (cons, 0, pairv);
3938 (* LVM struct copy functions. *)
3941 let has_optpercent_col =
3942 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
3944 pr "static CAMLprim value\n";
3945 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
3947 pr " CAMLparam0 ();\n";
3948 if has_optpercent_col then
3949 pr " CAMLlocal3 (rv, v, v2);\n"
3951 pr " CAMLlocal2 (rv, v);\n";
3953 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
3958 pr " v = caml_copy_string (%s->%s);\n" typ name
3960 pr " v = caml_alloc_string (32);\n";
3961 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
3964 pr " v = caml_copy_int64 (%s->%s);\n" typ name
3965 | name, `OptPercent ->
3966 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
3967 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
3968 pr " v = caml_alloc (1, 0);\n";
3969 pr " Store_field (v, 0, v2);\n";
3970 pr " } else /* None */\n";
3971 pr " v = Val_int (0);\n";
3973 pr " Store_field (rv, %d, v);\n" i
3975 pr " CAMLreturn (rv);\n";
3979 pr "static CAMLprim value\n";
3980 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
3983 pr " CAMLparam0 ();\n";
3984 pr " CAMLlocal2 (rv, v);\n";
3987 pr " if (%ss->len == 0)\n" typ;
3988 pr " CAMLreturn (Atom (0));\n";
3990 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
3991 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
3992 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
3993 pr " caml_modify (&Field (rv, i), v);\n";
3995 pr " CAMLreturn (rv);\n";
3999 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
4001 (* Stat copy functions. *)
4004 pr "static CAMLprim value\n";
4005 pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
4007 pr " CAMLparam0 ();\n";
4008 pr " CAMLlocal2 (rv, v);\n";
4010 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
4015 pr " v = caml_copy_int64 (%s->%s);\n" typ name
4017 pr " Store_field (rv, %d, v);\n" i
4019 pr " CAMLreturn (rv);\n";
4022 ) ["stat", stat_cols; "statvfs", statvfs_cols];
4026 fun (name, style, _, _, _, _, _) ->
4028 "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
4030 pr "CAMLprim value\n";
4031 pr "ocaml_guestfs_%s (value %s" name (List.hd params);
4032 List.iter (pr ", value %s") (List.tl params);
4037 | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
4038 pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
4039 pr " CAMLxparam%d (%s);\n"
4040 (List.length rest) (String.concat ", " rest)
4042 pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
4044 pr " CAMLlocal1 (rv);\n";
4047 pr " guestfs_h *g = Guestfs_val (gv);\n";
4048 pr " if (g == NULL)\n";
4049 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
4057 pr " const char *%s = String_val (%sv);\n" n n
4059 pr " const char *%s =\n" n;
4060 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
4063 pr " char **%s = ocaml_guestfs_strings_val (%sv);\n" n n
4065 pr " int %s = Bool_val (%sv);\n" n n
4067 pr " int %s = Int_val (%sv);\n" n n
4070 match fst style with
4071 | RErr -> pr " int r;\n"; "-1"
4072 | RInt _ -> pr " int r;\n"; "-1"
4073 | RInt64 _ -> pr " int64_t r;\n"; "-1"
4074 | RBool _ -> pr " int r;\n"; "-1"
4075 | RConstString _ -> pr " const char *r;\n"; "NULL"
4076 | RString _ -> pr " char *r;\n"; "NULL"
4082 pr " struct guestfs_int_bool *r;\n"; "NULL"
4084 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
4086 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
4088 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
4090 pr " struct guestfs_stat *r;\n"; "NULL"
4092 pr " struct guestfs_statvfs *r;\n"; "NULL"
4099 pr " caml_enter_blocking_section ();\n";
4100 pr " r = guestfs_%s " name;
4101 generate_call_args ~handle:"g" (snd style);
4103 pr " caml_leave_blocking_section ();\n";
4108 pr " ocaml_guestfs_free_strings (%s);\n" n;
4109 | String _ | OptString _ | Bool _ | Int _ | FileIn _ | FileOut _ -> ()
4112 pr " if (r == %s)\n" error_code;
4113 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
4116 (match fst style with
4117 | RErr -> pr " rv = Val_unit;\n"
4118 | RInt _ -> pr " rv = Val_int (r);\n"
4120 pr " rv = caml_copy_int64 (r);\n"
4121 | RBool _ -> pr " rv = Val_bool (r);\n"
4122 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
4124 pr " rv = caml_copy_string (r);\n";
4127 pr " rv = caml_copy_string_array ((const char **) r);\n";
4128 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
4131 pr " rv = caml_alloc (2, 0);\n";
4132 pr " Store_field (rv, 0, Val_int (r->i));\n";
4133 pr " Store_field (rv, 1, Val_bool (r->b));\n";
4134 pr " guestfs_free_int_bool (r);\n";
4136 pr " rv = copy_lvm_pv_list (r);\n";
4137 pr " guestfs_free_lvm_pv_list (r);\n";
4139 pr " rv = copy_lvm_vg_list (r);\n";
4140 pr " guestfs_free_lvm_vg_list (r);\n";
4142 pr " rv = copy_lvm_lv_list (r);\n";
4143 pr " guestfs_free_lvm_lv_list (r);\n";
4145 pr " rv = copy_stat (r);\n";
4148 pr " rv = copy_statvfs (r);\n";
4151 pr " rv = copy_table (r);\n";
4152 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
4156 pr " CAMLreturn (rv);\n";
4160 if List.length params > 5 then (
4161 pr "CAMLprim value\n";
4162 pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
4164 pr " return ocaml_guestfs_%s (argv[0]" name;
4165 iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
4172 and generate_ocaml_lvm_structure_decls () =
4175 pr "type lvm_%s = {\n" typ;
4178 | name, `String -> pr " %s : string;\n" name
4179 | name, `UUID -> pr " %s : string;\n" name
4180 | name, `Bytes -> pr " %s : int64;\n" name
4181 | name, `Int -> pr " %s : int64;\n" name
4182 | name, `OptPercent -> pr " %s : float option;\n" name
4186 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
4188 and generate_ocaml_stat_structure_decls () =
4191 pr "type %s = {\n" typ;
4194 | name, `Int -> pr " %s : int64;\n" name
4198 ) ["stat", stat_cols; "statvfs", statvfs_cols]
4200 and generate_ocaml_prototype ?(is_external = false) name style =
4201 if is_external then pr "external " else pr "val ";
4202 pr "%s : t -> " name;
4205 | String _ | FileIn _ | FileOut _ -> pr "string -> "
4206 | OptString _ -> pr "string option -> "
4207 | StringList _ -> pr "string array -> "
4208 | Bool _ -> pr "bool -> "
4209 | Int _ -> pr "int -> "
4211 (match fst style with
4212 | RErr -> pr "unit" (* all errors are turned into exceptions *)
4213 | RInt _ -> pr "int"
4214 | RInt64 _ -> pr "int64"
4215 | RBool _ -> pr "bool"
4216 | RConstString _ -> pr "string"
4217 | RString _ -> pr "string"
4218 | RStringList _ -> pr "string array"
4219 | RIntBool _ -> pr "int * bool"
4220 | RPVList _ -> pr "lvm_pv array"
4221 | RVGList _ -> pr "lvm_vg array"
4222 | RLVList _ -> pr "lvm_lv array"
4223 | RStat _ -> pr "stat"
4224 | RStatVFS _ -> pr "statvfs"
4225 | RHashtable _ -> pr "(string * string) list"
4227 if is_external then (
4229 if List.length (snd style) + 1 > 5 then
4230 pr "\"ocaml_guestfs_%s_byte\" " name;
4231 pr "\"ocaml_guestfs_%s\"" name
4235 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
4236 and generate_perl_xs () =
4237 generate_header CStyle LGPLv2;
4240 #include \"EXTERN.h\"
4244 #include <guestfs.h>
4247 #define PRId64 \"lld\"
4251 my_newSVll(long long val) {
4252 #ifdef USE_64_BIT_ALL
4253 return newSViv(val);
4257 len = snprintf(buf, 100, \"%%\" PRId64, val);
4258 return newSVpv(buf, len);
4263 #define PRIu64 \"llu\"
4267 my_newSVull(unsigned long long val) {
4268 #ifdef USE_64_BIT_ALL
4269 return newSVuv(val);
4273 len = snprintf(buf, 100, \"%%\" PRIu64, val);
4274 return newSVpv(buf, len);
4278 /* http://www.perlmonks.org/?node_id=680842 */
4280 XS_unpack_charPtrPtr (SV *arg) {
4285 if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV) {
4286 croak (\"array reference expected\");
4289 av = (AV *)SvRV (arg);
4290 ret = (char **)malloc (av_len (av) + 1 + 1);
4292 for (i = 0; i <= av_len (av); i++) {
4293 SV **elem = av_fetch (av, i, 0);
4295 if (!elem || !*elem)
4296 croak (\"missing element in list\");
4298 ret[i] = SvPV_nolen (*elem);
4306 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
4311 RETVAL = guestfs_create ();
4313 croak (\"could not create guestfs handle\");
4314 guestfs_set_error_handler (RETVAL, NULL, NULL);
4327 fun (name, style, _, _, _, _, _) ->
4328 (match fst style with
4329 | RErr -> pr "void\n"
4330 | RInt _ -> pr "SV *\n"
4331 | RInt64 _ -> pr "SV *\n"
4332 | RBool _ -> pr "SV *\n"
4333 | RConstString _ -> pr "SV *\n"
4334 | RString _ -> pr "SV *\n"
4337 | RPVList _ | RVGList _ | RLVList _
4338 | RStat _ | RStatVFS _
4340 pr "void\n" (* all lists returned implictly on the stack *)
4342 (* Call and arguments. *)
4344 generate_call_args ~handle:"g" (snd style);
4346 pr " guestfs_h *g;\n";
4349 | String n | FileIn n | FileOut n -> pr " char *%s;\n" n
4350 | OptString n -> pr " char *%s;\n" n
4351 | StringList n -> pr " char **%s;\n" n
4352 | Bool n -> pr " int %s;\n" n
4353 | Int n -> pr " int %s;\n" n
4356 let do_cleanups () =
4359 | String _ | OptString _ | Bool _ | Int _
4360 | FileIn _ | FileOut _ -> ()
4361 | StringList n -> pr " free (%s);\n" n
4366 (match fst style with
4371 pr " r = guestfs_%s " name;
4372 generate_call_args ~handle:"g" (snd style);
4375 pr " if (r == -1)\n";
4376 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4382 pr " %s = guestfs_%s " n name;
4383 generate_call_args ~handle:"g" (snd style);
4386 pr " if (%s == -1)\n" n;
4387 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4388 pr " RETVAL = newSViv (%s);\n" n;
4393 pr " int64_t %s;\n" n;
4395 pr " %s = guestfs_%s " n name;
4396 generate_call_args ~handle:"g" (snd style);
4399 pr " if (%s == -1)\n" n;
4400 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4401 pr " RETVAL = my_newSVll (%s);\n" n;
4406 pr " const char *%s;\n" n;
4408 pr " %s = guestfs_%s " n name;
4409 generate_call_args ~handle:"g" (snd style);
4412 pr " if (%s == NULL)\n" n;
4413 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4414 pr " RETVAL = newSVpv (%s, 0);\n" n;
4419 pr " char *%s;\n" n;
4421 pr " %s = guestfs_%s " n name;
4422 generate_call_args ~handle:"g" (snd style);
4425 pr " if (%s == NULL)\n" n;
4426 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4427 pr " RETVAL = newSVpv (%s, 0);\n" n;
4428 pr " free (%s);\n" n;
4431 | RStringList n | RHashtable n ->
4433 pr " char **%s;\n" n;
4436 pr " %s = guestfs_%s " n name;
4437 generate_call_args ~handle:"g" (snd style);
4440 pr " if (%s == NULL)\n" n;
4441 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4442 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
4443 pr " EXTEND (SP, n);\n";
4444 pr " for (i = 0; i < n; ++i) {\n";
4445 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
4446 pr " free (%s[i]);\n" n;
4448 pr " free (%s);\n" n;
4451 pr " struct guestfs_int_bool *r;\n";
4453 pr " r = guestfs_%s " name;
4454 generate_call_args ~handle:"g" (snd style);
4457 pr " if (r == NULL)\n";
4458 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4459 pr " EXTEND (SP, 2);\n";
4460 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
4461 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
4462 pr " guestfs_free_int_bool (r);\n";
4464 generate_perl_lvm_code "pv" pv_cols name style n do_cleanups
4466 generate_perl_lvm_code "vg" vg_cols name style n do_cleanups
4468 generate_perl_lvm_code "lv" lv_cols name style n do_cleanups
4470 generate_perl_stat_code "stat" stat_cols name style n do_cleanups
4472 generate_perl_stat_code
4473 "statvfs" statvfs_cols name style n do_cleanups
4479 and generate_perl_lvm_code typ cols name style n do_cleanups =
4481 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
4485 pr " %s = guestfs_%s " n name;
4486 generate_call_args ~handle:"g" (snd style);
4489 pr " if (%s == NULL)\n" n;
4490 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4491 pr " EXTEND (SP, %s->len);\n" n;
4492 pr " for (i = 0; i < %s->len; ++i) {\n" n;
4493 pr " hv = newHV ();\n";
4497 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
4498 name (String.length name) n name
4500 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
4501 name (String.length name) n name
4503 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
4504 name (String.length name) n name
4506 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
4507 name (String.length name) n name
4508 | name, `OptPercent ->
4509 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
4510 name (String.length name) n name
4512 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
4514 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
4516 and generate_perl_stat_code typ cols name style n do_cleanups =
4518 pr " struct guestfs_%s *%s;\n" typ n;
4520 pr " %s = guestfs_%s " n name;
4521 generate_call_args ~handle:"g" (snd style);
4524 pr " if (%s == NULL)\n" n;
4525 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4526 pr " EXTEND (SP, %d);\n" (List.length cols);
4530 pr " PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n" n name
4532 pr " free (%s);\n" n
4534 (* Generate Sys/Guestfs.pm. *)
4535 and generate_perl_pm () =
4536 generate_header HashStyle LGPLv2;
4543 Sys::Guestfs - Perl bindings for libguestfs
4549 my $h = Sys::Guestfs->new ();
4550 $h->add_drive ('guest.img');
4553 $h->mount ('/dev/sda1', '/');
4554 $h->touch ('/hello');
4559 The C<Sys::Guestfs> module provides a Perl XS binding to the
4560 libguestfs API for examining and modifying virtual machine
4563 Amongst the things this is good for: making batch configuration
4564 changes to guests, getting disk used/free statistics (see also:
4565 virt-df), migrating between virtualization systems (see also:
4566 virt-p2v), performing partial backups, performing partial guest
4567 clones, cloning guests and changing registry/UUID/hostname info, and
4570 Libguestfs uses Linux kernel and qemu code, and can access any type of
4571 guest filesystem that Linux and qemu can, including but not limited
4572 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
4573 schemes, qcow, qcow2, vmdk.
4575 Libguestfs provides ways to enumerate guest storage (eg. partitions,
4576 LVs, what filesystem is in each LV, etc.). It can also run commands
4577 in the context of the guest. Also you can access filesystems over FTP.
4581 All errors turn into calls to C<croak> (see L<Carp(3)>).
4589 package Sys::Guestfs;
4595 XSLoader::load ('Sys::Guestfs');
4597 =item $h = Sys::Guestfs->new ();
4599 Create a new guestfs handle.
4605 my $class = ref ($proto) || $proto;
4607 my $self = Sys::Guestfs::_create ();
4608 bless $self, $class;
4614 (* Actions. We only need to print documentation for these as
4615 * they are pulled in from the XS code automatically.
4618 fun (name, style, _, flags, _, _, longdesc) ->
4619 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
4621 generate_perl_prototype name style;
4623 pr "%s\n\n" longdesc;
4624 if List.mem ProtocolLimitWarning flags then
4625 pr "%s\n\n" protocol_limit_warning;
4626 if List.mem DangerWillRobinson flags then
4627 pr "%s\n\n" danger_will_robinson
4628 ) all_functions_sorted;
4640 Copyright (C) 2009 Red Hat Inc.
4644 Please see the file COPYING.LIB for the full license.
4648 L<guestfs(3)>, L<guestfish(1)>.
4653 and generate_perl_prototype name style =
4654 (match fst style with
4660 | RString n -> pr "$%s = " n
4661 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
4665 | RLVList n -> pr "@%s = " n
4668 | RHashtable n -> pr "%%%s = " n
4671 let comma = ref false in
4674 if !comma then pr ", ";
4677 | String n | OptString n | Bool n | Int n | FileIn n | FileOut n ->
4684 (* Generate Python C module. *)
4685 and generate_python_c () =
4686 generate_header CStyle LGPLv2;
4695 #include \"guestfs.h\"
4703 get_handle (PyObject *obj)
4706 assert (obj != Py_None);
4707 return ((Pyguestfs_Object *) obj)->g;
4711 put_handle (guestfs_h *g)
4715 PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
4718 /* This list should be freed (but not the strings) after use. */
4719 static const char **
4720 get_string_list (PyObject *obj)
4727 if (!PyList_Check (obj)) {
4728 PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
4732 len = PyList_Size (obj);
4733 r = malloc (sizeof (char *) * (len+1));
4735 PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
4739 for (i = 0; i < len; ++i)
4740 r[i] = PyString_AsString (PyList_GetItem (obj, i));
4747 put_string_list (char * const * const argv)
4752 for (argc = 0; argv[argc] != NULL; ++argc)
4755 list = PyList_New (argc);
4756 for (i = 0; i < argc; ++i)
4757 PyList_SetItem (list, i, PyString_FromString (argv[i]));
4763 put_table (char * const * const argv)
4765 PyObject *list, *item;
4768 for (argc = 0; argv[argc] != NULL; ++argc)
4771 list = PyList_New (argc >> 1);
4772 for (i = 0; i < argc; i += 2) {
4773 item = PyTuple_New (2);
4774 PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
4775 PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
4776 PyList_SetItem (list, i >> 1, item);
4783 free_strings (char **argv)
4787 for (argc = 0; argv[argc] != NULL; ++argc)
4793 py_guestfs_create (PyObject *self, PyObject *args)
4797 g = guestfs_create ();
4799 PyErr_SetString (PyExc_RuntimeError,
4800 \"guestfs.create: failed to allocate handle\");
4803 guestfs_set_error_handler (g, NULL, NULL);
4804 return put_handle (g);
4808 py_guestfs_close (PyObject *self, PyObject *args)
4813 if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
4815 g = get_handle (py_g);
4819 Py_INCREF (Py_None);
4825 (* LVM structures, turned into Python dictionaries. *)
4828 pr "static PyObject *\n";
4829 pr "put_lvm_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
4831 pr " PyObject *dict;\n";
4833 pr " dict = PyDict_New ();\n";
4837 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4838 pr " PyString_FromString (%s->%s));\n"
4841 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4842 pr " PyString_FromStringAndSize (%s->%s, 32));\n"
4845 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4846 pr " PyLong_FromUnsignedLongLong (%s->%s));\n"
4849 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4850 pr " PyLong_FromLongLong (%s->%s));\n"
4852 | name, `OptPercent ->
4853 pr " if (%s->%s >= 0)\n" typ name;
4854 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4855 pr " PyFloat_FromDouble ((double) %s->%s));\n"
4858 pr " Py_INCREF (Py_None);\n";
4859 pr " PyDict_SetItemString (dict, \"%s\", Py_None);" name;
4862 pr " return dict;\n";
4866 pr "static PyObject *\n";
4867 pr "put_lvm_%s_list (struct guestfs_lvm_%s_list *%ss)\n" typ typ typ;
4869 pr " PyObject *list;\n";
4872 pr " list = PyList_New (%ss->len);\n" typ;
4873 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
4874 pr " PyList_SetItem (list, i, put_lvm_%s (&%ss->val[i]));\n" typ typ;
4875 pr " return list;\n";
4878 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
4880 (* Stat structures, turned into Python dictionaries. *)
4883 pr "static PyObject *\n";
4884 pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
4886 pr " PyObject *dict;\n";
4888 pr " dict = PyDict_New ();\n";
4892 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4893 pr " PyLong_FromLongLong (%s->%s));\n"
4896 pr " return dict;\n";
4899 ) ["stat", stat_cols; "statvfs", statvfs_cols];
4901 (* Python wrapper functions. *)
4903 fun (name, style, _, _, _, _, _) ->
4904 pr "static PyObject *\n";
4905 pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
4908 pr " PyObject *py_g;\n";
4909 pr " guestfs_h *g;\n";
4910 pr " PyObject *py_r;\n";
4913 match fst style with
4914 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
4915 | RInt64 _ -> pr " int64_t r;\n"; "-1"
4916 | RConstString _ -> pr " const char *r;\n"; "NULL"
4917 | RString _ -> pr " char *r;\n"; "NULL"
4918 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
4919 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
4920 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
4921 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
4922 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
4923 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
4924 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
4928 | String n | FileIn n | FileOut n -> pr " const char *%s;\n" n
4929 | OptString n -> pr " const char *%s;\n" n
4931 pr " PyObject *py_%s;\n" n;
4932 pr " const char **%s;\n" n
4933 | Bool n -> pr " int %s;\n" n
4934 | Int n -> pr " int %s;\n" n
4939 (* Convert the parameters. *)
4940 pr " if (!PyArg_ParseTuple (args, (char *) \"O";
4943 | String _ | FileIn _ | FileOut _ -> pr "s"
4944 | OptString _ -> pr "z"
4945 | StringList _ -> pr "O"
4946 | Bool _ -> pr "i" (* XXX Python has booleans? *)
4949 pr ":guestfs_%s\",\n" name;
4953 | String n | FileIn n | FileOut n -> pr ", &%s" n
4954 | OptString n -> pr ", &%s" n
4955 | StringList n -> pr ", &py_%s" n
4956 | Bool n -> pr ", &%s" n
4957 | Int n -> pr ", &%s" n
4961 pr " return NULL;\n";
4963 pr " g = get_handle (py_g);\n";
4966 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
4968 pr " %s = get_string_list (py_%s);\n" n n;
4969 pr " if (!%s) return NULL;\n" n
4974 pr " r = guestfs_%s " name;
4975 generate_call_args ~handle:"g" (snd style);
4980 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
4982 pr " free (%s);\n" n
4985 pr " if (r == %s) {\n" error_code;
4986 pr " PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
4987 pr " return NULL;\n";
4991 (match fst style with
4993 pr " Py_INCREF (Py_None);\n";
4994 pr " py_r = Py_None;\n"
4996 | RBool _ -> pr " py_r = PyInt_FromLong ((long) r);\n"
4997 | RInt64 _ -> pr " py_r = PyLong_FromLongLong (r);\n"
4998 | RConstString _ -> pr " py_r = PyString_FromString (r);\n"
5000 pr " py_r = PyString_FromString (r);\n";
5003 pr " py_r = put_string_list (r);\n";
5004 pr " free_strings (r);\n"
5006 pr " py_r = PyTuple_New (2);\n";
5007 pr " PyTuple_SetItem (py_r, 0, PyInt_FromLong ((long) r->i));\n";
5008 pr " PyTuple_SetItem (py_r, 1, PyInt_FromLong ((long) r->b));\n";
5009 pr " guestfs_free_int_bool (r);\n"
5011 pr " py_r = put_lvm_pv_list (r);\n";
5012 pr " guestfs_free_lvm_pv_list (r);\n"
5014 pr " py_r = put_lvm_vg_list (r);\n";
5015 pr " guestfs_free_lvm_vg_list (r);\n"
5017 pr " py_r = put_lvm_lv_list (r);\n";
5018 pr " guestfs_free_lvm_lv_list (r);\n"
5020 pr " py_r = put_stat (r);\n";
5023 pr " py_r = put_statvfs (r);\n";
5026 pr " py_r = put_table (r);\n";
5027 pr " free_strings (r);\n"
5030 pr " return py_r;\n";
5035 (* Table of functions. *)
5036 pr "static PyMethodDef methods[] = {\n";
5037 pr " { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
5038 pr " { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
5040 fun (name, _, _, _, _, _, _) ->
5041 pr " { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
5044 pr " { NULL, NULL, 0, NULL }\n";
5048 (* Init function. *)
5051 initlibguestfsmod (void)
5053 static int initialized = 0;
5055 if (initialized) return;
5056 Py_InitModule ((char *) \"libguestfsmod\", methods);
5061 (* Generate Python module. *)
5062 and generate_python_py () =
5063 generate_header HashStyle LGPLv2;
5066 u\"\"\"Python bindings for libguestfs
5069 g = guestfs.GuestFS ()
5070 g.add_drive (\"guest.img\")
5073 parts = g.list_partitions ()
5075 The guestfs module provides a Python binding to the libguestfs API
5076 for examining and modifying virtual machine disk images.
5078 Amongst the things this is good for: making batch configuration
5079 changes to guests, getting disk used/free statistics (see also:
5080 virt-df), migrating between virtualization systems (see also:
5081 virt-p2v), performing partial backups, performing partial guest
5082 clones, cloning guests and changing registry/UUID/hostname info, and
5085 Libguestfs uses Linux kernel and qemu code, and can access any type of
5086 guest filesystem that Linux and qemu can, including but not limited
5087 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
5088 schemes, qcow, qcow2, vmdk.
5090 Libguestfs provides ways to enumerate guest storage (eg. partitions,
5091 LVs, what filesystem is in each LV, etc.). It can also run commands
5092 in the context of the guest. Also you can access filesystems over FTP.
5094 Errors which happen while using the API are turned into Python
5095 RuntimeError exceptions.
5097 To create a guestfs handle you usually have to perform the following
5100 # Create the handle, call add_drive at least once, and possibly
5101 # several times if the guest has multiple block devices:
5102 g = guestfs.GuestFS ()
5103 g.add_drive (\"guest.img\")
5105 # Launch the qemu subprocess and wait for it to become ready:
5109 # Now you can issue commands, for example:
5114 import libguestfsmod
5117 \"\"\"Instances of this class are libguestfs API handles.\"\"\"
5119 def __init__ (self):
5120 \"\"\"Create a new libguestfs handle.\"\"\"
5121 self._o = libguestfsmod.create ()
5124 libguestfsmod.close (self._o)
5129 fun (name, style, _, flags, _, _, longdesc) ->
5130 let doc = replace_str longdesc "C<guestfs_" "C<g." in
5132 match fst style with
5133 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _
5136 doc ^ "\n\nThis function returns a list of strings."
5138 doc ^ "\n\nThis function returns a tuple (int, bool).\n"
5140 doc ^ "\n\nThis function returns a list of PVs. Each PV is represented as a dictionary."
5142 doc ^ "\n\nThis function returns a list of VGs. Each VG is represented as a dictionary."
5144 doc ^ "\n\nThis function returns a list of LVs. Each LV is represented as a dictionary."
5146 doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the stat structure."
5148 doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the statvfs structure."
5150 doc ^ "\n\nThis function returns a dictionary." in
5152 if List.mem ProtocolLimitWarning flags then
5153 doc ^ "\n\n" ^ protocol_limit_warning
5156 if List.mem DangerWillRobinson flags then
5157 doc ^ "\n\n" ^ danger_will_robinson
5159 let doc = pod2text ~width:60 name doc in
5160 let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
5161 let doc = String.concat "\n " doc in
5164 generate_call_args ~handle:"self" (snd style);
5166 pr " u\"\"\"%s\"\"\"\n" doc;
5167 pr " return libguestfsmod.%s " name;
5168 generate_call_args ~handle:"self._o" (snd style);
5173 (* Useful if you need the longdesc POD text as plain text. Returns a
5176 and pod2text ~width name longdesc =
5177 let filename, chan = Filename.open_temp_file "gen" ".tmp" in
5178 fprintf chan "=head1 %s\n\n%s\n" name longdesc;
5180 let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
5181 let chan = Unix.open_process_in cmd in
5182 let lines = ref [] in
5184 let line = input_line chan in
5185 if i = 1 then (* discard the first line of output *)
5188 let line = triml line in
5189 lines := line :: !lines;
5192 let lines = try loop 1 with End_of_file -> List.rev !lines in
5193 Unix.unlink filename;
5194 match Unix.close_process_in chan with
5195 | Unix.WEXITED 0 -> lines
5197 failwithf "pod2text: process exited with non-zero status (%d)" i
5198 | Unix.WSIGNALED i | Unix.WSTOPPED i ->
5199 failwithf "pod2text: process signalled or stopped by signal %d" i
5201 (* Generate ruby bindings. *)
5202 and generate_ruby_c () =
5203 generate_header CStyle LGPLv2;
5211 #include \"guestfs.h\"
5213 #include \"extconf.h\"
5215 static VALUE m_guestfs; /* guestfs module */
5216 static VALUE c_guestfs; /* guestfs_h handle */
5217 static VALUE e_Error; /* used for all errors */
5219 static void ruby_guestfs_free (void *p)
5222 guestfs_close ((guestfs_h *) p);
5225 static VALUE ruby_guestfs_create (VALUE m)
5229 g = guestfs_create ();
5231 rb_raise (e_Error, \"failed to create guestfs handle\");
5233 /* Don't print error messages to stderr by default. */
5234 guestfs_set_error_handler (g, NULL, NULL);
5236 /* Wrap it, and make sure the close function is called when the
5239 return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
5242 static VALUE ruby_guestfs_close (VALUE gv)
5245 Data_Get_Struct (gv, guestfs_h, g);
5247 ruby_guestfs_free (g);
5248 DATA_PTR (gv) = NULL;
5256 fun (name, style, _, _, _, _, _) ->
5257 pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
5258 List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
5261 pr " guestfs_h *g;\n";
5262 pr " Data_Get_Struct (gv, guestfs_h, g);\n";
5264 pr " rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
5270 | String n | FileIn n | FileOut n ->
5271 pr " const char *%s = StringValueCStr (%sv);\n" n n;
5273 pr " rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
5274 pr " \"%s\", \"%s\");\n" n name
5276 pr " const char *%s = StringValueCStr (%sv);\n" n n
5280 pr " int i, len;\n";
5281 pr " len = RARRAY_LEN (%sv);\n" n;
5282 pr " %s = malloc (sizeof (char *) * (len+1));\n" n;
5283 pr " for (i = 0; i < len; ++i) {\n";
5284 pr " VALUE v = rb_ary_entry (%sv, i);\n" n;
5285 pr " %s[i] = StringValueCStr (v);\n" n;
5290 pr " int %s = NUM2INT (%sv);\n" n n
5295 match fst style with
5296 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
5297 | RInt64 _ -> pr " int64_t r;\n"; "-1"
5298 | RConstString _ -> pr " const char *r;\n"; "NULL"
5299 | RString _ -> pr " char *r;\n"; "NULL"
5300 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
5301 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
5302 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
5303 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
5304 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
5305 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
5306 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
5309 pr " r = guestfs_%s " name;
5310 generate_call_args ~handle:"g" (snd style);
5315 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
5317 pr " free (%s);\n" n
5320 pr " if (r == %s)\n" error_code;
5321 pr " rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
5324 (match fst style with
5326 pr " return Qnil;\n"
5327 | RInt _ | RBool _ ->
5328 pr " return INT2NUM (r);\n"
5330 pr " return ULL2NUM (r);\n"
5332 pr " return rb_str_new2 (r);\n";
5334 pr " VALUE rv = rb_str_new2 (r);\n";
5338 pr " int i, len = 0;\n";
5339 pr " for (i = 0; r[i] != NULL; ++i) len++;\n";
5340 pr " VALUE rv = rb_ary_new2 (len);\n";
5341 pr " for (i = 0; r[i] != NULL; ++i) {\n";
5342 pr " rb_ary_push (rv, rb_str_new2 (r[i]));\n";
5343 pr " free (r[i]);\n";
5348 pr " VALUE rv = rb_ary_new2 (2);\n";
5349 pr " rb_ary_push (rv, INT2NUM (r->i));\n";
5350 pr " rb_ary_push (rv, INT2NUM (r->b));\n";
5351 pr " guestfs_free_int_bool (r);\n";
5354 generate_ruby_lvm_code "pv" pv_cols
5356 generate_ruby_lvm_code "vg" vg_cols
5358 generate_ruby_lvm_code "lv" lv_cols
5360 pr " VALUE rv = rb_hash_new ();\n";
5364 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
5369 pr " VALUE rv = rb_hash_new ();\n";
5373 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
5378 pr " VALUE rv = rb_hash_new ();\n";
5380 pr " for (i = 0; r[i] != NULL; i+=2) {\n";
5381 pr " rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
5382 pr " free (r[i]);\n";
5383 pr " free (r[i+1]);\n";
5394 /* Initialize the module. */
5395 void Init__guestfs ()
5397 m_guestfs = rb_define_module (\"Guestfs\");
5398 c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
5399 e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
5401 rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
5402 rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
5405 (* Define the rest of the methods. *)
5407 fun (name, style, _, _, _, _, _) ->
5408 pr " rb_define_method (c_guestfs, \"%s\",\n" name;
5409 pr " ruby_guestfs_%s, %d);\n" name (List.length (snd style))
5414 (* Ruby code to return an LVM struct list. *)
5415 and generate_ruby_lvm_code typ cols =
5416 pr " VALUE rv = rb_ary_new2 (r->len);\n";
5418 pr " for (i = 0; i < r->len; ++i) {\n";
5419 pr " VALUE hv = rb_hash_new ();\n";
5423 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
5425 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
5428 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
5429 | name, `OptPercent ->
5430 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
5432 pr " rb_ary_push (rv, hv);\n";
5434 pr " guestfs_free_lvm_%s_list (r);\n" typ;
5437 let output_to filename =
5438 let filename_new = filename ^ ".new" in
5439 chan := open_out filename_new;
5443 Unix.rename filename_new filename;
5444 printf "written %s\n%!" filename;
5452 if not (Sys.file_exists "configure.ac") then (
5454 You are probably running this from the wrong directory.
5455 Run it from the top source directory using the command
5461 let close = output_to "src/guestfs_protocol.x" in
5465 let close = output_to "src/guestfs-structs.h" in
5466 generate_structs_h ();
5469 let close = output_to "src/guestfs-actions.h" in
5470 generate_actions_h ();
5473 let close = output_to "src/guestfs-actions.c" in
5474 generate_client_actions ();
5477 let close = output_to "daemon/actions.h" in
5478 generate_daemon_actions_h ();
5481 let close = output_to "daemon/stubs.c" in
5482 generate_daemon_actions ();
5485 let close = output_to "tests.c" in
5489 let close = output_to "fish/cmds.c" in
5490 generate_fish_cmds ();
5493 let close = output_to "fish/completion.c" in
5494 generate_fish_completion ();
5497 let close = output_to "guestfs-structs.pod" in
5498 generate_structs_pod ();
5501 let close = output_to "guestfs-actions.pod" in
5502 generate_actions_pod ();
5505 let close = output_to "guestfish-actions.pod" in
5506 generate_fish_actions_pod ();
5509 let close = output_to "ocaml/guestfs.mli" in
5510 generate_ocaml_mli ();
5513 let close = output_to "ocaml/guestfs.ml" in
5514 generate_ocaml_ml ();
5517 let close = output_to "ocaml/guestfs_c_actions.c" in
5518 generate_ocaml_c ();
5521 let close = output_to "perl/Guestfs.xs" in
5522 generate_perl_xs ();
5525 let close = output_to "perl/lib/Sys/Guestfs.pm" in
5526 generate_perl_pm ();
5529 let close = output_to "python/guestfs-py.c" in
5530 generate_python_c ();
5533 let close = output_to "python/guestfs.py" in
5534 generate_python_py ();
5537 let close = output_to "ruby/ext/guestfs/_guestfs.c" in