3 * Copyright (C) 2009 Red Hat Inc.
5 * This program is free software; you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation; either version 2 of the License, or
8 * (at your option) any later version.
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
15 * You should have received a copy of the GNU General Public License
16 * along with this program; if not, write to the Free Software
17 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
20 (* This script generates a large amount of code and documentation for
21 * all the daemon actions.
23 * To add a new action there are only two files you need to change,
24 * this one to describe the interface (see the big table below), and
25 * daemon/<somefile>.c to write the implementation.
27 * After editing this file, run it (./src/generator.ml) to regenerate
28 * all the output files.
30 * IMPORTANT: This script should NOT print any warnings. If it prints
31 * warnings, you should treat them as errors.
32 * [Need to add -warn-error to ocaml command line]
39 type style = ret * args
41 (* "RErr" as a return value means an int used as a simple error
42 * indication, ie. 0 or -1.
45 (* "RInt" as a return value means an int which is -1 for error
46 * or any value >= 0 on success. Only use this for smallish
47 * positive ints (0 <= i < 2^30).
50 (* "RInt64" is the same as RInt, but is guaranteed to be able
51 * to return a full 64 bit value, _except_ that -1 means error
52 * (so -1 cannot be a valid, non-error return value).
55 (* "RBool" is a bool return value which can be true/false or
59 (* "RConstString" is a string that refers to a constant value.
60 * Try to avoid using this. In particular you cannot use this
61 * for values returned from the daemon, because there is no
62 * thread-safe way to return them in the C API.
64 | RConstString of string
65 (* "RString" and "RStringList" are caller-frees. *)
67 | RStringList of string
68 (* Some limited tuples are possible: *)
69 | RIntBool of string * string
70 (* LVM PVs, VGs and LVs. *)
77 (* Key-value pairs of untyped strings. Turns into a hashtable or
78 * dictionary in languages which support it. DON'T use this as a
79 * general "bucket" for results. Prefer a stronger typed return
80 * value if one is available, or write a custom struct. Don't use
81 * this if the list could potentially be very long, since it is
82 * inefficient. Keys should be unique. NULLs are not permitted.
84 | RHashtable of string
86 and args = argt list (* Function parameters, guestfs handle is implicit. *)
88 (* Note in future we should allow a "variable args" parameter as
89 * the final parameter, to allow commands like
90 * chmod mode file [file(s)...]
91 * This is not implemented yet, but many commands (such as chmod)
92 * are currently defined with the argument order keeping this future
93 * possibility in mind.
96 | String of string (* const char *name, cannot be NULL *)
97 | OptString of string (* const char *name, may be NULL *)
98 | StringList of string(* list of strings (each string cannot be NULL) *)
99 | Bool of string (* boolean *)
100 | Int of string (* int (smallish ints, signed, <= 31 bits) *)
101 (* These are treated as filenames (simple string parameters) in
102 * the C API and bindings. But in the RPC protocol, we transfer
103 * the actual file content up to or down from the daemon.
104 * FileIn: local machine -> daemon (in request)
105 * FileOut: daemon -> local machine (in reply)
106 * In guestfish (only), the special name "-" means read from
107 * stdin or write to stdout.
113 | ProtocolLimitWarning (* display warning about protocol size limits *)
114 | DangerWillRobinson (* flags particularly dangerous commands *)
115 | FishAlias of string (* provide an alias for this cmd in guestfish *)
116 | FishAction of string (* call this function in guestfish *)
117 | NotInFish (* do not export via guestfish *)
119 let protocol_limit_warning =
120 "Because of the message protocol, there is a transfer limit
121 of somewhere between 2MB and 4MB. To transfer large files you should use
124 let danger_will_robinson =
125 "B<This command is dangerous. Without careful use you
126 can easily destroy all your data>."
128 (* You can supply zero or as many tests as you want per API call.
130 * Note that the test environment has 3 block devices, of size 500MB,
131 * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc).
132 * Note for partitioning purposes, the 500MB device has 63 cylinders.
134 * To be able to run the tests in a reasonable amount of time,
135 * the virtual machine and block devices are reused between tests.
136 * So don't try testing kill_subprocess :-x
138 * Between each test we umount-all and lvm-remove-all (except InitNone).
140 * Don't assume anything about the previous contents of the block
141 * devices. Use 'Init*' to create some initial scenarios.
143 type tests = (test_init * test) list
145 (* Run the command sequence and just expect nothing to fail. *)
147 (* Run the command sequence and expect the output of the final
148 * command to be the string.
150 | TestOutput of seq * string
151 (* Run the command sequence and expect the output of the final
152 * command to be the list of strings.
154 | TestOutputList of seq * string list
155 (* Run the command sequence and expect the output of the final
156 * command to be the integer.
158 | TestOutputInt of seq * int
159 (* Run the command sequence and expect the output of the final
160 * command to be a true value (!= 0 or != NULL).
162 | TestOutputTrue of seq
163 (* Run the command sequence and expect the output of the final
164 * command to be a false value (== 0 or == NULL, but not an error).
166 | TestOutputFalse of seq
167 (* Run the command sequence and expect the output of the final
168 * command to be a list of the given length (but don't care about
171 | TestOutputLength of seq * int
172 (* Run the command sequence and expect the output of the final
173 * command to be a structure.
175 | TestOutputStruct of seq * test_field_compare list
176 (* Run the command sequence and expect the final command (only)
179 | TestLastFail of seq
181 and test_field_compare =
182 | CompareWithInt of string * int
183 | CompareWithString of string * string
184 | CompareFieldsIntEq of string * string
185 | CompareFieldsStrEq of string * string
187 (* Some initial scenarios for testing. *)
189 (* Do nothing, block devices could contain random stuff including
190 * LVM PVs, and some filesystems might be mounted. This is usually
194 (* Block devices are empty and no filesystems are mounted. *)
196 (* /dev/sda contains a single partition /dev/sda1, which is formatted
197 * as ext2, empty [except for lost+found] and mounted on /.
198 * /dev/sdb and /dev/sdc may have random content.
203 * /dev/sda1 (is a PV):
204 * /dev/VG/LV (size 8MB):
205 * formatted as ext2, empty [except for lost+found], mounted on /
206 * /dev/sdb and /dev/sdc may have random content.
210 (* Sequence of commands for testing. *)
212 and cmd = string list
214 (* Note about long descriptions: When referring to another
215 * action, use the format C<guestfs_other> (ie. the full name of
216 * the C function). This will be replaced as appropriate in other
219 * Apart from that, long descriptions are just perldoc paragraphs.
222 let non_daemon_functions = [
223 ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
225 "launch the qemu subprocess",
227 Internally libguestfs is implemented by running a virtual machine
230 You should call this after configuring the handle
231 (eg. adding drives) but before performing any actions.");
233 ("wait_ready", (RErr, []), -1, [NotInFish],
235 "wait until the qemu subprocess launches",
237 Internally libguestfs is implemented by running a virtual machine
240 You should call this after C<guestfs_launch> to wait for the launch
243 ("kill_subprocess", (RErr, []), -1, [],
245 "kill the qemu subprocess",
247 This kills the qemu subprocess. You should never need to call this.");
249 ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
251 "add an image to examine or modify",
253 This function adds a virtual machine disk image C<filename> to the
254 guest. The first time you call this function, the disk appears as IDE
255 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
258 You don't necessarily need to be root when using libguestfs. However
259 you obviously do need sufficient permissions to access the filename
260 for whatever operations you want to perform (ie. read access if you
261 just want to read the image or write access if you want to modify the
264 This is equivalent to the qemu parameter C<-drive file=filename>.");
266 ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
268 "add a CD-ROM disk image to examine",
270 This function adds a virtual CD-ROM disk image to the guest.
272 This is equivalent to the qemu parameter C<-cdrom filename>.");
274 ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
276 "add qemu parameters",
278 This can be used to add arbitrary qemu command line parameters
279 of the form C<-param value>. Actually it's not quite arbitrary - we
280 prevent you from setting some parameters which would interfere with
281 parameters that we use.
283 The first character of C<param> string must be a C<-> (dash).
285 C<value> can be NULL.");
287 ("set_path", (RErr, [String "path"]), -1, [FishAlias "path"],
289 "set the search path",
291 Set the path that libguestfs searches for kernel and initrd.img.
293 The default is C<$libdir/guestfs> unless overridden by setting
294 C<LIBGUESTFS_PATH> environment variable.
296 The string C<path> is stashed in the libguestfs handle, so the caller
297 must make sure it remains valid for the lifetime of the handle.
299 Setting C<path> to C<NULL> restores the default path.");
301 ("get_path", (RConstString "path", []), -1, [],
303 "get the search path",
305 Return the current search path.
307 This is always non-NULL. If it wasn't set already, then this will
308 return the default path.");
310 ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
314 If C<autosync> is true, this enables autosync. Libguestfs will make a
315 best effort attempt to run C<guestfs_sync> when the handle is closed
316 (also if the program exits without closing handles).");
318 ("get_autosync", (RBool "autosync", []), -1, [],
322 Get the autosync flag.");
324 ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
328 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
330 Verbose messages are disabled unless the environment variable
331 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
333 ("get_verbose", (RBool "verbose", []), -1, [],
337 This returns the verbose messages flag.");
339 ("is_ready", (RBool "ready", []), -1, [],
341 "is ready to accept commands",
343 This returns true iff this handle is ready to accept commands
344 (in the C<READY> state).
346 For more information on states, see L<guestfs(3)>.");
348 ("is_config", (RBool "config", []), -1, [],
350 "is in configuration state",
352 This returns true iff this handle is being configured
353 (in the C<CONFIG> state).
355 For more information on states, see L<guestfs(3)>.");
357 ("is_launching", (RBool "launching", []), -1, [],
359 "is launching subprocess",
361 This returns true iff this handle is launching the subprocess
362 (in the C<LAUNCHING> state).
364 For more information on states, see L<guestfs(3)>.");
366 ("is_busy", (RBool "busy", []), -1, [],
368 "is busy processing a command",
370 This returns true iff this handle is busy processing a command
371 (in the C<BUSY> state).
373 For more information on states, see L<guestfs(3)>.");
375 ("get_state", (RInt "state", []), -1, [],
377 "get the current state",
379 This returns the current state as an opaque integer. This is
380 only useful for printing debug and internal error messages.
382 For more information on states, see L<guestfs(3)>.");
384 ("set_busy", (RErr, []), -1, [NotInFish],
388 This sets the state to C<BUSY>. This is only used when implementing
389 actions using the low-level API.
391 For more information on states, see L<guestfs(3)>.");
393 ("set_ready", (RErr, []), -1, [NotInFish],
395 "set state to ready",
397 This sets the state to C<READY>. This is only used when implementing
398 actions using the low-level API.
400 For more information on states, see L<guestfs(3)>.");
404 let daemon_functions = [
405 ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
406 [InitEmpty, TestOutput (
407 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
408 ["mkfs"; "ext2"; "/dev/sda1"];
409 ["mount"; "/dev/sda1"; "/"];
410 ["write_file"; "/new"; "new file contents"; "0"];
411 ["cat"; "/new"]], "new file contents")],
412 "mount a guest disk at a position in the filesystem",
414 Mount a guest disk at a position in the filesystem. Block devices
415 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
416 the guest. If those block devices contain partitions, they will have
417 the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
420 The rules are the same as for L<mount(2)>: A filesystem must
421 first be mounted on C</> before others can be mounted. Other
422 filesystems can only be mounted on directories which already
425 The mounted filesystem is writable, if we have sufficient permissions
426 on the underlying device.
428 The filesystem options C<sync> and C<noatime> are set with this
429 call, in order to improve reliability.");
431 ("sync", (RErr, []), 2, [],
432 [ InitEmpty, TestRun [["sync"]]],
433 "sync disks, writes are flushed through to the disk image",
435 This syncs the disk, so that any writes are flushed through to the
436 underlying disk image.
438 You should always call this if you have modified a disk image, before
439 closing the handle.");
441 ("touch", (RErr, [String "path"]), 3, [],
442 [InitBasicFS, TestOutputTrue (
444 ["exists"; "/new"]])],
445 "update file timestamps or create a new file",
447 Touch acts like the L<touch(1)> command. It can be used to
448 update the timestamps on a file, or, if the file does not exist,
449 to create a new zero-length file.");
451 ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
452 [InitBasicFS, TestOutput (
453 [["write_file"; "/new"; "new file contents"; "0"];
454 ["cat"; "/new"]], "new file contents")],
455 "list the contents of a file",
457 Return the contents of the file named C<path>.
459 Note that this function cannot correctly handle binary files
460 (specifically, files containing C<\\0> character which is treated
461 as end of string). For those you need to use the C<guestfs_download>
462 function which has a more complex interface.");
464 ("ll", (RString "listing", [String "directory"]), 5, [],
465 [], (* XXX Tricky to test because it depends on the exact format
466 * of the 'ls -l' command, which changes between F10 and F11.
468 "list the files in a directory (long format)",
470 List the files in C<directory> (relative to the root directory,
471 there is no cwd) in the format of 'ls -la'.
473 This command is mostly useful for interactive sessions. It
474 is I<not> intended that you try to parse the output string.");
476 ("ls", (RStringList "listing", [String "directory"]), 6, [],
477 [InitBasicFS, TestOutputList (
480 ["touch"; "/newest"];
481 ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
482 "list the files in a directory",
484 List the files in C<directory> (relative to the root directory,
485 there is no cwd). The '.' and '..' entries are not returned, but
486 hidden files are shown.
488 This command is mostly useful for interactive sessions. Programs
489 should probably use C<guestfs_readdir> instead.");
491 ("list_devices", (RStringList "devices", []), 7, [],
492 [InitEmpty, TestOutputList (
493 [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"])],
494 "list the block devices",
496 List all the block devices.
498 The full block device names are returned, eg. C</dev/sda>");
500 ("list_partitions", (RStringList "partitions", []), 8, [],
501 [InitBasicFS, TestOutputList (
502 [["list_partitions"]], ["/dev/sda1"]);
503 InitEmpty, TestOutputList (
504 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
505 ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
506 "list the partitions",
508 List all the partitions detected on all block devices.
510 The full partition device names are returned, eg. C</dev/sda1>
512 This does not return logical volumes. For that you will need to
513 call C<guestfs_lvs>.");
515 ("pvs", (RStringList "physvols", []), 9, [],
516 [InitBasicFSonLVM, TestOutputList (
517 [["pvs"]], ["/dev/sda1"]);
518 InitEmpty, TestOutputList (
519 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
520 ["pvcreate"; "/dev/sda1"];
521 ["pvcreate"; "/dev/sda2"];
522 ["pvcreate"; "/dev/sda3"];
523 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
524 "list the LVM physical volumes (PVs)",
526 List all the physical volumes detected. This is the equivalent
527 of the L<pvs(8)> command.
529 This returns a list of just the device names that contain
530 PVs (eg. C</dev/sda2>).
532 See also C<guestfs_pvs_full>.");
534 ("vgs", (RStringList "volgroups", []), 10, [],
535 [InitBasicFSonLVM, TestOutputList (
537 InitEmpty, TestOutputList (
538 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
539 ["pvcreate"; "/dev/sda1"];
540 ["pvcreate"; "/dev/sda2"];
541 ["pvcreate"; "/dev/sda3"];
542 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
543 ["vgcreate"; "VG2"; "/dev/sda3"];
544 ["vgs"]], ["VG1"; "VG2"])],
545 "list the LVM volume groups (VGs)",
547 List all the volumes groups detected. This is the equivalent
548 of the L<vgs(8)> command.
550 This returns a list of just the volume group names that were
551 detected (eg. C<VolGroup00>).
553 See also C<guestfs_vgs_full>.");
555 ("lvs", (RStringList "logvols", []), 11, [],
556 [InitBasicFSonLVM, TestOutputList (
557 [["lvs"]], ["/dev/VG/LV"]);
558 InitEmpty, TestOutputList (
559 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
560 ["pvcreate"; "/dev/sda1"];
561 ["pvcreate"; "/dev/sda2"];
562 ["pvcreate"; "/dev/sda3"];
563 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
564 ["vgcreate"; "VG2"; "/dev/sda3"];
565 ["lvcreate"; "LV1"; "VG1"; "50"];
566 ["lvcreate"; "LV2"; "VG1"; "50"];
567 ["lvcreate"; "LV3"; "VG2"; "50"];
568 ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
569 "list the LVM logical volumes (LVs)",
571 List all the logical volumes detected. This is the equivalent
572 of the L<lvs(8)> command.
574 This returns a list of the logical volume device names
575 (eg. C</dev/VolGroup00/LogVol00>).
577 See also C<guestfs_lvs_full>.");
579 ("pvs_full", (RPVList "physvols", []), 12, [],
580 [], (* XXX how to test? *)
581 "list the LVM physical volumes (PVs)",
583 List all the physical volumes detected. This is the equivalent
584 of the L<pvs(8)> command. The \"full\" version includes all fields.");
586 ("vgs_full", (RVGList "volgroups", []), 13, [],
587 [], (* XXX how to test? *)
588 "list the LVM volume groups (VGs)",
590 List all the volumes groups detected. This is the equivalent
591 of the L<vgs(8)> command. The \"full\" version includes all fields.");
593 ("lvs_full", (RLVList "logvols", []), 14, [],
594 [], (* XXX how to test? *)
595 "list the LVM logical volumes (LVs)",
597 List all the logical volumes detected. This is the equivalent
598 of the L<lvs(8)> command. The \"full\" version includes all fields.");
600 ("read_lines", (RStringList "lines", [String "path"]), 15, [],
601 [InitBasicFS, TestOutputList (
602 [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
603 ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);
604 InitBasicFS, TestOutputList (
605 [["write_file"; "/new"; ""; "0"];
606 ["read_lines"; "/new"]], [])],
607 "read file as lines",
609 Return the contents of the file named C<path>.
611 The file contents are returned as a list of lines. Trailing
612 C<LF> and C<CRLF> character sequences are I<not> returned.
614 Note that this function cannot correctly handle binary files
615 (specifically, files containing C<\\0> character which is treated
616 as end of line). For those you need to use the C<guestfs_read_file>
617 function which has a more complex interface.");
619 ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [],
620 [], (* XXX Augeas code needs tests. *)
621 "create a new Augeas handle",
623 Create a new Augeas handle for editing configuration files.
624 If there was any previous Augeas handle associated with this
625 guestfs session, then it is closed.
627 You must call this before using any other C<guestfs_aug_*>
630 C<root> is the filesystem root. C<root> must not be NULL,
633 The flags are the same as the flags defined in
634 E<lt>augeas.hE<gt>, the logical I<or> of the following
639 =item C<AUG_SAVE_BACKUP> = 1
641 Keep the original file with a C<.augsave> extension.
643 =item C<AUG_SAVE_NEWFILE> = 2
645 Save changes into a file with extension C<.augnew>, and
646 do not overwrite original. Overrides C<AUG_SAVE_BACKUP>.
648 =item C<AUG_TYPE_CHECK> = 4
650 Typecheck lenses (can be expensive).
652 =item C<AUG_NO_STDINC> = 8
654 Do not use standard load path for modules.
656 =item C<AUG_SAVE_NOOP> = 16
658 Make save a no-op, just record what would have been changed.
660 =item C<AUG_NO_LOAD> = 32
662 Do not load the tree in C<guestfs_aug_init>.
666 To close the handle, you can call C<guestfs_aug_close>.
668 To find out more about Augeas, see L<http://augeas.net/>.");
670 ("aug_close", (RErr, []), 26, [],
671 [], (* XXX Augeas code needs tests. *)
672 "close the current Augeas handle",
674 Close the current Augeas handle and free up any resources
675 used by it. After calling this, you have to call
676 C<guestfs_aug_init> again before you can use any other
679 ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
680 [], (* XXX Augeas code needs tests. *)
681 "define an Augeas variable",
683 Defines an Augeas variable C<name> whose value is the result
684 of evaluating C<expr>. If C<expr> is NULL, then C<name> is
687 On success this returns the number of nodes in C<expr>, or
688 C<0> if C<expr> evaluates to something which is not a nodeset.");
690 ("aug_defnode", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [],
691 [], (* XXX Augeas code needs tests. *)
692 "define an Augeas node",
694 Defines a variable C<name> whose value is the result of
697 If C<expr> evaluates to an empty nodeset, a node is created,
698 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
699 C<name> will be the nodeset containing that single node.
701 On success this returns a pair containing the
702 number of nodes in the nodeset, and a boolean flag
703 if a node was created.");
705 ("aug_get", (RString "val", [String "path"]), 19, [],
706 [], (* XXX Augeas code needs tests. *)
707 "look up the value of an Augeas path",
709 Look up the value associated with C<path>. If C<path>
710 matches exactly one node, the C<value> is returned.");
712 ("aug_set", (RErr, [String "path"; String "val"]), 20, [],
713 [], (* XXX Augeas code needs tests. *)
714 "set Augeas path to value",
716 Set the value associated with C<path> to C<value>.");
718 ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [],
719 [], (* XXX Augeas code needs tests. *)
720 "insert a sibling Augeas node",
722 Create a new sibling C<label> for C<path>, inserting it into
723 the tree before or after C<path> (depending on the boolean
726 C<path> must match exactly one existing node in the tree, and
727 C<label> must be a label, ie. not contain C</>, C<*> or end
728 with a bracketed index C<[N]>.");
730 ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
731 [], (* XXX Augeas code needs tests. *)
732 "remove an Augeas path",
734 Remove C<path> and all of its children.
736 On success this returns the number of entries which were removed.");
738 ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [],
739 [], (* XXX Augeas code needs tests. *)
742 Move the node C<src> to C<dest>. C<src> must match exactly
743 one node. C<dest> is overwritten if it exists.");
745 ("aug_match", (RStringList "matches", [String "path"]), 24, [],
746 [], (* XXX Augeas code needs tests. *)
747 "return Augeas nodes which match path",
749 Returns a list of paths which match the path expression C<path>.
750 The returned paths are sufficiently qualified so that they match
751 exactly one node in the current tree.");
753 ("aug_save", (RErr, []), 25, [],
754 [], (* XXX Augeas code needs tests. *)
755 "write all pending Augeas changes to disk",
757 This writes all pending changes to disk.
759 The flags which were passed to C<guestfs_aug_init> affect exactly
760 how files are saved.");
762 ("aug_load", (RErr, []), 27, [],
763 [], (* XXX Augeas code needs tests. *)
764 "load files into the tree",
766 Load files into the tree.
768 See C<aug_load> in the Augeas documentation for the full gory
771 ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
772 [], (* XXX Augeas code needs tests. *)
773 "list Augeas nodes under a path",
775 This is just a shortcut for listing C<guestfs_aug_match>
776 C<path/*> and sorting the resulting nodes into alphabetical order.");
778 ("rm", (RErr, [String "path"]), 29, [],
779 [InitBasicFS, TestRun
782 InitBasicFS, TestLastFail
784 InitBasicFS, TestLastFail
789 Remove the single file C<path>.");
791 ("rmdir", (RErr, [String "path"]), 30, [],
792 [InitBasicFS, TestRun
795 InitBasicFS, TestLastFail
797 InitBasicFS, TestLastFail
800 "remove a directory",
802 Remove the single directory C<path>.");
804 ("rm_rf", (RErr, [String "path"]), 31, [],
805 [InitBasicFS, TestOutputFalse
807 ["mkdir"; "/new/foo"];
808 ["touch"; "/new/foo/bar"];
810 ["exists"; "/new"]]],
811 "remove a file or directory recursively",
813 Remove the file or directory C<path>, recursively removing the
814 contents if its a directory. This is like the C<rm -rf> shell
817 ("mkdir", (RErr, [String "path"]), 32, [],
818 [InitBasicFS, TestOutputTrue
821 InitBasicFS, TestLastFail
822 [["mkdir"; "/new/foo/bar"]]],
823 "create a directory",
825 Create a directory named C<path>.");
827 ("mkdir_p", (RErr, [String "path"]), 33, [],
828 [InitBasicFS, TestOutputTrue
829 [["mkdir_p"; "/new/foo/bar"];
830 ["is_dir"; "/new/foo/bar"]];
831 InitBasicFS, TestOutputTrue
832 [["mkdir_p"; "/new/foo/bar"];
833 ["is_dir"; "/new/foo"]];
834 InitBasicFS, TestOutputTrue
835 [["mkdir_p"; "/new/foo/bar"];
836 ["is_dir"; "/new"]]],
837 "create a directory and parents",
839 Create a directory named C<path>, creating any parent directories
840 as necessary. This is like the C<mkdir -p> shell command.");
842 ("chmod", (RErr, [Int "mode"; String "path"]), 34, [],
843 [], (* XXX Need stat command to test *)
846 Change the mode (permissions) of C<path> to C<mode>. Only
847 numeric modes are supported.");
849 ("chown", (RErr, [Int "owner"; Int "group"; String "path"]), 35, [],
850 [], (* XXX Need stat command to test *)
851 "change file owner and group",
853 Change the file owner to C<owner> and group to C<group>.
855 Only numeric uid and gid are supported. If you want to use
856 names, you will need to locate and parse the password file
857 yourself (Augeas support makes this relatively easy).");
859 ("exists", (RBool "existsflag", [String "path"]), 36, [],
860 [InitBasicFS, TestOutputTrue (
862 ["exists"; "/new"]]);
863 InitBasicFS, TestOutputTrue (
865 ["exists"; "/new"]])],
866 "test if file or directory exists",
868 This returns C<true> if and only if there is a file, directory
869 (or anything) with the given C<path> name.
871 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
873 ("is_file", (RBool "fileflag", [String "path"]), 37, [],
874 [InitBasicFS, TestOutputTrue (
876 ["is_file"; "/new"]]);
877 InitBasicFS, TestOutputFalse (
879 ["is_file"; "/new"]])],
880 "test if file exists",
882 This returns C<true> if and only if there is a file
883 with the given C<path> name. Note that it returns false for
884 other objects like directories.
886 See also C<guestfs_stat>.");
888 ("is_dir", (RBool "dirflag", [String "path"]), 38, [],
889 [InitBasicFS, TestOutputFalse (
891 ["is_dir"; "/new"]]);
892 InitBasicFS, TestOutputTrue (
894 ["is_dir"; "/new"]])],
895 "test if file exists",
897 This returns C<true> if and only if there is a directory
898 with the given C<path> name. Note that it returns false for
899 other objects like files.
901 See also C<guestfs_stat>.");
903 ("pvcreate", (RErr, [String "device"]), 39, [],
904 [InitEmpty, TestOutputList (
905 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
906 ["pvcreate"; "/dev/sda1"];
907 ["pvcreate"; "/dev/sda2"];
908 ["pvcreate"; "/dev/sda3"];
909 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
910 "create an LVM physical volume",
912 This creates an LVM physical volume on the named C<device>,
913 where C<device> should usually be a partition name such
916 ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
917 [InitEmpty, TestOutputList (
918 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
919 ["pvcreate"; "/dev/sda1"];
920 ["pvcreate"; "/dev/sda2"];
921 ["pvcreate"; "/dev/sda3"];
922 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
923 ["vgcreate"; "VG2"; "/dev/sda3"];
924 ["vgs"]], ["VG1"; "VG2"])],
925 "create an LVM volume group",
927 This creates an LVM volume group called C<volgroup>
928 from the non-empty list of physical volumes C<physvols>.");
930 ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [],
931 [InitEmpty, TestOutputList (
932 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
933 ["pvcreate"; "/dev/sda1"];
934 ["pvcreate"; "/dev/sda2"];
935 ["pvcreate"; "/dev/sda3"];
936 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
937 ["vgcreate"; "VG2"; "/dev/sda3"];
938 ["lvcreate"; "LV1"; "VG1"; "50"];
939 ["lvcreate"; "LV2"; "VG1"; "50"];
940 ["lvcreate"; "LV3"; "VG2"; "50"];
941 ["lvcreate"; "LV4"; "VG2"; "50"];
942 ["lvcreate"; "LV5"; "VG2"; "50"];
944 ["/dev/VG1/LV1"; "/dev/VG1/LV2";
945 "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
946 "create an LVM volume group",
948 This creates an LVM volume group called C<logvol>
949 on the volume group C<volgroup>, with C<size> megabytes.");
951 ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [],
952 [InitEmpty, TestOutput (
953 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
954 ["mkfs"; "ext2"; "/dev/sda1"];
955 ["mount"; "/dev/sda1"; "/"];
956 ["write_file"; "/new"; "new file contents"; "0"];
957 ["cat"; "/new"]], "new file contents")],
960 This creates a filesystem on C<device> (usually a partition
961 of LVM logical volume). The filesystem type is C<fstype>, for
964 ("sfdisk", (RErr, [String "device";
965 Int "cyls"; Int "heads"; Int "sectors";
966 StringList "lines"]), 43, [DangerWillRobinson],
968 "create partitions on a block device",
970 This is a direct interface to the L<sfdisk(8)> program for creating
971 partitions on block devices.
973 C<device> should be a block device, for example C</dev/sda>.
975 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
976 and sectors on the device, which are passed directly to sfdisk as
977 the I<-C>, I<-H> and I<-S> parameters. If you pass C<0> for any
978 of these, then the corresponding parameter is omitted. Usually for
979 'large' disks, you can just pass C<0> for these, but for small
980 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
981 out the right geometry and you will need to tell it.
983 C<lines> is a list of lines that we feed to C<sfdisk>. For more
984 information refer to the L<sfdisk(8)> manpage.
986 To create a single partition occupying the whole disk, you would
987 pass C<lines> as a single element list, when the single element being
988 the string C<,> (comma).");
990 ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
991 [InitBasicFS, TestOutput (
992 [["write_file"; "/new"; "new file contents"; "0"];
993 ["cat"; "/new"]], "new file contents");
994 InitBasicFS, TestOutput (
995 [["write_file"; "/new"; "\nnew file contents\n"; "0"];
996 ["cat"; "/new"]], "\nnew file contents\n");
997 InitBasicFS, TestOutput (
998 [["write_file"; "/new"; "\n\n"; "0"];
999 ["cat"; "/new"]], "\n\n");
1000 InitBasicFS, TestOutput (
1001 [["write_file"; "/new"; ""; "0"];
1002 ["cat"; "/new"]], "");
1003 InitBasicFS, TestOutput (
1004 [["write_file"; "/new"; "\n\n\n"; "0"];
1005 ["cat"; "/new"]], "\n\n\n");
1006 InitBasicFS, TestOutput (
1007 [["write_file"; "/new"; "\n"; "0"];
1008 ["cat"; "/new"]], "\n")],
1011 This call creates a file called C<path>. The contents of the
1012 file is the string C<content> (which can contain any 8 bit data),
1013 with length C<size>.
1015 As a special case, if C<size> is C<0>
1016 then the length is calculated using C<strlen> (so in this case
1017 the content cannot contain embedded ASCII NULs).");
1019 ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
1020 [InitEmpty, TestOutputList (
1021 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1022 ["mkfs"; "ext2"; "/dev/sda1"];
1023 ["mount"; "/dev/sda1"; "/"];
1024 ["mounts"]], ["/dev/sda1"]);
1025 InitEmpty, TestOutputList (
1026 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1027 ["mkfs"; "ext2"; "/dev/sda1"];
1028 ["mount"; "/dev/sda1"; "/"];
1031 "unmount a filesystem",
1033 This unmounts the given filesystem. The filesystem may be
1034 specified either by its mountpoint (path) or the device which
1035 contains the filesystem.");
1037 ("mounts", (RStringList "devices", []), 46, [],
1038 [InitBasicFS, TestOutputList (
1039 [["mounts"]], ["/dev/sda1"])],
1040 "show mounted filesystems",
1042 This returns the list of currently mounted filesystems. It returns
1043 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
1045 Some internal mounts are not shown.");
1047 ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
1048 [InitBasicFS, TestOutputList (
1051 "unmount all filesystems",
1053 This unmounts all mounted filesystems.
1055 Some internal mounts are not unmounted by this call.");
1057 ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson],
1059 "remove all LVM LVs, VGs and PVs",
1061 This command removes all LVM logical volumes, volume groups
1062 and physical volumes.");
1064 ("file", (RString "description", [String "path"]), 49, [],
1065 [InitBasicFS, TestOutput (
1067 ["file"; "/new"]], "empty");
1068 InitBasicFS, TestOutput (
1069 [["write_file"; "/new"; "some content\n"; "0"];
1070 ["file"; "/new"]], "ASCII text");
1071 InitBasicFS, TestLastFail (
1072 [["file"; "/nofile"]])],
1073 "determine file type",
1075 This call uses the standard L<file(1)> command to determine
1076 the type or contents of the file. This also works on devices,
1077 for example to find out whether a partition contains a filesystem.
1079 The exact command which runs is C<file -bsL path>. Note in
1080 particular that the filename is not prepended to the output
1081 (the C<-b> option).");
1083 ("command", (RString "output", [StringList "arguments"]), 50, [],
1084 [], (* XXX how to test? *)
1085 "run a command from the guest filesystem",
1087 This call runs a command from the guest filesystem. The
1088 filesystem must be mounted, and must contain a compatible
1089 operating system (ie. something Linux, with the same
1090 or compatible processor architecture).
1092 The single parameter is an argv-style list of arguments.
1093 The first element is the name of the program to run.
1094 Subsequent elements are parameters. The list must be
1095 non-empty (ie. must contain a program name).
1097 The C<$PATH> environment variable will contain at least
1098 C</usr/bin> and C</bin>. If you require a program from
1099 another location, you should provide the full path in the
1102 Shared libraries and data files required by the program
1103 must be available on filesystems which are mounted in the
1104 correct places. It is the caller's responsibility to ensure
1105 all filesystems that are needed are mounted at the right
1108 ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [],
1109 [], (* XXX how to test? *)
1110 "run a command, returning lines",
1112 This is the same as C<guestfs_command>, but splits the
1113 result into a list of lines.");
1115 ("stat", (RStat "statbuf", [String "path"]), 52, [],
1116 [InitBasicFS, TestOutputStruct (
1118 ["stat"; "/new"]], [CompareWithInt ("size", 0)])],
1119 "get file information",
1121 Returns file information for the given C<path>.
1123 This is the same as the C<stat(2)> system call.");
1125 ("lstat", (RStat "statbuf", [String "path"]), 53, [],
1126 [InitBasicFS, TestOutputStruct (
1128 ["lstat"; "/new"]], [CompareWithInt ("size", 0)])],
1129 "get file information for a symbolic link",
1131 Returns file information for the given C<path>.
1133 This is the same as C<guestfs_stat> except that if C<path>
1134 is a symbolic link, then the link is stat-ed, not the file it
1137 This is the same as the C<lstat(2)> system call.");
1139 ("statvfs", (RStatVFS "statbuf", [String "path"]), 54, [],
1140 [InitBasicFS, TestOutputStruct (
1141 [["statvfs"; "/"]], [CompareWithInt ("bfree", 487702);
1142 CompareWithInt ("blocks", 490020);
1143 CompareWithInt ("bsize", 1024)])],
1144 "get file system statistics",
1146 Returns file system statistics for any mounted file system.
1147 C<path> should be a file or directory in the mounted file system
1148 (typically it is the mount point itself, but it doesn't need to be).
1150 This is the same as the C<statvfs(2)> system call.");
1152 ("tune2fs_l", (RHashtable "superblock", [String "device"]), 55, [],
1154 "get ext2/ext3 superblock details",
1156 This returns the contents of the ext2 or ext3 filesystem superblock
1159 It is the same as running C<tune2fs -l device>. See L<tune2fs(8)>
1160 manpage for more details. The list of fields returned isn't
1161 clearly defined, and depends on both the version of C<tune2fs>
1162 that libguestfs was built against, and the filesystem itself.");
1164 ("blockdev_setro", (RErr, [String "device"]), 56, [],
1165 [InitEmpty, TestOutputTrue (
1166 [["blockdev_setro"; "/dev/sda"];
1167 ["blockdev_getro"; "/dev/sda"]])],
1168 "set block device to read-only",
1170 Sets the block device named C<device> to read-only.
1172 This uses the L<blockdev(8)> command.");
1174 ("blockdev_setrw", (RErr, [String "device"]), 57, [],
1175 [InitEmpty, TestOutputFalse (
1176 [["blockdev_setrw"; "/dev/sda"];
1177 ["blockdev_getro"; "/dev/sda"]])],
1178 "set block device to read-write",
1180 Sets the block device named C<device> to read-write.
1182 This uses the L<blockdev(8)> command.");
1184 ("blockdev_getro", (RBool "ro", [String "device"]), 58, [],
1185 [InitEmpty, TestOutputTrue (
1186 [["blockdev_setro"; "/dev/sda"];
1187 ["blockdev_getro"; "/dev/sda"]])],
1188 "is block device set to read-only",
1190 Returns a boolean indicating if the block device is read-only
1191 (true if read-only, false if not).
1193 This uses the L<blockdev(8)> command.");
1195 ("blockdev_getss", (RInt "sectorsize", [String "device"]), 59, [],
1196 [InitEmpty, TestOutputInt (
1197 [["blockdev_getss"; "/dev/sda"]], 512)],
1198 "get sectorsize of block device",
1200 This returns the size of sectors on a block device.
1201 Usually 512, but can be larger for modern devices.
1203 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
1206 This uses the L<blockdev(8)> command.");
1208 ("blockdev_getbsz", (RInt "blocksize", [String "device"]), 60, [],
1209 [InitEmpty, TestOutputInt (
1210 [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1211 "get blocksize of block device",
1213 This returns the block size of a device.
1215 (Note this is different from both I<size in blocks> and
1216 I<filesystem block size>).
1218 This uses the L<blockdev(8)> command.");
1220 ("blockdev_setbsz", (RErr, [String "device"; Int "blocksize"]), 61, [],
1222 "set blocksize of block device",
1224 This sets the block size of a device.
1226 (Note this is different from both I<size in blocks> and
1227 I<filesystem block size>).
1229 This uses the L<blockdev(8)> command.");
1231 ("blockdev_getsz", (RInt64 "sizeinsectors", [String "device"]), 62, [],
1232 [InitEmpty, TestOutputInt (
1233 [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1234 "get total size of device in 512-byte sectors",
1236 This returns the size of the device in units of 512-byte sectors
1237 (even if the sectorsize isn't 512 bytes ... weird).
1239 See also C<guestfs_blockdev_getss> for the real sector size of
1240 the device, and C<guestfs_blockdev_getsize64> for the more
1241 useful I<size in bytes>.
1243 This uses the L<blockdev(8)> command.");
1245 ("blockdev_getsize64", (RInt64 "sizeinbytes", [String "device"]), 63, [],
1246 [InitEmpty, TestOutputInt (
1247 [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1248 "get total size of device in bytes",
1250 This returns the size of the device in bytes.
1252 See also C<guestfs_blockdev_getsz>.
1254 This uses the L<blockdev(8)> command.");
1256 ("blockdev_flushbufs", (RErr, [String "device"]), 64, [],
1258 [["blockdev_flushbufs"; "/dev/sda"]]],
1259 "flush device buffers",
1261 This tells the kernel to flush internal buffers associated
1264 This uses the L<blockdev(8)> command.");
1266 ("blockdev_rereadpt", (RErr, [String "device"]), 65, [],
1268 [["blockdev_rereadpt"; "/dev/sda"]]],
1269 "reread partition table",
1271 Reread the partition table on C<device>.
1273 This uses the L<blockdev(8)> command.");
1275 ("upload", (RErr, [FileIn "filename"; String "remotefilename"]), 66, [],
1277 "upload a file from the local machine",
1279 Upload local file C<filename> to C<remotefilename> on the
1282 C<filename> can also be a named pipe.
1284 See also C<guestfs_download>.");
1286 ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [],
1288 "download a file to the local machine",
1290 Download file C<remotefilename> and save it as C<filename>
1291 on the local machine.
1293 C<filename> can also be a named pipe.
1295 See also C<guestfs_upload>, C<guestfs_cat>.");
1297 ("checksum", (RString "checksum", [String "csumtype"; String "path"]), 68, [],
1298 [InitBasicFS, TestOutput (
1299 [["write_file"; "/new"; "test\n"; "0"];
1300 ["checksum"; "crc"; "/new"]], "935282863");
1301 InitBasicFS, TestLastFail (
1302 [["checksum"; "crc"; "/new"]]);
1303 InitBasicFS, TestOutput (
1304 [["write_file"; "/new"; "test\n"; "0"];
1305 ["checksum"; "md5"; "/new"]], "d8e8fca2dc0f896fd7cb4cb0031ba249");
1306 InitBasicFS, TestOutput (
1307 [["write_file"; "/new"; "test\n"; "0"];
1308 ["checksum"; "sha1"; "/new"]], "4e1243bd22c66e76c2ba9eddc1f91394e57f9f83");
1309 InitBasicFS, TestOutput (
1310 [["write_file"; "/new"; "test\n"; "0"];
1311 ["checksum"; "sha224"; "/new"]], "52f1bf093f4b7588726035c176c0cdb4376cfea53819f1395ac9e6ec");
1312 InitBasicFS, TestOutput (
1313 [["write_file"; "/new"; "test\n"; "0"];
1314 ["checksum"; "sha256"; "/new"]], "f2ca1bb6c7e907d06dafe4687e579fce76b37e4e93b7605022da52e6ccc26fd2");
1315 InitBasicFS, TestOutput (
1316 [["write_file"; "/new"; "test\n"; "0"];
1317 ["checksum"; "sha384"; "/new"]], "109bb6b5b6d5547c1ce03c7a8bd7d8f80c1cb0957f50c4f7fda04692079917e4f9cad52b878f3d8234e1a170b154b72d");
1318 InitBasicFS, TestOutput (
1319 [["write_file"; "/new"; "test\n"; "0"];
1320 ["checksum"; "sha512"; "/new"]], "0e3e75234abc68f4378a86b3f4b32a198ba301845b0cd6e50106e874345700cc6663a86c1ea125dc5e92be17c98f9a0f85ca9d5f595db2012f7cc3571945c123")],
1321 "compute MD5, SHAx or CRC checksum of file",
1323 This call computes the MD5, SHAx or CRC checksum of the
1326 The type of checksum to compute is given by the C<csumtype>
1327 parameter which must have one of the following values:
1333 Compute the cyclic redundancy check (CRC) specified by POSIX
1334 for the C<cksum> command.
1338 Compute the MD5 hash (using the C<md5sum> program).
1342 Compute the SHA1 hash (using the C<sha1sum> program).
1346 Compute the SHA224 hash (using the C<sha224sum> program).
1350 Compute the SHA256 hash (using the C<sha256sum> program).
1354 Compute the SHA384 hash (using the C<sha384sum> program).
1358 Compute the SHA512 hash (using the C<sha512sum> program).
1362 The checksum is returned as a printable string.");
1366 let all_functions = non_daemon_functions @ daemon_functions
1368 (* In some places we want the functions to be displayed sorted
1369 * alphabetically, so this is useful:
1371 let all_functions_sorted =
1372 List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
1373 compare n1 n2) all_functions
1375 (* Column names and types from LVM PVs/VGs/LVs. *)
1384 "pv_attr", `String (* XXX *);
1385 "pv_pe_count", `Int;
1386 "pv_pe_alloc_count", `Int;
1389 "pv_mda_count", `Int;
1390 "pv_mda_free", `Bytes;
1391 (* Not in Fedora 10:
1392 "pv_mda_size", `Bytes;
1399 "vg_attr", `String (* XXX *);
1402 "vg_sysid", `String;
1403 "vg_extent_size", `Bytes;
1404 "vg_extent_count", `Int;
1405 "vg_free_count", `Int;
1413 "vg_mda_count", `Int;
1414 "vg_mda_free", `Bytes;
1415 (* Not in Fedora 10:
1416 "vg_mda_size", `Bytes;
1422 "lv_attr", `String (* XXX *);
1425 "lv_kernel_major", `Int;
1426 "lv_kernel_minor", `Int;
1430 "snap_percent", `OptPercent;
1431 "copy_percent", `OptPercent;
1434 "mirror_log", `String;
1438 (* Column names and types from stat structures.
1439 * NB. Can't use things like 'st_atime' because glibc header files
1440 * define some of these as macros. Ugh.
1457 let statvfs_cols = [
1471 (* Useful functions.
1472 * Note we don't want to use any external OCaml libraries which
1473 * makes this a bit harder than it should be.
1475 let failwithf fs = ksprintf failwith fs
1477 let replace_char s c1 c2 =
1478 let s2 = String.copy s in
1479 let r = ref false in
1480 for i = 0 to String.length s2 - 1 do
1481 if String.unsafe_get s2 i = c1 then (
1482 String.unsafe_set s2 i c2;
1486 if not !r then s else s2
1490 (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
1492 let triml ?(test = isspace) str =
1494 let n = ref (String.length str) in
1495 while !n > 0 && test str.[!i]; do
1500 else String.sub str !i !n
1502 let trimr ?(test = isspace) str =
1503 let n = ref (String.length str) in
1504 while !n > 0 && test str.[!n-1]; do
1507 if !n = String.length str then str
1508 else String.sub str 0 !n
1510 let trim ?(test = isspace) str =
1511 trimr ~test (triml ~test str)
1513 let rec find s sub =
1514 let len = String.length s in
1515 let sublen = String.length sub in
1517 if i <= len-sublen then (
1519 if j < sublen then (
1520 if s.[i+j] = sub.[j] then loop2 (j+1)
1526 if r = -1 then loop (i+1) else r
1532 let rec replace_str s s1 s2 =
1533 let len = String.length s in
1534 let sublen = String.length s1 in
1535 let i = find s s1 in
1538 let s' = String.sub s 0 i in
1539 let s'' = String.sub s (i+sublen) (len-i-sublen) in
1540 s' ^ s2 ^ replace_str s'' s1 s2
1543 let rec string_split sep str =
1544 let len = String.length str in
1545 let seplen = String.length sep in
1546 let i = find str sep in
1547 if i = -1 then [str]
1549 let s' = String.sub str 0 i in
1550 let s'' = String.sub str (i+seplen) (len-i-seplen) in
1551 s' :: string_split sep s''
1554 let rec find_map f = function
1555 | [] -> raise Not_found
1559 | None -> find_map f xs
1562 let rec loop i = function
1564 | x :: xs -> f i x; loop (i+1) xs
1569 let rec loop i = function
1571 | x :: xs -> let r = f i x in r :: loop (i+1) xs
1575 let name_of_argt = function
1576 | String n | OptString n | StringList n | Bool n | Int n
1577 | FileIn n | FileOut n -> n
1579 let seq_of_test = function
1580 | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
1581 | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s
1582 | TestOutputLength (s, _) | TestOutputStruct (s, _)
1583 | TestLastFail s -> s
1585 (* Check function names etc. for consistency. *)
1586 let check_functions () =
1587 let contains_uppercase str =
1588 let len = String.length str in
1590 if i >= len then false
1593 if c >= 'A' && c <= 'Z' then true
1600 (* Check function names. *)
1602 fun (name, _, _, _, _, _, _) ->
1603 if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
1604 failwithf "function name %s does not need 'guestfs' prefix" name;
1605 if contains_uppercase name then
1606 failwithf "function name %s should not contain uppercase chars" name;
1607 if String.contains name '-' then
1608 failwithf "function name %s should not contain '-', use '_' instead."
1612 (* Check function parameter/return names. *)
1614 fun (name, style, _, _, _, _, _) ->
1615 let check_arg_ret_name n =
1616 if contains_uppercase n then
1617 failwithf "%s param/ret %s should not contain uppercase chars"
1619 if String.contains n '-' || String.contains n '_' then
1620 failwithf "%s param/ret %s should not contain '-' or '_'"
1623 failwithf "%s has a param/ret called 'value', which causes conflicts in the OCaml bindings, use something like 'val' or a more descriptive name" n;
1624 if n = "argv" || n = "args" then
1625 failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" n
1628 (match fst style with
1630 | RInt n | RInt64 n | RBool n | RConstString n | RString n
1631 | RStringList n | RPVList n | RVGList n | RLVList n
1632 | RStat n | RStatVFS n
1634 check_arg_ret_name n
1636 check_arg_ret_name n;
1637 check_arg_ret_name m
1639 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
1642 (* Check short descriptions. *)
1644 fun (name, _, _, _, _, shortdesc, _) ->
1645 if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
1646 failwithf "short description of %s should begin with lowercase." name;
1647 let c = shortdesc.[String.length shortdesc-1] in
1648 if c = '\n' || c = '.' then
1649 failwithf "short description of %s should not end with . or \\n." name
1652 (* Check long dscriptions. *)
1654 fun (name, _, _, _, _, _, longdesc) ->
1655 if longdesc.[String.length longdesc-1] = '\n' then
1656 failwithf "long description of %s should not end with \\n." name
1659 (* Check proc_nrs. *)
1661 fun (name, _, proc_nr, _, _, _, _) ->
1662 if proc_nr <= 0 then
1663 failwithf "daemon function %s should have proc_nr > 0" name
1667 fun (name, _, proc_nr, _, _, _, _) ->
1668 if proc_nr <> -1 then
1669 failwithf "non-daemon function %s should have proc_nr -1" name
1670 ) non_daemon_functions;
1673 List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
1676 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
1677 let rec loop = function
1680 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
1682 | (name1,nr1) :: (name2,nr2) :: _ ->
1683 failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
1691 (* Ignore functions that have no tests. We generate a
1692 * warning when the user does 'make check' instead.
1694 | name, _, _, _, [], _, _ -> ()
1695 | name, _, _, _, tests, _, _ ->
1699 match seq_of_test test with
1701 failwithf "%s has a test containing an empty sequence" name
1702 | cmds -> List.map List.hd cmds
1704 let funcs = List.flatten funcs in
1706 let tested = List.mem name funcs in
1709 failwithf "function %s has tests but does not test itself" name
1712 (* 'pr' prints to the current output file. *)
1713 let chan = ref stdout
1714 let pr fs = ksprintf (output_string !chan) fs
1716 (* Generate a header block in a number of standard styles. *)
1717 type comment_style = CStyle | HashStyle | OCamlStyle
1718 type license = GPLv2 | LGPLv2
1720 let generate_header comment license =
1721 let c = match comment with
1722 | CStyle -> pr "/* "; " *"
1723 | HashStyle -> pr "# "; "#"
1724 | OCamlStyle -> pr "(* "; " *" in
1725 pr "libguestfs generated file\n";
1726 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
1727 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
1729 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
1733 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
1734 pr "%s it under the terms of the GNU General Public License as published by\n" c;
1735 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
1736 pr "%s (at your option) any later version.\n" c;
1738 pr "%s This program is distributed in the hope that it will be useful,\n" c;
1739 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1740 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
1741 pr "%s GNU General Public License for more details.\n" c;
1743 pr "%s You should have received a copy of the GNU General Public License along\n" c;
1744 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
1745 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
1748 pr "%s This library is free software; you can redistribute it and/or\n" c;
1749 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
1750 pr "%s License as published by the Free Software Foundation; either\n" c;
1751 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
1753 pr "%s This library is distributed in the hope that it will be useful,\n" c;
1754 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1755 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
1756 pr "%s Lesser General Public License for more details.\n" c;
1758 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
1759 pr "%s License along with this library; if not, write to the Free Software\n" c;
1760 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
1763 | CStyle -> pr " */\n"
1765 | OCamlStyle -> pr " *)\n"
1769 (* Start of main code generation functions below this line. *)
1771 (* Generate the pod documentation for the C API. *)
1772 let rec generate_actions_pod () =
1774 fun (shortname, style, _, flags, _, _, longdesc) ->
1775 let name = "guestfs_" ^ shortname in
1776 pr "=head2 %s\n\n" name;
1778 generate_prototype ~extern:false ~handle:"handle" name style;
1780 pr "%s\n\n" longdesc;
1781 (match fst style with
1783 pr "This function returns 0 on success or -1 on error.\n\n"
1785 pr "On error this function returns -1.\n\n"
1787 pr "On error this function returns -1.\n\n"
1789 pr "This function returns a C truth value on success or -1 on error.\n\n"
1791 pr "This function returns a string, or NULL on error.
1792 The string is owned by the guest handle and must I<not> be freed.\n\n"
1794 pr "This function returns a string, or NULL on error.
1795 I<The caller must free the returned string after use>.\n\n"
1797 pr "This function returns a NULL-terminated array of strings
1798 (like L<environ(3)>), or NULL if there was an error.
1799 I<The caller must free the strings and the array after use>.\n\n"
1801 pr "This function returns a C<struct guestfs_int_bool *>,
1802 or NULL if there was an error.
1803 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
1805 pr "This function returns a C<struct guestfs_lvm_pv_list *>
1806 (see E<lt>guestfs-structs.hE<gt>),
1807 or NULL if there was an error.
1808 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
1810 pr "This function returns a C<struct guestfs_lvm_vg_list *>
1811 (see E<lt>guestfs-structs.hE<gt>),
1812 or NULL if there was an error.
1813 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
1815 pr "This function returns a C<struct guestfs_lvm_lv_list *>
1816 (see E<lt>guestfs-structs.hE<gt>),
1817 or NULL if there was an error.
1818 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
1820 pr "This function returns a C<struct guestfs_stat *>
1821 (see L<stat(2)> and E<lt>guestfs-structs.hE<gt>),
1822 or NULL if there was an error.
1823 I<The caller must call C<free> after use>.\n\n"
1825 pr "This function returns a C<struct guestfs_statvfs *>
1826 (see L<statvfs(2)> and E<lt>guestfs-structs.hE<gt>),
1827 or NULL if there was an error.
1828 I<The caller must call C<free> after use>.\n\n"
1830 pr "This function returns a NULL-terminated array of
1831 strings, or NULL if there was an error.
1832 The array of strings will always have length C<2n+1>, where
1833 C<n> keys and values alternate, followed by the trailing NULL entry.
1834 I<The caller must free the strings and the array after use>.\n\n"
1836 if List.mem ProtocolLimitWarning flags then
1837 pr "%s\n\n" protocol_limit_warning;
1838 if List.mem DangerWillRobinson flags then
1839 pr "%s\n\n" danger_will_robinson;
1840 ) all_functions_sorted
1842 and generate_structs_pod () =
1843 (* LVM structs documentation. *)
1846 pr "=head2 guestfs_lvm_%s\n" typ;
1848 pr " struct guestfs_lvm_%s {\n" typ;
1851 | name, `String -> pr " char *%s;\n" name
1853 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
1854 pr " char %s[32];\n" name
1855 | name, `Bytes -> pr " uint64_t %s;\n" name
1856 | name, `Int -> pr " int64_t %s;\n" name
1857 | name, `OptPercent ->
1858 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
1859 pr " float %s;\n" name
1862 pr " struct guestfs_lvm_%s_list {\n" typ;
1863 pr " uint32_t len; /* Number of elements in list. */\n";
1864 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
1867 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
1870 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1872 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
1873 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
1875 * We have to use an underscore instead of a dash because otherwise
1876 * rpcgen generates incorrect code.
1878 * This header is NOT exported to clients, but see also generate_structs_h.
1880 and generate_xdr () =
1881 generate_header CStyle LGPLv2;
1883 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
1884 pr "typedef string str<>;\n";
1887 (* LVM internal structures. *)
1891 pr "struct guestfs_lvm_int_%s {\n" typ;
1893 | name, `String -> pr " string %s<>;\n" name
1894 | name, `UUID -> pr " opaque %s[32];\n" name
1895 | name, `Bytes -> pr " hyper %s;\n" name
1896 | name, `Int -> pr " hyper %s;\n" name
1897 | name, `OptPercent -> pr " float %s;\n" name
1901 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
1903 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1905 (* Stat internal structures. *)
1909 pr "struct guestfs_int_%s {\n" typ;
1911 | name, `Int -> pr " hyper %s;\n" name
1915 ) ["stat", stat_cols; "statvfs", statvfs_cols];
1918 fun (shortname, style, _, _, _, _, _) ->
1919 let name = "guestfs_" ^ shortname in
1921 (match snd style with
1924 pr "struct %s_args {\n" name;
1927 | String n -> pr " string %s<>;\n" n
1928 | OptString n -> pr " str *%s;\n" n
1929 | StringList n -> pr " str %s<>;\n" n
1930 | Bool n -> pr " bool %s;\n" n
1931 | Int n -> pr " int %s;\n" n
1932 | FileIn _ | FileOut _ -> ()
1936 (match fst style with
1939 pr "struct %s_ret {\n" name;
1943 pr "struct %s_ret {\n" name;
1944 pr " hyper %s;\n" n;
1947 pr "struct %s_ret {\n" name;
1951 failwithf "RConstString cannot be returned from a daemon function"
1953 pr "struct %s_ret {\n" name;
1954 pr " string %s<>;\n" n;
1957 pr "struct %s_ret {\n" name;
1958 pr " str %s<>;\n" n;
1961 pr "struct %s_ret {\n" name;
1966 pr "struct %s_ret {\n" name;
1967 pr " guestfs_lvm_int_pv_list %s;\n" n;
1970 pr "struct %s_ret {\n" name;
1971 pr " guestfs_lvm_int_vg_list %s;\n" n;
1974 pr "struct %s_ret {\n" name;
1975 pr " guestfs_lvm_int_lv_list %s;\n" n;
1978 pr "struct %s_ret {\n" name;
1979 pr " guestfs_int_stat %s;\n" n;
1982 pr "struct %s_ret {\n" name;
1983 pr " guestfs_int_statvfs %s;\n" n;
1986 pr "struct %s_ret {\n" name;
1987 pr " str %s<>;\n" n;
1992 (* Table of procedure numbers. *)
1993 pr "enum guestfs_procedure {\n";
1995 fun (shortname, _, proc_nr, _, _, _, _) ->
1996 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
1998 pr " GUESTFS_PROC_NR_PROCS\n";
2002 (* Having to choose a maximum message size is annoying for several
2003 * reasons (it limits what we can do in the API), but it (a) makes
2004 * the protocol a lot simpler, and (b) provides a bound on the size
2005 * of the daemon which operates in limited memory space. For large
2006 * file transfers you should use FTP.
2008 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
2011 (* Message header, etc. *)
2013 /* The communication protocol is now documented in the guestfs(3)
2017 const GUESTFS_PROGRAM = 0x2000F5F5;
2018 const GUESTFS_PROTOCOL_VERSION = 1;
2020 /* These constants must be larger than any possible message length. */
2021 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
2022 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
2024 enum guestfs_message_direction {
2025 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
2026 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
2029 enum guestfs_message_status {
2030 GUESTFS_STATUS_OK = 0,
2031 GUESTFS_STATUS_ERROR = 1
2034 const GUESTFS_ERROR_LEN = 256;
2036 struct guestfs_message_error {
2037 string error_message<GUESTFS_ERROR_LEN>;
2040 struct guestfs_message_header {
2041 unsigned prog; /* GUESTFS_PROGRAM */
2042 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
2043 guestfs_procedure proc; /* GUESTFS_PROC_x */
2044 guestfs_message_direction direction;
2045 unsigned serial; /* message serial number */
2046 guestfs_message_status status;
2049 const GUESTFS_MAX_CHUNK_SIZE = 8192;
2051 struct guestfs_chunk {
2052 int cancel; /* if non-zero, transfer is cancelled */
2053 /* data size is 0 bytes if the transfer has finished successfully */
2054 opaque data<GUESTFS_MAX_CHUNK_SIZE>;
2058 (* Generate the guestfs-structs.h file. *)
2059 and generate_structs_h () =
2060 generate_header CStyle LGPLv2;
2062 (* This is a public exported header file containing various
2063 * structures. The structures are carefully written to have
2064 * exactly the same in-memory format as the XDR structures that
2065 * we use on the wire to the daemon. The reason for creating
2066 * copies of these structures here is just so we don't have to
2067 * export the whole of guestfs_protocol.h (which includes much
2068 * unrelated and XDR-dependent stuff that we don't want to be
2069 * public, or required by clients).
2071 * To reiterate, we will pass these structures to and from the
2072 * client with a simple assignment or memcpy, so the format
2073 * must be identical to what rpcgen / the RFC defines.
2076 (* guestfs_int_bool structure. *)
2077 pr "struct guestfs_int_bool {\n";
2083 (* LVM public structures. *)
2087 pr "struct guestfs_lvm_%s {\n" typ;
2090 | name, `String -> pr " char *%s;\n" name
2091 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
2092 | name, `Bytes -> pr " uint64_t %s;\n" name
2093 | name, `Int -> pr " int64_t %s;\n" name
2094 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
2098 pr "struct guestfs_lvm_%s_list {\n" typ;
2099 pr " uint32_t len;\n";
2100 pr " struct guestfs_lvm_%s *val;\n" typ;
2103 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2105 (* Stat structures. *)
2109 pr "struct guestfs_%s {\n" typ;
2112 | name, `Int -> pr " int64_t %s;\n" name
2116 ) ["stat", stat_cols; "statvfs", statvfs_cols]
2118 (* Generate the guestfs-actions.h file. *)
2119 and generate_actions_h () =
2120 generate_header CStyle LGPLv2;
2122 fun (shortname, style, _, _, _, _, _) ->
2123 let name = "guestfs_" ^ shortname in
2124 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
2128 (* Generate the client-side dispatch stubs. *)
2129 and generate_client_actions () =
2130 generate_header CStyle LGPLv2;
2136 #include \"guestfs.h\"
2137 #include \"guestfs_protocol.h\"
2139 #define error guestfs_error
2140 #define perrorf guestfs_perrorf
2141 #define safe_malloc guestfs_safe_malloc
2142 #define safe_realloc guestfs_safe_realloc
2143 #define safe_strdup guestfs_safe_strdup
2144 #define safe_memdup guestfs_safe_memdup
2146 /* Check the return message from a call for validity. */
2148 check_reply_header (guestfs_h *g,
2149 const struct guestfs_message_header *hdr,
2150 int proc_nr, int serial)
2152 if (hdr->prog != GUESTFS_PROGRAM) {
2153 error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
2156 if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
2157 error (g, \"wrong protocol version (%%d/%%d)\",
2158 hdr->vers, GUESTFS_PROTOCOL_VERSION);
2161 if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
2162 error (g, \"unexpected message direction (%%d/%%d)\",
2163 hdr->direction, GUESTFS_DIRECTION_REPLY);
2166 if (hdr->proc != proc_nr) {
2167 error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
2170 if (hdr->serial != serial) {
2171 error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
2178 /* Check we are in the right state to run a high-level action. */
2180 check_state (guestfs_h *g, const char *caller)
2182 if (!guestfs_is_ready (g)) {
2183 if (guestfs_is_config (g))
2184 error (g, \"%%s: call launch() before using this function\",
2186 else if (guestfs_is_launching (g))
2187 error (g, \"%%s: call wait_ready() before using this function\",
2190 error (g, \"%%s called from the wrong state, %%d != READY\",
2191 caller, guestfs_get_state (g));
2199 (* Client-side stubs for each function. *)
2201 fun (shortname, style, _, _, _, _, _) ->
2202 let name = "guestfs_" ^ shortname in
2204 (* Generate the context struct which stores the high-level
2205 * state between callback functions.
2207 pr "struct %s_ctx {\n" shortname;
2208 pr " /* This flag is set by the callbacks, so we know we've done\n";
2209 pr " * the callbacks as expected, and in the right sequence.\n";
2210 pr " * 0 = not called, 1 = send called,\n";
2211 pr " * 1001 = reply called.\n";
2213 pr " int cb_sequence;\n";
2214 pr " struct guestfs_message_header hdr;\n";
2215 pr " struct guestfs_message_error err;\n";
2216 (match fst style with
2219 failwithf "RConstString cannot be returned from a daemon function"
2221 | RBool _ | RString _ | RStringList _
2223 | RPVList _ | RVGList _ | RLVList _
2224 | RStat _ | RStatVFS _
2226 pr " struct %s_ret ret;\n" name
2231 (* Generate the reply callback function. *)
2232 pr "static void %s_reply_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
2234 pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
2235 pr " struct %s_ctx *ctx = (struct %s_ctx *) data;\n" shortname shortname;
2237 pr " ml->main_loop_quit (ml, g);\n";
2239 pr " if (!xdr_guestfs_message_header (xdr, &ctx->hdr)) {\n";
2240 pr " error (g, \"%%s: failed to parse reply header\", \"%s\");\n" name;
2243 pr " if (ctx->hdr.status == GUESTFS_STATUS_ERROR) {\n";
2244 pr " if (!xdr_guestfs_message_error (xdr, &ctx->err)) {\n";
2245 pr " error (g, \"%%s: failed to parse reply error\", \"%s\");\n"
2252 (match fst style with
2255 failwithf "RConstString cannot be returned from a daemon function"
2257 | RBool _ | RString _ | RStringList _
2259 | RPVList _ | RVGList _ | RLVList _
2260 | RStat _ | RStatVFS _
2262 pr " if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name;
2263 pr " error (g, \"%%s: failed to parse reply\", \"%s\");\n" name;
2269 pr " ctx->cb_sequence = 1001;\n";
2272 (* Generate the action stub. *)
2273 generate_prototype ~extern:false ~semicolon:false ~newline:true
2274 ~handle:"g" name style;
2277 match fst style with
2278 | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
2280 failwithf "RConstString cannot be returned from a daemon function"
2281 | RString _ | RStringList _ | RIntBool _
2282 | RPVList _ | RVGList _ | RLVList _
2283 | RStat _ | RStatVFS _
2289 (match snd style with
2291 | _ -> pr " struct %s_args args;\n" name
2294 pr " struct %s_ctx ctx;\n" shortname;
2295 pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
2296 pr " int serial;\n";
2298 pr " if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
2299 pr " guestfs_set_busy (g);\n";
2301 pr " memset (&ctx, 0, sizeof ctx);\n";
2304 (* Send the main header and arguments. *)
2305 (match snd style with
2307 pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s, NULL, NULL);\n"
2308 (String.uppercase shortname)
2313 pr " args.%s = (char *) %s;\n" n n
2315 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
2317 pr " args.%s.%s_val = (char **) %s;\n" n n n;
2318 pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
2320 pr " args.%s = %s;\n" n n
2322 pr " args.%s = %s;\n" n n
2323 | FileIn _ | FileOut _ -> ()
2325 pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s,\n"
2326 (String.uppercase shortname);
2327 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
2330 pr " if (serial == -1) {\n";
2331 pr " guestfs_set_ready (g);\n";
2332 pr " return %s;\n" error_code;
2336 (* Send any additional files (FileIn) requested. *)
2343 pr " r = guestfs__send_file_sync (g, %s);\n" n;
2344 pr " if (r == -1) {\n";
2345 pr " guestfs_set_ready (g);\n";
2346 pr " return %s;\n" error_code;
2348 pr " if (r == -2) /* daemon cancelled */\n";
2349 pr " goto read_reply;\n";
2355 (* Wait for the reply from the remote end. *)
2356 pr " read_reply:\n";
2357 pr " guestfs__switch_to_receiving (g);\n";
2358 pr " ctx.cb_sequence = 0;\n";
2359 pr " guestfs_set_reply_callback (g, %s_reply_cb, &ctx);\n" shortname;
2360 pr " (void) ml->main_loop_run (ml, g);\n";
2361 pr " guestfs_set_reply_callback (g, NULL, NULL);\n";
2362 pr " if (ctx.cb_sequence != 1001) {\n";
2363 pr " error (g, \"%%s reply failed, see earlier error messages\", \"%s\");\n" name;
2364 pr " guestfs_set_ready (g);\n";
2365 pr " return %s;\n" error_code;
2369 pr " if (check_reply_header (g, &ctx.hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
2370 (String.uppercase shortname);
2371 pr " guestfs_set_ready (g);\n";
2372 pr " return %s;\n" error_code;
2376 pr " if (ctx.hdr.status == GUESTFS_STATUS_ERROR) {\n";
2377 pr " error (g, \"%%s\", ctx.err.error_message);\n";
2378 pr " guestfs_set_ready (g);\n";
2379 pr " return %s;\n" error_code;
2383 (* Expecting to receive further files (FileOut)? *)
2387 pr " if (guestfs__receive_file_sync (g, %s) == -1) {\n" n;
2388 pr " guestfs_set_ready (g);\n";
2389 pr " return %s;\n" error_code;
2395 pr " guestfs_set_ready (g);\n";
2397 (match fst style with
2398 | RErr -> pr " return 0;\n"
2399 | RInt n | RInt64 n | RBool n ->
2400 pr " return ctx.ret.%s;\n" n
2402 failwithf "RConstString cannot be returned from a daemon function"
2404 pr " return ctx.ret.%s; /* caller will free */\n" n
2405 | RStringList n | RHashtable n ->
2406 pr " /* caller will free this, but we need to add a NULL entry */\n";
2407 pr " ctx.ret.%s.%s_val =\n" n n;
2408 pr " safe_realloc (g, ctx.ret.%s.%s_val,\n" n n;
2409 pr " sizeof (char *) * (ctx.ret.%s.%s_len + 1));\n"
2411 pr " ctx.ret.%s.%s_val[ctx.ret.%s.%s_len] = NULL;\n" n n n n;
2412 pr " return ctx.ret.%s.%s_val;\n" n n
2414 pr " /* caller with free this */\n";
2415 pr " return safe_memdup (g, &ctx.ret, sizeof (ctx.ret));\n"
2416 | RPVList n | RVGList n | RLVList n
2417 | RStat n | RStatVFS n ->
2418 pr " /* caller will free this */\n";
2419 pr " return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n
2425 (* Generate daemon/actions.h. *)
2426 and generate_daemon_actions_h () =
2427 generate_header CStyle GPLv2;
2429 pr "#include \"../src/guestfs_protocol.h\"\n";
2433 fun (name, style, _, _, _, _, _) ->
2435 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
2439 (* Generate the server-side stubs. *)
2440 and generate_daemon_actions () =
2441 generate_header CStyle GPLv2;
2443 pr "#define _GNU_SOURCE // for strchrnul\n";
2445 pr "#include <stdio.h>\n";
2446 pr "#include <stdlib.h>\n";
2447 pr "#include <string.h>\n";
2448 pr "#include <inttypes.h>\n";
2449 pr "#include <ctype.h>\n";
2450 pr "#include <rpc/types.h>\n";
2451 pr "#include <rpc/xdr.h>\n";
2453 pr "#include \"daemon.h\"\n";
2454 pr "#include \"../src/guestfs_protocol.h\"\n";
2455 pr "#include \"actions.h\"\n";
2459 fun (name, style, _, _, _, _, _) ->
2460 (* Generate server-side stubs. *)
2461 pr "static void %s_stub (XDR *xdr_in)\n" name;
2464 match fst style with
2465 | RErr | RInt _ -> pr " int r;\n"; "-1"
2466 | RInt64 _ -> pr " int64_t r;\n"; "-1"
2467 | RBool _ -> pr " int r;\n"; "-1"
2469 failwithf "RConstString cannot be returned from a daemon function"
2470 | RString _ -> pr " char *r;\n"; "NULL"
2471 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
2472 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
2473 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
2474 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
2475 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL"
2476 | RStat _ -> pr " guestfs_int_stat *r;\n"; "NULL"
2477 | RStatVFS _ -> pr " guestfs_int_statvfs *r;\n"; "NULL" in
2479 (match snd style with
2482 pr " struct guestfs_%s_args args;\n" name;
2486 | OptString n -> pr " const char *%s;\n" n
2487 | StringList n -> pr " char **%s;\n" n
2488 | Bool n -> pr " int %s;\n" n
2489 | Int n -> pr " int %s;\n" n
2490 | FileIn _ | FileOut _ -> ()
2495 (match snd style with
2498 pr " memset (&args, 0, sizeof args);\n";
2500 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
2501 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
2506 | String n -> pr " %s = args.%s;\n" n n
2507 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
2509 pr " args.%s.%s_val = realloc (args.%s.%s_val, sizeof (char *) * (args.%s.%s_len+1));\n" n n n n n n;
2510 pr " args.%s.%s_val[args.%s.%s_len] = NULL;\n" n n n n;
2511 pr " %s = args.%s.%s_val;\n" n n n
2512 | Bool n -> pr " %s = args.%s;\n" n n
2513 | Int n -> pr " %s = args.%s;\n" n n
2514 | FileIn _ | FileOut _ -> ()
2519 (* Don't want to call the impl with any FileIn or FileOut
2520 * parameters, since these go "outside" the RPC protocol.
2523 List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
2525 pr " r = do_%s " name;
2526 generate_call_args argsnofile;
2529 pr " if (r == %s)\n" error_code;
2530 pr " /* do_%s has already called reply_with_error */\n" name;
2534 (* If there are any FileOut parameters, then the impl must
2535 * send its own reply.
2538 List.exists (function FileOut _ -> true | _ -> false) (snd style) in
2540 pr " /* do_%s has already sent a reply */\n" name
2542 match fst style with
2543 | RErr -> pr " reply (NULL, NULL);\n"
2544 | RInt n | RInt64 n | RBool n ->
2545 pr " struct guestfs_%s_ret ret;\n" name;
2546 pr " ret.%s = r;\n" n;
2547 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2550 failwithf "RConstString cannot be returned from a daemon function"
2552 pr " struct guestfs_%s_ret ret;\n" name;
2553 pr " ret.%s = r;\n" n;
2554 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2557 | RStringList n | RHashtable n ->
2558 pr " struct guestfs_%s_ret ret;\n" name;
2559 pr " ret.%s.%s_len = count_strings (r);\n" n n;
2560 pr " ret.%s.%s_val = r;\n" n n;
2561 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2563 pr " free_strings (r);\n"
2565 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n"
2567 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
2568 | RPVList n | RVGList n | RLVList n
2569 | RStat n | RStatVFS n ->
2570 pr " struct guestfs_%s_ret ret;\n" name;
2571 pr " ret.%s = *r;\n" n;
2572 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
2574 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
2578 (* Free the args. *)
2579 (match snd style with
2584 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
2591 (* Dispatch function. *)
2592 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
2594 pr " switch (proc_nr) {\n";
2597 fun (name, style, _, _, _, _, _) ->
2598 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
2599 pr " %s_stub (xdr_in);\n" name;
2604 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
2609 (* LVM columns and tokenization functions. *)
2610 (* XXX This generates crap code. We should rethink how we
2616 pr "static const char *lvm_%s_cols = \"%s\";\n"
2617 typ (String.concat "," (List.map fst cols));
2620 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
2622 pr " char *tok, *p, *next;\n";
2626 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
2629 pr " if (!str) {\n";
2630 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
2633 pr " if (!*str || isspace (*str)) {\n";
2634 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
2639 fun (name, coltype) ->
2640 pr " if (!tok) {\n";
2641 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
2644 pr " p = strchrnul (tok, ',');\n";
2645 pr " if (*p) next = p+1; else next = NULL;\n";
2646 pr " *p = '\\0';\n";
2649 pr " r->%s = strdup (tok);\n" name;
2650 pr " if (r->%s == NULL) {\n" name;
2651 pr " perror (\"strdup\");\n";
2655 pr " for (i = j = 0; i < 32; ++j) {\n";
2656 pr " if (tok[j] == '\\0') {\n";
2657 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
2659 pr " } else if (tok[j] != '-')\n";
2660 pr " r->%s[i++] = tok[j];\n" name;
2663 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
2664 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2668 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
2669 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2673 pr " if (tok[0] == '\\0')\n";
2674 pr " r->%s = -1;\n" name;
2675 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
2676 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2680 pr " tok = next;\n";
2683 pr " if (tok != NULL) {\n";
2684 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
2691 pr "guestfs_lvm_int_%s_list *\n" typ;
2692 pr "parse_command_line_%ss (void)\n" typ;
2694 pr " char *out, *err;\n";
2695 pr " char *p, *pend;\n";
2697 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
2698 pr " void *newp;\n";
2700 pr " ret = malloc (sizeof *ret);\n";
2701 pr " if (!ret) {\n";
2702 pr " reply_with_perror (\"malloc\");\n";
2703 pr " return NULL;\n";
2706 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
2707 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
2709 pr " r = command (&out, &err,\n";
2710 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
2711 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
2712 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
2713 pr " if (r == -1) {\n";
2714 pr " reply_with_error (\"%%s\", err);\n";
2715 pr " free (out);\n";
2716 pr " free (err);\n";
2717 pr " free (ret);\n";
2718 pr " return NULL;\n";
2721 pr " free (err);\n";
2723 pr " /* Tokenize each line of the output. */\n";
2726 pr " while (p) {\n";
2727 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
2728 pr " if (pend) {\n";
2729 pr " *pend = '\\0';\n";
2733 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
2736 pr " if (!*p) { /* Empty line? Skip it. */\n";
2741 pr " /* Allocate some space to store this next entry. */\n";
2742 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
2743 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
2744 pr " if (newp == NULL) {\n";
2745 pr " reply_with_perror (\"realloc\");\n";
2746 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2747 pr " free (ret);\n";
2748 pr " free (out);\n";
2749 pr " return NULL;\n";
2751 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
2753 pr " /* Tokenize the next entry. */\n";
2754 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
2755 pr " if (r == -1) {\n";
2756 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
2757 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2758 pr " free (ret);\n";
2759 pr " free (out);\n";
2760 pr " return NULL;\n";
2767 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
2769 pr " free (out);\n";
2770 pr " return ret;\n";
2773 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2775 (* Generate the tests. *)
2776 and generate_tests () =
2777 generate_header CStyle GPLv2;
2784 #include <sys/types.h>
2787 #include \"guestfs.h\"
2789 static guestfs_h *g;
2790 static int suppress_error = 0;
2792 static void print_error (guestfs_h *g, void *data, const char *msg)
2794 if (!suppress_error)
2795 fprintf (stderr, \"%%s\\n\", msg);
2798 static void print_strings (char * const * const argv)
2802 for (argc = 0; argv[argc] != NULL; ++argc)
2803 printf (\"\\t%%s\\n\", argv[argc]);
2807 static void print_table (char * const * const argv)
2811 for (i = 0; argv[i] != NULL; i += 2)
2812 printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
2816 static void no_test_warnings (void)
2822 | name, _, _, _, [], _, _ ->
2823 pr " fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
2824 | name, _, _, _, tests, _, _ -> ()
2830 (* Generate the actual tests. Note that we generate the tests
2831 * in reverse order, deliberately, so that (in general) the
2832 * newest tests run first. This makes it quicker and easier to
2837 fun (name, _, _, _, tests, _, _) ->
2838 mapi (generate_one_test name) tests
2839 ) (List.rev all_functions) in
2840 let test_names = List.concat test_names in
2841 let nr_tests = List.length test_names in
2844 int main (int argc, char *argv[])
2851 int nr_tests, test_num = 0;
2853 no_test_warnings ();
2855 g = guestfs_create ();
2857 printf (\"guestfs_create FAILED\\n\");
2861 guestfs_set_error_handler (g, print_error, NULL);
2863 srcdir = getenv (\"srcdir\");
2864 if (!srcdir) srcdir = \".\";
2865 guestfs_set_path (g, srcdir);
2867 snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);
2868 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2873 if (lseek (fd, %d, SEEK_SET) == -1) {
2879 if (write (fd, &c, 1) == -1) {
2885 if (close (fd) == -1) {
2890 if (guestfs_add_drive (g, buf) == -1) {
2891 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2895 snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);
2896 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2901 if (lseek (fd, %d, SEEK_SET) == -1) {
2907 if (write (fd, &c, 1) == -1) {
2913 if (close (fd) == -1) {
2918 if (guestfs_add_drive (g, buf) == -1) {
2919 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2923 snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);
2924 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2929 if (lseek (fd, %d, SEEK_SET) == -1) {
2935 if (write (fd, &c, 1) == -1) {
2941 if (close (fd) == -1) {
2946 if (guestfs_add_drive (g, buf) == -1) {
2947 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2951 if (guestfs_launch (g) == -1) {
2952 printf (\"guestfs_launch FAILED\\n\");
2955 if (guestfs_wait_ready (g) == -1) {
2956 printf (\"guestfs_wait_ready FAILED\\n\");
2962 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
2966 pr " test_num++;\n";
2967 pr " printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
2968 pr " if (%s () == -1) {\n" test_name;
2969 pr " printf (\"%s FAILED\\n\");\n" test_name;
2975 pr " guestfs_close (g);\n";
2976 pr " snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);\n";
2977 pr " unlink (buf);\n";
2978 pr " snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);\n";
2979 pr " unlink (buf);\n";
2980 pr " snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);\n";
2981 pr " unlink (buf);\n";
2984 pr " if (failed > 0) {\n";
2985 pr " printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n";
2993 and generate_one_test name i (init, test) =
2994 let test_name = sprintf "test_%s_%d" name i in
2996 pr "static int %s (void)\n" test_name;
3002 pr " /* InitEmpty for %s (%d) */\n" name i;
3003 List.iter (generate_test_command_call test_name)
3007 pr " /* InitBasicFS for %s (%d): create ext2 on /dev/sda1 */\n" name i;
3008 List.iter (generate_test_command_call test_name)
3011 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
3012 ["mkfs"; "ext2"; "/dev/sda1"];
3013 ["mount"; "/dev/sda1"; "/"]]
3014 | InitBasicFSonLVM ->
3015 pr " /* InitBasicFSonLVM for %s (%d): create ext2 on /dev/VG/LV */\n"
3017 List.iter (generate_test_command_call test_name)
3020 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
3021 ["pvcreate"; "/dev/sda1"];
3022 ["vgcreate"; "VG"; "/dev/sda1"];
3023 ["lvcreate"; "LV"; "VG"; "8"];
3024 ["mkfs"; "ext2"; "/dev/VG/LV"];
3025 ["mount"; "/dev/VG/LV"; "/"]]
3028 let get_seq_last = function
3030 failwithf "%s: you cannot use [] (empty list) when expecting a command"
3033 let seq = List.rev seq in
3034 List.rev (List.tl seq), List.hd seq
3039 pr " /* TestRun for %s (%d) */\n" name i;
3040 List.iter (generate_test_command_call test_name) seq
3041 | TestOutput (seq, expected) ->
3042 pr " /* TestOutput for %s (%d) */\n" name i;
3043 let seq, last = get_seq_last seq in
3045 pr " if (strcmp (r, \"%s\") != 0) {\n" (c_quote expected);
3046 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r);\n" test_name (c_quote expected);
3050 List.iter (generate_test_command_call test_name) seq;
3051 generate_test_command_call ~test test_name last
3052 | TestOutputList (seq, expected) ->
3053 pr " /* TestOutputList for %s (%d) */\n" name i;
3054 let seq, last = get_seq_last seq in
3058 pr " if (!r[%d]) {\n" i;
3059 pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
3060 pr " print_strings (r);\n";
3063 pr " if (strcmp (r[%d], \"%s\") != 0) {\n" i (c_quote str);
3064 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r[%d]);\n" test_name (c_quote str) i;
3068 pr " if (r[%d] != NULL) {\n" (List.length expected);
3069 pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
3071 pr " print_strings (r);\n";
3075 List.iter (generate_test_command_call test_name) seq;
3076 generate_test_command_call ~test test_name last
3077 | TestOutputInt (seq, expected) ->
3078 pr " /* TestOutputInt for %s (%d) */\n" name i;
3079 let seq, last = get_seq_last seq in
3081 pr " if (r != %d) {\n" expected;
3082 pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\","
3088 List.iter (generate_test_command_call test_name) seq;
3089 generate_test_command_call ~test test_name last
3090 | TestOutputTrue seq ->
3091 pr " /* TestOutputTrue for %s (%d) */\n" name i;
3092 let seq, last = get_seq_last seq in
3095 pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n"
3100 List.iter (generate_test_command_call test_name) seq;
3101 generate_test_command_call ~test test_name last
3102 | TestOutputFalse seq ->
3103 pr " /* TestOutputFalse for %s (%d) */\n" name i;
3104 let seq, last = get_seq_last seq in
3107 pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n"
3112 List.iter (generate_test_command_call test_name) seq;
3113 generate_test_command_call ~test test_name last
3114 | TestOutputLength (seq, expected) ->
3115 pr " /* TestOutputLength for %s (%d) */\n" name i;
3116 let seq, last = get_seq_last seq in
3119 pr " for (j = 0; j < %d; ++j)\n" expected;
3120 pr " if (r[j] == NULL) {\n";
3121 pr " fprintf (stderr, \"%s: short list returned\\n\");\n"
3123 pr " print_strings (r);\n";
3126 pr " if (r[j] != NULL) {\n";
3127 pr " fprintf (stderr, \"%s: long list returned\\n\");\n"
3129 pr " print_strings (r);\n";
3133 List.iter (generate_test_command_call test_name) seq;
3134 generate_test_command_call ~test test_name last
3135 | TestOutputStruct (seq, checks) ->
3136 pr " /* TestOutputStruct for %s (%d) */\n" name i;
3137 let seq, last = get_seq_last seq in
3141 | CompareWithInt (field, expected) ->
3142 pr " if (r->%s != %d) {\n" field expected;
3143 pr " fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
3144 test_name field expected;
3145 pr " (int) r->%s);\n" field;
3148 | CompareWithString (field, expected) ->
3149 pr " if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
3150 pr " fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
3151 test_name field expected;
3152 pr " r->%s);\n" field;
3155 | CompareFieldsIntEq (field1, field2) ->
3156 pr " if (r->%s != r->%s) {\n" field1 field2;
3157 pr " fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
3158 test_name field1 field2;
3159 pr " (int) r->%s, (int) r->%s);\n" field1 field2;
3162 | CompareFieldsStrEq (field1, field2) ->
3163 pr " if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
3164 pr " fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
3165 test_name field1 field2;
3166 pr " r->%s, r->%s);\n" field1 field2;
3171 List.iter (generate_test_command_call test_name) seq;
3172 generate_test_command_call ~test test_name last
3173 | TestLastFail seq ->
3174 pr " /* TestLastFail for %s (%d) */\n" name i;
3175 let seq, last = get_seq_last seq in
3176 List.iter (generate_test_command_call test_name) seq;
3177 generate_test_command_call test_name ~expect_error:true last
3185 (* Generate the code to run a command, leaving the result in 'r'.
3186 * If you expect to get an error then you should set expect_error:true.
3188 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
3190 | [] -> assert false
3192 (* Look up the command to find out what args/ret it has. *)
3195 let _, style, _, _, _, _, _ =
3196 List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
3199 failwithf "%s: in test, command %s was not found" test_name name in
3201 if List.length (snd style) <> List.length args then
3202 failwithf "%s: in test, wrong number of args given to %s"
3213 | FileIn _, _ | FileOut _, _ -> ()
3214 | StringList n, arg ->
3215 pr " char *%s[] = {\n" n;
3216 let strs = string_split " " arg in
3218 fun str -> pr " \"%s\",\n" (c_quote str)
3222 ) (List.combine (snd style) args);
3225 match fst style with
3226 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
3227 | RInt64 _ -> pr " int64_t r;\n"; "-1"
3228 | RConstString _ -> pr " const char *r;\n"; "NULL"
3229 | RString _ -> pr " char *r;\n"; "NULL"
3230 | RStringList _ | RHashtable _ ->
3235 pr " struct guestfs_int_bool *r;\n"; "NULL"
3237 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
3239 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
3241 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
3243 pr " struct guestfs_stat *r;\n"; "NULL"
3245 pr " struct guestfs_statvfs *r;\n"; "NULL" in
3247 pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
3248 pr " r = guestfs_%s (g" name;
3250 (* Generate the parameters. *)
3254 | FileIn _, arg | FileOut _, arg ->
3255 pr ", \"%s\"" (c_quote arg)
3256 | OptString _, arg ->
3257 if arg = "NULL" then pr ", NULL" else pr ", \"%s\"" (c_quote arg)
3258 | StringList n, _ ->
3262 try int_of_string arg
3263 with Failure "int_of_string" ->
3264 failwithf "%s: expecting an int, but got '%s'" test_name arg in
3267 let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
3268 ) (List.combine (snd style) args);
3271 if not expect_error then
3272 pr " if (r == %s)\n" error_code
3274 pr " if (r != %s)\n" error_code;
3277 (* Insert the test code. *)
3283 (match fst style with
3284 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ -> ()
3285 | RString _ -> pr " free (r);\n"
3286 | RStringList _ | RHashtable _ ->
3287 pr " for (i = 0; r[i] != NULL; ++i)\n";
3288 pr " free (r[i]);\n";
3291 pr " guestfs_free_int_bool (r);\n"
3293 pr " guestfs_free_lvm_pv_list (r);\n"
3295 pr " guestfs_free_lvm_vg_list (r);\n"
3297 pr " guestfs_free_lvm_lv_list (r);\n"
3298 | RStat _ | RStatVFS _ ->
3305 let str = replace_str str "\r" "\\r" in
3306 let str = replace_str str "\n" "\\n" in
3307 let str = replace_str str "\t" "\\t" in
3310 (* Generate a lot of different functions for guestfish. *)
3311 and generate_fish_cmds () =
3312 generate_header CStyle GPLv2;
3316 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3318 let all_functions_sorted =
3320 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3321 ) all_functions_sorted in
3323 pr "#include <stdio.h>\n";
3324 pr "#include <stdlib.h>\n";
3325 pr "#include <string.h>\n";
3326 pr "#include <inttypes.h>\n";
3328 pr "#include <guestfs.h>\n";
3329 pr "#include \"fish.h\"\n";
3332 (* list_commands function, which implements guestfish -h *)
3333 pr "void list_commands (void)\n";
3335 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
3336 pr " list_builtin_commands ();\n";
3338 fun (name, _, _, flags, _, shortdesc, _) ->
3339 let name = replace_char name '_' '-' in
3340 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
3342 ) all_functions_sorted;
3343 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
3347 (* display_command function, which implements guestfish -h cmd *)
3348 pr "void display_command (const char *cmd)\n";
3351 fun (name, style, _, flags, _, shortdesc, longdesc) ->
3352 let name2 = replace_char name '_' '-' in
3354 try find_map (function FishAlias n -> Some n | _ -> None) flags
3355 with Not_found -> name in
3356 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
3358 match snd style with
3362 name2 (String.concat "> <" (List.map name_of_argt args)) in
3365 if List.mem ProtocolLimitWarning flags then
3366 ("\n\n" ^ protocol_limit_warning)
3369 (* For DangerWillRobinson commands, we should probably have
3370 * guestfish prompt before allowing you to use them (especially
3371 * in interactive mode). XXX
3375 if List.mem DangerWillRobinson flags then
3376 ("\n\n" ^ danger_will_robinson)
3379 let describe_alias =
3380 if name <> alias then
3381 sprintf "\n\nYou can use '%s' as an alias for this command." alias
3385 pr "strcasecmp (cmd, \"%s\") == 0" name;
3386 if name <> name2 then
3387 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
3388 if name <> alias then
3389 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
3391 pr " pod2text (\"%s - %s\", %S);\n"
3393 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
3396 pr " display_builtin_command (cmd);\n";
3400 (* print_{pv,vg,lv}_list functions *)
3404 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
3411 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
3413 pr " printf (\"%s: \");\n" name;
3414 pr " for (i = 0; i < 32; ++i)\n";
3415 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
3416 pr " printf (\"\\n\");\n"
3418 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
3420 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
3421 | name, `OptPercent ->
3422 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
3423 typ name name typ name;
3424 pr " else printf (\"%s: \\n\");\n" name
3428 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
3433 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
3434 pr " print_%s (&%ss->val[i]);\n" typ typ;
3437 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3439 (* print_{stat,statvfs} functions *)
3443 pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
3448 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
3452 ) ["stat", stat_cols; "statvfs", statvfs_cols];
3454 (* run_<action> actions *)
3456 fun (name, style, _, flags, _, _, _) ->
3457 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
3459 (match fst style with
3462 | RBool _ -> pr " int r;\n"
3463 | RInt64 _ -> pr " int64_t r;\n"
3464 | RConstString _ -> pr " const char *r;\n"
3465 | RString _ -> pr " char *r;\n"
3466 | RStringList _ | RHashtable _ -> pr " char **r;\n"
3467 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
3468 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
3469 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
3470 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
3471 | RStat _ -> pr " struct guestfs_stat *r;\n"
3472 | RStatVFS _ -> pr " struct guestfs_statvfs *r;\n"
3479 | FileOut n -> pr " const char *%s;\n" n
3480 | StringList n -> pr " char **%s;\n" n
3481 | Bool n -> pr " int %s;\n" n
3482 | Int n -> pr " int %s;\n" n
3485 (* Check and convert parameters. *)
3486 let argc_expected = List.length (snd style) in
3487 pr " if (argc != %d) {\n" argc_expected;
3488 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
3490 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
3496 | String name -> pr " %s = argv[%d];\n" name i
3498 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
3501 pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdin\";\n"
3504 pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n"
3506 | StringList name ->
3507 pr " %s = parse_string_list (argv[%d]);\n" name i
3509 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
3511 pr " %s = atoi (argv[%d]);\n" name i
3514 (* Call C API function. *)
3516 try find_map (function FishAction n -> Some n | _ -> None) flags
3517 with Not_found -> sprintf "guestfs_%s" name in
3519 generate_call_args ~handle:"g" (snd style);
3522 (* Check return value for errors and display command results. *)
3523 (match fst style with
3524 | RErr -> pr " return r;\n"
3526 pr " if (r == -1) return -1;\n";
3527 pr " printf (\"%%d\\n\", r);\n";
3530 pr " if (r == -1) return -1;\n";
3531 pr " printf (\"%%\" PRIi64 \"\\n\", r);\n";
3534 pr " if (r == -1) return -1;\n";
3535 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
3538 pr " if (r == NULL) return -1;\n";
3539 pr " printf (\"%%s\\n\", r);\n";
3542 pr " if (r == NULL) return -1;\n";
3543 pr " printf (\"%%s\\n\", r);\n";
3547 pr " if (r == NULL) return -1;\n";
3548 pr " print_strings (r);\n";
3549 pr " free_strings (r);\n";
3552 pr " if (r == NULL) return -1;\n";
3553 pr " printf (\"%%d, %%s\\n\", r->i,\n";
3554 pr " r->b ? \"true\" : \"false\");\n";
3555 pr " guestfs_free_int_bool (r);\n";
3558 pr " if (r == NULL) return -1;\n";
3559 pr " print_pv_list (r);\n";
3560 pr " guestfs_free_lvm_pv_list (r);\n";
3563 pr " if (r == NULL) return -1;\n";
3564 pr " print_vg_list (r);\n";
3565 pr " guestfs_free_lvm_vg_list (r);\n";
3568 pr " if (r == NULL) return -1;\n";
3569 pr " print_lv_list (r);\n";
3570 pr " guestfs_free_lvm_lv_list (r);\n";
3573 pr " if (r == NULL) return -1;\n";
3574 pr " print_stat (r);\n";
3578 pr " if (r == NULL) return -1;\n";
3579 pr " print_statvfs (r);\n";
3583 pr " if (r == NULL) return -1;\n";
3584 pr " print_table (r);\n";
3585 pr " free_strings (r);\n";
3592 (* run_action function *)
3593 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
3596 fun (name, _, _, flags, _, _, _) ->
3597 let name2 = replace_char name '_' '-' in
3599 try find_map (function FishAlias n -> Some n | _ -> None) flags
3600 with Not_found -> name in
3602 pr "strcasecmp (cmd, \"%s\") == 0" name;
3603 if name <> name2 then
3604 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
3605 if name <> alias then
3606 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
3608 pr " return run_%s (cmd, argc, argv);\n" name;
3612 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
3619 (* Readline completion for guestfish. *)
3620 and generate_fish_completion () =
3621 generate_header CStyle GPLv2;
3625 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3635 #ifdef HAVE_LIBREADLINE
3636 #include <readline/readline.h>
3641 #ifdef HAVE_LIBREADLINE
3643 static const char *commands[] = {
3646 (* Get the commands and sort them, including the aliases. *)
3649 fun (name, _, _, flags, _, _, _) ->
3650 let name2 = replace_char name '_' '-' in
3652 try find_map (function FishAlias n -> Some n | _ -> None) flags
3653 with Not_found -> name in
3655 if name <> alias then [name2; alias] else [name2]
3657 let commands = List.flatten commands in
3658 let commands = List.sort compare commands in
3660 List.iter (pr " \"%s\",\n") commands;
3666 generator (const char *text, int state)
3668 static int index, len;
3673 len = strlen (text);
3676 while ((name = commands[index]) != NULL) {
3678 if (strncasecmp (name, text, len) == 0)
3679 return strdup (name);
3685 #endif /* HAVE_LIBREADLINE */
3687 char **do_completion (const char *text, int start, int end)
3689 char **matches = NULL;
3691 #ifdef HAVE_LIBREADLINE
3693 matches = rl_completion_matches (text, generator);
3700 (* Generate the POD documentation for guestfish. *)
3701 and generate_fish_actions_pod () =
3702 let all_functions_sorted =
3704 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3705 ) all_functions_sorted in
3708 fun (name, style, _, flags, _, _, longdesc) ->
3709 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
3710 let name = replace_char name '_' '-' in
3712 try find_map (function FishAlias n -> Some n | _ -> None) flags
3713 with Not_found -> name in
3715 pr "=head2 %s" name;
3716 if name <> alias then
3723 | String n -> pr " %s" n
3724 | OptString n -> pr " %s" n
3725 | StringList n -> pr " %s,..." n
3726 | Bool _ -> pr " true|false"
3727 | Int n -> pr " %s" n
3728 | FileIn n | FileOut n -> pr " (%s|-)" n
3732 pr "%s\n\n" longdesc;
3734 if List.exists (function FileIn _ | FileOut _ -> true
3735 | _ -> false) (snd style) then
3736 pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
3738 if List.mem ProtocolLimitWarning flags then
3739 pr "%s\n\n" protocol_limit_warning;
3741 if List.mem DangerWillRobinson flags then
3742 pr "%s\n\n" danger_will_robinson
3743 ) all_functions_sorted
3745 (* Generate a C function prototype. *)
3746 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
3747 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
3749 ?handle name style =
3750 if extern then pr "extern ";
3751 if static then pr "static ";
3752 (match fst style with
3754 | RInt _ -> pr "int "
3755 | RInt64 _ -> pr "int64_t "
3756 | RBool _ -> pr "int "
3757 | RConstString _ -> pr "const char *"
3758 | RString _ -> pr "char *"
3759 | RStringList _ | RHashtable _ -> pr "char **"
3761 if not in_daemon then pr "struct guestfs_int_bool *"
3762 else pr "guestfs_%s_ret *" name
3764 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
3765 else pr "guestfs_lvm_int_pv_list *"
3767 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
3768 else pr "guestfs_lvm_int_vg_list *"
3770 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
3771 else pr "guestfs_lvm_int_lv_list *"
3773 if not in_daemon then pr "struct guestfs_stat *"
3774 else pr "guestfs_int_stat *"
3776 if not in_daemon then pr "struct guestfs_statvfs *"
3777 else pr "guestfs_int_statvfs *"
3779 pr "%s%s (" prefix name;
3780 if handle = None && List.length (snd style) = 0 then
3783 let comma = ref false in
3786 | Some handle -> pr "guestfs_h *%s" handle; comma := true
3790 if single_line then pr ", " else pr ",\n\t\t"
3797 | OptString n -> next (); pr "const char *%s" n
3798 | StringList n -> next (); pr "char * const* const %s" n
3799 | Bool n -> next (); pr "int %s" n
3800 | Int n -> next (); pr "int %s" n
3803 if not in_daemon then (next (); pr "const char *%s" n)
3807 if semicolon then pr ";";
3808 if newline then pr "\n"
3810 (* Generate C call arguments, eg "(handle, foo, bar)" *)
3811 and generate_call_args ?handle args =
3813 let comma = ref false in
3816 | Some handle -> pr "%s" handle; comma := true
3820 if !comma then pr ", ";
3822 pr "%s" (name_of_argt arg)
3826 (* Generate the OCaml bindings interface. *)
3827 and generate_ocaml_mli () =
3828 generate_header OCamlStyle LGPLv2;
3831 (** For API documentation you should refer to the C API
3832 in the guestfs(3) manual page. The OCaml API uses almost
3833 exactly the same calls. *)
3836 (** A [guestfs_h] handle. *)
3838 exception Error of string
3839 (** This exception is raised when there is an error. *)
3841 val create : unit -> t
3843 val close : t -> unit
3844 (** Handles are closed by the garbage collector when they become
3845 unreferenced, but callers can also call this in order to
3846 provide predictable cleanup. *)
3849 generate_ocaml_lvm_structure_decls ();
3851 generate_ocaml_stat_structure_decls ();
3855 fun (name, style, _, _, _, shortdesc, _) ->
3856 generate_ocaml_prototype name style;
3857 pr "(** %s *)\n" shortdesc;
3861 (* Generate the OCaml bindings implementation. *)
3862 and generate_ocaml_ml () =
3863 generate_header OCamlStyle LGPLv2;
3867 exception Error of string
3868 external create : unit -> t = \"ocaml_guestfs_create\"
3869 external close : t -> unit = \"ocaml_guestfs_close\"
3872 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
3876 generate_ocaml_lvm_structure_decls ();
3878 generate_ocaml_stat_structure_decls ();
3882 fun (name, style, _, _, _, shortdesc, _) ->
3883 generate_ocaml_prototype ~is_external:true name style;
3886 (* Generate the OCaml bindings C implementation. *)
3887 and generate_ocaml_c () =
3888 generate_header CStyle LGPLv2;
3895 #include <caml/config.h>
3896 #include <caml/alloc.h>
3897 #include <caml/callback.h>
3898 #include <caml/fail.h>
3899 #include <caml/memory.h>
3900 #include <caml/mlvalues.h>
3901 #include <caml/signals.h>
3903 #include <guestfs.h>
3905 #include \"guestfs_c.h\"
3907 /* Copy a hashtable of string pairs into an assoc-list. We return
3908 * the list in reverse order, but hashtables aren't supposed to be
3911 static CAMLprim value
3912 copy_table (char * const * argv)
3915 CAMLlocal5 (rv, pairv, kv, vv, cons);
3919 for (i = 0; argv[i] != NULL; i += 2) {
3920 kv = caml_copy_string (argv[i]);
3921 vv = caml_copy_string (argv[i+1]);
3922 pairv = caml_alloc (2, 0);
3923 Store_field (pairv, 0, kv);
3924 Store_field (pairv, 1, vv);
3925 cons = caml_alloc (2, 0);
3926 Store_field (cons, 1, rv);
3928 Store_field (cons, 0, pairv);
3936 (* LVM struct copy functions. *)
3939 let has_optpercent_col =
3940 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
3942 pr "static CAMLprim value\n";
3943 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
3945 pr " CAMLparam0 ();\n";
3946 if has_optpercent_col then
3947 pr " CAMLlocal3 (rv, v, v2);\n"
3949 pr " CAMLlocal2 (rv, v);\n";
3951 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
3956 pr " v = caml_copy_string (%s->%s);\n" typ name
3958 pr " v = caml_alloc_string (32);\n";
3959 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
3962 pr " v = caml_copy_int64 (%s->%s);\n" typ name
3963 | name, `OptPercent ->
3964 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
3965 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
3966 pr " v = caml_alloc (1, 0);\n";
3967 pr " Store_field (v, 0, v2);\n";
3968 pr " } else /* None */\n";
3969 pr " v = Val_int (0);\n";
3971 pr " Store_field (rv, %d, v);\n" i
3973 pr " CAMLreturn (rv);\n";
3977 pr "static CAMLprim value\n";
3978 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
3981 pr " CAMLparam0 ();\n";
3982 pr " CAMLlocal2 (rv, v);\n";
3985 pr " if (%ss->len == 0)\n" typ;
3986 pr " CAMLreturn (Atom (0));\n";
3988 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
3989 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
3990 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
3991 pr " caml_modify (&Field (rv, i), v);\n";
3993 pr " CAMLreturn (rv);\n";
3997 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3999 (* Stat copy functions. *)
4002 pr "static CAMLprim value\n";
4003 pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
4005 pr " CAMLparam0 ();\n";
4006 pr " CAMLlocal2 (rv, v);\n";
4008 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
4013 pr " v = caml_copy_int64 (%s->%s);\n" typ name
4015 pr " Store_field (rv, %d, v);\n" i
4017 pr " CAMLreturn (rv);\n";
4020 ) ["stat", stat_cols; "statvfs", statvfs_cols];
4024 fun (name, style, _, _, _, _, _) ->
4026 "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
4028 pr "CAMLprim value\n";
4029 pr "ocaml_guestfs_%s (value %s" name (List.hd params);
4030 List.iter (pr ", value %s") (List.tl params);
4035 | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
4036 pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
4037 pr " CAMLxparam%d (%s);\n"
4038 (List.length rest) (String.concat ", " rest)
4040 pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
4042 pr " CAMLlocal1 (rv);\n";
4045 pr " guestfs_h *g = Guestfs_val (gv);\n";
4046 pr " if (g == NULL)\n";
4047 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
4055 pr " const char *%s = String_val (%sv);\n" n n
4057 pr " const char *%s =\n" n;
4058 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
4061 pr " char **%s = ocaml_guestfs_strings_val (%sv);\n" n n
4063 pr " int %s = Bool_val (%sv);\n" n n
4065 pr " int %s = Int_val (%sv);\n" n n
4068 match fst style with
4069 | RErr -> pr " int r;\n"; "-1"
4070 | RInt _ -> pr " int r;\n"; "-1"
4071 | RInt64 _ -> pr " int64_t r;\n"; "-1"
4072 | RBool _ -> pr " int r;\n"; "-1"
4073 | RConstString _ -> pr " const char *r;\n"; "NULL"
4074 | RString _ -> pr " char *r;\n"; "NULL"
4080 pr " struct guestfs_int_bool *r;\n"; "NULL"
4082 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
4084 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
4086 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
4088 pr " struct guestfs_stat *r;\n"; "NULL"
4090 pr " struct guestfs_statvfs *r;\n"; "NULL"
4097 pr " caml_enter_blocking_section ();\n";
4098 pr " r = guestfs_%s " name;
4099 generate_call_args ~handle:"g" (snd style);
4101 pr " caml_leave_blocking_section ();\n";
4106 pr " ocaml_guestfs_free_strings (%s);\n" n;
4107 | String _ | OptString _ | Bool _ | Int _ | FileIn _ | FileOut _ -> ()
4110 pr " if (r == %s)\n" error_code;
4111 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
4114 (match fst style with
4115 | RErr -> pr " rv = Val_unit;\n"
4116 | RInt _ -> pr " rv = Val_int (r);\n"
4118 pr " rv = caml_copy_int64 (r);\n"
4119 | RBool _ -> pr " rv = Val_bool (r);\n"
4120 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
4122 pr " rv = caml_copy_string (r);\n";
4125 pr " rv = caml_copy_string_array ((const char **) r);\n";
4126 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
4129 pr " rv = caml_alloc (2, 0);\n";
4130 pr " Store_field (rv, 0, Val_int (r->i));\n";
4131 pr " Store_field (rv, 1, Val_bool (r->b));\n";
4132 pr " guestfs_free_int_bool (r);\n";
4134 pr " rv = copy_lvm_pv_list (r);\n";
4135 pr " guestfs_free_lvm_pv_list (r);\n";
4137 pr " rv = copy_lvm_vg_list (r);\n";
4138 pr " guestfs_free_lvm_vg_list (r);\n";
4140 pr " rv = copy_lvm_lv_list (r);\n";
4141 pr " guestfs_free_lvm_lv_list (r);\n";
4143 pr " rv = copy_stat (r);\n";
4146 pr " rv = copy_statvfs (r);\n";
4149 pr " rv = copy_table (r);\n";
4150 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
4154 pr " CAMLreturn (rv);\n";
4158 if List.length params > 5 then (
4159 pr "CAMLprim value\n";
4160 pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
4162 pr " return ocaml_guestfs_%s (argv[0]" name;
4163 iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
4170 and generate_ocaml_lvm_structure_decls () =
4173 pr "type lvm_%s = {\n" typ;
4176 | name, `String -> pr " %s : string;\n" name
4177 | name, `UUID -> pr " %s : string;\n" name
4178 | name, `Bytes -> pr " %s : int64;\n" name
4179 | name, `Int -> pr " %s : int64;\n" name
4180 | name, `OptPercent -> pr " %s : float option;\n" name
4184 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
4186 and generate_ocaml_stat_structure_decls () =
4189 pr "type %s = {\n" typ;
4192 | name, `Int -> pr " %s : int64;\n" name
4196 ) ["stat", stat_cols; "statvfs", statvfs_cols]
4198 and generate_ocaml_prototype ?(is_external = false) name style =
4199 if is_external then pr "external " else pr "val ";
4200 pr "%s : t -> " name;
4203 | String _ | FileIn _ | FileOut _ -> pr "string -> "
4204 | OptString _ -> pr "string option -> "
4205 | StringList _ -> pr "string array -> "
4206 | Bool _ -> pr "bool -> "
4207 | Int _ -> pr "int -> "
4209 (match fst style with
4210 | RErr -> pr "unit" (* all errors are turned into exceptions *)
4211 | RInt _ -> pr "int"
4212 | RInt64 _ -> pr "int64"
4213 | RBool _ -> pr "bool"
4214 | RConstString _ -> pr "string"
4215 | RString _ -> pr "string"
4216 | RStringList _ -> pr "string array"
4217 | RIntBool _ -> pr "int * bool"
4218 | RPVList _ -> pr "lvm_pv array"
4219 | RVGList _ -> pr "lvm_vg array"
4220 | RLVList _ -> pr "lvm_lv array"
4221 | RStat _ -> pr "stat"
4222 | RStatVFS _ -> pr "statvfs"
4223 | RHashtable _ -> pr "(string * string) list"
4225 if is_external then (
4227 if List.length (snd style) + 1 > 5 then
4228 pr "\"ocaml_guestfs_%s_byte\" " name;
4229 pr "\"ocaml_guestfs_%s\"" name
4233 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
4234 and generate_perl_xs () =
4235 generate_header CStyle LGPLv2;
4238 #include \"EXTERN.h\"
4242 #include <guestfs.h>
4245 #define PRId64 \"lld\"
4249 my_newSVll(long long val) {
4250 #ifdef USE_64_BIT_ALL
4251 return newSViv(val);
4255 len = snprintf(buf, 100, \"%%\" PRId64, val);
4256 return newSVpv(buf, len);
4261 #define PRIu64 \"llu\"
4265 my_newSVull(unsigned long long val) {
4266 #ifdef USE_64_BIT_ALL
4267 return newSVuv(val);
4271 len = snprintf(buf, 100, \"%%\" PRIu64, val);
4272 return newSVpv(buf, len);
4276 /* http://www.perlmonks.org/?node_id=680842 */
4278 XS_unpack_charPtrPtr (SV *arg) {
4283 if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV) {
4284 croak (\"array reference expected\");
4287 av = (AV *)SvRV (arg);
4288 ret = (char **)malloc (av_len (av) + 1 + 1);
4290 for (i = 0; i <= av_len (av); i++) {
4291 SV **elem = av_fetch (av, i, 0);
4293 if (!elem || !*elem)
4294 croak (\"missing element in list\");
4296 ret[i] = SvPV_nolen (*elem);
4304 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
4309 RETVAL = guestfs_create ();
4311 croak (\"could not create guestfs handle\");
4312 guestfs_set_error_handler (RETVAL, NULL, NULL);
4325 fun (name, style, _, _, _, _, _) ->
4326 (match fst style with
4327 | RErr -> pr "void\n"
4328 | RInt _ -> pr "SV *\n"
4329 | RInt64 _ -> pr "SV *\n"
4330 | RBool _ -> pr "SV *\n"
4331 | RConstString _ -> pr "SV *\n"
4332 | RString _ -> pr "SV *\n"
4335 | RPVList _ | RVGList _ | RLVList _
4336 | RStat _ | RStatVFS _
4338 pr "void\n" (* all lists returned implictly on the stack *)
4340 (* Call and arguments. *)
4342 generate_call_args ~handle:"g" (snd style);
4344 pr " guestfs_h *g;\n";
4347 | String n | FileIn n | FileOut n -> pr " char *%s;\n" n
4348 | OptString n -> pr " char *%s;\n" n
4349 | StringList n -> pr " char **%s;\n" n
4350 | Bool n -> pr " int %s;\n" n
4351 | Int n -> pr " int %s;\n" n
4354 let do_cleanups () =
4357 | String _ | OptString _ | Bool _ | Int _
4358 | FileIn _ | FileOut _ -> ()
4359 | StringList n -> pr " free (%s);\n" n
4364 (match fst style with
4369 pr " r = guestfs_%s " name;
4370 generate_call_args ~handle:"g" (snd style);
4373 pr " if (r == -1)\n";
4374 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4380 pr " %s = guestfs_%s " n name;
4381 generate_call_args ~handle:"g" (snd style);
4384 pr " if (%s == -1)\n" n;
4385 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4386 pr " RETVAL = newSViv (%s);\n" n;
4391 pr " int64_t %s;\n" n;
4393 pr " %s = guestfs_%s " n name;
4394 generate_call_args ~handle:"g" (snd style);
4397 pr " if (%s == -1)\n" n;
4398 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4399 pr " RETVAL = my_newSVll (%s);\n" n;
4404 pr " const char *%s;\n" n;
4406 pr " %s = guestfs_%s " n name;
4407 generate_call_args ~handle:"g" (snd style);
4410 pr " if (%s == NULL)\n" n;
4411 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4412 pr " RETVAL = newSVpv (%s, 0);\n" n;
4417 pr " char *%s;\n" n;
4419 pr " %s = guestfs_%s " n name;
4420 generate_call_args ~handle:"g" (snd style);
4423 pr " if (%s == NULL)\n" n;
4424 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4425 pr " RETVAL = newSVpv (%s, 0);\n" n;
4426 pr " free (%s);\n" n;
4429 | RStringList n | RHashtable n ->
4431 pr " char **%s;\n" n;
4434 pr " %s = guestfs_%s " n name;
4435 generate_call_args ~handle:"g" (snd style);
4438 pr " if (%s == NULL)\n" n;
4439 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4440 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
4441 pr " EXTEND (SP, n);\n";
4442 pr " for (i = 0; i < n; ++i) {\n";
4443 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
4444 pr " free (%s[i]);\n" n;
4446 pr " free (%s);\n" n;
4449 pr " struct guestfs_int_bool *r;\n";
4451 pr " r = guestfs_%s " name;
4452 generate_call_args ~handle:"g" (snd style);
4455 pr " if (r == NULL)\n";
4456 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4457 pr " EXTEND (SP, 2);\n";
4458 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
4459 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
4460 pr " guestfs_free_int_bool (r);\n";
4462 generate_perl_lvm_code "pv" pv_cols name style n do_cleanups
4464 generate_perl_lvm_code "vg" vg_cols name style n do_cleanups
4466 generate_perl_lvm_code "lv" lv_cols name style n do_cleanups
4468 generate_perl_stat_code "stat" stat_cols name style n do_cleanups
4470 generate_perl_stat_code
4471 "statvfs" statvfs_cols name style n do_cleanups
4477 and generate_perl_lvm_code typ cols name style n do_cleanups =
4479 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
4483 pr " %s = guestfs_%s " n name;
4484 generate_call_args ~handle:"g" (snd style);
4487 pr " if (%s == NULL)\n" n;
4488 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4489 pr " EXTEND (SP, %s->len);\n" n;
4490 pr " for (i = 0; i < %s->len; ++i) {\n" n;
4491 pr " hv = newHV ();\n";
4495 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
4496 name (String.length name) n name
4498 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
4499 name (String.length name) n name
4501 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
4502 name (String.length name) n name
4504 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
4505 name (String.length name) n name
4506 | name, `OptPercent ->
4507 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
4508 name (String.length name) n name
4510 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
4512 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
4514 and generate_perl_stat_code typ cols name style n do_cleanups =
4516 pr " struct guestfs_%s *%s;\n" typ n;
4518 pr " %s = guestfs_%s " n name;
4519 generate_call_args ~handle:"g" (snd style);
4522 pr " if (%s == NULL)\n" n;
4523 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4524 pr " EXTEND (SP, %d);\n" (List.length cols);
4528 pr " PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n" n name
4530 pr " free (%s);\n" n
4532 (* Generate Sys/Guestfs.pm. *)
4533 and generate_perl_pm () =
4534 generate_header HashStyle LGPLv2;
4541 Sys::Guestfs - Perl bindings for libguestfs
4547 my $h = Sys::Guestfs->new ();
4548 $h->add_drive ('guest.img');
4551 $h->mount ('/dev/sda1', '/');
4552 $h->touch ('/hello');
4557 The C<Sys::Guestfs> module provides a Perl XS binding to the
4558 libguestfs API for examining and modifying virtual machine
4561 Amongst the things this is good for: making batch configuration
4562 changes to guests, getting disk used/free statistics (see also:
4563 virt-df), migrating between virtualization systems (see also:
4564 virt-p2v), performing partial backups, performing partial guest
4565 clones, cloning guests and changing registry/UUID/hostname info, and
4568 Libguestfs uses Linux kernel and qemu code, and can access any type of
4569 guest filesystem that Linux and qemu can, including but not limited
4570 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
4571 schemes, qcow, qcow2, vmdk.
4573 Libguestfs provides ways to enumerate guest storage (eg. partitions,
4574 LVs, what filesystem is in each LV, etc.). It can also run commands
4575 in the context of the guest. Also you can access filesystems over FTP.
4579 All errors turn into calls to C<croak> (see L<Carp(3)>).
4587 package Sys::Guestfs;
4593 XSLoader::load ('Sys::Guestfs');
4595 =item $h = Sys::Guestfs->new ();
4597 Create a new guestfs handle.
4603 my $class = ref ($proto) || $proto;
4605 my $self = Sys::Guestfs::_create ();
4606 bless $self, $class;
4612 (* Actions. We only need to print documentation for these as
4613 * they are pulled in from the XS code automatically.
4616 fun (name, style, _, flags, _, _, longdesc) ->
4617 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
4619 generate_perl_prototype name style;
4621 pr "%s\n\n" longdesc;
4622 if List.mem ProtocolLimitWarning flags then
4623 pr "%s\n\n" protocol_limit_warning;
4624 if List.mem DangerWillRobinson flags then
4625 pr "%s\n\n" danger_will_robinson
4626 ) all_functions_sorted;
4638 Copyright (C) 2009 Red Hat Inc.
4642 Please see the file COPYING.LIB for the full license.
4646 L<guestfs(3)>, L<guestfish(1)>.
4651 and generate_perl_prototype name style =
4652 (match fst style with
4658 | RString n -> pr "$%s = " n
4659 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
4663 | RLVList n -> pr "@%s = " n
4666 | RHashtable n -> pr "%%%s = " n
4669 let comma = ref false in
4672 if !comma then pr ", ";
4675 | String n | OptString n | Bool n | Int n | FileIn n | FileOut n ->
4682 (* Generate Python C module. *)
4683 and generate_python_c () =
4684 generate_header CStyle LGPLv2;
4693 #include \"guestfs.h\"
4701 get_handle (PyObject *obj)
4704 assert (obj != Py_None);
4705 return ((Pyguestfs_Object *) obj)->g;
4709 put_handle (guestfs_h *g)
4713 PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
4716 /* This list should be freed (but not the strings) after use. */
4717 static const char **
4718 get_string_list (PyObject *obj)
4725 if (!PyList_Check (obj)) {
4726 PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
4730 len = PyList_Size (obj);
4731 r = malloc (sizeof (char *) * (len+1));
4733 PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
4737 for (i = 0; i < len; ++i)
4738 r[i] = PyString_AsString (PyList_GetItem (obj, i));
4745 put_string_list (char * const * const argv)
4750 for (argc = 0; argv[argc] != NULL; ++argc)
4753 list = PyList_New (argc);
4754 for (i = 0; i < argc; ++i)
4755 PyList_SetItem (list, i, PyString_FromString (argv[i]));
4761 put_table (char * const * const argv)
4763 PyObject *list, *item;
4766 for (argc = 0; argv[argc] != NULL; ++argc)
4769 list = PyList_New (argc >> 1);
4770 for (i = 0; i < argc; i += 2) {
4771 item = PyTuple_New (2);
4772 PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
4773 PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
4774 PyList_SetItem (list, i >> 1, item);
4781 free_strings (char **argv)
4785 for (argc = 0; argv[argc] != NULL; ++argc)
4791 py_guestfs_create (PyObject *self, PyObject *args)
4795 g = guestfs_create ();
4797 PyErr_SetString (PyExc_RuntimeError,
4798 \"guestfs.create: failed to allocate handle\");
4801 guestfs_set_error_handler (g, NULL, NULL);
4802 return put_handle (g);
4806 py_guestfs_close (PyObject *self, PyObject *args)
4811 if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
4813 g = get_handle (py_g);
4817 Py_INCREF (Py_None);
4823 (* LVM structures, turned into Python dictionaries. *)
4826 pr "static PyObject *\n";
4827 pr "put_lvm_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
4829 pr " PyObject *dict;\n";
4831 pr " dict = PyDict_New ();\n";
4835 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4836 pr " PyString_FromString (%s->%s));\n"
4839 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4840 pr " PyString_FromStringAndSize (%s->%s, 32));\n"
4843 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4844 pr " PyLong_FromUnsignedLongLong (%s->%s));\n"
4847 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4848 pr " PyLong_FromLongLong (%s->%s));\n"
4850 | name, `OptPercent ->
4851 pr " if (%s->%s >= 0)\n" typ name;
4852 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4853 pr " PyFloat_FromDouble ((double) %s->%s));\n"
4856 pr " Py_INCREF (Py_None);\n";
4857 pr " PyDict_SetItemString (dict, \"%s\", Py_None);" name;
4860 pr " return dict;\n";
4864 pr "static PyObject *\n";
4865 pr "put_lvm_%s_list (struct guestfs_lvm_%s_list *%ss)\n" typ typ typ;
4867 pr " PyObject *list;\n";
4870 pr " list = PyList_New (%ss->len);\n" typ;
4871 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
4872 pr " PyList_SetItem (list, i, put_lvm_%s (&%ss->val[i]));\n" typ typ;
4873 pr " return list;\n";
4876 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
4878 (* Stat structures, turned into Python dictionaries. *)
4881 pr "static PyObject *\n";
4882 pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
4884 pr " PyObject *dict;\n";
4886 pr " dict = PyDict_New ();\n";
4890 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4891 pr " PyLong_FromLongLong (%s->%s));\n"
4894 pr " return dict;\n";
4897 ) ["stat", stat_cols; "statvfs", statvfs_cols];
4899 (* Python wrapper functions. *)
4901 fun (name, style, _, _, _, _, _) ->
4902 pr "static PyObject *\n";
4903 pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
4906 pr " PyObject *py_g;\n";
4907 pr " guestfs_h *g;\n";
4908 pr " PyObject *py_r;\n";
4911 match fst style with
4912 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
4913 | RInt64 _ -> pr " int64_t r;\n"; "-1"
4914 | RConstString _ -> pr " const char *r;\n"; "NULL"
4915 | RString _ -> pr " char *r;\n"; "NULL"
4916 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
4917 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
4918 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
4919 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
4920 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
4921 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
4922 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
4926 | String n | FileIn n | FileOut n -> pr " const char *%s;\n" n
4927 | OptString n -> pr " const char *%s;\n" n
4929 pr " PyObject *py_%s;\n" n;
4930 pr " const char **%s;\n" n
4931 | Bool n -> pr " int %s;\n" n
4932 | Int n -> pr " int %s;\n" n
4937 (* Convert the parameters. *)
4938 pr " if (!PyArg_ParseTuple (args, (char *) \"O";
4941 | String _ | FileIn _ | FileOut _ -> pr "s"
4942 | OptString _ -> pr "z"
4943 | StringList _ -> pr "O"
4944 | Bool _ -> pr "i" (* XXX Python has booleans? *)
4947 pr ":guestfs_%s\",\n" name;
4951 | String n | FileIn n | FileOut n -> pr ", &%s" n
4952 | OptString n -> pr ", &%s" n
4953 | StringList n -> pr ", &py_%s" n
4954 | Bool n -> pr ", &%s" n
4955 | Int n -> pr ", &%s" n
4959 pr " return NULL;\n";
4961 pr " g = get_handle (py_g);\n";
4964 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
4966 pr " %s = get_string_list (py_%s);\n" n n;
4967 pr " if (!%s) return NULL;\n" n
4972 pr " r = guestfs_%s " name;
4973 generate_call_args ~handle:"g" (snd style);
4978 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
4980 pr " free (%s);\n" n
4983 pr " if (r == %s) {\n" error_code;
4984 pr " PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
4985 pr " return NULL;\n";
4989 (match fst style with
4991 pr " Py_INCREF (Py_None);\n";
4992 pr " py_r = Py_None;\n"
4994 | RBool _ -> pr " py_r = PyInt_FromLong ((long) r);\n"
4995 | RInt64 _ -> pr " py_r = PyLong_FromLongLong (r);\n"
4996 | RConstString _ -> pr " py_r = PyString_FromString (r);\n"
4998 pr " py_r = PyString_FromString (r);\n";
5001 pr " py_r = put_string_list (r);\n";
5002 pr " free_strings (r);\n"
5004 pr " py_r = PyTuple_New (2);\n";
5005 pr " PyTuple_SetItem (py_r, 0, PyInt_FromLong ((long) r->i));\n";
5006 pr " PyTuple_SetItem (py_r, 1, PyInt_FromLong ((long) r->b));\n";
5007 pr " guestfs_free_int_bool (r);\n"
5009 pr " py_r = put_lvm_pv_list (r);\n";
5010 pr " guestfs_free_lvm_pv_list (r);\n"
5012 pr " py_r = put_lvm_vg_list (r);\n";
5013 pr " guestfs_free_lvm_vg_list (r);\n"
5015 pr " py_r = put_lvm_lv_list (r);\n";
5016 pr " guestfs_free_lvm_lv_list (r);\n"
5018 pr " py_r = put_stat (r);\n";
5021 pr " py_r = put_statvfs (r);\n";
5024 pr " py_r = put_table (r);\n";
5025 pr " free_strings (r);\n"
5028 pr " return py_r;\n";
5033 (* Table of functions. *)
5034 pr "static PyMethodDef methods[] = {\n";
5035 pr " { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
5036 pr " { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
5038 fun (name, _, _, _, _, _, _) ->
5039 pr " { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
5042 pr " { NULL, NULL, 0, NULL }\n";
5046 (* Init function. *)
5049 initlibguestfsmod (void)
5051 static int initialized = 0;
5053 if (initialized) return;
5054 Py_InitModule ((char *) \"libguestfsmod\", methods);
5059 (* Generate Python module. *)
5060 and generate_python_py () =
5061 generate_header HashStyle LGPLv2;
5064 u\"\"\"Python bindings for libguestfs
5067 g = guestfs.GuestFS ()
5068 g.add_drive (\"guest.img\")
5071 parts = g.list_partitions ()
5073 The guestfs module provides a Python binding to the libguestfs API
5074 for examining and modifying virtual machine disk images.
5076 Amongst the things this is good for: making batch configuration
5077 changes to guests, getting disk used/free statistics (see also:
5078 virt-df), migrating between virtualization systems (see also:
5079 virt-p2v), performing partial backups, performing partial guest
5080 clones, cloning guests and changing registry/UUID/hostname info, and
5083 Libguestfs uses Linux kernel and qemu code, and can access any type of
5084 guest filesystem that Linux and qemu can, including but not limited
5085 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
5086 schemes, qcow, qcow2, vmdk.
5088 Libguestfs provides ways to enumerate guest storage (eg. partitions,
5089 LVs, what filesystem is in each LV, etc.). It can also run commands
5090 in the context of the guest. Also you can access filesystems over FTP.
5092 Errors which happen while using the API are turned into Python
5093 RuntimeError exceptions.
5095 To create a guestfs handle you usually have to perform the following
5098 # Create the handle, call add_drive at least once, and possibly
5099 # several times if the guest has multiple block devices:
5100 g = guestfs.GuestFS ()
5101 g.add_drive (\"guest.img\")
5103 # Launch the qemu subprocess and wait for it to become ready:
5107 # Now you can issue commands, for example:
5112 import libguestfsmod
5115 \"\"\"Instances of this class are libguestfs API handles.\"\"\"
5117 def __init__ (self):
5118 \"\"\"Create a new libguestfs handle.\"\"\"
5119 self._o = libguestfsmod.create ()
5122 libguestfsmod.close (self._o)
5127 fun (name, style, _, flags, _, _, longdesc) ->
5128 let doc = replace_str longdesc "C<guestfs_" "C<g." in
5130 match fst style with
5131 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _
5134 doc ^ "\n\nThis function returns a list of strings."
5136 doc ^ "\n\nThis function returns a tuple (int, bool).\n"
5138 doc ^ "\n\nThis function returns a list of PVs. Each PV is represented as a dictionary."
5140 doc ^ "\n\nThis function returns a list of VGs. Each VG is represented as a dictionary."
5142 doc ^ "\n\nThis function returns a list of LVs. Each LV is represented as a dictionary."
5144 doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the stat structure."
5146 doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the statvfs structure."
5148 doc ^ "\n\nThis function returns a dictionary." in
5150 if List.mem ProtocolLimitWarning flags then
5151 doc ^ "\n\n" ^ protocol_limit_warning
5154 if List.mem DangerWillRobinson flags then
5155 doc ^ "\n\n" ^ danger_will_robinson
5157 let doc = pod2text ~width:60 name doc in
5158 let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
5159 let doc = String.concat "\n " doc in
5162 generate_call_args ~handle:"self" (snd style);
5164 pr " u\"\"\"%s\"\"\"\n" doc;
5165 pr " return libguestfsmod.%s " name;
5166 generate_call_args ~handle:"self._o" (snd style);
5171 (* Useful if you need the longdesc POD text as plain text. Returns a
5174 and pod2text ~width name longdesc =
5175 let filename, chan = Filename.open_temp_file "gen" ".tmp" in
5176 fprintf chan "=head1 %s\n\n%s\n" name longdesc;
5178 let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
5179 let chan = Unix.open_process_in cmd in
5180 let lines = ref [] in
5182 let line = input_line chan in
5183 if i = 1 then (* discard the first line of output *)
5186 let line = triml line in
5187 lines := line :: !lines;
5190 let lines = try loop 1 with End_of_file -> List.rev !lines in
5191 Unix.unlink filename;
5192 match Unix.close_process_in chan with
5193 | Unix.WEXITED 0 -> lines
5195 failwithf "pod2text: process exited with non-zero status (%d)" i
5196 | Unix.WSIGNALED i | Unix.WSTOPPED i ->
5197 failwithf "pod2text: process signalled or stopped by signal %d" i
5199 (* Generate ruby bindings. *)
5200 and generate_ruby_c () =
5201 generate_header CStyle LGPLv2;
5209 #include \"guestfs.h\"
5211 #include \"extconf.h\"
5213 static VALUE m_guestfs; /* guestfs module */
5214 static VALUE c_guestfs; /* guestfs_h handle */
5215 static VALUE e_Error; /* used for all errors */
5217 static void ruby_guestfs_free (void *p)
5220 guestfs_close ((guestfs_h *) p);
5223 static VALUE ruby_guestfs_create (VALUE m)
5227 g = guestfs_create ();
5229 rb_raise (e_Error, \"failed to create guestfs handle\");
5231 /* Don't print error messages to stderr by default. */
5232 guestfs_set_error_handler (g, NULL, NULL);
5234 /* Wrap it, and make sure the close function is called when the
5237 return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
5240 static VALUE ruby_guestfs_close (VALUE gv)
5243 Data_Get_Struct (gv, guestfs_h, g);
5245 ruby_guestfs_free (g);
5246 DATA_PTR (gv) = NULL;
5254 fun (name, style, _, _, _, _, _) ->
5255 pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
5256 List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
5259 pr " guestfs_h *g;\n";
5260 pr " Data_Get_Struct (gv, guestfs_h, g);\n";
5262 pr " rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
5268 | String n | FileIn n | FileOut n ->
5269 pr " const char *%s = StringValueCStr (%sv);\n" n n;
5271 pr " rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
5272 pr " \"%s\", \"%s\");\n" n name
5274 pr " const char *%s = StringValueCStr (%sv);\n" n n
5278 pr " int i, len;\n";
5279 pr " len = RARRAY_LEN (%sv);\n" n;
5280 pr " %s = malloc (sizeof (char *) * (len+1));\n" n;
5281 pr " for (i = 0; i < len; ++i) {\n";
5282 pr " VALUE v = rb_ary_entry (%sv, i);\n" n;
5283 pr " %s[i] = StringValueCStr (v);\n" n;
5288 pr " int %s = NUM2INT (%sv);\n" n n
5293 match fst style with
5294 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
5295 | RInt64 _ -> pr " int64_t r;\n"; "-1"
5296 | RConstString _ -> pr " const char *r;\n"; "NULL"
5297 | RString _ -> pr " char *r;\n"; "NULL"
5298 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
5299 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
5300 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
5301 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
5302 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
5303 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
5304 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
5307 pr " r = guestfs_%s " name;
5308 generate_call_args ~handle:"g" (snd style);
5313 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
5315 pr " free (%s);\n" n
5318 pr " if (r == %s)\n" error_code;
5319 pr " rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
5322 (match fst style with
5324 pr " return Qnil;\n"
5325 | RInt _ | RBool _ ->
5326 pr " return INT2NUM (r);\n"
5328 pr " return ULL2NUM (r);\n"
5330 pr " return rb_str_new2 (r);\n";
5332 pr " VALUE rv = rb_str_new2 (r);\n";
5336 pr " int i, len = 0;\n";
5337 pr " for (i = 0; r[i] != NULL; ++i) len++;\n";
5338 pr " VALUE rv = rb_ary_new2 (len);\n";
5339 pr " for (i = 0; r[i] != NULL; ++i) {\n";
5340 pr " rb_ary_push (rv, rb_str_new2 (r[i]));\n";
5341 pr " free (r[i]);\n";
5346 pr " VALUE rv = rb_ary_new2 (2);\n";
5347 pr " rb_ary_push (rv, INT2NUM (r->i));\n";
5348 pr " rb_ary_push (rv, INT2NUM (r->b));\n";
5349 pr " guestfs_free_int_bool (r);\n";
5352 generate_ruby_lvm_code "pv" pv_cols
5354 generate_ruby_lvm_code "vg" vg_cols
5356 generate_ruby_lvm_code "lv" lv_cols
5358 pr " VALUE rv = rb_hash_new ();\n";
5362 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
5367 pr " VALUE rv = rb_hash_new ();\n";
5371 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
5376 pr " VALUE rv = rb_hash_new ();\n";
5378 pr " for (i = 0; r[i] != NULL; i+=2) {\n";
5379 pr " rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
5380 pr " free (r[i]);\n";
5381 pr " free (r[i+1]);\n";
5392 /* Initialize the module. */
5393 void Init__guestfs ()
5395 m_guestfs = rb_define_module (\"Guestfs\");
5396 c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
5397 e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
5399 rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
5400 rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
5403 (* Define the rest of the methods. *)
5405 fun (name, style, _, _, _, _, _) ->
5406 pr " rb_define_method (c_guestfs, \"%s\",\n" name;
5407 pr " ruby_guestfs_%s, %d);\n" name (List.length (snd style))
5412 (* Ruby code to return an LVM struct list. *)
5413 and generate_ruby_lvm_code typ cols =
5414 pr " VALUE rv = rb_ary_new2 (r->len);\n";
5416 pr " for (i = 0; i < r->len; ++i) {\n";
5417 pr " VALUE hv = rb_hash_new ();\n";
5421 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
5423 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
5426 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
5427 | name, `OptPercent ->
5428 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
5430 pr " rb_ary_push (rv, hv);\n";
5432 pr " guestfs_free_lvm_%s_list (r);\n" typ;
5435 let output_to filename =
5436 let filename_new = filename ^ ".new" in
5437 chan := open_out filename_new;
5441 Unix.rename filename_new filename;
5442 printf "written %s\n%!" filename;
5450 if not (Sys.file_exists "configure.ac") then (
5452 You are probably running this from the wrong directory.
5453 Run it from the top source directory using the command
5459 let close = output_to "src/guestfs_protocol.x" in
5463 let close = output_to "src/guestfs-structs.h" in
5464 generate_structs_h ();
5467 let close = output_to "src/guestfs-actions.h" in
5468 generate_actions_h ();
5471 let close = output_to "src/guestfs-actions.c" in
5472 generate_client_actions ();
5475 let close = output_to "daemon/actions.h" in
5476 generate_daemon_actions_h ();
5479 let close = output_to "daemon/stubs.c" in
5480 generate_daemon_actions ();
5483 let close = output_to "tests.c" in
5487 let close = output_to "fish/cmds.c" in
5488 generate_fish_cmds ();
5491 let close = output_to "fish/completion.c" in
5492 generate_fish_completion ();
5495 let close = output_to "guestfs-structs.pod" in
5496 generate_structs_pod ();
5499 let close = output_to "guestfs-actions.pod" in
5500 generate_actions_pod ();
5503 let close = output_to "guestfish-actions.pod" in
5504 generate_fish_actions_pod ();
5507 let close = output_to "ocaml/guestfs.mli" in
5508 generate_ocaml_mli ();
5511 let close = output_to "ocaml/guestfs.ml" in
5512 generate_ocaml_ml ();
5515 let close = output_to "ocaml/guestfs_c_actions.c" in
5516 generate_ocaml_c ();
5519 let close = output_to "perl/Guestfs.xs" in
5520 generate_perl_xs ();
5523 let close = output_to "perl/lib/Sys/Guestfs.pm" in
5524 generate_perl_pm ();
5527 let close = output_to "python/guestfs-py.c" in
5528 generate_python_c ();
5531 let close = output_to "python/guestfs.py" in
5532 generate_python_py ();
5535 let close = output_to "ruby/ext/guestfs/_guestfs.c" in