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)>.");
385 let daemon_functions = [
386 ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
387 [InitEmpty, TestOutput (
388 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
389 ["mkfs"; "ext2"; "/dev/sda1"];
390 ["mount"; "/dev/sda1"; "/"];
391 ["write_file"; "/new"; "new file contents"; "0"];
392 ["cat"; "/new"]], "new file contents")],
393 "mount a guest disk at a position in the filesystem",
395 Mount a guest disk at a position in the filesystem. Block devices
396 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
397 the guest. If those block devices contain partitions, they will have
398 the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
401 The rules are the same as for L<mount(2)>: A filesystem must
402 first be mounted on C</> before others can be mounted. Other
403 filesystems can only be mounted on directories which already
406 The mounted filesystem is writable, if we have sufficient permissions
407 on the underlying device.
409 The filesystem options C<sync> and C<noatime> are set with this
410 call, in order to improve reliability.");
412 ("sync", (RErr, []), 2, [],
413 [ InitEmpty, TestRun [["sync"]]],
414 "sync disks, writes are flushed through to the disk image",
416 This syncs the disk, so that any writes are flushed through to the
417 underlying disk image.
419 You should always call this if you have modified a disk image, before
420 closing the handle.");
422 ("touch", (RErr, [String "path"]), 3, [],
423 [InitBasicFS, TestOutputTrue (
425 ["exists"; "/new"]])],
426 "update file timestamps or create a new file",
428 Touch acts like the L<touch(1)> command. It can be used to
429 update the timestamps on a file, or, if the file does not exist,
430 to create a new zero-length file.");
432 ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
433 [InitBasicFS, TestOutput (
434 [["write_file"; "/new"; "new file contents"; "0"];
435 ["cat"; "/new"]], "new file contents")],
436 "list the contents of a file",
438 Return the contents of the file named C<path>.
440 Note that this function cannot correctly handle binary files
441 (specifically, files containing C<\\0> character which is treated
442 as end of string). For those you need to use the C<guestfs_download>
443 function which has a more complex interface.");
445 ("ll", (RString "listing", [String "directory"]), 5, [],
446 [], (* XXX Tricky to test because it depends on the exact format
447 * of the 'ls -l' command, which changes between F10 and F11.
449 "list the files in a directory (long format)",
451 List the files in C<directory> (relative to the root directory,
452 there is no cwd) in the format of 'ls -la'.
454 This command is mostly useful for interactive sessions. It
455 is I<not> intended that you try to parse the output string.");
457 ("ls", (RStringList "listing", [String "directory"]), 6, [],
458 [InitBasicFS, TestOutputList (
461 ["touch"; "/newest"];
462 ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
463 "list the files in a directory",
465 List the files in C<directory> (relative to the root directory,
466 there is no cwd). The '.' and '..' entries are not returned, but
467 hidden files are shown.
469 This command is mostly useful for interactive sessions. Programs
470 should probably use C<guestfs_readdir> instead.");
472 ("list_devices", (RStringList "devices", []), 7, [],
473 [InitEmpty, TestOutputList (
474 [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"])],
475 "list the block devices",
477 List all the block devices.
479 The full block device names are returned, eg. C</dev/sda>");
481 ("list_partitions", (RStringList "partitions", []), 8, [],
482 [InitBasicFS, TestOutputList (
483 [["list_partitions"]], ["/dev/sda1"]);
484 InitEmpty, TestOutputList (
485 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
486 ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
487 "list the partitions",
489 List all the partitions detected on all block devices.
491 The full partition device names are returned, eg. C</dev/sda1>
493 This does not return logical volumes. For that you will need to
494 call C<guestfs_lvs>.");
496 ("pvs", (RStringList "physvols", []), 9, [],
497 [InitBasicFSonLVM, TestOutputList (
498 [["pvs"]], ["/dev/sda1"]);
499 InitEmpty, TestOutputList (
500 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
501 ["pvcreate"; "/dev/sda1"];
502 ["pvcreate"; "/dev/sda2"];
503 ["pvcreate"; "/dev/sda3"];
504 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
505 "list the LVM physical volumes (PVs)",
507 List all the physical volumes detected. This is the equivalent
508 of the L<pvs(8)> command.
510 This returns a list of just the device names that contain
511 PVs (eg. C</dev/sda2>).
513 See also C<guestfs_pvs_full>.");
515 ("vgs", (RStringList "volgroups", []), 10, [],
516 [InitBasicFSonLVM, TestOutputList (
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 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
524 ["vgcreate"; "VG2"; "/dev/sda3"];
525 ["vgs"]], ["VG1"; "VG2"])],
526 "list the LVM volume groups (VGs)",
528 List all the volumes groups detected. This is the equivalent
529 of the L<vgs(8)> command.
531 This returns a list of just the volume group names that were
532 detected (eg. C<VolGroup00>).
534 See also C<guestfs_vgs_full>.");
536 ("lvs", (RStringList "logvols", []), 11, [],
537 [InitBasicFSonLVM, TestOutputList (
538 [["lvs"]], ["/dev/VG/LV"]);
539 InitEmpty, TestOutputList (
540 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
541 ["pvcreate"; "/dev/sda1"];
542 ["pvcreate"; "/dev/sda2"];
543 ["pvcreate"; "/dev/sda3"];
544 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
545 ["vgcreate"; "VG2"; "/dev/sda3"];
546 ["lvcreate"; "LV1"; "VG1"; "50"];
547 ["lvcreate"; "LV2"; "VG1"; "50"];
548 ["lvcreate"; "LV3"; "VG2"; "50"];
549 ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
550 "list the LVM logical volumes (LVs)",
552 List all the logical volumes detected. This is the equivalent
553 of the L<lvs(8)> command.
555 This returns a list of the logical volume device names
556 (eg. C</dev/VolGroup00/LogVol00>).
558 See also C<guestfs_lvs_full>.");
560 ("pvs_full", (RPVList "physvols", []), 12, [],
561 [], (* XXX how to test? *)
562 "list the LVM physical volumes (PVs)",
564 List all the physical volumes detected. This is the equivalent
565 of the L<pvs(8)> command. The \"full\" version includes all fields.");
567 ("vgs_full", (RVGList "volgroups", []), 13, [],
568 [], (* XXX how to test? *)
569 "list the LVM volume groups (VGs)",
571 List all the volumes groups detected. This is the equivalent
572 of the L<vgs(8)> command. The \"full\" version includes all fields.");
574 ("lvs_full", (RLVList "logvols", []), 14, [],
575 [], (* XXX how to test? *)
576 "list the LVM logical volumes (LVs)",
578 List all the logical volumes detected. This is the equivalent
579 of the L<lvs(8)> command. The \"full\" version includes all fields.");
581 ("read_lines", (RStringList "lines", [String "path"]), 15, [],
582 [InitBasicFS, TestOutputList (
583 [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
584 ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);
585 InitBasicFS, TestOutputList (
586 [["write_file"; "/new"; ""; "0"];
587 ["read_lines"; "/new"]], [])],
588 "read file as lines",
590 Return the contents of the file named C<path>.
592 The file contents are returned as a list of lines. Trailing
593 C<LF> and C<CRLF> character sequences are I<not> returned.
595 Note that this function cannot correctly handle binary files
596 (specifically, files containing C<\\0> character which is treated
597 as end of line). For those you need to use the C<guestfs_read_file>
598 function which has a more complex interface.");
600 ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [],
601 [], (* XXX Augeas code needs tests. *)
602 "create a new Augeas handle",
604 Create a new Augeas handle for editing configuration files.
605 If there was any previous Augeas handle associated with this
606 guestfs session, then it is closed.
608 You must call this before using any other C<guestfs_aug_*>
611 C<root> is the filesystem root. C<root> must not be NULL,
614 The flags are the same as the flags defined in
615 E<lt>augeas.hE<gt>, the logical I<or> of the following
620 =item C<AUG_SAVE_BACKUP> = 1
622 Keep the original file with a C<.augsave> extension.
624 =item C<AUG_SAVE_NEWFILE> = 2
626 Save changes into a file with extension C<.augnew>, and
627 do not overwrite original. Overrides C<AUG_SAVE_BACKUP>.
629 =item C<AUG_TYPE_CHECK> = 4
631 Typecheck lenses (can be expensive).
633 =item C<AUG_NO_STDINC> = 8
635 Do not use standard load path for modules.
637 =item C<AUG_SAVE_NOOP> = 16
639 Make save a no-op, just record what would have been changed.
641 =item C<AUG_NO_LOAD> = 32
643 Do not load the tree in C<guestfs_aug_init>.
647 To close the handle, you can call C<guestfs_aug_close>.
649 To find out more about Augeas, see L<http://augeas.net/>.");
651 ("aug_close", (RErr, []), 26, [],
652 [], (* XXX Augeas code needs tests. *)
653 "close the current Augeas handle",
655 Close the current Augeas handle and free up any resources
656 used by it. After calling this, you have to call
657 C<guestfs_aug_init> again before you can use any other
660 ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
661 [], (* XXX Augeas code needs tests. *)
662 "define an Augeas variable",
664 Defines an Augeas variable C<name> whose value is the result
665 of evaluating C<expr>. If C<expr> is NULL, then C<name> is
668 On success this returns the number of nodes in C<expr>, or
669 C<0> if C<expr> evaluates to something which is not a nodeset.");
671 ("aug_defnode", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [],
672 [], (* XXX Augeas code needs tests. *)
673 "define an Augeas node",
675 Defines a variable C<name> whose value is the result of
678 If C<expr> evaluates to an empty nodeset, a node is created,
679 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
680 C<name> will be the nodeset containing that single node.
682 On success this returns a pair containing the
683 number of nodes in the nodeset, and a boolean flag
684 if a node was created.");
686 ("aug_get", (RString "val", [String "path"]), 19, [],
687 [], (* XXX Augeas code needs tests. *)
688 "look up the value of an Augeas path",
690 Look up the value associated with C<path>. If C<path>
691 matches exactly one node, the C<value> is returned.");
693 ("aug_set", (RErr, [String "path"; String "val"]), 20, [],
694 [], (* XXX Augeas code needs tests. *)
695 "set Augeas path to value",
697 Set the value associated with C<path> to C<value>.");
699 ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [],
700 [], (* XXX Augeas code needs tests. *)
701 "insert a sibling Augeas node",
703 Create a new sibling C<label> for C<path>, inserting it into
704 the tree before or after C<path> (depending on the boolean
707 C<path> must match exactly one existing node in the tree, and
708 C<label> must be a label, ie. not contain C</>, C<*> or end
709 with a bracketed index C<[N]>.");
711 ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
712 [], (* XXX Augeas code needs tests. *)
713 "remove an Augeas path",
715 Remove C<path> and all of its children.
717 On success this returns the number of entries which were removed.");
719 ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [],
720 [], (* XXX Augeas code needs tests. *)
723 Move the node C<src> to C<dest>. C<src> must match exactly
724 one node. C<dest> is overwritten if it exists.");
726 ("aug_match", (RStringList "matches", [String "path"]), 24, [],
727 [], (* XXX Augeas code needs tests. *)
728 "return Augeas nodes which match path",
730 Returns a list of paths which match the path expression C<path>.
731 The returned paths are sufficiently qualified so that they match
732 exactly one node in the current tree.");
734 ("aug_save", (RErr, []), 25, [],
735 [], (* XXX Augeas code needs tests. *)
736 "write all pending Augeas changes to disk",
738 This writes all pending changes to disk.
740 The flags which were passed to C<guestfs_aug_init> affect exactly
741 how files are saved.");
743 ("aug_load", (RErr, []), 27, [],
744 [], (* XXX Augeas code needs tests. *)
745 "load files into the tree",
747 Load files into the tree.
749 See C<aug_load> in the Augeas documentation for the full gory
752 ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
753 [], (* XXX Augeas code needs tests. *)
754 "list Augeas nodes under a path",
756 This is just a shortcut for listing C<guestfs_aug_match>
757 C<path/*> and sorting the resulting nodes into alphabetical order.");
759 ("rm", (RErr, [String "path"]), 29, [],
760 [InitBasicFS, TestRun
763 InitBasicFS, TestLastFail
765 InitBasicFS, TestLastFail
770 Remove the single file C<path>.");
772 ("rmdir", (RErr, [String "path"]), 30, [],
773 [InitBasicFS, TestRun
776 InitBasicFS, TestLastFail
778 InitBasicFS, TestLastFail
781 "remove a directory",
783 Remove the single directory C<path>.");
785 ("rm_rf", (RErr, [String "path"]), 31, [],
786 [InitBasicFS, TestOutputFalse
788 ["mkdir"; "/new/foo"];
789 ["touch"; "/new/foo/bar"];
791 ["exists"; "/new"]]],
792 "remove a file or directory recursively",
794 Remove the file or directory C<path>, recursively removing the
795 contents if its a directory. This is like the C<rm -rf> shell
798 ("mkdir", (RErr, [String "path"]), 32, [],
799 [InitBasicFS, TestOutputTrue
802 InitBasicFS, TestLastFail
803 [["mkdir"; "/new/foo/bar"]]],
804 "create a directory",
806 Create a directory named C<path>.");
808 ("mkdir_p", (RErr, [String "path"]), 33, [],
809 [InitBasicFS, TestOutputTrue
810 [["mkdir_p"; "/new/foo/bar"];
811 ["is_dir"; "/new/foo/bar"]];
812 InitBasicFS, TestOutputTrue
813 [["mkdir_p"; "/new/foo/bar"];
814 ["is_dir"; "/new/foo"]];
815 InitBasicFS, TestOutputTrue
816 [["mkdir_p"; "/new/foo/bar"];
817 ["is_dir"; "/new"]]],
818 "create a directory and parents",
820 Create a directory named C<path>, creating any parent directories
821 as necessary. This is like the C<mkdir -p> shell command.");
823 ("chmod", (RErr, [Int "mode"; String "path"]), 34, [],
824 [], (* XXX Need stat command to test *)
827 Change the mode (permissions) of C<path> to C<mode>. Only
828 numeric modes are supported.");
830 ("chown", (RErr, [Int "owner"; Int "group"; String "path"]), 35, [],
831 [], (* XXX Need stat command to test *)
832 "change file owner and group",
834 Change the file owner to C<owner> and group to C<group>.
836 Only numeric uid and gid are supported. If you want to use
837 names, you will need to locate and parse the password file
838 yourself (Augeas support makes this relatively easy).");
840 ("exists", (RBool "existsflag", [String "path"]), 36, [],
841 [InitBasicFS, TestOutputTrue (
843 ["exists"; "/new"]]);
844 InitBasicFS, TestOutputTrue (
846 ["exists"; "/new"]])],
847 "test if file or directory exists",
849 This returns C<true> if and only if there is a file, directory
850 (or anything) with the given C<path> name.
852 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
854 ("is_file", (RBool "fileflag", [String "path"]), 37, [],
855 [InitBasicFS, TestOutputTrue (
857 ["is_file"; "/new"]]);
858 InitBasicFS, TestOutputFalse (
860 ["is_file"; "/new"]])],
861 "test if file exists",
863 This returns C<true> if and only if there is a file
864 with the given C<path> name. Note that it returns false for
865 other objects like directories.
867 See also C<guestfs_stat>.");
869 ("is_dir", (RBool "dirflag", [String "path"]), 38, [],
870 [InitBasicFS, TestOutputFalse (
872 ["is_dir"; "/new"]]);
873 InitBasicFS, TestOutputTrue (
875 ["is_dir"; "/new"]])],
876 "test if file exists",
878 This returns C<true> if and only if there is a directory
879 with the given C<path> name. Note that it returns false for
880 other objects like files.
882 See also C<guestfs_stat>.");
884 ("pvcreate", (RErr, [String "device"]), 39, [],
885 [InitEmpty, TestOutputList (
886 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
887 ["pvcreate"; "/dev/sda1"];
888 ["pvcreate"; "/dev/sda2"];
889 ["pvcreate"; "/dev/sda3"];
890 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
891 "create an LVM physical volume",
893 This creates an LVM physical volume on the named C<device>,
894 where C<device> should usually be a partition name such
897 ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
898 [InitEmpty, TestOutputList (
899 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
900 ["pvcreate"; "/dev/sda1"];
901 ["pvcreate"; "/dev/sda2"];
902 ["pvcreate"; "/dev/sda3"];
903 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
904 ["vgcreate"; "VG2"; "/dev/sda3"];
905 ["vgs"]], ["VG1"; "VG2"])],
906 "create an LVM volume group",
908 This creates an LVM volume group called C<volgroup>
909 from the non-empty list of physical volumes C<physvols>.");
911 ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [],
912 [InitEmpty, TestOutputList (
913 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
914 ["pvcreate"; "/dev/sda1"];
915 ["pvcreate"; "/dev/sda2"];
916 ["pvcreate"; "/dev/sda3"];
917 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
918 ["vgcreate"; "VG2"; "/dev/sda3"];
919 ["lvcreate"; "LV1"; "VG1"; "50"];
920 ["lvcreate"; "LV2"; "VG1"; "50"];
921 ["lvcreate"; "LV3"; "VG2"; "50"];
922 ["lvcreate"; "LV4"; "VG2"; "50"];
923 ["lvcreate"; "LV5"; "VG2"; "50"];
925 ["/dev/VG1/LV1"; "/dev/VG1/LV2";
926 "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
927 "create an LVM volume group",
929 This creates an LVM volume group called C<logvol>
930 on the volume group C<volgroup>, with C<size> megabytes.");
932 ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [],
933 [InitEmpty, TestOutput (
934 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
935 ["mkfs"; "ext2"; "/dev/sda1"];
936 ["mount"; "/dev/sda1"; "/"];
937 ["write_file"; "/new"; "new file contents"; "0"];
938 ["cat"; "/new"]], "new file contents")],
941 This creates a filesystem on C<device> (usually a partition
942 of LVM logical volume). The filesystem type is C<fstype>, for
945 ("sfdisk", (RErr, [String "device";
946 Int "cyls"; Int "heads"; Int "sectors";
947 StringList "lines"]), 43, [DangerWillRobinson],
949 "create partitions on a block device",
951 This is a direct interface to the L<sfdisk(8)> program for creating
952 partitions on block devices.
954 C<device> should be a block device, for example C</dev/sda>.
956 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
957 and sectors on the device, which are passed directly to sfdisk as
958 the I<-C>, I<-H> and I<-S> parameters. If you pass C<0> for any
959 of these, then the corresponding parameter is omitted. Usually for
960 'large' disks, you can just pass C<0> for these, but for small
961 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
962 out the right geometry and you will need to tell it.
964 C<lines> is a list of lines that we feed to C<sfdisk>. For more
965 information refer to the L<sfdisk(8)> manpage.
967 To create a single partition occupying the whole disk, you would
968 pass C<lines> as a single element list, when the single element being
969 the string C<,> (comma).");
971 ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
972 [InitBasicFS, TestOutput (
973 [["write_file"; "/new"; "new file contents"; "0"];
974 ["cat"; "/new"]], "new file contents");
975 InitBasicFS, TestOutput (
976 [["write_file"; "/new"; "\nnew file contents\n"; "0"];
977 ["cat"; "/new"]], "\nnew file contents\n");
978 InitBasicFS, TestOutput (
979 [["write_file"; "/new"; "\n\n"; "0"];
980 ["cat"; "/new"]], "\n\n");
981 InitBasicFS, TestOutput (
982 [["write_file"; "/new"; ""; "0"];
983 ["cat"; "/new"]], "");
984 InitBasicFS, TestOutput (
985 [["write_file"; "/new"; "\n\n\n"; "0"];
986 ["cat"; "/new"]], "\n\n\n");
987 InitBasicFS, TestOutput (
988 [["write_file"; "/new"; "\n"; "0"];
989 ["cat"; "/new"]], "\n")],
992 This call creates a file called C<path>. The contents of the
993 file is the string C<content> (which can contain any 8 bit data),
996 As a special case, if C<size> is C<0>
997 then the length is calculated using C<strlen> (so in this case
998 the content cannot contain embedded ASCII NULs).");
1000 ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
1001 [InitEmpty, TestOutputList (
1002 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1003 ["mkfs"; "ext2"; "/dev/sda1"];
1004 ["mount"; "/dev/sda1"; "/"];
1005 ["mounts"]], ["/dev/sda1"]);
1006 InitEmpty, TestOutputList (
1007 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1008 ["mkfs"; "ext2"; "/dev/sda1"];
1009 ["mount"; "/dev/sda1"; "/"];
1012 "unmount a filesystem",
1014 This unmounts the given filesystem. The filesystem may be
1015 specified either by its mountpoint (path) or the device which
1016 contains the filesystem.");
1018 ("mounts", (RStringList "devices", []), 46, [],
1019 [InitBasicFS, TestOutputList (
1020 [["mounts"]], ["/dev/sda1"])],
1021 "show mounted filesystems",
1023 This returns the list of currently mounted filesystems. It returns
1024 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
1026 Some internal mounts are not shown.");
1028 ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
1029 [InitBasicFS, TestOutputList (
1032 "unmount all filesystems",
1034 This unmounts all mounted filesystems.
1036 Some internal mounts are not unmounted by this call.");
1038 ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson],
1040 "remove all LVM LVs, VGs and PVs",
1042 This command removes all LVM logical volumes, volume groups
1043 and physical volumes.");
1045 ("file", (RString "description", [String "path"]), 49, [],
1046 [InitBasicFS, TestOutput (
1048 ["file"; "/new"]], "empty");
1049 InitBasicFS, TestOutput (
1050 [["write_file"; "/new"; "some content\n"; "0"];
1051 ["file"; "/new"]], "ASCII text");
1052 InitBasicFS, TestLastFail (
1053 [["file"; "/nofile"]])],
1054 "determine file type",
1056 This call uses the standard L<file(1)> command to determine
1057 the type or contents of the file. This also works on devices,
1058 for example to find out whether a partition contains a filesystem.
1060 The exact command which runs is C<file -bsL path>. Note in
1061 particular that the filename is not prepended to the output
1062 (the C<-b> option).");
1064 ("command", (RString "output", [StringList "arguments"]), 50, [],
1065 [], (* XXX how to test? *)
1066 "run a command from the guest filesystem",
1068 This call runs a command from the guest filesystem. The
1069 filesystem must be mounted, and must contain a compatible
1070 operating system (ie. something Linux, with the same
1071 or compatible processor architecture).
1073 The single parameter is an argv-style list of arguments.
1074 The first element is the name of the program to run.
1075 Subsequent elements are parameters. The list must be
1076 non-empty (ie. must contain a program name).
1078 The C<$PATH> environment variable will contain at least
1079 C</usr/bin> and C</bin>. If you require a program from
1080 another location, you should provide the full path in the
1083 Shared libraries and data files required by the program
1084 must be available on filesystems which are mounted in the
1085 correct places. It is the caller's responsibility to ensure
1086 all filesystems that are needed are mounted at the right
1089 ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [],
1090 [], (* XXX how to test? *)
1091 "run a command, returning lines",
1093 This is the same as C<guestfs_command>, but splits the
1094 result into a list of lines.");
1096 ("stat", (RStat "statbuf", [String "path"]), 52, [],
1097 [InitBasicFS, TestOutputStruct (
1099 ["stat"; "/new"]], [CompareWithInt ("size", 0)])],
1100 "get file information",
1102 Returns file information for the given C<path>.
1104 This is the same as the C<stat(2)> system call.");
1106 ("lstat", (RStat "statbuf", [String "path"]), 53, [],
1107 [InitBasicFS, TestOutputStruct (
1109 ["lstat"; "/new"]], [CompareWithInt ("size", 0)])],
1110 "get file information for a symbolic link",
1112 Returns file information for the given C<path>.
1114 This is the same as C<guestfs_stat> except that if C<path>
1115 is a symbolic link, then the link is stat-ed, not the file it
1118 This is the same as the C<lstat(2)> system call.");
1120 ("statvfs", (RStatVFS "statbuf", [String "path"]), 54, [],
1121 [InitBasicFS, TestOutputStruct (
1122 [["statvfs"; "/"]], [CompareWithInt ("bfree", 487702);
1123 CompareWithInt ("blocks", 490020);
1124 CompareWithInt ("bsize", 1024)])],
1125 "get file system statistics",
1127 Returns file system statistics for any mounted file system.
1128 C<path> should be a file or directory in the mounted file system
1129 (typically it is the mount point itself, but it doesn't need to be).
1131 This is the same as the C<statvfs(2)> system call.");
1133 ("tune2fs_l", (RHashtable "superblock", [String "device"]), 55, [],
1135 "get ext2/ext3 superblock details",
1137 This returns the contents of the ext2 or ext3 filesystem superblock
1140 It is the same as running C<tune2fs -l device>. See L<tune2fs(8)>
1141 manpage for more details. The list of fields returned isn't
1142 clearly defined, and depends on both the version of C<tune2fs>
1143 that libguestfs was built against, and the filesystem itself.");
1145 ("blockdev_setro", (RErr, [String "device"]), 56, [],
1146 [InitEmpty, TestOutputTrue (
1147 [["blockdev_setro"; "/dev/sda"];
1148 ["blockdev_getro"; "/dev/sda"]])],
1149 "set block device to read-only",
1151 Sets the block device named C<device> to read-only.
1153 This uses the L<blockdev(8)> command.");
1155 ("blockdev_setrw", (RErr, [String "device"]), 57, [],
1156 [InitEmpty, TestOutputFalse (
1157 [["blockdev_setrw"; "/dev/sda"];
1158 ["blockdev_getro"; "/dev/sda"]])],
1159 "set block device to read-write",
1161 Sets the block device named C<device> to read-write.
1163 This uses the L<blockdev(8)> command.");
1165 ("blockdev_getro", (RBool "ro", [String "device"]), 58, [],
1166 [InitEmpty, TestOutputTrue (
1167 [["blockdev_setro"; "/dev/sda"];
1168 ["blockdev_getro"; "/dev/sda"]])],
1169 "is block device set to read-only",
1171 Returns a boolean indicating if the block device is read-only
1172 (true if read-only, false if not).
1174 This uses the L<blockdev(8)> command.");
1176 ("blockdev_getss", (RInt "sectorsize", [String "device"]), 59, [],
1177 [InitEmpty, TestOutputInt (
1178 [["blockdev_getss"; "/dev/sda"]], 512)],
1179 "get sectorsize of block device",
1181 This returns the size of sectors on a block device.
1182 Usually 512, but can be larger for modern devices.
1184 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
1187 This uses the L<blockdev(8)> command.");
1189 ("blockdev_getbsz", (RInt "blocksize", [String "device"]), 60, [],
1190 [InitEmpty, TestOutputInt (
1191 [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1192 "get blocksize of block device",
1194 This returns the block size of a device.
1196 (Note this is different from both I<size in blocks> and
1197 I<filesystem block size>).
1199 This uses the L<blockdev(8)> command.");
1201 ("blockdev_setbsz", (RErr, [String "device"; Int "blocksize"]), 61, [],
1203 "set blocksize of block device",
1205 This sets the block size of a device.
1207 (Note this is different from both I<size in blocks> and
1208 I<filesystem block size>).
1210 This uses the L<blockdev(8)> command.");
1212 ("blockdev_getsz", (RInt64 "sizeinsectors", [String "device"]), 62, [],
1213 [InitEmpty, TestOutputInt (
1214 [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1215 "get total size of device in 512-byte sectors",
1217 This returns the size of the device in units of 512-byte sectors
1218 (even if the sectorsize isn't 512 bytes ... weird).
1220 See also C<guestfs_blockdev_getss> for the real sector size of
1221 the device, and C<guestfs_blockdev_getsize64> for the more
1222 useful I<size in bytes>.
1224 This uses the L<blockdev(8)> command.");
1226 ("blockdev_getsize64", (RInt64 "sizeinbytes", [String "device"]), 63, [],
1227 [InitEmpty, TestOutputInt (
1228 [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1229 "get total size of device in bytes",
1231 This returns the size of the device in bytes.
1233 See also C<guestfs_blockdev_getsz>.
1235 This uses the L<blockdev(8)> command.");
1237 ("blockdev_flushbufs", (RErr, [String "device"]), 64, [],
1239 [["blockdev_flushbufs"; "/dev/sda"]]],
1240 "flush device buffers",
1242 This tells the kernel to flush internal buffers associated
1245 This uses the L<blockdev(8)> command.");
1247 ("blockdev_rereadpt", (RErr, [String "device"]), 65, [],
1249 [["blockdev_rereadpt"; "/dev/sda"]]],
1250 "reread partition table",
1252 Reread the partition table on C<device>.
1254 This uses the L<blockdev(8)> command.");
1256 ("upload", (RErr, [FileIn "filename"; String "remotefilename"]), 66, [],
1258 "upload a file from the local machine",
1260 Upload local file C<filename> to C<remotefilename> on the
1263 C<filename> can also be a named pipe.
1265 See also C<guestfs_download>.");
1267 ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [],
1269 "download a file to the local machine",
1271 Download file C<remotefilename> and save it as C<filename>
1272 on the local machine.
1274 C<filename> can also be a named pipe.
1276 See also C<guestfs_upload>, C<guestfs_cat>.");
1280 let all_functions = non_daemon_functions @ daemon_functions
1282 (* In some places we want the functions to be displayed sorted
1283 * alphabetically, so this is useful:
1285 let all_functions_sorted =
1286 List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
1287 compare n1 n2) all_functions
1289 (* Column names and types from LVM PVs/VGs/LVs. *)
1298 "pv_attr", `String (* XXX *);
1299 "pv_pe_count", `Int;
1300 "pv_pe_alloc_count", `Int;
1303 "pv_mda_count", `Int;
1304 "pv_mda_free", `Bytes;
1305 (* Not in Fedora 10:
1306 "pv_mda_size", `Bytes;
1313 "vg_attr", `String (* XXX *);
1316 "vg_sysid", `String;
1317 "vg_extent_size", `Bytes;
1318 "vg_extent_count", `Int;
1319 "vg_free_count", `Int;
1327 "vg_mda_count", `Int;
1328 "vg_mda_free", `Bytes;
1329 (* Not in Fedora 10:
1330 "vg_mda_size", `Bytes;
1336 "lv_attr", `String (* XXX *);
1339 "lv_kernel_major", `Int;
1340 "lv_kernel_minor", `Int;
1344 "snap_percent", `OptPercent;
1345 "copy_percent", `OptPercent;
1348 "mirror_log", `String;
1352 (* Column names and types from stat structures.
1353 * NB. Can't use things like 'st_atime' because glibc header files
1354 * define some of these as macros. Ugh.
1371 let statvfs_cols = [
1385 (* Useful functions.
1386 * Note we don't want to use any external OCaml libraries which
1387 * makes this a bit harder than it should be.
1389 let failwithf fs = ksprintf failwith fs
1391 let replace_char s c1 c2 =
1392 let s2 = String.copy s in
1393 let r = ref false in
1394 for i = 0 to String.length s2 - 1 do
1395 if String.unsafe_get s2 i = c1 then (
1396 String.unsafe_set s2 i c2;
1400 if not !r then s else s2
1404 (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
1406 let triml ?(test = isspace) str =
1408 let n = ref (String.length str) in
1409 while !n > 0 && test str.[!i]; do
1414 else String.sub str !i !n
1416 let trimr ?(test = isspace) str =
1417 let n = ref (String.length str) in
1418 while !n > 0 && test str.[!n-1]; do
1421 if !n = String.length str then str
1422 else String.sub str 0 !n
1424 let trim ?(test = isspace) str =
1425 trimr ~test (triml ~test str)
1427 let rec find s sub =
1428 let len = String.length s in
1429 let sublen = String.length sub in
1431 if i <= len-sublen then (
1433 if j < sublen then (
1434 if s.[i+j] = sub.[j] then loop2 (j+1)
1440 if r = -1 then loop (i+1) else r
1446 let rec replace_str s s1 s2 =
1447 let len = String.length s in
1448 let sublen = String.length s1 in
1449 let i = find s s1 in
1452 let s' = String.sub s 0 i in
1453 let s'' = String.sub s (i+sublen) (len-i-sublen) in
1454 s' ^ s2 ^ replace_str s'' s1 s2
1457 let rec string_split sep str =
1458 let len = String.length str in
1459 let seplen = String.length sep in
1460 let i = find str sep in
1461 if i = -1 then [str]
1463 let s' = String.sub str 0 i in
1464 let s'' = String.sub str (i+seplen) (len-i-seplen) in
1465 s' :: string_split sep s''
1468 let rec find_map f = function
1469 | [] -> raise Not_found
1473 | None -> find_map f xs
1476 let rec loop i = function
1478 | x :: xs -> f i x; loop (i+1) xs
1483 let rec loop i = function
1485 | x :: xs -> let r = f i x in r :: loop (i+1) xs
1489 let name_of_argt = function
1490 | String n | OptString n | StringList n | Bool n | Int n
1491 | FileIn n | FileOut n -> n
1493 let seq_of_test = function
1494 | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
1495 | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s
1496 | TestOutputLength (s, _) | TestOutputStruct (s, _)
1497 | TestLastFail s -> s
1499 (* Check function names etc. for consistency. *)
1500 let check_functions () =
1501 let contains_uppercase str =
1502 let len = String.length str in
1504 if i >= len then false
1507 if c >= 'A' && c <= 'Z' then true
1514 (* Check function names. *)
1516 fun (name, _, _, _, _, _, _) ->
1517 if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
1518 failwithf "function name %s does not need 'guestfs' prefix" name;
1519 if contains_uppercase name then
1520 failwithf "function name %s should not contain uppercase chars" name;
1521 if String.contains name '-' then
1522 failwithf "function name %s should not contain '-', use '_' instead."
1526 (* Check function parameter/return names. *)
1528 fun (name, style, _, _, _, _, _) ->
1529 let check_arg_ret_name n =
1530 if contains_uppercase n then
1531 failwithf "%s param/ret %s should not contain uppercase chars"
1533 if String.contains n '-' || String.contains n '_' then
1534 failwithf "%s param/ret %s should not contain '-' or '_'"
1537 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;
1538 if n = "argv" || n = "args" then
1539 failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" n
1542 (match fst style with
1544 | RInt n | RInt64 n | RBool n | RConstString n | RString n
1545 | RStringList n | RPVList n | RVGList n | RLVList n
1546 | RStat n | RStatVFS n
1548 check_arg_ret_name n
1550 check_arg_ret_name n;
1551 check_arg_ret_name m
1553 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
1556 (* Check short descriptions. *)
1558 fun (name, _, _, _, _, shortdesc, _) ->
1559 if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
1560 failwithf "short description of %s should begin with lowercase." name;
1561 let c = shortdesc.[String.length shortdesc-1] in
1562 if c = '\n' || c = '.' then
1563 failwithf "short description of %s should not end with . or \\n." name
1566 (* Check long dscriptions. *)
1568 fun (name, _, _, _, _, _, longdesc) ->
1569 if longdesc.[String.length longdesc-1] = '\n' then
1570 failwithf "long description of %s should not end with \\n." name
1573 (* Check proc_nrs. *)
1575 fun (name, _, proc_nr, _, _, _, _) ->
1576 if proc_nr <= 0 then
1577 failwithf "daemon function %s should have proc_nr > 0" name
1581 fun (name, _, proc_nr, _, _, _, _) ->
1582 if proc_nr <> -1 then
1583 failwithf "non-daemon function %s should have proc_nr -1" name
1584 ) non_daemon_functions;
1587 List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
1590 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
1591 let rec loop = function
1594 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
1596 | (name1,nr1) :: (name2,nr2) :: _ ->
1597 failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
1605 (* Ignore functions that have no tests. We generate a
1606 * warning when the user does 'make check' instead.
1608 | name, _, _, _, [], _, _ -> ()
1609 | name, _, _, _, tests, _, _ ->
1613 match seq_of_test test with
1615 failwithf "%s has a test containing an empty sequence" name
1616 | cmds -> List.map List.hd cmds
1618 let funcs = List.flatten funcs in
1620 let tested = List.mem name funcs in
1623 failwithf "function %s has tests but does not test itself" name
1626 (* 'pr' prints to the current output file. *)
1627 let chan = ref stdout
1628 let pr fs = ksprintf (output_string !chan) fs
1630 (* Generate a header block in a number of standard styles. *)
1631 type comment_style = CStyle | HashStyle | OCamlStyle
1632 type license = GPLv2 | LGPLv2
1634 let generate_header comment license =
1635 let c = match comment with
1636 | CStyle -> pr "/* "; " *"
1637 | HashStyle -> pr "# "; "#"
1638 | OCamlStyle -> pr "(* "; " *" in
1639 pr "libguestfs generated file\n";
1640 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
1641 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
1643 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
1647 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
1648 pr "%s it under the terms of the GNU General Public License as published by\n" c;
1649 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
1650 pr "%s (at your option) any later version.\n" c;
1652 pr "%s This program is distributed in the hope that it will be useful,\n" c;
1653 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1654 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
1655 pr "%s GNU General Public License for more details.\n" c;
1657 pr "%s You should have received a copy of the GNU General Public License along\n" c;
1658 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
1659 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
1662 pr "%s This library is free software; you can redistribute it and/or\n" c;
1663 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
1664 pr "%s License as published by the Free Software Foundation; either\n" c;
1665 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
1667 pr "%s This library is distributed in the hope that it will be useful,\n" c;
1668 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1669 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
1670 pr "%s Lesser General Public License for more details.\n" c;
1672 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
1673 pr "%s License along with this library; if not, write to the Free Software\n" c;
1674 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
1677 | CStyle -> pr " */\n"
1679 | OCamlStyle -> pr " *)\n"
1683 (* Start of main code generation functions below this line. *)
1685 (* Generate the pod documentation for the C API. *)
1686 let rec generate_actions_pod () =
1688 fun (shortname, style, _, flags, _, _, longdesc) ->
1689 let name = "guestfs_" ^ shortname in
1690 pr "=head2 %s\n\n" name;
1692 generate_prototype ~extern:false ~handle:"handle" name style;
1694 pr "%s\n\n" longdesc;
1695 (match fst style with
1697 pr "This function returns 0 on success or -1 on error.\n\n"
1699 pr "On error this function returns -1.\n\n"
1701 pr "On error this function returns -1.\n\n"
1703 pr "This function returns a C truth value on success or -1 on error.\n\n"
1705 pr "This function returns a string, or NULL on error.
1706 The string is owned by the guest handle and must I<not> be freed.\n\n"
1708 pr "This function returns a string, or NULL on error.
1709 I<The caller must free the returned string after use>.\n\n"
1711 pr "This function returns a NULL-terminated array of strings
1712 (like L<environ(3)>), or NULL if there was an error.
1713 I<The caller must free the strings and the array after use>.\n\n"
1715 pr "This function returns a C<struct guestfs_int_bool *>,
1716 or NULL if there was an error.
1717 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
1719 pr "This function returns a C<struct guestfs_lvm_pv_list *>
1720 (see E<lt>guestfs-structs.hE<gt>),
1721 or NULL if there was an error.
1722 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
1724 pr "This function returns a C<struct guestfs_lvm_vg_list *>
1725 (see E<lt>guestfs-structs.hE<gt>),
1726 or NULL if there was an error.
1727 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
1729 pr "This function returns a C<struct guestfs_lvm_lv_list *>
1730 (see E<lt>guestfs-structs.hE<gt>),
1731 or NULL if there was an error.
1732 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
1734 pr "This function returns a C<struct guestfs_stat *>
1735 (see L<stat(2)> and E<lt>guestfs-structs.hE<gt>),
1736 or NULL if there was an error.
1737 I<The caller must call C<free> after use>.\n\n"
1739 pr "This function returns a C<struct guestfs_statvfs *>
1740 (see L<statvfs(2)> and E<lt>guestfs-structs.hE<gt>),
1741 or NULL if there was an error.
1742 I<The caller must call C<free> after use>.\n\n"
1744 pr "This function returns a NULL-terminated array of
1745 strings, or NULL if there was an error.
1746 The array of strings will always have length C<2n+1>, where
1747 C<n> keys and values alternate, followed by the trailing NULL entry.
1748 I<The caller must free the strings and the array after use>.\n\n"
1750 if List.mem ProtocolLimitWarning flags then
1751 pr "%s\n\n" protocol_limit_warning;
1752 if List.mem DangerWillRobinson flags then
1753 pr "%s\n\n" danger_will_robinson;
1754 ) all_functions_sorted
1756 and generate_structs_pod () =
1757 (* LVM structs documentation. *)
1760 pr "=head2 guestfs_lvm_%s\n" typ;
1762 pr " struct guestfs_lvm_%s {\n" typ;
1765 | name, `String -> pr " char *%s;\n" name
1767 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
1768 pr " char %s[32];\n" name
1769 | name, `Bytes -> pr " uint64_t %s;\n" name
1770 | name, `Int -> pr " int64_t %s;\n" name
1771 | name, `OptPercent ->
1772 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
1773 pr " float %s;\n" name
1776 pr " struct guestfs_lvm_%s_list {\n" typ;
1777 pr " uint32_t len; /* Number of elements in list. */\n";
1778 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
1781 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
1784 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1786 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
1787 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
1789 * We have to use an underscore instead of a dash because otherwise
1790 * rpcgen generates incorrect code.
1792 * This header is NOT exported to clients, but see also generate_structs_h.
1794 and generate_xdr () =
1795 generate_header CStyle LGPLv2;
1797 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
1798 pr "typedef string str<>;\n";
1801 (* LVM internal structures. *)
1805 pr "struct guestfs_lvm_int_%s {\n" typ;
1807 | name, `String -> pr " string %s<>;\n" name
1808 | name, `UUID -> pr " opaque %s[32];\n" name
1809 | name, `Bytes -> pr " hyper %s;\n" name
1810 | name, `Int -> pr " hyper %s;\n" name
1811 | name, `OptPercent -> pr " float %s;\n" name
1815 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
1817 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1819 (* Stat internal structures. *)
1823 pr "struct guestfs_int_%s {\n" typ;
1825 | name, `Int -> pr " hyper %s;\n" name
1829 ) ["stat", stat_cols; "statvfs", statvfs_cols];
1832 fun (shortname, style, _, _, _, _, _) ->
1833 let name = "guestfs_" ^ shortname in
1835 (match snd style with
1838 pr "struct %s_args {\n" name;
1841 | String n -> pr " string %s<>;\n" n
1842 | OptString n -> pr " str *%s;\n" n
1843 | StringList n -> pr " str %s<>;\n" n
1844 | Bool n -> pr " bool %s;\n" n
1845 | Int n -> pr " int %s;\n" n
1846 | FileIn _ | FileOut _ -> ()
1850 (match fst style with
1853 pr "struct %s_ret {\n" name;
1857 pr "struct %s_ret {\n" name;
1858 pr " hyper %s;\n" n;
1861 pr "struct %s_ret {\n" name;
1865 failwithf "RConstString cannot be returned from a daemon function"
1867 pr "struct %s_ret {\n" name;
1868 pr " string %s<>;\n" n;
1871 pr "struct %s_ret {\n" name;
1872 pr " str %s<>;\n" n;
1875 pr "struct %s_ret {\n" name;
1880 pr "struct %s_ret {\n" name;
1881 pr " guestfs_lvm_int_pv_list %s;\n" n;
1884 pr "struct %s_ret {\n" name;
1885 pr " guestfs_lvm_int_vg_list %s;\n" n;
1888 pr "struct %s_ret {\n" name;
1889 pr " guestfs_lvm_int_lv_list %s;\n" n;
1892 pr "struct %s_ret {\n" name;
1893 pr " guestfs_int_stat %s;\n" n;
1896 pr "struct %s_ret {\n" name;
1897 pr " guestfs_int_statvfs %s;\n" n;
1900 pr "struct %s_ret {\n" name;
1901 pr " str %s<>;\n" n;
1906 (* Table of procedure numbers. *)
1907 pr "enum guestfs_procedure {\n";
1909 fun (shortname, _, proc_nr, _, _, _, _) ->
1910 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
1912 pr " GUESTFS_PROC_NR_PROCS\n";
1916 (* Having to choose a maximum message size is annoying for several
1917 * reasons (it limits what we can do in the API), but it (a) makes
1918 * the protocol a lot simpler, and (b) provides a bound on the size
1919 * of the daemon which operates in limited memory space. For large
1920 * file transfers you should use FTP.
1922 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
1925 (* Message header, etc. *)
1927 /* The communication protocol is now documented in the guestfs(3)
1931 const GUESTFS_PROGRAM = 0x2000F5F5;
1932 const GUESTFS_PROTOCOL_VERSION = 1;
1934 /* These constants must be larger than any possible message length. */
1935 const GUESTFS_LAUNCH_FLAG = 0xf5f55f5f;
1936 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
1938 enum guestfs_message_direction {
1939 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
1940 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
1943 enum guestfs_message_status {
1944 GUESTFS_STATUS_OK = 0,
1945 GUESTFS_STATUS_ERROR = 1
1948 const GUESTFS_ERROR_LEN = 256;
1950 struct guestfs_message_error {
1951 string error_message<GUESTFS_ERROR_LEN>;
1954 struct guestfs_message_header {
1955 unsigned prog; /* GUESTFS_PROGRAM */
1956 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
1957 guestfs_procedure proc; /* GUESTFS_PROC_x */
1958 guestfs_message_direction direction;
1959 unsigned serial; /* message serial number */
1960 guestfs_message_status status;
1963 const GUESTFS_MAX_CHUNK_SIZE = 8192;
1965 struct guestfs_chunk {
1966 int cancel; /* if non-zero, transfer is cancelled */
1967 /* data size is 0 bytes if the transfer has finished successfully */
1968 opaque data<GUESTFS_MAX_CHUNK_SIZE>;
1972 (* Generate the guestfs-structs.h file. *)
1973 and generate_structs_h () =
1974 generate_header CStyle LGPLv2;
1976 (* This is a public exported header file containing various
1977 * structures. The structures are carefully written to have
1978 * exactly the same in-memory format as the XDR structures that
1979 * we use on the wire to the daemon. The reason for creating
1980 * copies of these structures here is just so we don't have to
1981 * export the whole of guestfs_protocol.h (which includes much
1982 * unrelated and XDR-dependent stuff that we don't want to be
1983 * public, or required by clients).
1985 * To reiterate, we will pass these structures to and from the
1986 * client with a simple assignment or memcpy, so the format
1987 * must be identical to what rpcgen / the RFC defines.
1990 (* guestfs_int_bool structure. *)
1991 pr "struct guestfs_int_bool {\n";
1997 (* LVM public structures. *)
2001 pr "struct guestfs_lvm_%s {\n" typ;
2004 | name, `String -> pr " char *%s;\n" name
2005 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
2006 | name, `Bytes -> pr " uint64_t %s;\n" name
2007 | name, `Int -> pr " int64_t %s;\n" name
2008 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
2012 pr "struct guestfs_lvm_%s_list {\n" typ;
2013 pr " uint32_t len;\n";
2014 pr " struct guestfs_lvm_%s *val;\n" typ;
2017 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2019 (* Stat structures. *)
2023 pr "struct guestfs_%s {\n" typ;
2026 | name, `Int -> pr " int64_t %s;\n" name
2030 ) ["stat", stat_cols; "statvfs", statvfs_cols]
2032 (* Generate the guestfs-actions.h file. *)
2033 and generate_actions_h () =
2034 generate_header CStyle LGPLv2;
2036 fun (shortname, style, _, _, _, _, _) ->
2037 let name = "guestfs_" ^ shortname in
2038 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
2042 (* Generate the client-side dispatch stubs. *)
2043 and generate_client_actions () =
2044 generate_header CStyle LGPLv2;
2050 #include \"guestfs.h\"
2051 #include \"guestfs_protocol.h\"
2053 #define error guestfs_error
2054 #define perrorf guestfs_perrorf
2055 #define safe_malloc guestfs_safe_malloc
2056 #define safe_realloc guestfs_safe_realloc
2057 #define safe_strdup guestfs_safe_strdup
2058 #define safe_memdup guestfs_safe_memdup
2060 /* Check the return message from a call for validity. */
2062 check_reply_header (guestfs_h *g,
2063 const struct guestfs_message_header *hdr,
2064 int proc_nr, int serial)
2066 if (hdr->prog != GUESTFS_PROGRAM) {
2067 error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
2070 if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
2071 error (g, \"wrong protocol version (%%d/%%d)\",
2072 hdr->vers, GUESTFS_PROTOCOL_VERSION);
2075 if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
2076 error (g, \"unexpected message direction (%%d/%%d)\",
2077 hdr->direction, GUESTFS_DIRECTION_REPLY);
2080 if (hdr->proc != proc_nr) {
2081 error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
2084 if (hdr->serial != serial) {
2085 error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
2092 /* Check we are in the right state to run a high-level action. */
2094 check_state (guestfs_h *g, const char *caller)
2096 if (!guestfs_is_ready (g)) {
2097 if (guestfs_is_config (g))
2098 error (g, \"%%s: call launch() before using this function\",
2100 else if (guestfs_is_launching (g))
2101 error (g, \"%%s: call wait_ready() before using this function\",
2104 error (g, \"%%s called from the wrong state, %%d != READY\",
2105 caller, guestfs_get_state (g));
2113 (* Client-side stubs for each function. *)
2115 fun (shortname, style, _, _, _, _, _) ->
2116 let name = "guestfs_" ^ shortname in
2118 (* Generate the context struct which stores the high-level
2119 * state between callback functions.
2121 pr "struct %s_ctx {\n" shortname;
2122 pr " /* This flag is set by the callbacks, so we know we've done\n";
2123 pr " * the callbacks as expected, and in the right sequence.\n";
2124 pr " * 0 = not called, 1 = send called,\n";
2125 pr " * 1001 = reply called.\n";
2127 pr " int cb_sequence;\n";
2128 pr " struct guestfs_message_header hdr;\n";
2129 pr " struct guestfs_message_error err;\n";
2130 (match fst style with
2133 failwithf "RConstString cannot be returned from a daemon function"
2135 | RBool _ | RString _ | RStringList _
2137 | RPVList _ | RVGList _ | RLVList _
2138 | RStat _ | RStatVFS _
2140 pr " struct %s_ret ret;\n" name
2145 (* Generate the reply callback function. *)
2146 pr "static void %s_reply_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
2148 pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
2149 pr " struct %s_ctx *ctx = (struct %s_ctx *) data;\n" shortname shortname;
2151 pr " ml->main_loop_quit (ml, g);\n";
2153 pr " if (!xdr_guestfs_message_header (xdr, &ctx->hdr)) {\n";
2154 pr " error (g, \"%%s: failed to parse reply header\", \"%s\");\n" name;
2157 pr " if (ctx->hdr.status == GUESTFS_STATUS_ERROR) {\n";
2158 pr " if (!xdr_guestfs_message_error (xdr, &ctx->err)) {\n";
2159 pr " error (g, \"%%s: failed to parse reply error\", \"%s\");\n"
2166 (match fst style with
2169 failwithf "RConstString cannot be returned from a daemon function"
2171 | RBool _ | RString _ | RStringList _
2173 | RPVList _ | RVGList _ | RLVList _
2174 | RStat _ | RStatVFS _
2176 pr " if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name;
2177 pr " error (g, \"%%s: failed to parse reply\", \"%s\");\n" name;
2183 pr " ctx->cb_sequence = 1001;\n";
2186 (* Generate the action stub. *)
2187 generate_prototype ~extern:false ~semicolon:false ~newline:true
2188 ~handle:"g" name style;
2191 match fst style with
2192 | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
2194 failwithf "RConstString cannot be returned from a daemon function"
2195 | RString _ | RStringList _ | RIntBool _
2196 | RPVList _ | RVGList _ | RLVList _
2197 | RStat _ | RStatVFS _
2203 (match snd style with
2205 | _ -> pr " struct %s_args args;\n" name
2208 pr " struct %s_ctx ctx;\n" shortname;
2209 pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
2210 pr " int serial;\n";
2212 pr " if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
2214 pr " memset (&ctx, 0, sizeof ctx);\n";
2217 (* Send the main header and arguments. *)
2218 (match snd style with
2220 pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s, NULL, NULL);\n"
2221 (String.uppercase shortname)
2226 pr " args.%s = (char *) %s;\n" n n
2228 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
2230 pr " args.%s.%s_val = (char **) %s;\n" n n n;
2231 pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
2233 pr " args.%s = %s;\n" n n
2235 pr " args.%s = %s;\n" n n
2236 | FileIn _ | FileOut _ -> ()
2238 pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s,\n"
2239 (String.uppercase shortname);
2240 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
2243 pr " if (serial == -1)\n";
2244 pr " return %s;\n" error_code;
2247 (* Send any additional files (FileIn) requested. *)
2251 pr " if (guestfs__send_file_sync (g, %s) == -1)\n" n;
2252 pr " return %s;\n" error_code;
2257 (* Wait for the reply from the remote end. *)
2258 pr " guestfs__switch_to_receiving (g);\n";
2259 pr " ctx.cb_sequence = 0;\n";
2260 pr " guestfs_set_reply_callback (g, %s_reply_cb, &ctx);\n" shortname;
2261 pr " (void) ml->main_loop_run (ml, g);\n";
2262 pr " guestfs_set_reply_callback (g, NULL, NULL);\n";
2263 pr " if (ctx.cb_sequence != 1001) {\n";
2264 pr " error (g, \"%%s reply failed, see earlier error messages\", \"%s\");\n" name;
2265 pr " return %s;\n" error_code;
2269 pr " if (check_reply_header (g, &ctx.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
2270 (String.uppercase shortname);
2271 pr " return %s;\n" error_code;
2274 pr " if (ctx.hdr.status == GUESTFS_STATUS_ERROR) {\n";
2275 pr " error (g, \"%%s\", ctx.err.error_message);\n";
2276 pr " return %s;\n" error_code;
2280 (* Expecting to receive further files (FileOut)? *)
2284 pr " if (guestfs__receive_file_sync (g, %s) == -1)\n" n;
2285 pr " return %s;\n" error_code;
2290 (match fst style with
2291 | RErr -> pr " return 0;\n"
2292 | RInt n | RInt64 n | RBool n ->
2293 pr " return ctx.ret.%s;\n" n
2295 failwithf "RConstString cannot be returned from a daemon function"
2297 pr " return ctx.ret.%s; /* caller will free */\n" n
2298 | RStringList n | RHashtable n ->
2299 pr " /* caller will free this, but we need to add a NULL entry */\n";
2300 pr " ctx.ret.%s.%s_val =\n" n n;
2301 pr " safe_realloc (g, ctx.ret.%s.%s_val,\n" n n;
2302 pr " sizeof (char *) * (ctx.ret.%s.%s_len + 1));\n"
2304 pr " ctx.ret.%s.%s_val[ctx.ret.%s.%s_len] = NULL;\n" n n n n;
2305 pr " return ctx.ret.%s.%s_val;\n" n n
2307 pr " /* caller with free this */\n";
2308 pr " return safe_memdup (g, &ctx.ret, sizeof (ctx.ret));\n"
2309 | RPVList n | RVGList n | RLVList n
2310 | RStat n | RStatVFS n ->
2311 pr " /* caller will free this */\n";
2312 pr " return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n
2318 (* Generate daemon/actions.h. *)
2319 and generate_daemon_actions_h () =
2320 generate_header CStyle GPLv2;
2322 pr "#include \"../src/guestfs_protocol.h\"\n";
2326 fun (name, style, _, _, _, _, _) ->
2328 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
2332 (* Generate the server-side stubs. *)
2333 and generate_daemon_actions () =
2334 generate_header CStyle GPLv2;
2336 pr "#define _GNU_SOURCE // for strchrnul\n";
2338 pr "#include <stdio.h>\n";
2339 pr "#include <stdlib.h>\n";
2340 pr "#include <string.h>\n";
2341 pr "#include <inttypes.h>\n";
2342 pr "#include <ctype.h>\n";
2343 pr "#include <rpc/types.h>\n";
2344 pr "#include <rpc/xdr.h>\n";
2346 pr "#include \"daemon.h\"\n";
2347 pr "#include \"../src/guestfs_protocol.h\"\n";
2348 pr "#include \"actions.h\"\n";
2352 fun (name, style, _, _, _, _, _) ->
2353 (* Generate server-side stubs. *)
2354 pr "static void %s_stub (XDR *xdr_in)\n" name;
2357 match fst style with
2358 | RErr | RInt _ -> pr " int r;\n"; "-1"
2359 | RInt64 _ -> pr " int64_t r;\n"; "-1"
2360 | RBool _ -> pr " int r;\n"; "-1"
2362 failwithf "RConstString cannot be returned from a daemon function"
2363 | RString _ -> pr " char *r;\n"; "NULL"
2364 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
2365 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
2366 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
2367 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
2368 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL"
2369 | RStat _ -> pr " guestfs_int_stat *r;\n"; "NULL"
2370 | RStatVFS _ -> pr " guestfs_int_statvfs *r;\n"; "NULL" in
2372 (match snd style with
2375 pr " struct guestfs_%s_args args;\n" name;
2379 | OptString n -> pr " const char *%s;\n" n
2380 | StringList n -> pr " char **%s;\n" n
2381 | Bool n -> pr " int %s;\n" n
2382 | Int n -> pr " int %s;\n" n
2383 | FileIn _ | FileOut _ -> ()
2388 (match snd style with
2391 pr " memset (&args, 0, sizeof args);\n";
2393 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
2394 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
2399 | String n -> pr " %s = args.%s;\n" n n
2400 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
2402 pr " args.%s.%s_val = realloc (args.%s.%s_val, sizeof (char *) * (args.%s.%s_len+1));\n" n n n n n n;
2403 pr " args.%s.%s_val[args.%s.%s_len] = NULL;\n" n n n n;
2404 pr " %s = args.%s.%s_val;\n" n n n
2405 | Bool n -> pr " %s = args.%s;\n" n n
2406 | Int n -> pr " %s = args.%s;\n" n n
2407 | FileIn _ | FileOut _ -> ()
2412 (* Don't want to call the impl with any FileIn or FileOut
2413 * parameters, since these go "outside" the RPC protocol.
2416 List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
2418 pr " r = do_%s " name;
2419 generate_call_args argsnofile;
2422 pr " if (r == %s)\n" error_code;
2423 pr " /* do_%s has already called reply_with_error */\n" name;
2427 (* If there are any FileOut parameters, then the impl must
2428 * send its own reply.
2431 List.exists (function FileOut _ -> true | _ -> false) (snd style) in
2433 pr " /* do_%s has already sent a reply */\n" name
2435 match fst style with
2436 | RErr -> pr " reply (NULL, NULL);\n"
2437 | RInt n | RInt64 n | RBool n ->
2438 pr " struct guestfs_%s_ret ret;\n" name;
2439 pr " ret.%s = r;\n" n;
2440 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2443 failwithf "RConstString cannot be returned from a daemon function"
2445 pr " struct guestfs_%s_ret ret;\n" name;
2446 pr " ret.%s = r;\n" n;
2447 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2450 | RStringList n | RHashtable n ->
2451 pr " struct guestfs_%s_ret ret;\n" name;
2452 pr " ret.%s.%s_len = count_strings (r);\n" n n;
2453 pr " ret.%s.%s_val = r;\n" n n;
2454 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
2456 pr " free_strings (r);\n"
2458 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n"
2460 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
2461 | RPVList n | RVGList n | RLVList n
2462 | RStat n | RStatVFS n ->
2463 pr " struct guestfs_%s_ret ret;\n" name;
2464 pr " ret.%s = *r;\n" n;
2465 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
2467 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
2471 (* Free the args. *)
2472 (match snd style with
2477 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
2484 (* Dispatch function. *)
2485 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
2487 pr " switch (proc_nr) {\n";
2490 fun (name, style, _, _, _, _, _) ->
2491 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
2492 pr " %s_stub (xdr_in);\n" name;
2497 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
2502 (* LVM columns and tokenization functions. *)
2503 (* XXX This generates crap code. We should rethink how we
2509 pr "static const char *lvm_%s_cols = \"%s\";\n"
2510 typ (String.concat "," (List.map fst cols));
2513 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
2515 pr " char *tok, *p, *next;\n";
2519 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
2522 pr " if (!str) {\n";
2523 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
2526 pr " if (!*str || isspace (*str)) {\n";
2527 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
2532 fun (name, coltype) ->
2533 pr " if (!tok) {\n";
2534 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
2537 pr " p = strchrnul (tok, ',');\n";
2538 pr " if (*p) next = p+1; else next = NULL;\n";
2539 pr " *p = '\\0';\n";
2542 pr " r->%s = strdup (tok);\n" name;
2543 pr " if (r->%s == NULL) {\n" name;
2544 pr " perror (\"strdup\");\n";
2548 pr " for (i = j = 0; i < 32; ++j) {\n";
2549 pr " if (tok[j] == '\\0') {\n";
2550 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
2552 pr " } else if (tok[j] != '-')\n";
2553 pr " r->%s[i++] = tok[j];\n" name;
2556 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
2557 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2561 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
2562 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2566 pr " if (tok[0] == '\\0')\n";
2567 pr " r->%s = -1;\n" name;
2568 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
2569 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2573 pr " tok = next;\n";
2576 pr " if (tok != NULL) {\n";
2577 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
2584 pr "guestfs_lvm_int_%s_list *\n" typ;
2585 pr "parse_command_line_%ss (void)\n" typ;
2587 pr " char *out, *err;\n";
2588 pr " char *p, *pend;\n";
2590 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
2591 pr " void *newp;\n";
2593 pr " ret = malloc (sizeof *ret);\n";
2594 pr " if (!ret) {\n";
2595 pr " reply_with_perror (\"malloc\");\n";
2596 pr " return NULL;\n";
2599 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
2600 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
2602 pr " r = command (&out, &err,\n";
2603 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
2604 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
2605 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
2606 pr " if (r == -1) {\n";
2607 pr " reply_with_error (\"%%s\", err);\n";
2608 pr " free (out);\n";
2609 pr " free (err);\n";
2610 pr " free (ret);\n";
2611 pr " return NULL;\n";
2614 pr " free (err);\n";
2616 pr " /* Tokenize each line of the output. */\n";
2619 pr " while (p) {\n";
2620 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
2621 pr " if (pend) {\n";
2622 pr " *pend = '\\0';\n";
2626 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
2629 pr " if (!*p) { /* Empty line? Skip it. */\n";
2634 pr " /* Allocate some space to store this next entry. */\n";
2635 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
2636 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
2637 pr " if (newp == NULL) {\n";
2638 pr " reply_with_perror (\"realloc\");\n";
2639 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2640 pr " free (ret);\n";
2641 pr " free (out);\n";
2642 pr " return NULL;\n";
2644 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
2646 pr " /* Tokenize the next entry. */\n";
2647 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
2648 pr " if (r == -1) {\n";
2649 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
2650 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2651 pr " free (ret);\n";
2652 pr " free (out);\n";
2653 pr " return NULL;\n";
2660 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
2662 pr " free (out);\n";
2663 pr " return ret;\n";
2666 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2668 (* Generate the tests. *)
2669 and generate_tests () =
2670 generate_header CStyle GPLv2;
2677 #include <sys/types.h>
2680 #include \"guestfs.h\"
2682 static guestfs_h *g;
2683 static int suppress_error = 0;
2685 static void print_error (guestfs_h *g, void *data, const char *msg)
2687 if (!suppress_error)
2688 fprintf (stderr, \"%%s\\n\", msg);
2691 static void print_strings (char * const * const argv)
2695 for (argc = 0; argv[argc] != NULL; ++argc)
2696 printf (\"\\t%%s\\n\", argv[argc]);
2700 static void print_table (char * const * const argv)
2704 for (i = 0; argv[i] != NULL; i += 2)
2705 printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
2709 static void no_test_warnings (void)
2715 | name, _, _, _, [], _, _ ->
2716 pr " fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
2717 | name, _, _, _, tests, _, _ -> ()
2723 (* Generate the actual tests. Note that we generate the tests
2724 * in reverse order, deliberately, so that (in general) the
2725 * newest tests run first. This makes it quicker and easier to
2730 fun (name, _, _, _, tests, _, _) ->
2731 mapi (generate_one_test name) tests
2732 ) (List.rev all_functions) in
2733 let test_names = List.concat test_names in
2734 let nr_tests = List.length test_names in
2737 int main (int argc, char *argv[])
2744 int nr_tests, test_num = 0;
2746 no_test_warnings ();
2748 g = guestfs_create ();
2750 printf (\"guestfs_create FAILED\\n\");
2754 guestfs_set_error_handler (g, print_error, NULL);
2756 srcdir = getenv (\"srcdir\");
2757 if (!srcdir) srcdir = \".\";
2758 guestfs_set_path (g, srcdir);
2760 snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);
2761 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2766 if (lseek (fd, %d, SEEK_SET) == -1) {
2772 if (write (fd, &c, 1) == -1) {
2778 if (close (fd) == -1) {
2783 if (guestfs_add_drive (g, buf) == -1) {
2784 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2788 snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);
2789 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2794 if (lseek (fd, %d, SEEK_SET) == -1) {
2800 if (write (fd, &c, 1) == -1) {
2806 if (close (fd) == -1) {
2811 if (guestfs_add_drive (g, buf) == -1) {
2812 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2816 snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);
2817 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2822 if (lseek (fd, %d, SEEK_SET) == -1) {
2828 if (write (fd, &c, 1) == -1) {
2834 if (close (fd) == -1) {
2839 if (guestfs_add_drive (g, buf) == -1) {
2840 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2844 if (guestfs_launch (g) == -1) {
2845 printf (\"guestfs_launch FAILED\\n\");
2848 if (guestfs_wait_ready (g) == -1) {
2849 printf (\"guestfs_wait_ready FAILED\\n\");
2855 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
2859 pr " test_num++;\n";
2860 pr " printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
2861 pr " if (%s () == -1) {\n" test_name;
2862 pr " printf (\"%s FAILED\\n\");\n" test_name;
2868 pr " guestfs_close (g);\n";
2869 pr " snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);\n";
2870 pr " unlink (buf);\n";
2871 pr " snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);\n";
2872 pr " unlink (buf);\n";
2873 pr " snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);\n";
2874 pr " unlink (buf);\n";
2877 pr " if (failed > 0) {\n";
2878 pr " printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n";
2886 and generate_one_test name i (init, test) =
2887 let test_name = sprintf "test_%s_%d" name i in
2889 pr "static int %s (void)\n" test_name;
2895 pr " /* InitEmpty for %s (%d) */\n" name i;
2896 List.iter (generate_test_command_call test_name)
2900 pr " /* InitBasicFS for %s (%d): create ext2 on /dev/sda1 */\n" name i;
2901 List.iter (generate_test_command_call test_name)
2904 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2905 ["mkfs"; "ext2"; "/dev/sda1"];
2906 ["mount"; "/dev/sda1"; "/"]]
2907 | InitBasicFSonLVM ->
2908 pr " /* InitBasicFSonLVM for %s (%d): create ext2 on /dev/VG/LV */\n"
2910 List.iter (generate_test_command_call test_name)
2913 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2914 ["pvcreate"; "/dev/sda1"];
2915 ["vgcreate"; "VG"; "/dev/sda1"];
2916 ["lvcreate"; "LV"; "VG"; "8"];
2917 ["mkfs"; "ext2"; "/dev/VG/LV"];
2918 ["mount"; "/dev/VG/LV"; "/"]]
2921 let get_seq_last = function
2923 failwithf "%s: you cannot use [] (empty list) when expecting a command"
2926 let seq = List.rev seq in
2927 List.rev (List.tl seq), List.hd seq
2932 pr " /* TestRun for %s (%d) */\n" name i;
2933 List.iter (generate_test_command_call test_name) seq
2934 | TestOutput (seq, expected) ->
2935 pr " /* TestOutput for %s (%d) */\n" name i;
2936 let seq, last = get_seq_last seq in
2938 pr " if (strcmp (r, \"%s\") != 0) {\n" (c_quote expected);
2939 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r);\n" test_name (c_quote expected);
2943 List.iter (generate_test_command_call test_name) seq;
2944 generate_test_command_call ~test test_name last
2945 | TestOutputList (seq, expected) ->
2946 pr " /* TestOutputList for %s (%d) */\n" name i;
2947 let seq, last = get_seq_last seq in
2951 pr " if (!r[%d]) {\n" i;
2952 pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
2953 pr " print_strings (r);\n";
2956 pr " if (strcmp (r[%d], \"%s\") != 0) {\n" i (c_quote str);
2957 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r[%d]);\n" test_name (c_quote str) i;
2961 pr " if (r[%d] != NULL) {\n" (List.length expected);
2962 pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
2964 pr " print_strings (r);\n";
2968 List.iter (generate_test_command_call test_name) seq;
2969 generate_test_command_call ~test test_name last
2970 | TestOutputInt (seq, expected) ->
2971 pr " /* TestOutputInt for %s (%d) */\n" name i;
2972 let seq, last = get_seq_last seq in
2974 pr " if (r != %d) {\n" expected;
2975 pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\","
2981 List.iter (generate_test_command_call test_name) seq;
2982 generate_test_command_call ~test test_name last
2983 | TestOutputTrue seq ->
2984 pr " /* TestOutputTrue for %s (%d) */\n" name i;
2985 let seq, last = get_seq_last seq in
2988 pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n"
2993 List.iter (generate_test_command_call test_name) seq;
2994 generate_test_command_call ~test test_name last
2995 | TestOutputFalse seq ->
2996 pr " /* TestOutputFalse for %s (%d) */\n" name i;
2997 let seq, last = get_seq_last seq in
3000 pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n"
3005 List.iter (generate_test_command_call test_name) seq;
3006 generate_test_command_call ~test test_name last
3007 | TestOutputLength (seq, expected) ->
3008 pr " /* TestOutputLength for %s (%d) */\n" name i;
3009 let seq, last = get_seq_last seq in
3012 pr " for (j = 0; j < %d; ++j)\n" expected;
3013 pr " if (r[j] == NULL) {\n";
3014 pr " fprintf (stderr, \"%s: short list returned\\n\");\n"
3016 pr " print_strings (r);\n";
3019 pr " if (r[j] != NULL) {\n";
3020 pr " fprintf (stderr, \"%s: long list returned\\n\");\n"
3022 pr " print_strings (r);\n";
3026 List.iter (generate_test_command_call test_name) seq;
3027 generate_test_command_call ~test test_name last
3028 | TestOutputStruct (seq, checks) ->
3029 pr " /* TestOutputStruct for %s (%d) */\n" name i;
3030 let seq, last = get_seq_last seq in
3034 | CompareWithInt (field, expected) ->
3035 pr " if (r->%s != %d) {\n" field expected;
3036 pr " fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
3037 test_name field expected;
3038 pr " (int) r->%s);\n" field;
3041 | CompareWithString (field, expected) ->
3042 pr " if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
3043 pr " fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
3044 test_name field expected;
3045 pr " r->%s);\n" field;
3048 | CompareFieldsIntEq (field1, field2) ->
3049 pr " if (r->%s != r->%s) {\n" field1 field2;
3050 pr " fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
3051 test_name field1 field2;
3052 pr " (int) r->%s, (int) r->%s);\n" field1 field2;
3055 | CompareFieldsStrEq (field1, field2) ->
3056 pr " if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
3057 pr " fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
3058 test_name field1 field2;
3059 pr " r->%s, r->%s);\n" field1 field2;
3064 List.iter (generate_test_command_call test_name) seq;
3065 generate_test_command_call ~test test_name last
3066 | TestLastFail seq ->
3067 pr " /* TestLastFail for %s (%d) */\n" name i;
3068 let seq, last = get_seq_last seq in
3069 List.iter (generate_test_command_call test_name) seq;
3070 generate_test_command_call test_name ~expect_error:true last
3078 (* Generate the code to run a command, leaving the result in 'r'.
3079 * If you expect to get an error then you should set expect_error:true.
3081 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
3083 | [] -> assert false
3085 (* Look up the command to find out what args/ret it has. *)
3088 let _, style, _, _, _, _, _ =
3089 List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
3092 failwithf "%s: in test, command %s was not found" test_name name in
3094 if List.length (snd style) <> List.length args then
3095 failwithf "%s: in test, wrong number of args given to %s"
3106 | FileIn _, _ | FileOut _, _ -> ()
3107 | StringList n, arg ->
3108 pr " char *%s[] = {\n" n;
3109 let strs = string_split " " arg in
3111 fun str -> pr " \"%s\",\n" (c_quote str)
3115 ) (List.combine (snd style) args);
3118 match fst style with
3119 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
3120 | RInt64 _ -> pr " int64_t r;\n"; "-1"
3121 | RConstString _ -> pr " const char *r;\n"; "NULL"
3122 | RString _ -> pr " char *r;\n"; "NULL"
3123 | RStringList _ | RHashtable _ ->
3128 pr " struct guestfs_int_bool *r;\n"; "NULL"
3130 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
3132 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
3134 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
3136 pr " struct guestfs_stat *r;\n"; "NULL"
3138 pr " struct guestfs_statvfs *r;\n"; "NULL" in
3140 pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
3141 pr " r = guestfs_%s (g" name;
3143 (* Generate the parameters. *)
3147 | FileIn _, arg | FileOut _, arg ->
3148 pr ", \"%s\"" (c_quote arg)
3149 | OptString _, arg ->
3150 if arg = "NULL" then pr ", NULL" else pr ", \"%s\"" (c_quote arg)
3151 | StringList n, _ ->
3155 try int_of_string arg
3156 with Failure "int_of_string" ->
3157 failwithf "%s: expecting an int, but got '%s'" test_name arg in
3160 let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
3161 ) (List.combine (snd style) args);
3164 if not expect_error then
3165 pr " if (r == %s)\n" error_code
3167 pr " if (r != %s)\n" error_code;
3170 (* Insert the test code. *)
3176 (match fst style with
3177 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ -> ()
3178 | RString _ -> pr " free (r);\n"
3179 | RStringList _ | RHashtable _ ->
3180 pr " for (i = 0; r[i] != NULL; ++i)\n";
3181 pr " free (r[i]);\n";
3184 pr " guestfs_free_int_bool (r);\n"
3186 pr " guestfs_free_lvm_pv_list (r);\n"
3188 pr " guestfs_free_lvm_vg_list (r);\n"
3190 pr " guestfs_free_lvm_lv_list (r);\n"
3191 | RStat _ | RStatVFS _ ->
3198 let str = replace_str str "\r" "\\r" in
3199 let str = replace_str str "\n" "\\n" in
3200 let str = replace_str str "\t" "\\t" in
3203 (* Generate a lot of different functions for guestfish. *)
3204 and generate_fish_cmds () =
3205 generate_header CStyle GPLv2;
3209 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3211 let all_functions_sorted =
3213 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3214 ) all_functions_sorted in
3216 pr "#include <stdio.h>\n";
3217 pr "#include <stdlib.h>\n";
3218 pr "#include <string.h>\n";
3219 pr "#include <inttypes.h>\n";
3221 pr "#include <guestfs.h>\n";
3222 pr "#include \"fish.h\"\n";
3225 (* list_commands function, which implements guestfish -h *)
3226 pr "void list_commands (void)\n";
3228 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
3229 pr " list_builtin_commands ();\n";
3231 fun (name, _, _, flags, _, shortdesc, _) ->
3232 let name = replace_char name '_' '-' in
3233 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
3235 ) all_functions_sorted;
3236 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
3240 (* display_command function, which implements guestfish -h cmd *)
3241 pr "void display_command (const char *cmd)\n";
3244 fun (name, style, _, flags, _, shortdesc, longdesc) ->
3245 let name2 = replace_char name '_' '-' in
3247 try find_map (function FishAlias n -> Some n | _ -> None) flags
3248 with Not_found -> name in
3249 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
3251 match snd style with
3255 name2 (String.concat "> <" (List.map name_of_argt args)) in
3258 if List.mem ProtocolLimitWarning flags then
3259 ("\n\n" ^ protocol_limit_warning)
3262 (* For DangerWillRobinson commands, we should probably have
3263 * guestfish prompt before allowing you to use them (especially
3264 * in interactive mode). XXX
3268 if List.mem DangerWillRobinson flags then
3269 ("\n\n" ^ danger_will_robinson)
3272 let describe_alias =
3273 if name <> alias then
3274 sprintf "\n\nYou can use '%s' as an alias for this command." alias
3278 pr "strcasecmp (cmd, \"%s\") == 0" name;
3279 if name <> name2 then
3280 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
3281 if name <> alias then
3282 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
3284 pr " pod2text (\"%s - %s\", %S);\n"
3286 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
3289 pr " display_builtin_command (cmd);\n";
3293 (* print_{pv,vg,lv}_list functions *)
3297 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
3304 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
3306 pr " printf (\"%s: \");\n" name;
3307 pr " for (i = 0; i < 32; ++i)\n";
3308 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
3309 pr " printf (\"\\n\");\n"
3311 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
3313 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
3314 | name, `OptPercent ->
3315 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
3316 typ name name typ name;
3317 pr " else printf (\"%s: \\n\");\n" name
3321 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
3326 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
3327 pr " print_%s (&%ss->val[i]);\n" typ typ;
3330 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3332 (* print_{stat,statvfs} functions *)
3336 pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
3341 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
3345 ) ["stat", stat_cols; "statvfs", statvfs_cols];
3347 (* run_<action> actions *)
3349 fun (name, style, _, flags, _, _, _) ->
3350 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
3352 (match fst style with
3355 | RBool _ -> pr " int r;\n"
3356 | RInt64 _ -> pr " int64_t r;\n"
3357 | RConstString _ -> pr " const char *r;\n"
3358 | RString _ -> pr " char *r;\n"
3359 | RStringList _ | RHashtable _ -> pr " char **r;\n"
3360 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
3361 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
3362 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
3363 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
3364 | RStat _ -> pr " struct guestfs_stat *r;\n"
3365 | RStatVFS _ -> pr " struct guestfs_statvfs *r;\n"
3372 | FileOut n -> pr " const char *%s;\n" n
3373 | StringList n -> pr " char **%s;\n" n
3374 | Bool n -> pr " int %s;\n" n
3375 | Int n -> pr " int %s;\n" n
3378 (* Check and convert parameters. *)
3379 let argc_expected = List.length (snd style) in
3380 pr " if (argc != %d) {\n" argc_expected;
3381 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
3383 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
3389 | String name -> pr " %s = argv[%d];\n" name i
3391 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
3394 pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdin\";\n"
3397 pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n"
3399 | StringList name ->
3400 pr " %s = parse_string_list (argv[%d]);\n" name i
3402 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
3404 pr " %s = atoi (argv[%d]);\n" name i
3407 (* Call C API function. *)
3409 try find_map (function FishAction n -> Some n | _ -> None) flags
3410 with Not_found -> sprintf "guestfs_%s" name in
3412 generate_call_args ~handle:"g" (snd style);
3415 (* Check return value for errors and display command results. *)
3416 (match fst style with
3417 | RErr -> pr " return r;\n"
3419 pr " if (r == -1) return -1;\n";
3420 pr " printf (\"%%d\\n\", r);\n";
3423 pr " if (r == -1) return -1;\n";
3424 pr " printf (\"%%\" PRIi64 \"\\n\", r);\n";
3427 pr " if (r == -1) return -1;\n";
3428 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
3431 pr " if (r == NULL) return -1;\n";
3432 pr " printf (\"%%s\\n\", r);\n";
3435 pr " if (r == NULL) return -1;\n";
3436 pr " printf (\"%%s\\n\", r);\n";
3440 pr " if (r == NULL) return -1;\n";
3441 pr " print_strings (r);\n";
3442 pr " free_strings (r);\n";
3445 pr " if (r == NULL) return -1;\n";
3446 pr " printf (\"%%d, %%s\\n\", r->i,\n";
3447 pr " r->b ? \"true\" : \"false\");\n";
3448 pr " guestfs_free_int_bool (r);\n";
3451 pr " if (r == NULL) return -1;\n";
3452 pr " print_pv_list (r);\n";
3453 pr " guestfs_free_lvm_pv_list (r);\n";
3456 pr " if (r == NULL) return -1;\n";
3457 pr " print_vg_list (r);\n";
3458 pr " guestfs_free_lvm_vg_list (r);\n";
3461 pr " if (r == NULL) return -1;\n";
3462 pr " print_lv_list (r);\n";
3463 pr " guestfs_free_lvm_lv_list (r);\n";
3466 pr " if (r == NULL) return -1;\n";
3467 pr " print_stat (r);\n";
3471 pr " if (r == NULL) return -1;\n";
3472 pr " print_statvfs (r);\n";
3476 pr " if (r == NULL) return -1;\n";
3477 pr " print_table (r);\n";
3478 pr " free_strings (r);\n";
3485 (* run_action function *)
3486 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
3489 fun (name, _, _, flags, _, _, _) ->
3490 let name2 = replace_char name '_' '-' in
3492 try find_map (function FishAlias n -> Some n | _ -> None) flags
3493 with Not_found -> name in
3495 pr "strcasecmp (cmd, \"%s\") == 0" name;
3496 if name <> name2 then
3497 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
3498 if name <> alias then
3499 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
3501 pr " return run_%s (cmd, argc, argv);\n" name;
3505 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
3512 (* Readline completion for guestfish. *)
3513 and generate_fish_completion () =
3514 generate_header CStyle GPLv2;
3518 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3528 #ifdef HAVE_LIBREADLINE
3529 #include <readline/readline.h>
3534 #ifdef HAVE_LIBREADLINE
3536 static const char *commands[] = {
3539 (* Get the commands and sort them, including the aliases. *)
3542 fun (name, _, _, flags, _, _, _) ->
3543 let name2 = replace_char name '_' '-' in
3545 try find_map (function FishAlias n -> Some n | _ -> None) flags
3546 with Not_found -> name in
3548 if name <> alias then [name2; alias] else [name2]
3550 let commands = List.flatten commands in
3551 let commands = List.sort compare commands in
3553 List.iter (pr " \"%s\",\n") commands;
3559 generator (const char *text, int state)
3561 static int index, len;
3566 len = strlen (text);
3569 while ((name = commands[index]) != NULL) {
3571 if (strncasecmp (name, text, len) == 0)
3572 return strdup (name);
3578 #endif /* HAVE_LIBREADLINE */
3580 char **do_completion (const char *text, int start, int end)
3582 char **matches = NULL;
3584 #ifdef HAVE_LIBREADLINE
3586 matches = rl_completion_matches (text, generator);
3593 (* Generate the POD documentation for guestfish. *)
3594 and generate_fish_actions_pod () =
3595 let all_functions_sorted =
3597 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3598 ) all_functions_sorted in
3601 fun (name, style, _, flags, _, _, longdesc) ->
3602 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
3603 let name = replace_char name '_' '-' in
3605 try find_map (function FishAlias n -> Some n | _ -> None) flags
3606 with Not_found -> name in
3608 pr "=head2 %s" name;
3609 if name <> alias then
3616 | String n -> pr " %s" n
3617 | OptString n -> pr " %s" n
3618 | StringList n -> pr " %s,..." n
3619 | Bool _ -> pr " true|false"
3620 | Int n -> pr " %s" n
3621 | FileIn n | FileOut n -> pr " (%s|-)" n
3625 pr "%s\n\n" longdesc;
3627 if List.exists (function FileIn _ | FileOut _ -> true
3628 | _ -> false) (snd style) then
3629 pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
3631 if List.mem ProtocolLimitWarning flags then
3632 pr "%s\n\n" protocol_limit_warning;
3634 if List.mem DangerWillRobinson flags then
3635 pr "%s\n\n" danger_will_robinson
3636 ) all_functions_sorted
3638 (* Generate a C function prototype. *)
3639 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
3640 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
3642 ?handle name style =
3643 if extern then pr "extern ";
3644 if static then pr "static ";
3645 (match fst style with
3647 | RInt _ -> pr "int "
3648 | RInt64 _ -> pr "int64_t "
3649 | RBool _ -> pr "int "
3650 | RConstString _ -> pr "const char *"
3651 | RString _ -> pr "char *"
3652 | RStringList _ | RHashtable _ -> pr "char **"
3654 if not in_daemon then pr "struct guestfs_int_bool *"
3655 else pr "guestfs_%s_ret *" name
3657 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
3658 else pr "guestfs_lvm_int_pv_list *"
3660 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
3661 else pr "guestfs_lvm_int_vg_list *"
3663 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
3664 else pr "guestfs_lvm_int_lv_list *"
3666 if not in_daemon then pr "struct guestfs_stat *"
3667 else pr "guestfs_int_stat *"
3669 if not in_daemon then pr "struct guestfs_statvfs *"
3670 else pr "guestfs_int_statvfs *"
3672 pr "%s%s (" prefix name;
3673 if handle = None && List.length (snd style) = 0 then
3676 let comma = ref false in
3679 | Some handle -> pr "guestfs_h *%s" handle; comma := true
3683 if single_line then pr ", " else pr ",\n\t\t"
3690 | OptString n -> next (); pr "const char *%s" n
3691 | StringList n -> next (); pr "char * const* const %s" n
3692 | Bool n -> next (); pr "int %s" n
3693 | Int n -> next (); pr "int %s" n
3696 if not in_daemon then (next (); pr "const char *%s" n)
3700 if semicolon then pr ";";
3701 if newline then pr "\n"
3703 (* Generate C call arguments, eg "(handle, foo, bar)" *)
3704 and generate_call_args ?handle args =
3706 let comma = ref false in
3709 | Some handle -> pr "%s" handle; comma := true
3713 if !comma then pr ", ";
3715 pr "%s" (name_of_argt arg)
3719 (* Generate the OCaml bindings interface. *)
3720 and generate_ocaml_mli () =
3721 generate_header OCamlStyle LGPLv2;
3724 (** For API documentation you should refer to the C API
3725 in the guestfs(3) manual page. The OCaml API uses almost
3726 exactly the same calls. *)
3729 (** A [guestfs_h] handle. *)
3731 exception Error of string
3732 (** This exception is raised when there is an error. *)
3734 val create : unit -> t
3736 val close : t -> unit
3737 (** Handles are closed by the garbage collector when they become
3738 unreferenced, but callers can also call this in order to
3739 provide predictable cleanup. *)
3742 generate_ocaml_lvm_structure_decls ();
3744 generate_ocaml_stat_structure_decls ();
3748 fun (name, style, _, _, _, shortdesc, _) ->
3749 generate_ocaml_prototype name style;
3750 pr "(** %s *)\n" shortdesc;
3754 (* Generate the OCaml bindings implementation. *)
3755 and generate_ocaml_ml () =
3756 generate_header OCamlStyle LGPLv2;
3760 exception Error of string
3761 external create : unit -> t = \"ocaml_guestfs_create\"
3762 external close : t -> unit = \"ocaml_guestfs_close\"
3765 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
3769 generate_ocaml_lvm_structure_decls ();
3771 generate_ocaml_stat_structure_decls ();
3775 fun (name, style, _, _, _, shortdesc, _) ->
3776 generate_ocaml_prototype ~is_external:true name style;
3779 (* Generate the OCaml bindings C implementation. *)
3780 and generate_ocaml_c () =
3781 generate_header CStyle LGPLv2;
3788 #include <caml/config.h>
3789 #include <caml/alloc.h>
3790 #include <caml/callback.h>
3791 #include <caml/fail.h>
3792 #include <caml/memory.h>
3793 #include <caml/mlvalues.h>
3794 #include <caml/signals.h>
3796 #include <guestfs.h>
3798 #include \"guestfs_c.h\"
3800 /* Copy a hashtable of string pairs into an assoc-list. We return
3801 * the list in reverse order, but hashtables aren't supposed to be
3804 static CAMLprim value
3805 copy_table (char * const * argv)
3808 CAMLlocal5 (rv, pairv, kv, vv, cons);
3812 for (i = 0; argv[i] != NULL; i += 2) {
3813 kv = caml_copy_string (argv[i]);
3814 vv = caml_copy_string (argv[i+1]);
3815 pairv = caml_alloc (2, 0);
3816 Store_field (pairv, 0, kv);
3817 Store_field (pairv, 1, vv);
3818 cons = caml_alloc (2, 0);
3819 Store_field (cons, 1, rv);
3821 Store_field (cons, 0, pairv);
3829 (* LVM struct copy functions. *)
3832 let has_optpercent_col =
3833 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
3835 pr "static CAMLprim value\n";
3836 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
3838 pr " CAMLparam0 ();\n";
3839 if has_optpercent_col then
3840 pr " CAMLlocal3 (rv, v, v2);\n"
3842 pr " CAMLlocal2 (rv, v);\n";
3844 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
3849 pr " v = caml_copy_string (%s->%s);\n" typ name
3851 pr " v = caml_alloc_string (32);\n";
3852 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
3855 pr " v = caml_copy_int64 (%s->%s);\n" typ name
3856 | name, `OptPercent ->
3857 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
3858 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
3859 pr " v = caml_alloc (1, 0);\n";
3860 pr " Store_field (v, 0, v2);\n";
3861 pr " } else /* None */\n";
3862 pr " v = Val_int (0);\n";
3864 pr " Store_field (rv, %d, v);\n" i
3866 pr " CAMLreturn (rv);\n";
3870 pr "static CAMLprim value\n";
3871 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
3874 pr " CAMLparam0 ();\n";
3875 pr " CAMLlocal2 (rv, v);\n";
3878 pr " if (%ss->len == 0)\n" typ;
3879 pr " CAMLreturn (Atom (0));\n";
3881 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
3882 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
3883 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
3884 pr " caml_modify (&Field (rv, i), v);\n";
3886 pr " CAMLreturn (rv);\n";
3890 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3892 (* Stat copy functions. *)
3895 pr "static CAMLprim value\n";
3896 pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
3898 pr " CAMLparam0 ();\n";
3899 pr " CAMLlocal2 (rv, v);\n";
3901 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
3906 pr " v = caml_copy_int64 (%s->%s);\n" typ name
3908 pr " Store_field (rv, %d, v);\n" i
3910 pr " CAMLreturn (rv);\n";
3913 ) ["stat", stat_cols; "statvfs", statvfs_cols];
3917 fun (name, style, _, _, _, _, _) ->
3919 "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
3921 pr "CAMLprim value\n";
3922 pr "ocaml_guestfs_%s (value %s" name (List.hd params);
3923 List.iter (pr ", value %s") (List.tl params);
3928 | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
3929 pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
3930 pr " CAMLxparam%d (%s);\n"
3931 (List.length rest) (String.concat ", " rest)
3933 pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
3935 pr " CAMLlocal1 (rv);\n";
3938 pr " guestfs_h *g = Guestfs_val (gv);\n";
3939 pr " if (g == NULL)\n";
3940 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
3948 pr " const char *%s = String_val (%sv);\n" n n
3950 pr " const char *%s =\n" n;
3951 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
3954 pr " char **%s = ocaml_guestfs_strings_val (%sv);\n" n n
3956 pr " int %s = Bool_val (%sv);\n" n n
3958 pr " int %s = Int_val (%sv);\n" n n
3961 match fst style with
3962 | RErr -> pr " int r;\n"; "-1"
3963 | RInt _ -> pr " int r;\n"; "-1"
3964 | RInt64 _ -> pr " int64_t r;\n"; "-1"
3965 | RBool _ -> pr " int r;\n"; "-1"
3966 | RConstString _ -> pr " const char *r;\n"; "NULL"
3967 | RString _ -> pr " char *r;\n"; "NULL"
3973 pr " struct guestfs_int_bool *r;\n"; "NULL"
3975 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
3977 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
3979 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
3981 pr " struct guestfs_stat *r;\n"; "NULL"
3983 pr " struct guestfs_statvfs *r;\n"; "NULL"
3990 pr " caml_enter_blocking_section ();\n";
3991 pr " r = guestfs_%s " name;
3992 generate_call_args ~handle:"g" (snd style);
3994 pr " caml_leave_blocking_section ();\n";
3999 pr " ocaml_guestfs_free_strings (%s);\n" n;
4000 | String _ | OptString _ | Bool _ | Int _ | FileIn _ | FileOut _ -> ()
4003 pr " if (r == %s)\n" error_code;
4004 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
4007 (match fst style with
4008 | RErr -> pr " rv = Val_unit;\n"
4009 | RInt _ -> pr " rv = Val_int (r);\n"
4011 pr " rv = caml_copy_int64 (r);\n"
4012 | RBool _ -> pr " rv = Val_bool (r);\n"
4013 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
4015 pr " rv = caml_copy_string (r);\n";
4018 pr " rv = caml_copy_string_array ((const char **) r);\n";
4019 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
4022 pr " rv = caml_alloc (2, 0);\n";
4023 pr " Store_field (rv, 0, Val_int (r->i));\n";
4024 pr " Store_field (rv, 1, Val_bool (r->b));\n";
4025 pr " guestfs_free_int_bool (r);\n";
4027 pr " rv = copy_lvm_pv_list (r);\n";
4028 pr " guestfs_free_lvm_pv_list (r);\n";
4030 pr " rv = copy_lvm_vg_list (r);\n";
4031 pr " guestfs_free_lvm_vg_list (r);\n";
4033 pr " rv = copy_lvm_lv_list (r);\n";
4034 pr " guestfs_free_lvm_lv_list (r);\n";
4036 pr " rv = copy_stat (r);\n";
4039 pr " rv = copy_statvfs (r);\n";
4042 pr " rv = copy_table (r);\n";
4043 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
4047 pr " CAMLreturn (rv);\n";
4051 if List.length params > 5 then (
4052 pr "CAMLprim value\n";
4053 pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
4055 pr " return ocaml_guestfs_%s (argv[0]" name;
4056 iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
4063 and generate_ocaml_lvm_structure_decls () =
4066 pr "type lvm_%s = {\n" typ;
4069 | name, `String -> pr " %s : string;\n" name
4070 | name, `UUID -> pr " %s : string;\n" name
4071 | name, `Bytes -> pr " %s : int64;\n" name
4072 | name, `Int -> pr " %s : int64;\n" name
4073 | name, `OptPercent -> pr " %s : float option;\n" name
4077 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
4079 and generate_ocaml_stat_structure_decls () =
4082 pr "type %s = {\n" typ;
4085 | name, `Int -> pr " %s : int64;\n" name
4089 ) ["stat", stat_cols; "statvfs", statvfs_cols]
4091 and generate_ocaml_prototype ?(is_external = false) name style =
4092 if is_external then pr "external " else pr "val ";
4093 pr "%s : t -> " name;
4096 | String _ | FileIn _ | FileOut _ -> pr "string -> "
4097 | OptString _ -> pr "string option -> "
4098 | StringList _ -> pr "string array -> "
4099 | Bool _ -> pr "bool -> "
4100 | Int _ -> pr "int -> "
4102 (match fst style with
4103 | RErr -> pr "unit" (* all errors are turned into exceptions *)
4104 | RInt _ -> pr "int"
4105 | RInt64 _ -> pr "int64"
4106 | RBool _ -> pr "bool"
4107 | RConstString _ -> pr "string"
4108 | RString _ -> pr "string"
4109 | RStringList _ -> pr "string array"
4110 | RIntBool _ -> pr "int * bool"
4111 | RPVList _ -> pr "lvm_pv array"
4112 | RVGList _ -> pr "lvm_vg array"
4113 | RLVList _ -> pr "lvm_lv array"
4114 | RStat _ -> pr "stat"
4115 | RStatVFS _ -> pr "statvfs"
4116 | RHashtable _ -> pr "(string * string) list"
4118 if is_external then (
4120 if List.length (snd style) + 1 > 5 then
4121 pr "\"ocaml_guestfs_%s_byte\" " name;
4122 pr "\"ocaml_guestfs_%s\"" name
4126 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
4127 and generate_perl_xs () =
4128 generate_header CStyle LGPLv2;
4131 #include \"EXTERN.h\"
4135 #include <guestfs.h>
4138 #define PRId64 \"lld\"
4142 my_newSVll(long long val) {
4143 #ifdef USE_64_BIT_ALL
4144 return newSViv(val);
4148 len = snprintf(buf, 100, \"%%\" PRId64, val);
4149 return newSVpv(buf, len);
4154 #define PRIu64 \"llu\"
4158 my_newSVull(unsigned long long val) {
4159 #ifdef USE_64_BIT_ALL
4160 return newSVuv(val);
4164 len = snprintf(buf, 100, \"%%\" PRIu64, val);
4165 return newSVpv(buf, len);
4169 /* http://www.perlmonks.org/?node_id=680842 */
4171 XS_unpack_charPtrPtr (SV *arg) {
4176 if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV) {
4177 croak (\"array reference expected\");
4180 av = (AV *)SvRV (arg);
4181 ret = (char **)malloc (av_len (av) + 1 + 1);
4183 for (i = 0; i <= av_len (av); i++) {
4184 SV **elem = av_fetch (av, i, 0);
4186 if (!elem || !*elem)
4187 croak (\"missing element in list\");
4189 ret[i] = SvPV_nolen (*elem);
4197 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
4202 RETVAL = guestfs_create ();
4204 croak (\"could not create guestfs handle\");
4205 guestfs_set_error_handler (RETVAL, NULL, NULL);
4218 fun (name, style, _, _, _, _, _) ->
4219 (match fst style with
4220 | RErr -> pr "void\n"
4221 | RInt _ -> pr "SV *\n"
4222 | RInt64 _ -> pr "SV *\n"
4223 | RBool _ -> pr "SV *\n"
4224 | RConstString _ -> pr "SV *\n"
4225 | RString _ -> pr "SV *\n"
4228 | RPVList _ | RVGList _ | RLVList _
4229 | RStat _ | RStatVFS _
4231 pr "void\n" (* all lists returned implictly on the stack *)
4233 (* Call and arguments. *)
4235 generate_call_args ~handle:"g" (snd style);
4237 pr " guestfs_h *g;\n";
4240 | String n | FileIn n | FileOut n -> pr " char *%s;\n" n
4241 | OptString n -> pr " char *%s;\n" n
4242 | StringList n -> pr " char **%s;\n" n
4243 | Bool n -> pr " int %s;\n" n
4244 | Int n -> pr " int %s;\n" n
4247 let do_cleanups () =
4250 | String _ | OptString _ | Bool _ | Int _
4251 | FileIn _ | FileOut _ -> ()
4252 | StringList n -> pr " free (%s);\n" n
4257 (match fst style with
4262 pr " r = guestfs_%s " name;
4263 generate_call_args ~handle:"g" (snd style);
4266 pr " if (r == -1)\n";
4267 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4273 pr " %s = guestfs_%s " n name;
4274 generate_call_args ~handle:"g" (snd style);
4277 pr " if (%s == -1)\n" n;
4278 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4279 pr " RETVAL = newSViv (%s);\n" n;
4284 pr " int64_t %s;\n" n;
4286 pr " %s = guestfs_%s " n name;
4287 generate_call_args ~handle:"g" (snd style);
4290 pr " if (%s == -1)\n" n;
4291 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4292 pr " RETVAL = my_newSVll (%s);\n" n;
4297 pr " const char *%s;\n" n;
4299 pr " %s = guestfs_%s " n name;
4300 generate_call_args ~handle:"g" (snd style);
4303 pr " if (%s == NULL)\n" n;
4304 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4305 pr " RETVAL = newSVpv (%s, 0);\n" n;
4310 pr " char *%s;\n" n;
4312 pr " %s = guestfs_%s " n name;
4313 generate_call_args ~handle:"g" (snd style);
4316 pr " if (%s == NULL)\n" n;
4317 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4318 pr " RETVAL = newSVpv (%s, 0);\n" n;
4319 pr " free (%s);\n" n;
4322 | RStringList n | RHashtable n ->
4324 pr " char **%s;\n" n;
4327 pr " %s = guestfs_%s " n name;
4328 generate_call_args ~handle:"g" (snd style);
4331 pr " if (%s == NULL)\n" n;
4332 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4333 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
4334 pr " EXTEND (SP, n);\n";
4335 pr " for (i = 0; i < n; ++i) {\n";
4336 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
4337 pr " free (%s[i]);\n" n;
4339 pr " free (%s);\n" n;
4342 pr " struct guestfs_int_bool *r;\n";
4344 pr " r = guestfs_%s " name;
4345 generate_call_args ~handle:"g" (snd style);
4348 pr " if (r == NULL)\n";
4349 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4350 pr " EXTEND (SP, 2);\n";
4351 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
4352 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
4353 pr " guestfs_free_int_bool (r);\n";
4355 generate_perl_lvm_code "pv" pv_cols name style n do_cleanups
4357 generate_perl_lvm_code "vg" vg_cols name style n do_cleanups
4359 generate_perl_lvm_code "lv" lv_cols name style n do_cleanups
4361 generate_perl_stat_code "stat" stat_cols name style n do_cleanups
4363 generate_perl_stat_code
4364 "statvfs" statvfs_cols name style n do_cleanups
4370 and generate_perl_lvm_code typ cols name style n do_cleanups =
4372 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
4376 pr " %s = guestfs_%s " n name;
4377 generate_call_args ~handle:"g" (snd style);
4380 pr " if (%s == NULL)\n" n;
4381 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4382 pr " EXTEND (SP, %s->len);\n" n;
4383 pr " for (i = 0; i < %s->len; ++i) {\n" n;
4384 pr " hv = newHV ();\n";
4388 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
4389 name (String.length name) n name
4391 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
4392 name (String.length name) n name
4394 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
4395 name (String.length name) n name
4397 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
4398 name (String.length name) n name
4399 | name, `OptPercent ->
4400 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
4401 name (String.length name) n name
4403 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
4405 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
4407 and generate_perl_stat_code typ cols name style n do_cleanups =
4409 pr " struct guestfs_%s *%s;\n" typ n;
4411 pr " %s = guestfs_%s " n name;
4412 generate_call_args ~handle:"g" (snd style);
4415 pr " if (%s == NULL)\n" n;
4416 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4417 pr " EXTEND (SP, %d);\n" (List.length cols);
4421 pr " PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n" n name
4423 pr " free (%s);\n" n
4425 (* Generate Sys/Guestfs.pm. *)
4426 and generate_perl_pm () =
4427 generate_header HashStyle LGPLv2;
4434 Sys::Guestfs - Perl bindings for libguestfs
4440 my $h = Sys::Guestfs->new ();
4441 $h->add_drive ('guest.img');
4444 $h->mount ('/dev/sda1', '/');
4445 $h->touch ('/hello');
4450 The C<Sys::Guestfs> module provides a Perl XS binding to the
4451 libguestfs API for examining and modifying virtual machine
4454 Amongst the things this is good for: making batch configuration
4455 changes to guests, getting disk used/free statistics (see also:
4456 virt-df), migrating between virtualization systems (see also:
4457 virt-p2v), performing partial backups, performing partial guest
4458 clones, cloning guests and changing registry/UUID/hostname info, and
4461 Libguestfs uses Linux kernel and qemu code, and can access any type of
4462 guest filesystem that Linux and qemu can, including but not limited
4463 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
4464 schemes, qcow, qcow2, vmdk.
4466 Libguestfs provides ways to enumerate guest storage (eg. partitions,
4467 LVs, what filesystem is in each LV, etc.). It can also run commands
4468 in the context of the guest. Also you can access filesystems over FTP.
4472 All errors turn into calls to C<croak> (see L<Carp(3)>).
4480 package Sys::Guestfs;
4486 XSLoader::load ('Sys::Guestfs');
4488 =item $h = Sys::Guestfs->new ();
4490 Create a new guestfs handle.
4496 my $class = ref ($proto) || $proto;
4498 my $self = Sys::Guestfs::_create ();
4499 bless $self, $class;
4505 (* Actions. We only need to print documentation for these as
4506 * they are pulled in from the XS code automatically.
4509 fun (name, style, _, flags, _, _, longdesc) ->
4510 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
4512 generate_perl_prototype name style;
4514 pr "%s\n\n" longdesc;
4515 if List.mem ProtocolLimitWarning flags then
4516 pr "%s\n\n" protocol_limit_warning;
4517 if List.mem DangerWillRobinson flags then
4518 pr "%s\n\n" danger_will_robinson
4519 ) all_functions_sorted;
4531 Copyright (C) 2009 Red Hat Inc.
4535 Please see the file COPYING.LIB for the full license.
4539 L<guestfs(3)>, L<guestfish(1)>.
4544 and generate_perl_prototype name style =
4545 (match fst style with
4551 | RString n -> pr "$%s = " n
4552 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
4556 | RLVList n -> pr "@%s = " n
4559 | RHashtable n -> pr "%%%s = " n
4562 let comma = ref false in
4565 if !comma then pr ", ";
4568 | String n | OptString n | Bool n | Int n | FileIn n | FileOut n ->
4575 (* Generate Python C module. *)
4576 and generate_python_c () =
4577 generate_header CStyle LGPLv2;
4586 #include \"guestfs.h\"
4594 get_handle (PyObject *obj)
4597 assert (obj != Py_None);
4598 return ((Pyguestfs_Object *) obj)->g;
4602 put_handle (guestfs_h *g)
4606 PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
4609 /* This list should be freed (but not the strings) after use. */
4610 static const char **
4611 get_string_list (PyObject *obj)
4618 if (!PyList_Check (obj)) {
4619 PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
4623 len = PyList_Size (obj);
4624 r = malloc (sizeof (char *) * (len+1));
4626 PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
4630 for (i = 0; i < len; ++i)
4631 r[i] = PyString_AsString (PyList_GetItem (obj, i));
4638 put_string_list (char * const * const argv)
4643 for (argc = 0; argv[argc] != NULL; ++argc)
4646 list = PyList_New (argc);
4647 for (i = 0; i < argc; ++i)
4648 PyList_SetItem (list, i, PyString_FromString (argv[i]));
4654 put_table (char * const * const argv)
4656 PyObject *list, *item;
4659 for (argc = 0; argv[argc] != NULL; ++argc)
4662 list = PyList_New (argc >> 1);
4663 for (i = 0; i < argc; i += 2) {
4664 item = PyTuple_New (2);
4665 PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
4666 PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
4667 PyList_SetItem (list, i >> 1, item);
4674 free_strings (char **argv)
4678 for (argc = 0; argv[argc] != NULL; ++argc)
4684 py_guestfs_create (PyObject *self, PyObject *args)
4688 g = guestfs_create ();
4690 PyErr_SetString (PyExc_RuntimeError,
4691 \"guestfs.create: failed to allocate handle\");
4694 guestfs_set_error_handler (g, NULL, NULL);
4695 return put_handle (g);
4699 py_guestfs_close (PyObject *self, PyObject *args)
4704 if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
4706 g = get_handle (py_g);
4710 Py_INCREF (Py_None);
4716 (* LVM structures, turned into Python dictionaries. *)
4719 pr "static PyObject *\n";
4720 pr "put_lvm_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
4722 pr " PyObject *dict;\n";
4724 pr " dict = PyDict_New ();\n";
4728 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4729 pr " PyString_FromString (%s->%s));\n"
4732 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4733 pr " PyString_FromStringAndSize (%s->%s, 32));\n"
4736 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4737 pr " PyLong_FromUnsignedLongLong (%s->%s));\n"
4740 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4741 pr " PyLong_FromLongLong (%s->%s));\n"
4743 | name, `OptPercent ->
4744 pr " if (%s->%s >= 0)\n" typ name;
4745 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4746 pr " PyFloat_FromDouble ((double) %s->%s));\n"
4749 pr " Py_INCREF (Py_None);\n";
4750 pr " PyDict_SetItemString (dict, \"%s\", Py_None);" name;
4753 pr " return dict;\n";
4757 pr "static PyObject *\n";
4758 pr "put_lvm_%s_list (struct guestfs_lvm_%s_list *%ss)\n" typ typ typ;
4760 pr " PyObject *list;\n";
4763 pr " list = PyList_New (%ss->len);\n" typ;
4764 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
4765 pr " PyList_SetItem (list, i, put_lvm_%s (&%ss->val[i]));\n" typ typ;
4766 pr " return list;\n";
4769 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
4771 (* Stat structures, turned into Python dictionaries. *)
4774 pr "static PyObject *\n";
4775 pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
4777 pr " PyObject *dict;\n";
4779 pr " dict = PyDict_New ();\n";
4783 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4784 pr " PyLong_FromLongLong (%s->%s));\n"
4787 pr " return dict;\n";
4790 ) ["stat", stat_cols; "statvfs", statvfs_cols];
4792 (* Python wrapper functions. *)
4794 fun (name, style, _, _, _, _, _) ->
4795 pr "static PyObject *\n";
4796 pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
4799 pr " PyObject *py_g;\n";
4800 pr " guestfs_h *g;\n";
4801 pr " PyObject *py_r;\n";
4804 match fst style with
4805 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
4806 | RInt64 _ -> pr " int64_t r;\n"; "-1"
4807 | RConstString _ -> pr " const char *r;\n"; "NULL"
4808 | RString _ -> pr " char *r;\n"; "NULL"
4809 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
4810 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
4811 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
4812 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
4813 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
4814 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
4815 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
4819 | String n | FileIn n | FileOut n -> pr " const char *%s;\n" n
4820 | OptString n -> pr " const char *%s;\n" n
4822 pr " PyObject *py_%s;\n" n;
4823 pr " const char **%s;\n" n
4824 | Bool n -> pr " int %s;\n" n
4825 | Int n -> pr " int %s;\n" n
4830 (* Convert the parameters. *)
4831 pr " if (!PyArg_ParseTuple (args, (char *) \"O";
4834 | String _ | FileIn _ | FileOut _ -> pr "s"
4835 | OptString _ -> pr "z"
4836 | StringList _ -> pr "O"
4837 | Bool _ -> pr "i" (* XXX Python has booleans? *)
4840 pr ":guestfs_%s\",\n" name;
4844 | String n | FileIn n | FileOut n -> pr ", &%s" n
4845 | OptString n -> pr ", &%s" n
4846 | StringList n -> pr ", &py_%s" n
4847 | Bool n -> pr ", &%s" n
4848 | Int n -> pr ", &%s" n
4852 pr " return NULL;\n";
4854 pr " g = get_handle (py_g);\n";
4857 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
4859 pr " %s = get_string_list (py_%s);\n" n n;
4860 pr " if (!%s) return NULL;\n" n
4865 pr " r = guestfs_%s " name;
4866 generate_call_args ~handle:"g" (snd style);
4871 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
4873 pr " free (%s);\n" n
4876 pr " if (r == %s) {\n" error_code;
4877 pr " PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
4878 pr " return NULL;\n";
4882 (match fst style with
4884 pr " Py_INCREF (Py_None);\n";
4885 pr " py_r = Py_None;\n"
4887 | RBool _ -> pr " py_r = PyInt_FromLong ((long) r);\n"
4888 | RInt64 _ -> pr " py_r = PyLong_FromLongLong (r);\n"
4889 | RConstString _ -> pr " py_r = PyString_FromString (r);\n"
4891 pr " py_r = PyString_FromString (r);\n";
4894 pr " py_r = put_string_list (r);\n";
4895 pr " free_strings (r);\n"
4897 pr " py_r = PyTuple_New (2);\n";
4898 pr " PyTuple_SetItem (py_r, 0, PyInt_FromLong ((long) r->i));\n";
4899 pr " PyTuple_SetItem (py_r, 1, PyInt_FromLong ((long) r->b));\n";
4900 pr " guestfs_free_int_bool (r);\n"
4902 pr " py_r = put_lvm_pv_list (r);\n";
4903 pr " guestfs_free_lvm_pv_list (r);\n"
4905 pr " py_r = put_lvm_vg_list (r);\n";
4906 pr " guestfs_free_lvm_vg_list (r);\n"
4908 pr " py_r = put_lvm_lv_list (r);\n";
4909 pr " guestfs_free_lvm_lv_list (r);\n"
4911 pr " py_r = put_stat (r);\n";
4914 pr " py_r = put_statvfs (r);\n";
4917 pr " py_r = put_table (r);\n";
4918 pr " free_strings (r);\n"
4921 pr " return py_r;\n";
4926 (* Table of functions. *)
4927 pr "static PyMethodDef methods[] = {\n";
4928 pr " { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
4929 pr " { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
4931 fun (name, _, _, _, _, _, _) ->
4932 pr " { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
4935 pr " { NULL, NULL, 0, NULL }\n";
4939 (* Init function. *)
4942 initlibguestfsmod (void)
4944 static int initialized = 0;
4946 if (initialized) return;
4947 Py_InitModule ((char *) \"libguestfsmod\", methods);
4952 (* Generate Python module. *)
4953 and generate_python_py () =
4954 generate_header HashStyle LGPLv2;
4957 u\"\"\"Python bindings for libguestfs
4960 g = guestfs.GuestFS ()
4961 g.add_drive (\"guest.img\")
4964 parts = g.list_partitions ()
4966 The guestfs module provides a Python binding to the libguestfs API
4967 for examining and modifying virtual machine disk images.
4969 Amongst the things this is good for: making batch configuration
4970 changes to guests, getting disk used/free statistics (see also:
4971 virt-df), migrating between virtualization systems (see also:
4972 virt-p2v), performing partial backups, performing partial guest
4973 clones, cloning guests and changing registry/UUID/hostname info, and
4976 Libguestfs uses Linux kernel and qemu code, and can access any type of
4977 guest filesystem that Linux and qemu can, including but not limited
4978 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
4979 schemes, qcow, qcow2, vmdk.
4981 Libguestfs provides ways to enumerate guest storage (eg. partitions,
4982 LVs, what filesystem is in each LV, etc.). It can also run commands
4983 in the context of the guest. Also you can access filesystems over FTP.
4985 Errors which happen while using the API are turned into Python
4986 RuntimeError exceptions.
4988 To create a guestfs handle you usually have to perform the following
4991 # Create the handle, call add_drive at least once, and possibly
4992 # several times if the guest has multiple block devices:
4993 g = guestfs.GuestFS ()
4994 g.add_drive (\"guest.img\")
4996 # Launch the qemu subprocess and wait for it to become ready:
5000 # Now you can issue commands, for example:
5005 import libguestfsmod
5008 \"\"\"Instances of this class are libguestfs API handles.\"\"\"
5010 def __init__ (self):
5011 \"\"\"Create a new libguestfs handle.\"\"\"
5012 self._o = libguestfsmod.create ()
5015 libguestfsmod.close (self._o)
5020 fun (name, style, _, flags, _, _, longdesc) ->
5021 let doc = replace_str longdesc "C<guestfs_" "C<g." in
5023 match fst style with
5024 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _
5027 doc ^ "\n\nThis function returns a list of strings."
5029 doc ^ "\n\nThis function returns a tuple (int, bool).\n"
5031 doc ^ "\n\nThis function returns a list of PVs. Each PV is represented as a dictionary."
5033 doc ^ "\n\nThis function returns a list of VGs. Each VG is represented as a dictionary."
5035 doc ^ "\n\nThis function returns a list of LVs. Each LV is represented as a dictionary."
5037 doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the stat structure."
5039 doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the statvfs structure."
5041 doc ^ "\n\nThis function returns a dictionary." in
5043 if List.mem ProtocolLimitWarning flags then
5044 doc ^ "\n\n" ^ protocol_limit_warning
5047 if List.mem DangerWillRobinson flags then
5048 doc ^ "\n\n" ^ danger_will_robinson
5050 let doc = pod2text ~width:60 name doc in
5051 let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
5052 let doc = String.concat "\n " doc in
5055 generate_call_args ~handle:"self" (snd style);
5057 pr " u\"\"\"%s\"\"\"\n" doc;
5058 pr " return libguestfsmod.%s " name;
5059 generate_call_args ~handle:"self._o" (snd style);
5064 (* Useful if you need the longdesc POD text as plain text. Returns a
5067 and pod2text ~width name longdesc =
5068 let filename, chan = Filename.open_temp_file "gen" ".tmp" in
5069 fprintf chan "=head1 %s\n\n%s\n" name longdesc;
5071 let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
5072 let chan = Unix.open_process_in cmd in
5073 let lines = ref [] in
5075 let line = input_line chan in
5076 if i = 1 then (* discard the first line of output *)
5079 let line = triml line in
5080 lines := line :: !lines;
5083 let lines = try loop 1 with End_of_file -> List.rev !lines in
5084 Unix.unlink filename;
5085 match Unix.close_process_in chan with
5086 | Unix.WEXITED 0 -> lines
5088 failwithf "pod2text: process exited with non-zero status (%d)" i
5089 | Unix.WSIGNALED i | Unix.WSTOPPED i ->
5090 failwithf "pod2text: process signalled or stopped by signal %d" i
5092 (* Generate ruby bindings. *)
5093 and generate_ruby_c () =
5094 generate_header CStyle LGPLv2;
5102 #include \"guestfs.h\"
5104 #include \"extconf.h\"
5106 static VALUE m_guestfs; /* guestfs module */
5107 static VALUE c_guestfs; /* guestfs_h handle */
5108 static VALUE e_Error; /* used for all errors */
5110 static void ruby_guestfs_free (void *p)
5113 guestfs_close ((guestfs_h *) p);
5116 static VALUE ruby_guestfs_create (VALUE m)
5120 g = guestfs_create ();
5122 rb_raise (e_Error, \"failed to create guestfs handle\");
5124 /* Don't print error messages to stderr by default. */
5125 guestfs_set_error_handler (g, NULL, NULL);
5127 /* Wrap it, and make sure the close function is called when the
5130 return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
5133 static VALUE ruby_guestfs_close (VALUE gv)
5136 Data_Get_Struct (gv, guestfs_h, g);
5138 ruby_guestfs_free (g);
5139 DATA_PTR (gv) = NULL;
5147 fun (name, style, _, _, _, _, _) ->
5148 pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
5149 List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
5152 pr " guestfs_h *g;\n";
5153 pr " Data_Get_Struct (gv, guestfs_h, g);\n";
5155 pr " rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
5161 | String n | FileIn n | FileOut n ->
5162 pr " const char *%s = StringValueCStr (%sv);\n" n n;
5164 pr " rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
5165 pr " \"%s\", \"%s\");\n" n name
5167 pr " const char *%s = StringValueCStr (%sv);\n" n n
5171 pr " int i, len;\n";
5172 pr " len = RARRAY_LEN (%sv);\n" n;
5173 pr " %s = malloc (sizeof (char *) * (len+1));\n" n;
5174 pr " for (i = 0; i < len; ++i) {\n";
5175 pr " VALUE v = rb_ary_entry (%sv, i);\n" n;
5176 pr " %s[i] = StringValueCStr (v);\n" n;
5181 pr " int %s = NUM2INT (%sv);\n" n n
5186 match fst style with
5187 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
5188 | RInt64 _ -> pr " int64_t r;\n"; "-1"
5189 | RConstString _ -> pr " const char *r;\n"; "NULL"
5190 | RString _ -> pr " char *r;\n"; "NULL"
5191 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
5192 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
5193 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
5194 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
5195 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
5196 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
5197 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
5200 pr " r = guestfs_%s " name;
5201 generate_call_args ~handle:"g" (snd style);
5206 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
5208 pr " free (%s);\n" n
5211 pr " if (r == %s)\n" error_code;
5212 pr " rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
5215 (match fst style with
5217 pr " return Qnil;\n"
5218 | RInt _ | RBool _ ->
5219 pr " return INT2NUM (r);\n"
5221 pr " return ULL2NUM (r);\n"
5223 pr " return rb_str_new2 (r);\n";
5225 pr " VALUE rv = rb_str_new2 (r);\n";
5229 pr " int i, len = 0;\n";
5230 pr " for (i = 0; r[i] != NULL; ++i) len++;\n";
5231 pr " VALUE rv = rb_ary_new2 (len);\n";
5232 pr " for (i = 0; r[i] != NULL; ++i) {\n";
5233 pr " rb_ary_push (rv, rb_str_new2 (r[i]));\n";
5234 pr " free (r[i]);\n";
5239 pr " VALUE rv = rb_ary_new2 (2);\n";
5240 pr " rb_ary_push (rv, INT2NUM (r->i));\n";
5241 pr " rb_ary_push (rv, INT2NUM (r->b));\n";
5242 pr " guestfs_free_int_bool (r);\n";
5245 generate_ruby_lvm_code "pv" pv_cols
5247 generate_ruby_lvm_code "vg" vg_cols
5249 generate_ruby_lvm_code "lv" lv_cols
5251 pr " VALUE rv = rb_hash_new ();\n";
5255 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
5260 pr " VALUE rv = rb_hash_new ();\n";
5264 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
5269 pr " VALUE rv = rb_hash_new ();\n";
5271 pr " for (i = 0; r[i] != NULL; i+=2) {\n";
5272 pr " rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
5273 pr " free (r[i]);\n";
5274 pr " free (r[i+1]);\n";
5285 /* Initialize the module. */
5286 void Init__guestfs ()
5288 m_guestfs = rb_define_module (\"Guestfs\");
5289 c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
5290 e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
5292 rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
5293 rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
5296 (* Define the rest of the methods. *)
5298 fun (name, style, _, _, _, _, _) ->
5299 pr " rb_define_method (c_guestfs, \"%s\",\n" name;
5300 pr " ruby_guestfs_%s, %d);\n" name (List.length (snd style))
5305 (* Ruby code to return an LVM struct list. *)
5306 and generate_ruby_lvm_code typ cols =
5307 pr " VALUE rv = rb_ary_new2 (r->len);\n";
5309 pr " for (i = 0; i < r->len; ++i) {\n";
5310 pr " VALUE hv = rb_hash_new ();\n";
5314 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
5316 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
5319 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
5320 | name, `OptPercent ->
5321 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
5323 pr " rb_ary_push (rv, hv);\n";
5325 pr " guestfs_free_lvm_%s_list (r);\n" typ;
5328 let output_to filename =
5329 let filename_new = filename ^ ".new" in
5330 chan := open_out filename_new;
5334 Unix.rename filename_new filename;
5335 printf "written %s\n%!" filename;
5343 if not (Sys.file_exists "configure.ac") then (
5345 You are probably running this from the wrong directory.
5346 Run it from the top source directory using the command
5352 let close = output_to "src/guestfs_protocol.x" in
5356 let close = output_to "src/guestfs-structs.h" in
5357 generate_structs_h ();
5360 let close = output_to "src/guestfs-actions.h" in
5361 generate_actions_h ();
5364 let close = output_to "src/guestfs-actions.c" in
5365 generate_client_actions ();
5368 let close = output_to "daemon/actions.h" in
5369 generate_daemon_actions_h ();
5372 let close = output_to "daemon/stubs.c" in
5373 generate_daemon_actions ();
5376 let close = output_to "tests.c" in
5380 let close = output_to "fish/cmds.c" in
5381 generate_fish_cmds ();
5384 let close = output_to "fish/completion.c" in
5385 generate_fish_completion ();
5388 let close = output_to "guestfs-structs.pod" in
5389 generate_structs_pod ();
5392 let close = output_to "guestfs-actions.pod" in
5393 generate_actions_pod ();
5396 let close = output_to "guestfish-actions.pod" in
5397 generate_fish_actions_pod ();
5400 let close = output_to "ocaml/guestfs.mli" in
5401 generate_ocaml_mli ();
5404 let close = output_to "ocaml/guestfs.ml" in
5405 generate_ocaml_ml ();
5408 let close = output_to "ocaml/guestfs_c_actions.c" in
5409 generate_ocaml_c ();
5412 let close = output_to "perl/Guestfs.xs" in
5413 generate_perl_xs ();
5416 let close = output_to "perl/lib/Sys/Guestfs.pm" in
5417 generate_perl_pm ();
5420 let close = output_to "python/guestfs-py.c" in
5421 generate_python_c ();
5424 let close = output_to "python/guestfs.py" in
5425 generate_python_py ();
5428 let close = output_to "ruby/ext/guestfs/_guestfs.c" in