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>.");
1299 let all_functions = non_daemon_functions @ daemon_functions
1301 (* In some places we want the functions to be displayed sorted
1302 * alphabetically, so this is useful:
1304 let all_functions_sorted =
1305 List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
1306 compare n1 n2) all_functions
1308 (* Column names and types from LVM PVs/VGs/LVs. *)
1317 "pv_attr", `String (* XXX *);
1318 "pv_pe_count", `Int;
1319 "pv_pe_alloc_count", `Int;
1322 "pv_mda_count", `Int;
1323 "pv_mda_free", `Bytes;
1324 (* Not in Fedora 10:
1325 "pv_mda_size", `Bytes;
1332 "vg_attr", `String (* XXX *);
1335 "vg_sysid", `String;
1336 "vg_extent_size", `Bytes;
1337 "vg_extent_count", `Int;
1338 "vg_free_count", `Int;
1346 "vg_mda_count", `Int;
1347 "vg_mda_free", `Bytes;
1348 (* Not in Fedora 10:
1349 "vg_mda_size", `Bytes;
1355 "lv_attr", `String (* XXX *);
1358 "lv_kernel_major", `Int;
1359 "lv_kernel_minor", `Int;
1363 "snap_percent", `OptPercent;
1364 "copy_percent", `OptPercent;
1367 "mirror_log", `String;
1371 (* Column names and types from stat structures.
1372 * NB. Can't use things like 'st_atime' because glibc header files
1373 * define some of these as macros. Ugh.
1390 let statvfs_cols = [
1404 (* Useful functions.
1405 * Note we don't want to use any external OCaml libraries which
1406 * makes this a bit harder than it should be.
1408 let failwithf fs = ksprintf failwith fs
1410 let replace_char s c1 c2 =
1411 let s2 = String.copy s in
1412 let r = ref false in
1413 for i = 0 to String.length s2 - 1 do
1414 if String.unsafe_get s2 i = c1 then (
1415 String.unsafe_set s2 i c2;
1419 if not !r then s else s2
1423 (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
1425 let triml ?(test = isspace) str =
1427 let n = ref (String.length str) in
1428 while !n > 0 && test str.[!i]; do
1433 else String.sub str !i !n
1435 let trimr ?(test = isspace) str =
1436 let n = ref (String.length str) in
1437 while !n > 0 && test str.[!n-1]; do
1440 if !n = String.length str then str
1441 else String.sub str 0 !n
1443 let trim ?(test = isspace) str =
1444 trimr ~test (triml ~test str)
1446 let rec find s sub =
1447 let len = String.length s in
1448 let sublen = String.length sub in
1450 if i <= len-sublen then (
1452 if j < sublen then (
1453 if s.[i+j] = sub.[j] then loop2 (j+1)
1459 if r = -1 then loop (i+1) else r
1465 let rec replace_str s s1 s2 =
1466 let len = String.length s in
1467 let sublen = String.length s1 in
1468 let i = find s s1 in
1471 let s' = String.sub s 0 i in
1472 let s'' = String.sub s (i+sublen) (len-i-sublen) in
1473 s' ^ s2 ^ replace_str s'' s1 s2
1476 let rec string_split sep str =
1477 let len = String.length str in
1478 let seplen = String.length sep in
1479 let i = find str sep in
1480 if i = -1 then [str]
1482 let s' = String.sub str 0 i in
1483 let s'' = String.sub str (i+seplen) (len-i-seplen) in
1484 s' :: string_split sep s''
1487 let rec find_map f = function
1488 | [] -> raise Not_found
1492 | None -> find_map f xs
1495 let rec loop i = function
1497 | x :: xs -> f i x; loop (i+1) xs
1502 let rec loop i = function
1504 | x :: xs -> let r = f i x in r :: loop (i+1) xs
1508 let name_of_argt = function
1509 | String n | OptString n | StringList n | Bool n | Int n
1510 | FileIn n | FileOut n -> n
1512 let seq_of_test = function
1513 | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
1514 | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s
1515 | TestOutputLength (s, _) | TestOutputStruct (s, _)
1516 | TestLastFail s -> s
1518 (* Check function names etc. for consistency. *)
1519 let check_functions () =
1520 let contains_uppercase str =
1521 let len = String.length str in
1523 if i >= len then false
1526 if c >= 'A' && c <= 'Z' then true
1533 (* Check function names. *)
1535 fun (name, _, _, _, _, _, _) ->
1536 if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
1537 failwithf "function name %s does not need 'guestfs' prefix" name;
1538 if contains_uppercase name then
1539 failwithf "function name %s should not contain uppercase chars" name;
1540 if String.contains name '-' then
1541 failwithf "function name %s should not contain '-', use '_' instead."
1545 (* Check function parameter/return names. *)
1547 fun (name, style, _, _, _, _, _) ->
1548 let check_arg_ret_name n =
1549 if contains_uppercase n then
1550 failwithf "%s param/ret %s should not contain uppercase chars"
1552 if String.contains n '-' || String.contains n '_' then
1553 failwithf "%s param/ret %s should not contain '-' or '_'"
1556 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;
1557 if n = "argv" || n = "args" then
1558 failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" n
1561 (match fst style with
1563 | RInt n | RInt64 n | RBool n | RConstString n | RString n
1564 | RStringList n | RPVList n | RVGList n | RLVList n
1565 | RStat n | RStatVFS n
1567 check_arg_ret_name n
1569 check_arg_ret_name n;
1570 check_arg_ret_name m
1572 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
1575 (* Check short descriptions. *)
1577 fun (name, _, _, _, _, shortdesc, _) ->
1578 if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
1579 failwithf "short description of %s should begin with lowercase." name;
1580 let c = shortdesc.[String.length shortdesc-1] in
1581 if c = '\n' || c = '.' then
1582 failwithf "short description of %s should not end with . or \\n." name
1585 (* Check long dscriptions. *)
1587 fun (name, _, _, _, _, _, longdesc) ->
1588 if longdesc.[String.length longdesc-1] = '\n' then
1589 failwithf "long description of %s should not end with \\n." name
1592 (* Check proc_nrs. *)
1594 fun (name, _, proc_nr, _, _, _, _) ->
1595 if proc_nr <= 0 then
1596 failwithf "daemon function %s should have proc_nr > 0" name
1600 fun (name, _, proc_nr, _, _, _, _) ->
1601 if proc_nr <> -1 then
1602 failwithf "non-daemon function %s should have proc_nr -1" name
1603 ) non_daemon_functions;
1606 List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
1609 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
1610 let rec loop = function
1613 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
1615 | (name1,nr1) :: (name2,nr2) :: _ ->
1616 failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
1624 (* Ignore functions that have no tests. We generate a
1625 * warning when the user does 'make check' instead.
1627 | name, _, _, _, [], _, _ -> ()
1628 | name, _, _, _, tests, _, _ ->
1632 match seq_of_test test with
1634 failwithf "%s has a test containing an empty sequence" name
1635 | cmds -> List.map List.hd cmds
1637 let funcs = List.flatten funcs in
1639 let tested = List.mem name funcs in
1642 failwithf "function %s has tests but does not test itself" name
1645 (* 'pr' prints to the current output file. *)
1646 let chan = ref stdout
1647 let pr fs = ksprintf (output_string !chan) fs
1649 (* Generate a header block in a number of standard styles. *)
1650 type comment_style = CStyle | HashStyle | OCamlStyle
1651 type license = GPLv2 | LGPLv2
1653 let generate_header comment license =
1654 let c = match comment with
1655 | CStyle -> pr "/* "; " *"
1656 | HashStyle -> pr "# "; "#"
1657 | OCamlStyle -> pr "(* "; " *" in
1658 pr "libguestfs generated file\n";
1659 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
1660 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
1662 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
1666 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
1667 pr "%s it under the terms of the GNU General Public License as published by\n" c;
1668 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
1669 pr "%s (at your option) any later version.\n" c;
1671 pr "%s This program is distributed in the hope that it will be useful,\n" c;
1672 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1673 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
1674 pr "%s GNU General Public License for more details.\n" c;
1676 pr "%s You should have received a copy of the GNU General Public License along\n" c;
1677 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
1678 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
1681 pr "%s This library is free software; you can redistribute it and/or\n" c;
1682 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
1683 pr "%s License as published by the Free Software Foundation; either\n" c;
1684 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
1686 pr "%s This library is distributed in the hope that it will be useful,\n" c;
1687 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1688 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
1689 pr "%s Lesser General Public License for more details.\n" c;
1691 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
1692 pr "%s License along with this library; if not, write to the Free Software\n" c;
1693 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
1696 | CStyle -> pr " */\n"
1698 | OCamlStyle -> pr " *)\n"
1702 (* Start of main code generation functions below this line. *)
1704 (* Generate the pod documentation for the C API. *)
1705 let rec generate_actions_pod () =
1707 fun (shortname, style, _, flags, _, _, longdesc) ->
1708 let name = "guestfs_" ^ shortname in
1709 pr "=head2 %s\n\n" name;
1711 generate_prototype ~extern:false ~handle:"handle" name style;
1713 pr "%s\n\n" longdesc;
1714 (match fst style with
1716 pr "This function returns 0 on success or -1 on error.\n\n"
1718 pr "On error this function returns -1.\n\n"
1720 pr "On error this function returns -1.\n\n"
1722 pr "This function returns a C truth value on success or -1 on error.\n\n"
1724 pr "This function returns a string, or NULL on error.
1725 The string is owned by the guest handle and must I<not> be freed.\n\n"
1727 pr "This function returns a string, or NULL on error.
1728 I<The caller must free the returned string after use>.\n\n"
1730 pr "This function returns a NULL-terminated array of strings
1731 (like L<environ(3)>), or NULL if there was an error.
1732 I<The caller must free the strings and the array after use>.\n\n"
1734 pr "This function returns a C<struct guestfs_int_bool *>,
1735 or NULL if there was an error.
1736 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
1738 pr "This function returns a C<struct guestfs_lvm_pv_list *>
1739 (see E<lt>guestfs-structs.hE<gt>),
1740 or NULL if there was an error.
1741 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
1743 pr "This function returns a C<struct guestfs_lvm_vg_list *>
1744 (see E<lt>guestfs-structs.hE<gt>),
1745 or NULL if there was an error.
1746 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
1748 pr "This function returns a C<struct guestfs_lvm_lv_list *>
1749 (see E<lt>guestfs-structs.hE<gt>),
1750 or NULL if there was an error.
1751 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
1753 pr "This function returns a C<struct guestfs_stat *>
1754 (see L<stat(2)> and E<lt>guestfs-structs.hE<gt>),
1755 or NULL if there was an error.
1756 I<The caller must call C<free> after use>.\n\n"
1758 pr "This function returns a C<struct guestfs_statvfs *>
1759 (see L<statvfs(2)> and E<lt>guestfs-structs.hE<gt>),
1760 or NULL if there was an error.
1761 I<The caller must call C<free> after use>.\n\n"
1763 pr "This function returns a NULL-terminated array of
1764 strings, or NULL if there was an error.
1765 The array of strings will always have length C<2n+1>, where
1766 C<n> keys and values alternate, followed by the trailing NULL entry.
1767 I<The caller must free the strings and the array after use>.\n\n"
1769 if List.mem ProtocolLimitWarning flags then
1770 pr "%s\n\n" protocol_limit_warning;
1771 if List.mem DangerWillRobinson flags then
1772 pr "%s\n\n" danger_will_robinson;
1773 ) all_functions_sorted
1775 and generate_structs_pod () =
1776 (* LVM structs documentation. *)
1779 pr "=head2 guestfs_lvm_%s\n" typ;
1781 pr " struct guestfs_lvm_%s {\n" typ;
1784 | name, `String -> pr " char *%s;\n" name
1786 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
1787 pr " char %s[32];\n" name
1788 | name, `Bytes -> pr " uint64_t %s;\n" name
1789 | name, `Int -> pr " int64_t %s;\n" name
1790 | name, `OptPercent ->
1791 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
1792 pr " float %s;\n" name
1795 pr " struct guestfs_lvm_%s_list {\n" typ;
1796 pr " uint32_t len; /* Number of elements in list. */\n";
1797 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
1800 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
1803 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1805 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
1806 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
1808 * We have to use an underscore instead of a dash because otherwise
1809 * rpcgen generates incorrect code.
1811 * This header is NOT exported to clients, but see also generate_structs_h.
1813 and generate_xdr () =
1814 generate_header CStyle LGPLv2;
1816 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
1817 pr "typedef string str<>;\n";
1820 (* LVM internal structures. *)
1824 pr "struct guestfs_lvm_int_%s {\n" typ;
1826 | name, `String -> pr " string %s<>;\n" name
1827 | name, `UUID -> pr " opaque %s[32];\n" name
1828 | name, `Bytes -> pr " hyper %s;\n" name
1829 | name, `Int -> pr " hyper %s;\n" name
1830 | name, `OptPercent -> pr " float %s;\n" name
1834 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
1836 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1838 (* Stat internal structures. *)
1842 pr "struct guestfs_int_%s {\n" typ;
1844 | name, `Int -> pr " hyper %s;\n" name
1848 ) ["stat", stat_cols; "statvfs", statvfs_cols];
1851 fun (shortname, style, _, _, _, _, _) ->
1852 let name = "guestfs_" ^ shortname in
1854 (match snd style with
1857 pr "struct %s_args {\n" name;
1860 | String n -> pr " string %s<>;\n" n
1861 | OptString n -> pr " str *%s;\n" n
1862 | StringList n -> pr " str %s<>;\n" n
1863 | Bool n -> pr " bool %s;\n" n
1864 | Int n -> pr " int %s;\n" n
1865 | FileIn _ | FileOut _ -> ()
1869 (match fst style with
1872 pr "struct %s_ret {\n" name;
1876 pr "struct %s_ret {\n" name;
1877 pr " hyper %s;\n" n;
1880 pr "struct %s_ret {\n" name;
1884 failwithf "RConstString cannot be returned from a daemon function"
1886 pr "struct %s_ret {\n" name;
1887 pr " string %s<>;\n" n;
1890 pr "struct %s_ret {\n" name;
1891 pr " str %s<>;\n" n;
1894 pr "struct %s_ret {\n" name;
1899 pr "struct %s_ret {\n" name;
1900 pr " guestfs_lvm_int_pv_list %s;\n" n;
1903 pr "struct %s_ret {\n" name;
1904 pr " guestfs_lvm_int_vg_list %s;\n" n;
1907 pr "struct %s_ret {\n" name;
1908 pr " guestfs_lvm_int_lv_list %s;\n" n;
1911 pr "struct %s_ret {\n" name;
1912 pr " guestfs_int_stat %s;\n" n;
1915 pr "struct %s_ret {\n" name;
1916 pr " guestfs_int_statvfs %s;\n" n;
1919 pr "struct %s_ret {\n" name;
1920 pr " str %s<>;\n" n;
1925 (* Table of procedure numbers. *)
1926 pr "enum guestfs_procedure {\n";
1928 fun (shortname, _, proc_nr, _, _, _, _) ->
1929 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
1931 pr " GUESTFS_PROC_NR_PROCS\n";
1935 (* Having to choose a maximum message size is annoying for several
1936 * reasons (it limits what we can do in the API), but it (a) makes
1937 * the protocol a lot simpler, and (b) provides a bound on the size
1938 * of the daemon which operates in limited memory space. For large
1939 * file transfers you should use FTP.
1941 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
1944 (* Message header, etc. *)
1946 /* The communication protocol is now documented in the guestfs(3)
1950 const GUESTFS_PROGRAM = 0x2000F5F5;
1951 const GUESTFS_PROTOCOL_VERSION = 1;
1953 /* These constants must be larger than any possible message length. */
1954 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
1955 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
1957 enum guestfs_message_direction {
1958 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
1959 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
1962 enum guestfs_message_status {
1963 GUESTFS_STATUS_OK = 0,
1964 GUESTFS_STATUS_ERROR = 1
1967 const GUESTFS_ERROR_LEN = 256;
1969 struct guestfs_message_error {
1970 string error_message<GUESTFS_ERROR_LEN>;
1973 struct guestfs_message_header {
1974 unsigned prog; /* GUESTFS_PROGRAM */
1975 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
1976 guestfs_procedure proc; /* GUESTFS_PROC_x */
1977 guestfs_message_direction direction;
1978 unsigned serial; /* message serial number */
1979 guestfs_message_status status;
1982 const GUESTFS_MAX_CHUNK_SIZE = 8192;
1984 struct guestfs_chunk {
1985 int cancel; /* if non-zero, transfer is cancelled */
1986 /* data size is 0 bytes if the transfer has finished successfully */
1987 opaque data<GUESTFS_MAX_CHUNK_SIZE>;
1991 (* Generate the guestfs-structs.h file. *)
1992 and generate_structs_h () =
1993 generate_header CStyle LGPLv2;
1995 (* This is a public exported header file containing various
1996 * structures. The structures are carefully written to have
1997 * exactly the same in-memory format as the XDR structures that
1998 * we use on the wire to the daemon. The reason for creating
1999 * copies of these structures here is just so we don't have to
2000 * export the whole of guestfs_protocol.h (which includes much
2001 * unrelated and XDR-dependent stuff that we don't want to be
2002 * public, or required by clients).
2004 * To reiterate, we will pass these structures to and from the
2005 * client with a simple assignment or memcpy, so the format
2006 * must be identical to what rpcgen / the RFC defines.
2009 (* guestfs_int_bool structure. *)
2010 pr "struct guestfs_int_bool {\n";
2016 (* LVM public structures. *)
2020 pr "struct guestfs_lvm_%s {\n" typ;
2023 | name, `String -> pr " char *%s;\n" name
2024 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
2025 | name, `Bytes -> pr " uint64_t %s;\n" name
2026 | name, `Int -> pr " int64_t %s;\n" name
2027 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
2031 pr "struct guestfs_lvm_%s_list {\n" typ;
2032 pr " uint32_t len;\n";
2033 pr " struct guestfs_lvm_%s *val;\n" typ;
2036 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2038 (* Stat structures. *)
2042 pr "struct guestfs_%s {\n" typ;
2045 | name, `Int -> pr " int64_t %s;\n" name
2049 ) ["stat", stat_cols; "statvfs", statvfs_cols]
2051 (* Generate the guestfs-actions.h file. *)
2052 and generate_actions_h () =
2053 generate_header CStyle LGPLv2;
2055 fun (shortname, style, _, _, _, _, _) ->
2056 let name = "guestfs_" ^ shortname in
2057 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
2061 (* Generate the client-side dispatch stubs. *)
2062 and generate_client_actions () =
2063 generate_header CStyle LGPLv2;
2069 #include \"guestfs.h\"
2070 #include \"guestfs_protocol.h\"
2072 #define error guestfs_error
2073 #define perrorf guestfs_perrorf
2074 #define safe_malloc guestfs_safe_malloc
2075 #define safe_realloc guestfs_safe_realloc
2076 #define safe_strdup guestfs_safe_strdup
2077 #define safe_memdup guestfs_safe_memdup
2079 /* Check the return message from a call for validity. */
2081 check_reply_header (guestfs_h *g,
2082 const struct guestfs_message_header *hdr,
2083 int proc_nr, int serial)
2085 if (hdr->prog != GUESTFS_PROGRAM) {
2086 error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
2089 if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
2090 error (g, \"wrong protocol version (%%d/%%d)\",
2091 hdr->vers, GUESTFS_PROTOCOL_VERSION);
2094 if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
2095 error (g, \"unexpected message direction (%%d/%%d)\",
2096 hdr->direction, GUESTFS_DIRECTION_REPLY);
2099 if (hdr->proc != proc_nr) {
2100 error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
2103 if (hdr->serial != serial) {
2104 error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
2111 /* Check we are in the right state to run a high-level action. */
2113 check_state (guestfs_h *g, const char *caller)
2115 if (!guestfs_is_ready (g)) {
2116 if (guestfs_is_config (g))
2117 error (g, \"%%s: call launch() before using this function\",
2119 else if (guestfs_is_launching (g))
2120 error (g, \"%%s: call wait_ready() before using this function\",
2123 error (g, \"%%s called from the wrong state, %%d != READY\",
2124 caller, guestfs_get_state (g));
2132 (* Client-side stubs for each function. *)
2134 fun (shortname, style, _, _, _, _, _) ->
2135 let name = "guestfs_" ^ shortname in
2137 (* Generate the context struct which stores the high-level
2138 * state between callback functions.
2140 pr "struct %s_ctx {\n" shortname;
2141 pr " /* This flag is set by the callbacks, so we know we've done\n";
2142 pr " * the callbacks as expected, and in the right sequence.\n";
2143 pr " * 0 = not called, 1 = send called,\n";
2144 pr " * 1001 = reply called.\n";
2146 pr " int cb_sequence;\n";
2147 pr " struct guestfs_message_header hdr;\n";
2148 pr " struct guestfs_message_error err;\n";
2149 (match fst style with
2152 failwithf "RConstString cannot be returned from a daemon function"
2154 | RBool _ | RString _ | RStringList _
2156 | RPVList _ | RVGList _ | RLVList _
2157 | RStat _ | RStatVFS _
2159 pr " struct %s_ret ret;\n" name
2164 (* Generate the reply callback function. *)
2165 pr "static void %s_reply_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
2167 pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
2168 pr " struct %s_ctx *ctx = (struct %s_ctx *) data;\n" shortname shortname;
2170 pr " ml->main_loop_quit (ml, g);\n";
2172 pr " if (!xdr_guestfs_message_header (xdr, &ctx->hdr)) {\n";
2173 pr " error (g, \"%%s: failed to parse reply header\", \"%s\");\n" name;
2176 pr " if (ctx->hdr.status == GUESTFS_STATUS_ERROR) {\n";
2177 pr " if (!xdr_guestfs_message_error (xdr, &ctx->err)) {\n";
2178 pr " error (g, \"%%s: failed to parse reply error\", \"%s\");\n"
2185 (match fst style with
2188 failwithf "RConstString cannot be returned from a daemon function"
2190 | RBool _ | RString _ | RStringList _
2192 | RPVList _ | RVGList _ | RLVList _
2193 | RStat _ | RStatVFS _
2195 pr " if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name;
2196 pr " error (g, \"%%s: failed to parse reply\", \"%s\");\n" name;
2202 pr " ctx->cb_sequence = 1001;\n";
2205 (* Generate the action stub. *)
2206 generate_prototype ~extern:false ~semicolon:false ~newline:true
2207 ~handle:"g" name style;
2210 match fst style with
2211 | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
2213 failwithf "RConstString cannot be returned from a daemon function"
2214 | RString _ | RStringList _ | RIntBool _
2215 | RPVList _ | RVGList _ | RLVList _
2216 | RStat _ | RStatVFS _
2222 (match snd style with
2224 | _ -> pr " struct %s_args args;\n" name
2227 pr " struct %s_ctx ctx;\n" shortname;
2228 pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
2229 pr " int serial;\n";
2231 pr " if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
2232 pr " guestfs_set_busy (g);\n";
2234 pr " memset (&ctx, 0, sizeof ctx);\n";
2237 (* Send the main header and arguments. *)
2238 (match snd style with
2240 pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s, NULL, NULL);\n"
2241 (String.uppercase shortname)
2246 pr " args.%s = (char *) %s;\n" n n
2248 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
2250 pr " args.%s.%s_val = (char **) %s;\n" n n n;
2251 pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
2253 pr " args.%s = %s;\n" n n
2255 pr " args.%s = %s;\n" n n
2256 | FileIn _ | FileOut _ -> ()
2258 pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s,\n"
2259 (String.uppercase shortname);
2260 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
2263 pr " if (serial == -1) {\n";
2264 pr " guestfs_set_ready (g);\n";
2265 pr " return %s;\n" error_code;
2269 (* Send any additional files (FileIn) requested. *)
2276 pr " r = guestfs__send_file_sync (g, %s);\n" n;
2277 pr " if (r == -1) {\n";
2278 pr " guestfs_set_ready (g);\n";
2279 pr " return %s;\n" error_code;
2281 pr " if (r == -2) /* daemon cancelled */\n";
2282 pr " goto read_reply;\n";
2288 (* Wait for the reply from the remote end. *)
2289 pr " read_reply:\n";
2290 pr " guestfs__switch_to_receiving (g);\n";
2291 pr " ctx.cb_sequence = 0;\n";
2292 pr " guestfs_set_reply_callback (g, %s_reply_cb, &ctx);\n" shortname;
2293 pr " (void) ml->main_loop_run (ml, g);\n";
2294 pr " guestfs_set_reply_callback (g, NULL, NULL);\n";
2295 pr " if (ctx.cb_sequence != 1001) {\n";
2296 pr " error (g, \"%%s reply failed, see earlier error messages\", \"%s\");\n" name;
2297 pr " guestfs_set_ready (g);\n";
2298 pr " return %s;\n" error_code;
2302 pr " if (check_reply_header (g, &ctx.hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
2303 (String.uppercase shortname);
2304 pr " guestfs_set_ready (g);\n";
2305 pr " return %s;\n" error_code;
2309 pr " if (ctx.hdr.status == GUESTFS_STATUS_ERROR) {\n";
2310 pr " error (g, \"%%s\", ctx.err.error_message);\n";
2311 pr " guestfs_set_ready (g);\n";
2312 pr " return %s;\n" error_code;
2316 (* Expecting to receive further files (FileOut)? *)
2320 pr " if (guestfs__receive_file_sync (g, %s) == -1) {\n" n;
2321 pr " guestfs_set_ready (g);\n";
2322 pr " return %s;\n" error_code;
2328 pr " guestfs_set_ready (g);\n";
2330 (match fst style with
2331 | RErr -> pr " return 0;\n"
2332 | RInt n | RInt64 n | RBool n ->
2333 pr " return ctx.ret.%s;\n" n
2335 failwithf "RConstString cannot be returned from a daemon function"
2337 pr " return ctx.ret.%s; /* caller will free */\n" n
2338 | RStringList n | RHashtable n ->
2339 pr " /* caller will free this, but we need to add a NULL entry */\n";
2340 pr " ctx.ret.%s.%s_val =\n" n n;
2341 pr " safe_realloc (g, ctx.ret.%s.%s_val,\n" n n;
2342 pr " sizeof (char *) * (ctx.ret.%s.%s_len + 1));\n"
2344 pr " ctx.ret.%s.%s_val[ctx.ret.%s.%s_len] = NULL;\n" n n n n;
2345 pr " return ctx.ret.%s.%s_val;\n" n n
2347 pr " /* caller with free this */\n";
2348 pr " return safe_memdup (g, &ctx.ret, sizeof (ctx.ret));\n"
2349 | RPVList n | RVGList n | RLVList n
2350 | RStat n | RStatVFS n ->
2351 pr " /* caller will free this */\n";
2352 pr " return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n
2358 (* Generate daemon/actions.h. *)
2359 and generate_daemon_actions_h () =
2360 generate_header CStyle GPLv2;
2362 pr "#include \"../src/guestfs_protocol.h\"\n";
2366 fun (name, style, _, _, _, _, _) ->
2368 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
2372 (* Generate the server-side stubs. *)
2373 and generate_daemon_actions () =
2374 generate_header CStyle GPLv2;
2376 pr "#define _GNU_SOURCE // for strchrnul\n";
2378 pr "#include <stdio.h>\n";
2379 pr "#include <stdlib.h>\n";
2380 pr "#include <string.h>\n";
2381 pr "#include <inttypes.h>\n";
2382 pr "#include <ctype.h>\n";
2383 pr "#include <rpc/types.h>\n";
2384 pr "#include <rpc/xdr.h>\n";
2386 pr "#include \"daemon.h\"\n";
2387 pr "#include \"../src/guestfs_protocol.h\"\n";
2388 pr "#include \"actions.h\"\n";
2392 fun (name, style, _, _, _, _, _) ->
2393 (* Generate server-side stubs. *)
2394 pr "static void %s_stub (XDR *xdr_in)\n" name;
2397 match fst style with
2398 | RErr | RInt _ -> pr " int r;\n"; "-1"
2399 | RInt64 _ -> pr " int64_t r;\n"; "-1"
2400 | RBool _ -> pr " int r;\n"; "-1"
2402 failwithf "RConstString cannot be returned from a daemon function"
2403 | RString _ -> pr " char *r;\n"; "NULL"
2404 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
2405 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
2406 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
2407 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
2408 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL"
2409 | RStat _ -> pr " guestfs_int_stat *r;\n"; "NULL"
2410 | RStatVFS _ -> pr " guestfs_int_statvfs *r;\n"; "NULL" in
2412 (match snd style with
2415 pr " struct guestfs_%s_args args;\n" name;
2419 | OptString n -> pr " const char *%s;\n" n
2420 | StringList n -> pr " char **%s;\n" n
2421 | Bool n -> pr " int %s;\n" n
2422 | Int n -> pr " int %s;\n" n
2423 | FileIn _ | FileOut _ -> ()
2428 (match snd style with
2431 pr " memset (&args, 0, sizeof args);\n";
2433 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
2434 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
2439 | String n -> pr " %s = args.%s;\n" n n
2440 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
2442 pr " args.%s.%s_val = realloc (args.%s.%s_val, sizeof (char *) * (args.%s.%s_len+1));\n" n n n n n n;
2443 pr " args.%s.%s_val[args.%s.%s_len] = NULL;\n" n n n n;
2444 pr " %s = args.%s.%s_val;\n" n n n
2445 | Bool n -> pr " %s = args.%s;\n" n n
2446 | Int n -> pr " %s = args.%s;\n" n n
2447 | FileIn _ | FileOut _ -> ()
2452 (* Don't want to call the impl with any FileIn or FileOut
2453 * parameters, since these go "outside" the RPC protocol.
2456 List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
2458 pr " r = do_%s " name;
2459 generate_call_args argsnofile;
2462 pr " if (r == %s)\n" error_code;
2463 pr " /* do_%s has already called reply_with_error */\n" name;
2467 (* If there are any FileOut parameters, then the impl must
2468 * send its own reply.
2471 List.exists (function FileOut _ -> true | _ -> false) (snd style) in
2473 pr " /* do_%s has already sent a reply */\n" name
2475 match fst style with
2476 | RErr -> pr " reply (NULL, NULL);\n"
2477 | RInt n | RInt64 n | RBool n ->
2478 pr " struct guestfs_%s_ret ret;\n" name;
2479 pr " ret.%s = r;\n" n;
2480 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2483 failwithf "RConstString cannot be returned from a daemon function"
2485 pr " struct guestfs_%s_ret ret;\n" name;
2486 pr " ret.%s = r;\n" n;
2487 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2490 | RStringList n | RHashtable n ->
2491 pr " struct guestfs_%s_ret ret;\n" name;
2492 pr " ret.%s.%s_len = count_strings (r);\n" n n;
2493 pr " ret.%s.%s_val = r;\n" n n;
2494 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2496 pr " free_strings (r);\n"
2498 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n"
2500 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
2501 | RPVList n | RVGList n | RLVList n
2502 | RStat n | RStatVFS n ->
2503 pr " struct guestfs_%s_ret ret;\n" name;
2504 pr " ret.%s = *r;\n" n;
2505 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
2507 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
2511 (* Free the args. *)
2512 (match snd style with
2517 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
2524 (* Dispatch function. *)
2525 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
2527 pr " switch (proc_nr) {\n";
2530 fun (name, style, _, _, _, _, _) ->
2531 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
2532 pr " %s_stub (xdr_in);\n" name;
2537 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
2542 (* LVM columns and tokenization functions. *)
2543 (* XXX This generates crap code. We should rethink how we
2549 pr "static const char *lvm_%s_cols = \"%s\";\n"
2550 typ (String.concat "," (List.map fst cols));
2553 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
2555 pr " char *tok, *p, *next;\n";
2559 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
2562 pr " if (!str) {\n";
2563 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
2566 pr " if (!*str || isspace (*str)) {\n";
2567 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
2572 fun (name, coltype) ->
2573 pr " if (!tok) {\n";
2574 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
2577 pr " p = strchrnul (tok, ',');\n";
2578 pr " if (*p) next = p+1; else next = NULL;\n";
2579 pr " *p = '\\0';\n";
2582 pr " r->%s = strdup (tok);\n" name;
2583 pr " if (r->%s == NULL) {\n" name;
2584 pr " perror (\"strdup\");\n";
2588 pr " for (i = j = 0; i < 32; ++j) {\n";
2589 pr " if (tok[j] == '\\0') {\n";
2590 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
2592 pr " } else if (tok[j] != '-')\n";
2593 pr " r->%s[i++] = tok[j];\n" name;
2596 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
2597 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2601 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
2602 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2606 pr " if (tok[0] == '\\0')\n";
2607 pr " r->%s = -1;\n" name;
2608 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
2609 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2613 pr " tok = next;\n";
2616 pr " if (tok != NULL) {\n";
2617 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
2624 pr "guestfs_lvm_int_%s_list *\n" typ;
2625 pr "parse_command_line_%ss (void)\n" typ;
2627 pr " char *out, *err;\n";
2628 pr " char *p, *pend;\n";
2630 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
2631 pr " void *newp;\n";
2633 pr " ret = malloc (sizeof *ret);\n";
2634 pr " if (!ret) {\n";
2635 pr " reply_with_perror (\"malloc\");\n";
2636 pr " return NULL;\n";
2639 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
2640 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
2642 pr " r = command (&out, &err,\n";
2643 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
2644 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
2645 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
2646 pr " if (r == -1) {\n";
2647 pr " reply_with_error (\"%%s\", err);\n";
2648 pr " free (out);\n";
2649 pr " free (err);\n";
2650 pr " free (ret);\n";
2651 pr " return NULL;\n";
2654 pr " free (err);\n";
2656 pr " /* Tokenize each line of the output. */\n";
2659 pr " while (p) {\n";
2660 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
2661 pr " if (pend) {\n";
2662 pr " *pend = '\\0';\n";
2666 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
2669 pr " if (!*p) { /* Empty line? Skip it. */\n";
2674 pr " /* Allocate some space to store this next entry. */\n";
2675 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
2676 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
2677 pr " if (newp == NULL) {\n";
2678 pr " reply_with_perror (\"realloc\");\n";
2679 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2680 pr " free (ret);\n";
2681 pr " free (out);\n";
2682 pr " return NULL;\n";
2684 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
2686 pr " /* Tokenize the next entry. */\n";
2687 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
2688 pr " if (r == -1) {\n";
2689 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
2690 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2691 pr " free (ret);\n";
2692 pr " free (out);\n";
2693 pr " return NULL;\n";
2700 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
2702 pr " free (out);\n";
2703 pr " return ret;\n";
2706 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2708 (* Generate the tests. *)
2709 and generate_tests () =
2710 generate_header CStyle GPLv2;
2717 #include <sys/types.h>
2720 #include \"guestfs.h\"
2722 static guestfs_h *g;
2723 static int suppress_error = 0;
2725 static void print_error (guestfs_h *g, void *data, const char *msg)
2727 if (!suppress_error)
2728 fprintf (stderr, \"%%s\\n\", msg);
2731 static void print_strings (char * const * const argv)
2735 for (argc = 0; argv[argc] != NULL; ++argc)
2736 printf (\"\\t%%s\\n\", argv[argc]);
2740 static void print_table (char * const * const argv)
2744 for (i = 0; argv[i] != NULL; i += 2)
2745 printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
2749 static void no_test_warnings (void)
2755 | name, _, _, _, [], _, _ ->
2756 pr " fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
2757 | name, _, _, _, tests, _, _ -> ()
2763 (* Generate the actual tests. Note that we generate the tests
2764 * in reverse order, deliberately, so that (in general) the
2765 * newest tests run first. This makes it quicker and easier to
2770 fun (name, _, _, _, tests, _, _) ->
2771 mapi (generate_one_test name) tests
2772 ) (List.rev all_functions) in
2773 let test_names = List.concat test_names in
2774 let nr_tests = List.length test_names in
2777 int main (int argc, char *argv[])
2784 int nr_tests, test_num = 0;
2786 no_test_warnings ();
2788 g = guestfs_create ();
2790 printf (\"guestfs_create FAILED\\n\");
2794 guestfs_set_error_handler (g, print_error, NULL);
2796 srcdir = getenv (\"srcdir\");
2797 if (!srcdir) srcdir = \".\";
2798 guestfs_set_path (g, srcdir);
2800 snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);
2801 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2806 if (lseek (fd, %d, SEEK_SET) == -1) {
2812 if (write (fd, &c, 1) == -1) {
2818 if (close (fd) == -1) {
2823 if (guestfs_add_drive (g, buf) == -1) {
2824 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2828 snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);
2829 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2834 if (lseek (fd, %d, SEEK_SET) == -1) {
2840 if (write (fd, &c, 1) == -1) {
2846 if (close (fd) == -1) {
2851 if (guestfs_add_drive (g, buf) == -1) {
2852 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2856 snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);
2857 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2862 if (lseek (fd, %d, SEEK_SET) == -1) {
2868 if (write (fd, &c, 1) == -1) {
2874 if (close (fd) == -1) {
2879 if (guestfs_add_drive (g, buf) == -1) {
2880 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2884 if (guestfs_launch (g) == -1) {
2885 printf (\"guestfs_launch FAILED\\n\");
2888 if (guestfs_wait_ready (g) == -1) {
2889 printf (\"guestfs_wait_ready FAILED\\n\");
2895 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
2899 pr " test_num++;\n";
2900 pr " printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
2901 pr " if (%s () == -1) {\n" test_name;
2902 pr " printf (\"%s FAILED\\n\");\n" test_name;
2908 pr " guestfs_close (g);\n";
2909 pr " snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);\n";
2910 pr " unlink (buf);\n";
2911 pr " snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);\n";
2912 pr " unlink (buf);\n";
2913 pr " snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);\n";
2914 pr " unlink (buf);\n";
2917 pr " if (failed > 0) {\n";
2918 pr " printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n";
2926 and generate_one_test name i (init, test) =
2927 let test_name = sprintf "test_%s_%d" name i in
2929 pr "static int %s (void)\n" test_name;
2935 pr " /* InitEmpty for %s (%d) */\n" name i;
2936 List.iter (generate_test_command_call test_name)
2940 pr " /* InitBasicFS for %s (%d): create ext2 on /dev/sda1 */\n" name i;
2941 List.iter (generate_test_command_call test_name)
2944 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2945 ["mkfs"; "ext2"; "/dev/sda1"];
2946 ["mount"; "/dev/sda1"; "/"]]
2947 | InitBasicFSonLVM ->
2948 pr " /* InitBasicFSonLVM for %s (%d): create ext2 on /dev/VG/LV */\n"
2950 List.iter (generate_test_command_call test_name)
2953 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2954 ["pvcreate"; "/dev/sda1"];
2955 ["vgcreate"; "VG"; "/dev/sda1"];
2956 ["lvcreate"; "LV"; "VG"; "8"];
2957 ["mkfs"; "ext2"; "/dev/VG/LV"];
2958 ["mount"; "/dev/VG/LV"; "/"]]
2961 let get_seq_last = function
2963 failwithf "%s: you cannot use [] (empty list) when expecting a command"
2966 let seq = List.rev seq in
2967 List.rev (List.tl seq), List.hd seq
2972 pr " /* TestRun for %s (%d) */\n" name i;
2973 List.iter (generate_test_command_call test_name) seq
2974 | TestOutput (seq, expected) ->
2975 pr " /* TestOutput for %s (%d) */\n" name i;
2976 let seq, last = get_seq_last seq in
2978 pr " if (strcmp (r, \"%s\") != 0) {\n" (c_quote expected);
2979 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r);\n" test_name (c_quote expected);
2983 List.iter (generate_test_command_call test_name) seq;
2984 generate_test_command_call ~test test_name last
2985 | TestOutputList (seq, expected) ->
2986 pr " /* TestOutputList for %s (%d) */\n" name i;
2987 let seq, last = get_seq_last seq in
2991 pr " if (!r[%d]) {\n" i;
2992 pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
2993 pr " print_strings (r);\n";
2996 pr " if (strcmp (r[%d], \"%s\") != 0) {\n" i (c_quote str);
2997 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r[%d]);\n" test_name (c_quote str) i;
3001 pr " if (r[%d] != NULL) {\n" (List.length expected);
3002 pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
3004 pr " print_strings (r);\n";
3008 List.iter (generate_test_command_call test_name) seq;
3009 generate_test_command_call ~test test_name last
3010 | TestOutputInt (seq, expected) ->
3011 pr " /* TestOutputInt for %s (%d) */\n" name i;
3012 let seq, last = get_seq_last seq in
3014 pr " if (r != %d) {\n" expected;
3015 pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\","
3021 List.iter (generate_test_command_call test_name) seq;
3022 generate_test_command_call ~test test_name last
3023 | TestOutputTrue seq ->
3024 pr " /* TestOutputTrue for %s (%d) */\n" name i;
3025 let seq, last = get_seq_last seq in
3028 pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n"
3033 List.iter (generate_test_command_call test_name) seq;
3034 generate_test_command_call ~test test_name last
3035 | TestOutputFalse seq ->
3036 pr " /* TestOutputFalse for %s (%d) */\n" name i;
3037 let seq, last = get_seq_last seq in
3040 pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n"
3045 List.iter (generate_test_command_call test_name) seq;
3046 generate_test_command_call ~test test_name last
3047 | TestOutputLength (seq, expected) ->
3048 pr " /* TestOutputLength for %s (%d) */\n" name i;
3049 let seq, last = get_seq_last seq in
3052 pr " for (j = 0; j < %d; ++j)\n" expected;
3053 pr " if (r[j] == NULL) {\n";
3054 pr " fprintf (stderr, \"%s: short list returned\\n\");\n"
3056 pr " print_strings (r);\n";
3059 pr " if (r[j] != NULL) {\n";
3060 pr " fprintf (stderr, \"%s: long list returned\\n\");\n"
3062 pr " print_strings (r);\n";
3066 List.iter (generate_test_command_call test_name) seq;
3067 generate_test_command_call ~test test_name last
3068 | TestOutputStruct (seq, checks) ->
3069 pr " /* TestOutputStruct for %s (%d) */\n" name i;
3070 let seq, last = get_seq_last seq in
3074 | CompareWithInt (field, expected) ->
3075 pr " if (r->%s != %d) {\n" field expected;
3076 pr " fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
3077 test_name field expected;
3078 pr " (int) r->%s);\n" field;
3081 | CompareWithString (field, expected) ->
3082 pr " if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
3083 pr " fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
3084 test_name field expected;
3085 pr " r->%s);\n" field;
3088 | CompareFieldsIntEq (field1, field2) ->
3089 pr " if (r->%s != r->%s) {\n" field1 field2;
3090 pr " fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
3091 test_name field1 field2;
3092 pr " (int) r->%s, (int) r->%s);\n" field1 field2;
3095 | CompareFieldsStrEq (field1, field2) ->
3096 pr " if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
3097 pr " fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
3098 test_name field1 field2;
3099 pr " r->%s, r->%s);\n" field1 field2;
3104 List.iter (generate_test_command_call test_name) seq;
3105 generate_test_command_call ~test test_name last
3106 | TestLastFail seq ->
3107 pr " /* TestLastFail for %s (%d) */\n" name i;
3108 let seq, last = get_seq_last seq in
3109 List.iter (generate_test_command_call test_name) seq;
3110 generate_test_command_call test_name ~expect_error:true last
3118 (* Generate the code to run a command, leaving the result in 'r'.
3119 * If you expect to get an error then you should set expect_error:true.
3121 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
3123 | [] -> assert false
3125 (* Look up the command to find out what args/ret it has. *)
3128 let _, style, _, _, _, _, _ =
3129 List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
3132 failwithf "%s: in test, command %s was not found" test_name name in
3134 if List.length (snd style) <> List.length args then
3135 failwithf "%s: in test, wrong number of args given to %s"
3146 | FileIn _, _ | FileOut _, _ -> ()
3147 | StringList n, arg ->
3148 pr " char *%s[] = {\n" n;
3149 let strs = string_split " " arg in
3151 fun str -> pr " \"%s\",\n" (c_quote str)
3155 ) (List.combine (snd style) args);
3158 match fst style with
3159 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
3160 | RInt64 _ -> pr " int64_t r;\n"; "-1"
3161 | RConstString _ -> pr " const char *r;\n"; "NULL"
3162 | RString _ -> pr " char *r;\n"; "NULL"
3163 | RStringList _ | RHashtable _ ->
3168 pr " struct guestfs_int_bool *r;\n"; "NULL"
3170 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
3172 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
3174 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
3176 pr " struct guestfs_stat *r;\n"; "NULL"
3178 pr " struct guestfs_statvfs *r;\n"; "NULL" in
3180 pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
3181 pr " r = guestfs_%s (g" name;
3183 (* Generate the parameters. *)
3187 | FileIn _, arg | FileOut _, arg ->
3188 pr ", \"%s\"" (c_quote arg)
3189 | OptString _, arg ->
3190 if arg = "NULL" then pr ", NULL" else pr ", \"%s\"" (c_quote arg)
3191 | StringList n, _ ->
3195 try int_of_string arg
3196 with Failure "int_of_string" ->
3197 failwithf "%s: expecting an int, but got '%s'" test_name arg in
3200 let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
3201 ) (List.combine (snd style) args);
3204 if not expect_error then
3205 pr " if (r == %s)\n" error_code
3207 pr " if (r != %s)\n" error_code;
3210 (* Insert the test code. *)
3216 (match fst style with
3217 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ -> ()
3218 | RString _ -> pr " free (r);\n"
3219 | RStringList _ | RHashtable _ ->
3220 pr " for (i = 0; r[i] != NULL; ++i)\n";
3221 pr " free (r[i]);\n";
3224 pr " guestfs_free_int_bool (r);\n"
3226 pr " guestfs_free_lvm_pv_list (r);\n"
3228 pr " guestfs_free_lvm_vg_list (r);\n"
3230 pr " guestfs_free_lvm_lv_list (r);\n"
3231 | RStat _ | RStatVFS _ ->
3238 let str = replace_str str "\r" "\\r" in
3239 let str = replace_str str "\n" "\\n" in
3240 let str = replace_str str "\t" "\\t" in
3243 (* Generate a lot of different functions for guestfish. *)
3244 and generate_fish_cmds () =
3245 generate_header CStyle GPLv2;
3249 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3251 let all_functions_sorted =
3253 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3254 ) all_functions_sorted in
3256 pr "#include <stdio.h>\n";
3257 pr "#include <stdlib.h>\n";
3258 pr "#include <string.h>\n";
3259 pr "#include <inttypes.h>\n";
3261 pr "#include <guestfs.h>\n";
3262 pr "#include \"fish.h\"\n";
3265 (* list_commands function, which implements guestfish -h *)
3266 pr "void list_commands (void)\n";
3268 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
3269 pr " list_builtin_commands ();\n";
3271 fun (name, _, _, flags, _, shortdesc, _) ->
3272 let name = replace_char name '_' '-' in
3273 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
3275 ) all_functions_sorted;
3276 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
3280 (* display_command function, which implements guestfish -h cmd *)
3281 pr "void display_command (const char *cmd)\n";
3284 fun (name, style, _, flags, _, shortdesc, longdesc) ->
3285 let name2 = replace_char name '_' '-' in
3287 try find_map (function FishAlias n -> Some n | _ -> None) flags
3288 with Not_found -> name in
3289 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
3291 match snd style with
3295 name2 (String.concat "> <" (List.map name_of_argt args)) in
3298 if List.mem ProtocolLimitWarning flags then
3299 ("\n\n" ^ protocol_limit_warning)
3302 (* For DangerWillRobinson commands, we should probably have
3303 * guestfish prompt before allowing you to use them (especially
3304 * in interactive mode). XXX
3308 if List.mem DangerWillRobinson flags then
3309 ("\n\n" ^ danger_will_robinson)
3312 let describe_alias =
3313 if name <> alias then
3314 sprintf "\n\nYou can use '%s' as an alias for this command." alias
3318 pr "strcasecmp (cmd, \"%s\") == 0" name;
3319 if name <> name2 then
3320 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
3321 if name <> alias then
3322 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
3324 pr " pod2text (\"%s - %s\", %S);\n"
3326 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
3329 pr " display_builtin_command (cmd);\n";
3333 (* print_{pv,vg,lv}_list functions *)
3337 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
3344 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
3346 pr " printf (\"%s: \");\n" name;
3347 pr " for (i = 0; i < 32; ++i)\n";
3348 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
3349 pr " printf (\"\\n\");\n"
3351 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
3353 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
3354 | name, `OptPercent ->
3355 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
3356 typ name name typ name;
3357 pr " else printf (\"%s: \\n\");\n" name
3361 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
3366 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
3367 pr " print_%s (&%ss->val[i]);\n" typ typ;
3370 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3372 (* print_{stat,statvfs} functions *)
3376 pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
3381 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
3385 ) ["stat", stat_cols; "statvfs", statvfs_cols];
3387 (* run_<action> actions *)
3389 fun (name, style, _, flags, _, _, _) ->
3390 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
3392 (match fst style with
3395 | RBool _ -> pr " int r;\n"
3396 | RInt64 _ -> pr " int64_t r;\n"
3397 | RConstString _ -> pr " const char *r;\n"
3398 | RString _ -> pr " char *r;\n"
3399 | RStringList _ | RHashtable _ -> pr " char **r;\n"
3400 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
3401 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
3402 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
3403 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
3404 | RStat _ -> pr " struct guestfs_stat *r;\n"
3405 | RStatVFS _ -> pr " struct guestfs_statvfs *r;\n"
3412 | FileOut n -> pr " const char *%s;\n" n
3413 | StringList n -> pr " char **%s;\n" n
3414 | Bool n -> pr " int %s;\n" n
3415 | Int n -> pr " int %s;\n" n
3418 (* Check and convert parameters. *)
3419 let argc_expected = List.length (snd style) in
3420 pr " if (argc != %d) {\n" argc_expected;
3421 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
3423 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
3429 | String name -> pr " %s = argv[%d];\n" name i
3431 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
3434 pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdin\";\n"
3437 pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n"
3439 | StringList name ->
3440 pr " %s = parse_string_list (argv[%d]);\n" name i
3442 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
3444 pr " %s = atoi (argv[%d]);\n" name i
3447 (* Call C API function. *)
3449 try find_map (function FishAction n -> Some n | _ -> None) flags
3450 with Not_found -> sprintf "guestfs_%s" name in
3452 generate_call_args ~handle:"g" (snd style);
3455 (* Check return value for errors and display command results. *)
3456 (match fst style with
3457 | RErr -> pr " return r;\n"
3459 pr " if (r == -1) return -1;\n";
3460 pr " printf (\"%%d\\n\", r);\n";
3463 pr " if (r == -1) return -1;\n";
3464 pr " printf (\"%%\" PRIi64 \"\\n\", r);\n";
3467 pr " if (r == -1) return -1;\n";
3468 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
3471 pr " if (r == NULL) return -1;\n";
3472 pr " printf (\"%%s\\n\", r);\n";
3475 pr " if (r == NULL) return -1;\n";
3476 pr " printf (\"%%s\\n\", r);\n";
3480 pr " if (r == NULL) return -1;\n";
3481 pr " print_strings (r);\n";
3482 pr " free_strings (r);\n";
3485 pr " if (r == NULL) return -1;\n";
3486 pr " printf (\"%%d, %%s\\n\", r->i,\n";
3487 pr " r->b ? \"true\" : \"false\");\n";
3488 pr " guestfs_free_int_bool (r);\n";
3491 pr " if (r == NULL) return -1;\n";
3492 pr " print_pv_list (r);\n";
3493 pr " guestfs_free_lvm_pv_list (r);\n";
3496 pr " if (r == NULL) return -1;\n";
3497 pr " print_vg_list (r);\n";
3498 pr " guestfs_free_lvm_vg_list (r);\n";
3501 pr " if (r == NULL) return -1;\n";
3502 pr " print_lv_list (r);\n";
3503 pr " guestfs_free_lvm_lv_list (r);\n";
3506 pr " if (r == NULL) return -1;\n";
3507 pr " print_stat (r);\n";
3511 pr " if (r == NULL) return -1;\n";
3512 pr " print_statvfs (r);\n";
3516 pr " if (r == NULL) return -1;\n";
3517 pr " print_table (r);\n";
3518 pr " free_strings (r);\n";
3525 (* run_action function *)
3526 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
3529 fun (name, _, _, flags, _, _, _) ->
3530 let name2 = replace_char name '_' '-' in
3532 try find_map (function FishAlias n -> Some n | _ -> None) flags
3533 with Not_found -> name in
3535 pr "strcasecmp (cmd, \"%s\") == 0" name;
3536 if name <> name2 then
3537 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
3538 if name <> alias then
3539 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
3541 pr " return run_%s (cmd, argc, argv);\n" name;
3545 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
3552 (* Readline completion for guestfish. *)
3553 and generate_fish_completion () =
3554 generate_header CStyle GPLv2;
3558 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3568 #ifdef HAVE_LIBREADLINE
3569 #include <readline/readline.h>
3574 #ifdef HAVE_LIBREADLINE
3576 static const char *commands[] = {
3579 (* Get the commands and sort them, including the aliases. *)
3582 fun (name, _, _, flags, _, _, _) ->
3583 let name2 = replace_char name '_' '-' in
3585 try find_map (function FishAlias n -> Some n | _ -> None) flags
3586 with Not_found -> name in
3588 if name <> alias then [name2; alias] else [name2]
3590 let commands = List.flatten commands in
3591 let commands = List.sort compare commands in
3593 List.iter (pr " \"%s\",\n") commands;
3599 generator (const char *text, int state)
3601 static int index, len;
3606 len = strlen (text);
3609 while ((name = commands[index]) != NULL) {
3611 if (strncasecmp (name, text, len) == 0)
3612 return strdup (name);
3618 #endif /* HAVE_LIBREADLINE */
3620 char **do_completion (const char *text, int start, int end)
3622 char **matches = NULL;
3624 #ifdef HAVE_LIBREADLINE
3626 matches = rl_completion_matches (text, generator);
3633 (* Generate the POD documentation for guestfish. *)
3634 and generate_fish_actions_pod () =
3635 let all_functions_sorted =
3637 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3638 ) all_functions_sorted in
3641 fun (name, style, _, flags, _, _, longdesc) ->
3642 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
3643 let name = replace_char name '_' '-' in
3645 try find_map (function FishAlias n -> Some n | _ -> None) flags
3646 with Not_found -> name in
3648 pr "=head2 %s" name;
3649 if name <> alias then
3656 | String n -> pr " %s" n
3657 | OptString n -> pr " %s" n
3658 | StringList n -> pr " %s,..." n
3659 | Bool _ -> pr " true|false"
3660 | Int n -> pr " %s" n
3661 | FileIn n | FileOut n -> pr " (%s|-)" n
3665 pr "%s\n\n" longdesc;
3667 if List.exists (function FileIn _ | FileOut _ -> true
3668 | _ -> false) (snd style) then
3669 pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
3671 if List.mem ProtocolLimitWarning flags then
3672 pr "%s\n\n" protocol_limit_warning;
3674 if List.mem DangerWillRobinson flags then
3675 pr "%s\n\n" danger_will_robinson
3676 ) all_functions_sorted
3678 (* Generate a C function prototype. *)
3679 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
3680 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
3682 ?handle name style =
3683 if extern then pr "extern ";
3684 if static then pr "static ";
3685 (match fst style with
3687 | RInt _ -> pr "int "
3688 | RInt64 _ -> pr "int64_t "
3689 | RBool _ -> pr "int "
3690 | RConstString _ -> pr "const char *"
3691 | RString _ -> pr "char *"
3692 | RStringList _ | RHashtable _ -> pr "char **"
3694 if not in_daemon then pr "struct guestfs_int_bool *"
3695 else pr "guestfs_%s_ret *" name
3697 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
3698 else pr "guestfs_lvm_int_pv_list *"
3700 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
3701 else pr "guestfs_lvm_int_vg_list *"
3703 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
3704 else pr "guestfs_lvm_int_lv_list *"
3706 if not in_daemon then pr "struct guestfs_stat *"
3707 else pr "guestfs_int_stat *"
3709 if not in_daemon then pr "struct guestfs_statvfs *"
3710 else pr "guestfs_int_statvfs *"
3712 pr "%s%s (" prefix name;
3713 if handle = None && List.length (snd style) = 0 then
3716 let comma = ref false in
3719 | Some handle -> pr "guestfs_h *%s" handle; comma := true
3723 if single_line then pr ", " else pr ",\n\t\t"
3730 | OptString n -> next (); pr "const char *%s" n
3731 | StringList n -> next (); pr "char * const* const %s" n
3732 | Bool n -> next (); pr "int %s" n
3733 | Int n -> next (); pr "int %s" n
3736 if not in_daemon then (next (); pr "const char *%s" n)
3740 if semicolon then pr ";";
3741 if newline then pr "\n"
3743 (* Generate C call arguments, eg "(handle, foo, bar)" *)
3744 and generate_call_args ?handle args =
3746 let comma = ref false in
3749 | Some handle -> pr "%s" handle; comma := true
3753 if !comma then pr ", ";
3755 pr "%s" (name_of_argt arg)
3759 (* Generate the OCaml bindings interface. *)
3760 and generate_ocaml_mli () =
3761 generate_header OCamlStyle LGPLv2;
3764 (** For API documentation you should refer to the C API
3765 in the guestfs(3) manual page. The OCaml API uses almost
3766 exactly the same calls. *)
3769 (** A [guestfs_h] handle. *)
3771 exception Error of string
3772 (** This exception is raised when there is an error. *)
3774 val create : unit -> t
3776 val close : t -> unit
3777 (** Handles are closed by the garbage collector when they become
3778 unreferenced, but callers can also call this in order to
3779 provide predictable cleanup. *)
3782 generate_ocaml_lvm_structure_decls ();
3784 generate_ocaml_stat_structure_decls ();
3788 fun (name, style, _, _, _, shortdesc, _) ->
3789 generate_ocaml_prototype name style;
3790 pr "(** %s *)\n" shortdesc;
3794 (* Generate the OCaml bindings implementation. *)
3795 and generate_ocaml_ml () =
3796 generate_header OCamlStyle LGPLv2;
3800 exception Error of string
3801 external create : unit -> t = \"ocaml_guestfs_create\"
3802 external close : t -> unit = \"ocaml_guestfs_close\"
3805 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
3809 generate_ocaml_lvm_structure_decls ();
3811 generate_ocaml_stat_structure_decls ();
3815 fun (name, style, _, _, _, shortdesc, _) ->
3816 generate_ocaml_prototype ~is_external:true name style;
3819 (* Generate the OCaml bindings C implementation. *)
3820 and generate_ocaml_c () =
3821 generate_header CStyle LGPLv2;
3828 #include <caml/config.h>
3829 #include <caml/alloc.h>
3830 #include <caml/callback.h>
3831 #include <caml/fail.h>
3832 #include <caml/memory.h>
3833 #include <caml/mlvalues.h>
3834 #include <caml/signals.h>
3836 #include <guestfs.h>
3838 #include \"guestfs_c.h\"
3840 /* Copy a hashtable of string pairs into an assoc-list. We return
3841 * the list in reverse order, but hashtables aren't supposed to be
3844 static CAMLprim value
3845 copy_table (char * const * argv)
3848 CAMLlocal5 (rv, pairv, kv, vv, cons);
3852 for (i = 0; argv[i] != NULL; i += 2) {
3853 kv = caml_copy_string (argv[i]);
3854 vv = caml_copy_string (argv[i+1]);
3855 pairv = caml_alloc (2, 0);
3856 Store_field (pairv, 0, kv);
3857 Store_field (pairv, 1, vv);
3858 cons = caml_alloc (2, 0);
3859 Store_field (cons, 1, rv);
3861 Store_field (cons, 0, pairv);
3869 (* LVM struct copy functions. *)
3872 let has_optpercent_col =
3873 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
3875 pr "static CAMLprim value\n";
3876 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
3878 pr " CAMLparam0 ();\n";
3879 if has_optpercent_col then
3880 pr " CAMLlocal3 (rv, v, v2);\n"
3882 pr " CAMLlocal2 (rv, v);\n";
3884 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
3889 pr " v = caml_copy_string (%s->%s);\n" typ name
3891 pr " v = caml_alloc_string (32);\n";
3892 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
3895 pr " v = caml_copy_int64 (%s->%s);\n" typ name
3896 | name, `OptPercent ->
3897 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
3898 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
3899 pr " v = caml_alloc (1, 0);\n";
3900 pr " Store_field (v, 0, v2);\n";
3901 pr " } else /* None */\n";
3902 pr " v = Val_int (0);\n";
3904 pr " Store_field (rv, %d, v);\n" i
3906 pr " CAMLreturn (rv);\n";
3910 pr "static CAMLprim value\n";
3911 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
3914 pr " CAMLparam0 ();\n";
3915 pr " CAMLlocal2 (rv, v);\n";
3918 pr " if (%ss->len == 0)\n" typ;
3919 pr " CAMLreturn (Atom (0));\n";
3921 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
3922 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
3923 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
3924 pr " caml_modify (&Field (rv, i), v);\n";
3926 pr " CAMLreturn (rv);\n";
3930 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3932 (* Stat copy functions. *)
3935 pr "static CAMLprim value\n";
3936 pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
3938 pr " CAMLparam0 ();\n";
3939 pr " CAMLlocal2 (rv, v);\n";
3941 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
3946 pr " v = caml_copy_int64 (%s->%s);\n" typ name
3948 pr " Store_field (rv, %d, v);\n" i
3950 pr " CAMLreturn (rv);\n";
3953 ) ["stat", stat_cols; "statvfs", statvfs_cols];
3957 fun (name, style, _, _, _, _, _) ->
3959 "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
3961 pr "CAMLprim value\n";
3962 pr "ocaml_guestfs_%s (value %s" name (List.hd params);
3963 List.iter (pr ", value %s") (List.tl params);
3968 | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
3969 pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
3970 pr " CAMLxparam%d (%s);\n"
3971 (List.length rest) (String.concat ", " rest)
3973 pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
3975 pr " CAMLlocal1 (rv);\n";
3978 pr " guestfs_h *g = Guestfs_val (gv);\n";
3979 pr " if (g == NULL)\n";
3980 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
3988 pr " const char *%s = String_val (%sv);\n" n n
3990 pr " const char *%s =\n" n;
3991 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
3994 pr " char **%s = ocaml_guestfs_strings_val (%sv);\n" n n
3996 pr " int %s = Bool_val (%sv);\n" n n
3998 pr " int %s = Int_val (%sv);\n" n n
4001 match fst style with
4002 | RErr -> pr " int r;\n"; "-1"
4003 | RInt _ -> pr " int r;\n"; "-1"
4004 | RInt64 _ -> pr " int64_t r;\n"; "-1"
4005 | RBool _ -> pr " int r;\n"; "-1"
4006 | RConstString _ -> pr " const char *r;\n"; "NULL"
4007 | RString _ -> pr " char *r;\n"; "NULL"
4013 pr " struct guestfs_int_bool *r;\n"; "NULL"
4015 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
4017 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
4019 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
4021 pr " struct guestfs_stat *r;\n"; "NULL"
4023 pr " struct guestfs_statvfs *r;\n"; "NULL"
4030 pr " caml_enter_blocking_section ();\n";
4031 pr " r = guestfs_%s " name;
4032 generate_call_args ~handle:"g" (snd style);
4034 pr " caml_leave_blocking_section ();\n";
4039 pr " ocaml_guestfs_free_strings (%s);\n" n;
4040 | String _ | OptString _ | Bool _ | Int _ | FileIn _ | FileOut _ -> ()
4043 pr " if (r == %s)\n" error_code;
4044 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
4047 (match fst style with
4048 | RErr -> pr " rv = Val_unit;\n"
4049 | RInt _ -> pr " rv = Val_int (r);\n"
4051 pr " rv = caml_copy_int64 (r);\n"
4052 | RBool _ -> pr " rv = Val_bool (r);\n"
4053 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
4055 pr " rv = caml_copy_string (r);\n";
4058 pr " rv = caml_copy_string_array ((const char **) r);\n";
4059 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
4062 pr " rv = caml_alloc (2, 0);\n";
4063 pr " Store_field (rv, 0, Val_int (r->i));\n";
4064 pr " Store_field (rv, 1, Val_bool (r->b));\n";
4065 pr " guestfs_free_int_bool (r);\n";
4067 pr " rv = copy_lvm_pv_list (r);\n";
4068 pr " guestfs_free_lvm_pv_list (r);\n";
4070 pr " rv = copy_lvm_vg_list (r);\n";
4071 pr " guestfs_free_lvm_vg_list (r);\n";
4073 pr " rv = copy_lvm_lv_list (r);\n";
4074 pr " guestfs_free_lvm_lv_list (r);\n";
4076 pr " rv = copy_stat (r);\n";
4079 pr " rv = copy_statvfs (r);\n";
4082 pr " rv = copy_table (r);\n";
4083 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
4087 pr " CAMLreturn (rv);\n";
4091 if List.length params > 5 then (
4092 pr "CAMLprim value\n";
4093 pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
4095 pr " return ocaml_guestfs_%s (argv[0]" name;
4096 iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
4103 and generate_ocaml_lvm_structure_decls () =
4106 pr "type lvm_%s = {\n" typ;
4109 | name, `String -> pr " %s : string;\n" name
4110 | name, `UUID -> pr " %s : string;\n" name
4111 | name, `Bytes -> pr " %s : int64;\n" name
4112 | name, `Int -> pr " %s : int64;\n" name
4113 | name, `OptPercent -> pr " %s : float option;\n" name
4117 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
4119 and generate_ocaml_stat_structure_decls () =
4122 pr "type %s = {\n" typ;
4125 | name, `Int -> pr " %s : int64;\n" name
4129 ) ["stat", stat_cols; "statvfs", statvfs_cols]
4131 and generate_ocaml_prototype ?(is_external = false) name style =
4132 if is_external then pr "external " else pr "val ";
4133 pr "%s : t -> " name;
4136 | String _ | FileIn _ | FileOut _ -> pr "string -> "
4137 | OptString _ -> pr "string option -> "
4138 | StringList _ -> pr "string array -> "
4139 | Bool _ -> pr "bool -> "
4140 | Int _ -> pr "int -> "
4142 (match fst style with
4143 | RErr -> pr "unit" (* all errors are turned into exceptions *)
4144 | RInt _ -> pr "int"
4145 | RInt64 _ -> pr "int64"
4146 | RBool _ -> pr "bool"
4147 | RConstString _ -> pr "string"
4148 | RString _ -> pr "string"
4149 | RStringList _ -> pr "string array"
4150 | RIntBool _ -> pr "int * bool"
4151 | RPVList _ -> pr "lvm_pv array"
4152 | RVGList _ -> pr "lvm_vg array"
4153 | RLVList _ -> pr "lvm_lv array"
4154 | RStat _ -> pr "stat"
4155 | RStatVFS _ -> pr "statvfs"
4156 | RHashtable _ -> pr "(string * string) list"
4158 if is_external then (
4160 if List.length (snd style) + 1 > 5 then
4161 pr "\"ocaml_guestfs_%s_byte\" " name;
4162 pr "\"ocaml_guestfs_%s\"" name
4166 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
4167 and generate_perl_xs () =
4168 generate_header CStyle LGPLv2;
4171 #include \"EXTERN.h\"
4175 #include <guestfs.h>
4178 #define PRId64 \"lld\"
4182 my_newSVll(long long val) {
4183 #ifdef USE_64_BIT_ALL
4184 return newSViv(val);
4188 len = snprintf(buf, 100, \"%%\" PRId64, val);
4189 return newSVpv(buf, len);
4194 #define PRIu64 \"llu\"
4198 my_newSVull(unsigned long long val) {
4199 #ifdef USE_64_BIT_ALL
4200 return newSVuv(val);
4204 len = snprintf(buf, 100, \"%%\" PRIu64, val);
4205 return newSVpv(buf, len);
4209 /* http://www.perlmonks.org/?node_id=680842 */
4211 XS_unpack_charPtrPtr (SV *arg) {
4216 if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV) {
4217 croak (\"array reference expected\");
4220 av = (AV *)SvRV (arg);
4221 ret = (char **)malloc (av_len (av) + 1 + 1);
4223 for (i = 0; i <= av_len (av); i++) {
4224 SV **elem = av_fetch (av, i, 0);
4226 if (!elem || !*elem)
4227 croak (\"missing element in list\");
4229 ret[i] = SvPV_nolen (*elem);
4237 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
4242 RETVAL = guestfs_create ();
4244 croak (\"could not create guestfs handle\");
4245 guestfs_set_error_handler (RETVAL, NULL, NULL);
4258 fun (name, style, _, _, _, _, _) ->
4259 (match fst style with
4260 | RErr -> pr "void\n"
4261 | RInt _ -> pr "SV *\n"
4262 | RInt64 _ -> pr "SV *\n"
4263 | RBool _ -> pr "SV *\n"
4264 | RConstString _ -> pr "SV *\n"
4265 | RString _ -> pr "SV *\n"
4268 | RPVList _ | RVGList _ | RLVList _
4269 | RStat _ | RStatVFS _
4271 pr "void\n" (* all lists returned implictly on the stack *)
4273 (* Call and arguments. *)
4275 generate_call_args ~handle:"g" (snd style);
4277 pr " guestfs_h *g;\n";
4280 | String n | FileIn n | FileOut n -> pr " char *%s;\n" n
4281 | OptString n -> pr " char *%s;\n" n
4282 | StringList n -> pr " char **%s;\n" n
4283 | Bool n -> pr " int %s;\n" n
4284 | Int n -> pr " int %s;\n" n
4287 let do_cleanups () =
4290 | String _ | OptString _ | Bool _ | Int _
4291 | FileIn _ | FileOut _ -> ()
4292 | StringList n -> pr " free (%s);\n" n
4297 (match fst style with
4302 pr " r = guestfs_%s " name;
4303 generate_call_args ~handle:"g" (snd style);
4306 pr " if (r == -1)\n";
4307 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4313 pr " %s = guestfs_%s " n name;
4314 generate_call_args ~handle:"g" (snd style);
4317 pr " if (%s == -1)\n" n;
4318 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4319 pr " RETVAL = newSViv (%s);\n" n;
4324 pr " int64_t %s;\n" n;
4326 pr " %s = guestfs_%s " n name;
4327 generate_call_args ~handle:"g" (snd style);
4330 pr " if (%s == -1)\n" n;
4331 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4332 pr " RETVAL = my_newSVll (%s);\n" n;
4337 pr " const char *%s;\n" n;
4339 pr " %s = guestfs_%s " n name;
4340 generate_call_args ~handle:"g" (snd style);
4343 pr " if (%s == NULL)\n" n;
4344 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4345 pr " RETVAL = newSVpv (%s, 0);\n" n;
4350 pr " char *%s;\n" n;
4352 pr " %s = guestfs_%s " n name;
4353 generate_call_args ~handle:"g" (snd style);
4356 pr " if (%s == NULL)\n" n;
4357 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4358 pr " RETVAL = newSVpv (%s, 0);\n" n;
4359 pr " free (%s);\n" n;
4362 | RStringList n | RHashtable n ->
4364 pr " char **%s;\n" n;
4367 pr " %s = guestfs_%s " n name;
4368 generate_call_args ~handle:"g" (snd style);
4371 pr " if (%s == NULL)\n" n;
4372 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4373 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
4374 pr " EXTEND (SP, n);\n";
4375 pr " for (i = 0; i < n; ++i) {\n";
4376 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
4377 pr " free (%s[i]);\n" n;
4379 pr " free (%s);\n" n;
4382 pr " struct guestfs_int_bool *r;\n";
4384 pr " r = guestfs_%s " name;
4385 generate_call_args ~handle:"g" (snd style);
4388 pr " if (r == NULL)\n";
4389 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4390 pr " EXTEND (SP, 2);\n";
4391 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
4392 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
4393 pr " guestfs_free_int_bool (r);\n";
4395 generate_perl_lvm_code "pv" pv_cols name style n do_cleanups
4397 generate_perl_lvm_code "vg" vg_cols name style n do_cleanups
4399 generate_perl_lvm_code "lv" lv_cols name style n do_cleanups
4401 generate_perl_stat_code "stat" stat_cols name style n do_cleanups
4403 generate_perl_stat_code
4404 "statvfs" statvfs_cols name style n do_cleanups
4410 and generate_perl_lvm_code typ cols name style n do_cleanups =
4412 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
4416 pr " %s = guestfs_%s " n name;
4417 generate_call_args ~handle:"g" (snd style);
4420 pr " if (%s == NULL)\n" n;
4421 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4422 pr " EXTEND (SP, %s->len);\n" n;
4423 pr " for (i = 0; i < %s->len; ++i) {\n" n;
4424 pr " hv = newHV ();\n";
4428 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
4429 name (String.length name) n name
4431 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
4432 name (String.length name) n name
4434 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
4435 name (String.length name) n name
4437 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
4438 name (String.length name) n name
4439 | name, `OptPercent ->
4440 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
4441 name (String.length name) n name
4443 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
4445 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
4447 and generate_perl_stat_code typ cols name style n do_cleanups =
4449 pr " struct guestfs_%s *%s;\n" typ n;
4451 pr " %s = guestfs_%s " n name;
4452 generate_call_args ~handle:"g" (snd style);
4455 pr " if (%s == NULL)\n" n;
4456 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4457 pr " EXTEND (SP, %d);\n" (List.length cols);
4461 pr " PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n" n name
4463 pr " free (%s);\n" n
4465 (* Generate Sys/Guestfs.pm. *)
4466 and generate_perl_pm () =
4467 generate_header HashStyle LGPLv2;
4474 Sys::Guestfs - Perl bindings for libguestfs
4480 my $h = Sys::Guestfs->new ();
4481 $h->add_drive ('guest.img');
4484 $h->mount ('/dev/sda1', '/');
4485 $h->touch ('/hello');
4490 The C<Sys::Guestfs> module provides a Perl XS binding to the
4491 libguestfs API for examining and modifying virtual machine
4494 Amongst the things this is good for: making batch configuration
4495 changes to guests, getting disk used/free statistics (see also:
4496 virt-df), migrating between virtualization systems (see also:
4497 virt-p2v), performing partial backups, performing partial guest
4498 clones, cloning guests and changing registry/UUID/hostname info, and
4501 Libguestfs uses Linux kernel and qemu code, and can access any type of
4502 guest filesystem that Linux and qemu can, including but not limited
4503 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
4504 schemes, qcow, qcow2, vmdk.
4506 Libguestfs provides ways to enumerate guest storage (eg. partitions,
4507 LVs, what filesystem is in each LV, etc.). It can also run commands
4508 in the context of the guest. Also you can access filesystems over FTP.
4512 All errors turn into calls to C<croak> (see L<Carp(3)>).
4520 package Sys::Guestfs;
4526 XSLoader::load ('Sys::Guestfs');
4528 =item $h = Sys::Guestfs->new ();
4530 Create a new guestfs handle.
4536 my $class = ref ($proto) || $proto;
4538 my $self = Sys::Guestfs::_create ();
4539 bless $self, $class;
4545 (* Actions. We only need to print documentation for these as
4546 * they are pulled in from the XS code automatically.
4549 fun (name, style, _, flags, _, _, longdesc) ->
4550 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
4552 generate_perl_prototype name style;
4554 pr "%s\n\n" longdesc;
4555 if List.mem ProtocolLimitWarning flags then
4556 pr "%s\n\n" protocol_limit_warning;
4557 if List.mem DangerWillRobinson flags then
4558 pr "%s\n\n" danger_will_robinson
4559 ) all_functions_sorted;
4571 Copyright (C) 2009 Red Hat Inc.
4575 Please see the file COPYING.LIB for the full license.
4579 L<guestfs(3)>, L<guestfish(1)>.
4584 and generate_perl_prototype name style =
4585 (match fst style with
4591 | RString n -> pr "$%s = " n
4592 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
4596 | RLVList n -> pr "@%s = " n
4599 | RHashtable n -> pr "%%%s = " n
4602 let comma = ref false in
4605 if !comma then pr ", ";
4608 | String n | OptString n | Bool n | Int n | FileIn n | FileOut n ->
4615 (* Generate Python C module. *)
4616 and generate_python_c () =
4617 generate_header CStyle LGPLv2;
4626 #include \"guestfs.h\"
4634 get_handle (PyObject *obj)
4637 assert (obj != Py_None);
4638 return ((Pyguestfs_Object *) obj)->g;
4642 put_handle (guestfs_h *g)
4646 PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
4649 /* This list should be freed (but not the strings) after use. */
4650 static const char **
4651 get_string_list (PyObject *obj)
4658 if (!PyList_Check (obj)) {
4659 PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
4663 len = PyList_Size (obj);
4664 r = malloc (sizeof (char *) * (len+1));
4666 PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
4670 for (i = 0; i < len; ++i)
4671 r[i] = PyString_AsString (PyList_GetItem (obj, i));
4678 put_string_list (char * const * const argv)
4683 for (argc = 0; argv[argc] != NULL; ++argc)
4686 list = PyList_New (argc);
4687 for (i = 0; i < argc; ++i)
4688 PyList_SetItem (list, i, PyString_FromString (argv[i]));
4694 put_table (char * const * const argv)
4696 PyObject *list, *item;
4699 for (argc = 0; argv[argc] != NULL; ++argc)
4702 list = PyList_New (argc >> 1);
4703 for (i = 0; i < argc; i += 2) {
4704 item = PyTuple_New (2);
4705 PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
4706 PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
4707 PyList_SetItem (list, i >> 1, item);
4714 free_strings (char **argv)
4718 for (argc = 0; argv[argc] != NULL; ++argc)
4724 py_guestfs_create (PyObject *self, PyObject *args)
4728 g = guestfs_create ();
4730 PyErr_SetString (PyExc_RuntimeError,
4731 \"guestfs.create: failed to allocate handle\");
4734 guestfs_set_error_handler (g, NULL, NULL);
4735 return put_handle (g);
4739 py_guestfs_close (PyObject *self, PyObject *args)
4744 if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
4746 g = get_handle (py_g);
4750 Py_INCREF (Py_None);
4756 (* LVM structures, turned into Python dictionaries. *)
4759 pr "static PyObject *\n";
4760 pr "put_lvm_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
4762 pr " PyObject *dict;\n";
4764 pr " dict = PyDict_New ();\n";
4768 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4769 pr " PyString_FromString (%s->%s));\n"
4772 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4773 pr " PyString_FromStringAndSize (%s->%s, 32));\n"
4776 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4777 pr " PyLong_FromUnsignedLongLong (%s->%s));\n"
4780 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4781 pr " PyLong_FromLongLong (%s->%s));\n"
4783 | name, `OptPercent ->
4784 pr " if (%s->%s >= 0)\n" typ name;
4785 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4786 pr " PyFloat_FromDouble ((double) %s->%s));\n"
4789 pr " Py_INCREF (Py_None);\n";
4790 pr " PyDict_SetItemString (dict, \"%s\", Py_None);" name;
4793 pr " return dict;\n";
4797 pr "static PyObject *\n";
4798 pr "put_lvm_%s_list (struct guestfs_lvm_%s_list *%ss)\n" typ typ typ;
4800 pr " PyObject *list;\n";
4803 pr " list = PyList_New (%ss->len);\n" typ;
4804 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
4805 pr " PyList_SetItem (list, i, put_lvm_%s (&%ss->val[i]));\n" typ typ;
4806 pr " return list;\n";
4809 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
4811 (* Stat structures, turned into Python dictionaries. *)
4814 pr "static PyObject *\n";
4815 pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
4817 pr " PyObject *dict;\n";
4819 pr " dict = PyDict_New ();\n";
4823 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4824 pr " PyLong_FromLongLong (%s->%s));\n"
4827 pr " return dict;\n";
4830 ) ["stat", stat_cols; "statvfs", statvfs_cols];
4832 (* Python wrapper functions. *)
4834 fun (name, style, _, _, _, _, _) ->
4835 pr "static PyObject *\n";
4836 pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
4839 pr " PyObject *py_g;\n";
4840 pr " guestfs_h *g;\n";
4841 pr " PyObject *py_r;\n";
4844 match fst style with
4845 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
4846 | RInt64 _ -> pr " int64_t r;\n"; "-1"
4847 | RConstString _ -> pr " const char *r;\n"; "NULL"
4848 | RString _ -> pr " char *r;\n"; "NULL"
4849 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
4850 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
4851 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
4852 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
4853 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
4854 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
4855 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
4859 | String n | FileIn n | FileOut n -> pr " const char *%s;\n" n
4860 | OptString n -> pr " const char *%s;\n" n
4862 pr " PyObject *py_%s;\n" n;
4863 pr " const char **%s;\n" n
4864 | Bool n -> pr " int %s;\n" n
4865 | Int n -> pr " int %s;\n" n
4870 (* Convert the parameters. *)
4871 pr " if (!PyArg_ParseTuple (args, (char *) \"O";
4874 | String _ | FileIn _ | FileOut _ -> pr "s"
4875 | OptString _ -> pr "z"
4876 | StringList _ -> pr "O"
4877 | Bool _ -> pr "i" (* XXX Python has booleans? *)
4880 pr ":guestfs_%s\",\n" name;
4884 | String n | FileIn n | FileOut n -> pr ", &%s" n
4885 | OptString n -> pr ", &%s" n
4886 | StringList n -> pr ", &py_%s" n
4887 | Bool n -> pr ", &%s" n
4888 | Int n -> pr ", &%s" n
4892 pr " return NULL;\n";
4894 pr " g = get_handle (py_g);\n";
4897 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
4899 pr " %s = get_string_list (py_%s);\n" n n;
4900 pr " if (!%s) return NULL;\n" n
4905 pr " r = guestfs_%s " name;
4906 generate_call_args ~handle:"g" (snd style);
4911 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
4913 pr " free (%s);\n" n
4916 pr " if (r == %s) {\n" error_code;
4917 pr " PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
4918 pr " return NULL;\n";
4922 (match fst style with
4924 pr " Py_INCREF (Py_None);\n";
4925 pr " py_r = Py_None;\n"
4927 | RBool _ -> pr " py_r = PyInt_FromLong ((long) r);\n"
4928 | RInt64 _ -> pr " py_r = PyLong_FromLongLong (r);\n"
4929 | RConstString _ -> pr " py_r = PyString_FromString (r);\n"
4931 pr " py_r = PyString_FromString (r);\n";
4934 pr " py_r = put_string_list (r);\n";
4935 pr " free_strings (r);\n"
4937 pr " py_r = PyTuple_New (2);\n";
4938 pr " PyTuple_SetItem (py_r, 0, PyInt_FromLong ((long) r->i));\n";
4939 pr " PyTuple_SetItem (py_r, 1, PyInt_FromLong ((long) r->b));\n";
4940 pr " guestfs_free_int_bool (r);\n"
4942 pr " py_r = put_lvm_pv_list (r);\n";
4943 pr " guestfs_free_lvm_pv_list (r);\n"
4945 pr " py_r = put_lvm_vg_list (r);\n";
4946 pr " guestfs_free_lvm_vg_list (r);\n"
4948 pr " py_r = put_lvm_lv_list (r);\n";
4949 pr " guestfs_free_lvm_lv_list (r);\n"
4951 pr " py_r = put_stat (r);\n";
4954 pr " py_r = put_statvfs (r);\n";
4957 pr " py_r = put_table (r);\n";
4958 pr " free_strings (r);\n"
4961 pr " return py_r;\n";
4966 (* Table of functions. *)
4967 pr "static PyMethodDef methods[] = {\n";
4968 pr " { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
4969 pr " { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
4971 fun (name, _, _, _, _, _, _) ->
4972 pr " { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
4975 pr " { NULL, NULL, 0, NULL }\n";
4979 (* Init function. *)
4982 initlibguestfsmod (void)
4984 static int initialized = 0;
4986 if (initialized) return;
4987 Py_InitModule ((char *) \"libguestfsmod\", methods);
4992 (* Generate Python module. *)
4993 and generate_python_py () =
4994 generate_header HashStyle LGPLv2;
4997 u\"\"\"Python bindings for libguestfs
5000 g = guestfs.GuestFS ()
5001 g.add_drive (\"guest.img\")
5004 parts = g.list_partitions ()
5006 The guestfs module provides a Python binding to the libguestfs API
5007 for examining and modifying virtual machine disk images.
5009 Amongst the things this is good for: making batch configuration
5010 changes to guests, getting disk used/free statistics (see also:
5011 virt-df), migrating between virtualization systems (see also:
5012 virt-p2v), performing partial backups, performing partial guest
5013 clones, cloning guests and changing registry/UUID/hostname info, and
5016 Libguestfs uses Linux kernel and qemu code, and can access any type of
5017 guest filesystem that Linux and qemu can, including but not limited
5018 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
5019 schemes, qcow, qcow2, vmdk.
5021 Libguestfs provides ways to enumerate guest storage (eg. partitions,
5022 LVs, what filesystem is in each LV, etc.). It can also run commands
5023 in the context of the guest. Also you can access filesystems over FTP.
5025 Errors which happen while using the API are turned into Python
5026 RuntimeError exceptions.
5028 To create a guestfs handle you usually have to perform the following
5031 # Create the handle, call add_drive at least once, and possibly
5032 # several times if the guest has multiple block devices:
5033 g = guestfs.GuestFS ()
5034 g.add_drive (\"guest.img\")
5036 # Launch the qemu subprocess and wait for it to become ready:
5040 # Now you can issue commands, for example:
5045 import libguestfsmod
5048 \"\"\"Instances of this class are libguestfs API handles.\"\"\"
5050 def __init__ (self):
5051 \"\"\"Create a new libguestfs handle.\"\"\"
5052 self._o = libguestfsmod.create ()
5055 libguestfsmod.close (self._o)
5060 fun (name, style, _, flags, _, _, longdesc) ->
5061 let doc = replace_str longdesc "C<guestfs_" "C<g." in
5063 match fst style with
5064 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _
5067 doc ^ "\n\nThis function returns a list of strings."
5069 doc ^ "\n\nThis function returns a tuple (int, bool).\n"
5071 doc ^ "\n\nThis function returns a list of PVs. Each PV is represented as a dictionary."
5073 doc ^ "\n\nThis function returns a list of VGs. Each VG is represented as a dictionary."
5075 doc ^ "\n\nThis function returns a list of LVs. Each LV is represented as a dictionary."
5077 doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the stat structure."
5079 doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the statvfs structure."
5081 doc ^ "\n\nThis function returns a dictionary." in
5083 if List.mem ProtocolLimitWarning flags then
5084 doc ^ "\n\n" ^ protocol_limit_warning
5087 if List.mem DangerWillRobinson flags then
5088 doc ^ "\n\n" ^ danger_will_robinson
5090 let doc = pod2text ~width:60 name doc in
5091 let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
5092 let doc = String.concat "\n " doc in
5095 generate_call_args ~handle:"self" (snd style);
5097 pr " u\"\"\"%s\"\"\"\n" doc;
5098 pr " return libguestfsmod.%s " name;
5099 generate_call_args ~handle:"self._o" (snd style);
5104 (* Useful if you need the longdesc POD text as plain text. Returns a
5107 and pod2text ~width name longdesc =
5108 let filename, chan = Filename.open_temp_file "gen" ".tmp" in
5109 fprintf chan "=head1 %s\n\n%s\n" name longdesc;
5111 let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
5112 let chan = Unix.open_process_in cmd in
5113 let lines = ref [] in
5115 let line = input_line chan in
5116 if i = 1 then (* discard the first line of output *)
5119 let line = triml line in
5120 lines := line :: !lines;
5123 let lines = try loop 1 with End_of_file -> List.rev !lines in
5124 Unix.unlink filename;
5125 match Unix.close_process_in chan with
5126 | Unix.WEXITED 0 -> lines
5128 failwithf "pod2text: process exited with non-zero status (%d)" i
5129 | Unix.WSIGNALED i | Unix.WSTOPPED i ->
5130 failwithf "pod2text: process signalled or stopped by signal %d" i
5132 (* Generate ruby bindings. *)
5133 and generate_ruby_c () =
5134 generate_header CStyle LGPLv2;
5142 #include \"guestfs.h\"
5144 #include \"extconf.h\"
5146 static VALUE m_guestfs; /* guestfs module */
5147 static VALUE c_guestfs; /* guestfs_h handle */
5148 static VALUE e_Error; /* used for all errors */
5150 static void ruby_guestfs_free (void *p)
5153 guestfs_close ((guestfs_h *) p);
5156 static VALUE ruby_guestfs_create (VALUE m)
5160 g = guestfs_create ();
5162 rb_raise (e_Error, \"failed to create guestfs handle\");
5164 /* Don't print error messages to stderr by default. */
5165 guestfs_set_error_handler (g, NULL, NULL);
5167 /* Wrap it, and make sure the close function is called when the
5170 return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
5173 static VALUE ruby_guestfs_close (VALUE gv)
5176 Data_Get_Struct (gv, guestfs_h, g);
5178 ruby_guestfs_free (g);
5179 DATA_PTR (gv) = NULL;
5187 fun (name, style, _, _, _, _, _) ->
5188 pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
5189 List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
5192 pr " guestfs_h *g;\n";
5193 pr " Data_Get_Struct (gv, guestfs_h, g);\n";
5195 pr " rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
5201 | String n | FileIn n | FileOut n ->
5202 pr " const char *%s = StringValueCStr (%sv);\n" n n;
5204 pr " rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
5205 pr " \"%s\", \"%s\");\n" n name
5207 pr " const char *%s = StringValueCStr (%sv);\n" n n
5211 pr " int i, len;\n";
5212 pr " len = RARRAY_LEN (%sv);\n" n;
5213 pr " %s = malloc (sizeof (char *) * (len+1));\n" n;
5214 pr " for (i = 0; i < len; ++i) {\n";
5215 pr " VALUE v = rb_ary_entry (%sv, i);\n" n;
5216 pr " %s[i] = StringValueCStr (v);\n" n;
5221 pr " int %s = NUM2INT (%sv);\n" n n
5226 match fst style with
5227 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
5228 | RInt64 _ -> pr " int64_t r;\n"; "-1"
5229 | RConstString _ -> pr " const char *r;\n"; "NULL"
5230 | RString _ -> pr " char *r;\n"; "NULL"
5231 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
5232 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
5233 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
5234 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
5235 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
5236 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
5237 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
5240 pr " r = guestfs_%s " name;
5241 generate_call_args ~handle:"g" (snd style);
5246 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
5248 pr " free (%s);\n" n
5251 pr " if (r == %s)\n" error_code;
5252 pr " rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
5255 (match fst style with
5257 pr " return Qnil;\n"
5258 | RInt _ | RBool _ ->
5259 pr " return INT2NUM (r);\n"
5261 pr " return ULL2NUM (r);\n"
5263 pr " return rb_str_new2 (r);\n";
5265 pr " VALUE rv = rb_str_new2 (r);\n";
5269 pr " int i, len = 0;\n";
5270 pr " for (i = 0; r[i] != NULL; ++i) len++;\n";
5271 pr " VALUE rv = rb_ary_new2 (len);\n";
5272 pr " for (i = 0; r[i] != NULL; ++i) {\n";
5273 pr " rb_ary_push (rv, rb_str_new2 (r[i]));\n";
5274 pr " free (r[i]);\n";
5279 pr " VALUE rv = rb_ary_new2 (2);\n";
5280 pr " rb_ary_push (rv, INT2NUM (r->i));\n";
5281 pr " rb_ary_push (rv, INT2NUM (r->b));\n";
5282 pr " guestfs_free_int_bool (r);\n";
5285 generate_ruby_lvm_code "pv" pv_cols
5287 generate_ruby_lvm_code "vg" vg_cols
5289 generate_ruby_lvm_code "lv" lv_cols
5291 pr " VALUE rv = rb_hash_new ();\n";
5295 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
5300 pr " VALUE rv = rb_hash_new ();\n";
5304 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
5309 pr " VALUE rv = rb_hash_new ();\n";
5311 pr " for (i = 0; r[i] != NULL; i+=2) {\n";
5312 pr " rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
5313 pr " free (r[i]);\n";
5314 pr " free (r[i+1]);\n";
5325 /* Initialize the module. */
5326 void Init__guestfs ()
5328 m_guestfs = rb_define_module (\"Guestfs\");
5329 c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
5330 e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
5332 rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
5333 rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
5336 (* Define the rest of the methods. *)
5338 fun (name, style, _, _, _, _, _) ->
5339 pr " rb_define_method (c_guestfs, \"%s\",\n" name;
5340 pr " ruby_guestfs_%s, %d);\n" name (List.length (snd style))
5345 (* Ruby code to return an LVM struct list. *)
5346 and generate_ruby_lvm_code typ cols =
5347 pr " VALUE rv = rb_ary_new2 (r->len);\n";
5349 pr " for (i = 0; i < r->len; ++i) {\n";
5350 pr " VALUE hv = rb_hash_new ();\n";
5354 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
5356 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
5359 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
5360 | name, `OptPercent ->
5361 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
5363 pr " rb_ary_push (rv, hv);\n";
5365 pr " guestfs_free_lvm_%s_list (r);\n" typ;
5368 let output_to filename =
5369 let filename_new = filename ^ ".new" in
5370 chan := open_out filename_new;
5374 Unix.rename filename_new filename;
5375 printf "written %s\n%!" filename;
5383 if not (Sys.file_exists "configure.ac") then (
5385 You are probably running this from the wrong directory.
5386 Run it from the top source directory using the command
5392 let close = output_to "src/guestfs_protocol.x" in
5396 let close = output_to "src/guestfs-structs.h" in
5397 generate_structs_h ();
5400 let close = output_to "src/guestfs-actions.h" in
5401 generate_actions_h ();
5404 let close = output_to "src/guestfs-actions.c" in
5405 generate_client_actions ();
5408 let close = output_to "daemon/actions.h" in
5409 generate_daemon_actions_h ();
5412 let close = output_to "daemon/stubs.c" in
5413 generate_daemon_actions ();
5416 let close = output_to "tests.c" in
5420 let close = output_to "fish/cmds.c" in
5421 generate_fish_cmds ();
5424 let close = output_to "fish/completion.c" in
5425 generate_fish_completion ();
5428 let close = output_to "guestfs-structs.pod" in
5429 generate_structs_pod ();
5432 let close = output_to "guestfs-actions.pod" in
5433 generate_actions_pod ();
5436 let close = output_to "guestfish-actions.pod" in
5437 generate_fish_actions_pod ();
5440 let close = output_to "ocaml/guestfs.mli" in
5441 generate_ocaml_mli ();
5444 let close = output_to "ocaml/guestfs.ml" in
5445 generate_ocaml_ml ();
5448 let close = output_to "ocaml/guestfs_c_actions.c" in
5449 generate_ocaml_c ();
5452 let close = output_to "perl/Guestfs.xs" in
5453 generate_perl_xs ();
5456 let close = output_to "perl/lib/Sys/Guestfs.pm" in
5457 generate_perl_pm ();
5460 let close = output_to "python/guestfs-py.c" in
5461 generate_python_c ();
5464 let close = output_to "python/guestfs.py" in
5465 generate_python_py ();
5468 let close = output_to "ruby/ext/guestfs/_guestfs.c" in