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) *)
103 | ProtocolLimitWarning (* display warning about protocol size limits *)
104 | DangerWillRobinson (* flags particularly dangerous commands *)
105 | FishAlias of string (* provide an alias for this cmd in guestfish *)
106 | FishAction of string (* call this function in guestfish *)
107 | NotInFish (* do not export via guestfish *)
109 let protocol_limit_warning =
110 "Because of the message protocol, there is a transfer limit
111 of somewhere between 2MB and 4MB. To transfer large files you should use
114 let danger_will_robinson =
115 "B<This command is dangerous. Without careful use you
116 can easily destroy all your data>."
118 (* You can supply zero or as many tests as you want per API call.
120 * Note that the test environment has 3 block devices, of size 500MB,
121 * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc).
122 * Note for partitioning purposes, the 500MB device has 63 cylinders.
124 * To be able to run the tests in a reasonable amount of time,
125 * the virtual machine and block devices are reused between tests.
126 * So don't try testing kill_subprocess :-x
128 * Between each test we umount-all and lvm-remove-all (except InitNone).
130 * Don't assume anything about the previous contents of the block
131 * devices. Use 'Init*' to create some initial scenarios.
133 type tests = (test_init * test) list
135 (* Run the command sequence and just expect nothing to fail. *)
137 (* Run the command sequence and expect the output of the final
138 * command to be the string.
140 | TestOutput of seq * string
141 (* Run the command sequence and expect the output of the final
142 * command to be the list of strings.
144 | TestOutputList of seq * string list
145 (* Run the command sequence and expect the output of the final
146 * command to be the integer.
148 | TestOutputInt of seq * int
149 (* Run the command sequence and expect the output of the final
150 * command to be a true value (!= 0 or != NULL).
152 | TestOutputTrue of seq
153 (* Run the command sequence and expect the output of the final
154 * command to be a false value (== 0 or == NULL, but not an error).
156 | TestOutputFalse of seq
157 (* Run the command sequence and expect the output of the final
158 * command to be a list of the given length (but don't care about
161 | TestOutputLength of seq * int
162 (* Run the command sequence and expect the output of the final
163 * command to be a structure.
165 | TestOutputStruct of seq * test_field_compare list
166 (* Run the command sequence and expect the final command (only)
169 | TestLastFail of seq
171 and test_field_compare =
172 | CompareWithInt of string * int
173 | CompareWithString of string * string
174 | CompareFieldsIntEq of string * string
175 | CompareFieldsStrEq of string * string
177 (* Some initial scenarios for testing. *)
179 (* Do nothing, block devices could contain random stuff including
180 * LVM PVs, and some filesystems might be mounted. This is usually
184 (* Block devices are empty and no filesystems are mounted. *)
186 (* /dev/sda contains a single partition /dev/sda1, which is formatted
187 * as ext2, empty [except for lost+found] and mounted on /.
188 * /dev/sdb and /dev/sdc may have random content.
193 * /dev/sda1 (is a PV):
194 * /dev/VG/LV (size 8MB):
195 * formatted as ext2, empty [except for lost+found], mounted on /
196 * /dev/sdb and /dev/sdc may have random content.
200 (* Sequence of commands for testing. *)
202 and cmd = string list
204 (* Note about long descriptions: When referring to another
205 * action, use the format C<guestfs_other> (ie. the full name of
206 * the C function). This will be replaced as appropriate in other
209 * Apart from that, long descriptions are just perldoc paragraphs.
212 let non_daemon_functions = [
213 ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
215 "launch the qemu subprocess",
217 Internally libguestfs is implemented by running a virtual machine
220 You should call this after configuring the handle
221 (eg. adding drives) but before performing any actions.");
223 ("wait_ready", (RErr, []), -1, [NotInFish],
225 "wait until the qemu subprocess launches",
227 Internally libguestfs is implemented by running a virtual machine
230 You should call this after C<guestfs_launch> to wait for the launch
233 ("kill_subprocess", (RErr, []), -1, [],
235 "kill the qemu subprocess",
237 This kills the qemu subprocess. You should never need to call this.");
239 ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
241 "add an image to examine or modify",
243 This function adds a virtual machine disk image C<filename> to the
244 guest. The first time you call this function, the disk appears as IDE
245 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
248 You don't necessarily need to be root when using libguestfs. However
249 you obviously do need sufficient permissions to access the filename
250 for whatever operations you want to perform (ie. read access if you
251 just want to read the image or write access if you want to modify the
254 This is equivalent to the qemu parameter C<-drive file=filename>.");
256 ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
258 "add a CD-ROM disk image to examine",
260 This function adds a virtual CD-ROM disk image to the guest.
262 This is equivalent to the qemu parameter C<-cdrom filename>.");
264 ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
266 "add qemu parameters",
268 This can be used to add arbitrary qemu command line parameters
269 of the form C<-param value>. Actually it's not quite arbitrary - we
270 prevent you from setting some parameters which would interfere with
271 parameters that we use.
273 The first character of C<param> string must be a C<-> (dash).
275 C<value> can be NULL.");
277 ("set_path", (RErr, [String "path"]), -1, [FishAlias "path"],
279 "set the search path",
281 Set the path that libguestfs searches for kernel and initrd.img.
283 The default is C<$libdir/guestfs> unless overridden by setting
284 C<LIBGUESTFS_PATH> environment variable.
286 The string C<path> is stashed in the libguestfs handle, so the caller
287 must make sure it remains valid for the lifetime of the handle.
289 Setting C<path> to C<NULL> restores the default path.");
291 ("get_path", (RConstString "path", []), -1, [],
293 "get the search path",
295 Return the current search path.
297 This is always non-NULL. If it wasn't set already, then this will
298 return the default path.");
300 ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
304 If C<autosync> is true, this enables autosync. Libguestfs will make a
305 best effort attempt to run C<guestfs_sync> when the handle is closed
306 (also if the program exits without closing handles).");
308 ("get_autosync", (RBool "autosync", []), -1, [],
312 Get the autosync flag.");
314 ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
318 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
320 Verbose messages are disabled unless the environment variable
321 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
323 ("get_verbose", (RBool "verbose", []), -1, [],
327 This returns the verbose messages flag.")
330 let daemon_functions = [
331 ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
332 [InitEmpty, TestOutput (
333 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
334 ["mkfs"; "ext2"; "/dev/sda1"];
335 ["mount"; "/dev/sda1"; "/"];
336 ["write_file"; "/new"; "new file contents"; "0"];
337 ["cat"; "/new"]], "new file contents")],
338 "mount a guest disk at a position in the filesystem",
340 Mount a guest disk at a position in the filesystem. Block devices
341 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
342 the guest. If those block devices contain partitions, they will have
343 the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
346 The rules are the same as for L<mount(2)>: A filesystem must
347 first be mounted on C</> before others can be mounted. Other
348 filesystems can only be mounted on directories which already
351 The mounted filesystem is writable, if we have sufficient permissions
352 on the underlying device.
354 The filesystem options C<sync> and C<noatime> are set with this
355 call, in order to improve reliability.");
357 ("sync", (RErr, []), 2, [],
358 [ InitEmpty, TestRun [["sync"]]],
359 "sync disks, writes are flushed through to the disk image",
361 This syncs the disk, so that any writes are flushed through to the
362 underlying disk image.
364 You should always call this if you have modified a disk image, before
365 closing the handle.");
367 ("touch", (RErr, [String "path"]), 3, [],
368 [InitBasicFS, TestOutputTrue (
370 ["exists"; "/new"]])],
371 "update file timestamps or create a new file",
373 Touch acts like the L<touch(1)> command. It can be used to
374 update the timestamps on a file, or, if the file does not exist,
375 to create a new zero-length file.");
377 ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
378 [InitBasicFS, TestOutput (
379 [["write_file"; "/new"; "new file contents"; "0"];
380 ["cat"; "/new"]], "new file contents")],
381 "list the contents of a file",
383 Return the contents of the file named C<path>.
385 Note that this function cannot correctly handle binary files
386 (specifically, files containing C<\\0> character which is treated
387 as end of string). For those you need to use the C<guestfs_read_file>
388 function which has a more complex interface.");
390 ("ll", (RString "listing", [String "directory"]), 5, [],
391 [], (* XXX Tricky to test because it depends on the exact format
392 * of the 'ls -l' command, which changes between F10 and F11.
394 "list the files in a directory (long format)",
396 List the files in C<directory> (relative to the root directory,
397 there is no cwd) in the format of 'ls -la'.
399 This command is mostly useful for interactive sessions. It
400 is I<not> intended that you try to parse the output string.");
402 ("ls", (RStringList "listing", [String "directory"]), 6, [],
403 [InitBasicFS, TestOutputList (
406 ["touch"; "/newest"];
407 ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
408 "list the files in a directory",
410 List the files in C<directory> (relative to the root directory,
411 there is no cwd). The '.' and '..' entries are not returned, but
412 hidden files are shown.
414 This command is mostly useful for interactive sessions. Programs
415 should probably use C<guestfs_readdir> instead.");
417 ("list_devices", (RStringList "devices", []), 7, [],
418 [InitEmpty, TestOutputList (
419 [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"])],
420 "list the block devices",
422 List all the block devices.
424 The full block device names are returned, eg. C</dev/sda>");
426 ("list_partitions", (RStringList "partitions", []), 8, [],
427 [InitBasicFS, TestOutputList (
428 [["list_partitions"]], ["/dev/sda1"]);
429 InitEmpty, TestOutputList (
430 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
431 ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
432 "list the partitions",
434 List all the partitions detected on all block devices.
436 The full partition device names are returned, eg. C</dev/sda1>
438 This does not return logical volumes. For that you will need to
439 call C<guestfs_lvs>.");
441 ("pvs", (RStringList "physvols", []), 9, [],
442 [InitBasicFSonLVM, TestOutputList (
443 [["pvs"]], ["/dev/sda1"]);
444 InitEmpty, TestOutputList (
445 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
446 ["pvcreate"; "/dev/sda1"];
447 ["pvcreate"; "/dev/sda2"];
448 ["pvcreate"; "/dev/sda3"];
449 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
450 "list the LVM physical volumes (PVs)",
452 List all the physical volumes detected. This is the equivalent
453 of the L<pvs(8)> command.
455 This returns a list of just the device names that contain
456 PVs (eg. C</dev/sda2>).
458 See also C<guestfs_pvs_full>.");
460 ("vgs", (RStringList "volgroups", []), 10, [],
461 [InitBasicFSonLVM, TestOutputList (
463 InitEmpty, TestOutputList (
464 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
465 ["pvcreate"; "/dev/sda1"];
466 ["pvcreate"; "/dev/sda2"];
467 ["pvcreate"; "/dev/sda3"];
468 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
469 ["vgcreate"; "VG2"; "/dev/sda3"];
470 ["vgs"]], ["VG1"; "VG2"])],
471 "list the LVM volume groups (VGs)",
473 List all the volumes groups detected. This is the equivalent
474 of the L<vgs(8)> command.
476 This returns a list of just the volume group names that were
477 detected (eg. C<VolGroup00>).
479 See also C<guestfs_vgs_full>.");
481 ("lvs", (RStringList "logvols", []), 11, [],
482 [InitBasicFSonLVM, TestOutputList (
483 [["lvs"]], ["/dev/VG/LV"]);
484 InitEmpty, TestOutputList (
485 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
486 ["pvcreate"; "/dev/sda1"];
487 ["pvcreate"; "/dev/sda2"];
488 ["pvcreate"; "/dev/sda3"];
489 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
490 ["vgcreate"; "VG2"; "/dev/sda3"];
491 ["lvcreate"; "LV1"; "VG1"; "50"];
492 ["lvcreate"; "LV2"; "VG1"; "50"];
493 ["lvcreate"; "LV3"; "VG2"; "50"];
494 ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
495 "list the LVM logical volumes (LVs)",
497 List all the logical volumes detected. This is the equivalent
498 of the L<lvs(8)> command.
500 This returns a list of the logical volume device names
501 (eg. C</dev/VolGroup00/LogVol00>).
503 See also C<guestfs_lvs_full>.");
505 ("pvs_full", (RPVList "physvols", []), 12, [],
506 [], (* XXX how to test? *)
507 "list the LVM physical volumes (PVs)",
509 List all the physical volumes detected. This is the equivalent
510 of the L<pvs(8)> command. The \"full\" version includes all fields.");
512 ("vgs_full", (RVGList "volgroups", []), 13, [],
513 [], (* XXX how to test? *)
514 "list the LVM volume groups (VGs)",
516 List all the volumes groups detected. This is the equivalent
517 of the L<vgs(8)> command. The \"full\" version includes all fields.");
519 ("lvs_full", (RLVList "logvols", []), 14, [],
520 [], (* XXX how to test? *)
521 "list the LVM logical volumes (LVs)",
523 List all the logical volumes detected. This is the equivalent
524 of the L<lvs(8)> command. The \"full\" version includes all fields.");
526 ("read_lines", (RStringList "lines", [String "path"]), 15, [],
527 [InitBasicFS, TestOutputList (
528 [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
529 ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);
530 InitBasicFS, TestOutputList (
531 [["write_file"; "/new"; ""; "0"];
532 ["read_lines"; "/new"]], [])],
533 "read file as lines",
535 Return the contents of the file named C<path>.
537 The file contents are returned as a list of lines. Trailing
538 C<LF> and C<CRLF> character sequences are I<not> returned.
540 Note that this function cannot correctly handle binary files
541 (specifically, files containing C<\\0> character which is treated
542 as end of line). For those you need to use the C<guestfs_read_file>
543 function which has a more complex interface.");
545 ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [],
546 [], (* XXX Augeas code needs tests. *)
547 "create a new Augeas handle",
549 Create a new Augeas handle for editing configuration files.
550 If there was any previous Augeas handle associated with this
551 guestfs session, then it is closed.
553 You must call this before using any other C<guestfs_aug_*>
556 C<root> is the filesystem root. C<root> must not be NULL,
559 The flags are the same as the flags defined in
560 E<lt>augeas.hE<gt>, the logical I<or> of the following
565 =item C<AUG_SAVE_BACKUP> = 1
567 Keep the original file with a C<.augsave> extension.
569 =item C<AUG_SAVE_NEWFILE> = 2
571 Save changes into a file with extension C<.augnew>, and
572 do not overwrite original. Overrides C<AUG_SAVE_BACKUP>.
574 =item C<AUG_TYPE_CHECK> = 4
576 Typecheck lenses (can be expensive).
578 =item C<AUG_NO_STDINC> = 8
580 Do not use standard load path for modules.
582 =item C<AUG_SAVE_NOOP> = 16
584 Make save a no-op, just record what would have been changed.
586 =item C<AUG_NO_LOAD> = 32
588 Do not load the tree in C<guestfs_aug_init>.
592 To close the handle, you can call C<guestfs_aug_close>.
594 To find out more about Augeas, see L<http://augeas.net/>.");
596 ("aug_close", (RErr, []), 26, [],
597 [], (* XXX Augeas code needs tests. *)
598 "close the current Augeas handle",
600 Close the current Augeas handle and free up any resources
601 used by it. After calling this, you have to call
602 C<guestfs_aug_init> again before you can use any other
605 ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
606 [], (* XXX Augeas code needs tests. *)
607 "define an Augeas variable",
609 Defines an Augeas variable C<name> whose value is the result
610 of evaluating C<expr>. If C<expr> is NULL, then C<name> is
613 On success this returns the number of nodes in C<expr>, or
614 C<0> if C<expr> evaluates to something which is not a nodeset.");
616 ("aug_defnode", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [],
617 [], (* XXX Augeas code needs tests. *)
618 "define an Augeas node",
620 Defines a variable C<name> whose value is the result of
623 If C<expr> evaluates to an empty nodeset, a node is created,
624 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
625 C<name> will be the nodeset containing that single node.
627 On success this returns a pair containing the
628 number of nodes in the nodeset, and a boolean flag
629 if a node was created.");
631 ("aug_get", (RString "val", [String "path"]), 19, [],
632 [], (* XXX Augeas code needs tests. *)
633 "look up the value of an Augeas path",
635 Look up the value associated with C<path>. If C<path>
636 matches exactly one node, the C<value> is returned.");
638 ("aug_set", (RErr, [String "path"; String "val"]), 20, [],
639 [], (* XXX Augeas code needs tests. *)
640 "set Augeas path to value",
642 Set the value associated with C<path> to C<value>.");
644 ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [],
645 [], (* XXX Augeas code needs tests. *)
646 "insert a sibling Augeas node",
648 Create a new sibling C<label> for C<path>, inserting it into
649 the tree before or after C<path> (depending on the boolean
652 C<path> must match exactly one existing node in the tree, and
653 C<label> must be a label, ie. not contain C</>, C<*> or end
654 with a bracketed index C<[N]>.");
656 ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
657 [], (* XXX Augeas code needs tests. *)
658 "remove an Augeas path",
660 Remove C<path> and all of its children.
662 On success this returns the number of entries which were removed.");
664 ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [],
665 [], (* XXX Augeas code needs tests. *)
668 Move the node C<src> to C<dest>. C<src> must match exactly
669 one node. C<dest> is overwritten if it exists.");
671 ("aug_match", (RStringList "matches", [String "path"]), 24, [],
672 [], (* XXX Augeas code needs tests. *)
673 "return Augeas nodes which match path",
675 Returns a list of paths which match the path expression C<path>.
676 The returned paths are sufficiently qualified so that they match
677 exactly one node in the current tree.");
679 ("aug_save", (RErr, []), 25, [],
680 [], (* XXX Augeas code needs tests. *)
681 "write all pending Augeas changes to disk",
683 This writes all pending changes to disk.
685 The flags which were passed to C<guestfs_aug_init> affect exactly
686 how files are saved.");
688 ("aug_load", (RErr, []), 27, [],
689 [], (* XXX Augeas code needs tests. *)
690 "load files into the tree",
692 Load files into the tree.
694 See C<aug_load> in the Augeas documentation for the full gory
697 ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
698 [], (* XXX Augeas code needs tests. *)
699 "list Augeas nodes under a path",
701 This is just a shortcut for listing C<guestfs_aug_match>
702 C<path/*> and sorting the resulting nodes into alphabetical order.");
704 ("rm", (RErr, [String "path"]), 29, [],
705 [InitBasicFS, TestRun
708 InitBasicFS, TestLastFail
710 InitBasicFS, TestLastFail
715 Remove the single file C<path>.");
717 ("rmdir", (RErr, [String "path"]), 30, [],
718 [InitBasicFS, TestRun
721 InitBasicFS, TestLastFail
723 InitBasicFS, TestLastFail
726 "remove a directory",
728 Remove the single directory C<path>.");
730 ("rm_rf", (RErr, [String "path"]), 31, [],
731 [InitBasicFS, TestOutputFalse
733 ["mkdir"; "/new/foo"];
734 ["touch"; "/new/foo/bar"];
736 ["exists"; "/new"]]],
737 "remove a file or directory recursively",
739 Remove the file or directory C<path>, recursively removing the
740 contents if its a directory. This is like the C<rm -rf> shell
743 ("mkdir", (RErr, [String "path"]), 32, [],
744 [InitBasicFS, TestOutputTrue
747 InitBasicFS, TestLastFail
748 [["mkdir"; "/new/foo/bar"]]],
749 "create a directory",
751 Create a directory named C<path>.");
753 ("mkdir_p", (RErr, [String "path"]), 33, [],
754 [InitBasicFS, TestOutputTrue
755 [["mkdir_p"; "/new/foo/bar"];
756 ["is_dir"; "/new/foo/bar"]];
757 InitBasicFS, TestOutputTrue
758 [["mkdir_p"; "/new/foo/bar"];
759 ["is_dir"; "/new/foo"]];
760 InitBasicFS, TestOutputTrue
761 [["mkdir_p"; "/new/foo/bar"];
762 ["is_dir"; "/new"]]],
763 "create a directory and parents",
765 Create a directory named C<path>, creating any parent directories
766 as necessary. This is like the C<mkdir -p> shell command.");
768 ("chmod", (RErr, [Int "mode"; String "path"]), 34, [],
769 [], (* XXX Need stat command to test *)
772 Change the mode (permissions) of C<path> to C<mode>. Only
773 numeric modes are supported.");
775 ("chown", (RErr, [Int "owner"; Int "group"; String "path"]), 35, [],
776 [], (* XXX Need stat command to test *)
777 "change file owner and group",
779 Change the file owner to C<owner> and group to C<group>.
781 Only numeric uid and gid are supported. If you want to use
782 names, you will need to locate and parse the password file
783 yourself (Augeas support makes this relatively easy).");
785 ("exists", (RBool "existsflag", [String "path"]), 36, [],
786 [InitBasicFS, TestOutputTrue (
788 ["exists"; "/new"]]);
789 InitBasicFS, TestOutputTrue (
791 ["exists"; "/new"]])],
792 "test if file or directory exists",
794 This returns C<true> if and only if there is a file, directory
795 (or anything) with the given C<path> name.
797 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
799 ("is_file", (RBool "fileflag", [String "path"]), 37, [],
800 [InitBasicFS, TestOutputTrue (
802 ["is_file"; "/new"]]);
803 InitBasicFS, TestOutputFalse (
805 ["is_file"; "/new"]])],
806 "test if file exists",
808 This returns C<true> if and only if there is a file
809 with the given C<path> name. Note that it returns false for
810 other objects like directories.
812 See also C<guestfs_stat>.");
814 ("is_dir", (RBool "dirflag", [String "path"]), 38, [],
815 [InitBasicFS, TestOutputFalse (
817 ["is_dir"; "/new"]]);
818 InitBasicFS, TestOutputTrue (
820 ["is_dir"; "/new"]])],
821 "test if file exists",
823 This returns C<true> if and only if there is a directory
824 with the given C<path> name. Note that it returns false for
825 other objects like files.
827 See also C<guestfs_stat>.");
829 ("pvcreate", (RErr, [String "device"]), 39, [],
830 [InitEmpty, TestOutputList (
831 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
832 ["pvcreate"; "/dev/sda1"];
833 ["pvcreate"; "/dev/sda2"];
834 ["pvcreate"; "/dev/sda3"];
835 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
836 "create an LVM physical volume",
838 This creates an LVM physical volume on the named C<device>,
839 where C<device> should usually be a partition name such
842 ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
843 [InitEmpty, TestOutputList (
844 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
845 ["pvcreate"; "/dev/sda1"];
846 ["pvcreate"; "/dev/sda2"];
847 ["pvcreate"; "/dev/sda3"];
848 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
849 ["vgcreate"; "VG2"; "/dev/sda3"];
850 ["vgs"]], ["VG1"; "VG2"])],
851 "create an LVM volume group",
853 This creates an LVM volume group called C<volgroup>
854 from the non-empty list of physical volumes C<physvols>.");
856 ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [],
857 [InitEmpty, TestOutputList (
858 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
859 ["pvcreate"; "/dev/sda1"];
860 ["pvcreate"; "/dev/sda2"];
861 ["pvcreate"; "/dev/sda3"];
862 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
863 ["vgcreate"; "VG2"; "/dev/sda3"];
864 ["lvcreate"; "LV1"; "VG1"; "50"];
865 ["lvcreate"; "LV2"; "VG1"; "50"];
866 ["lvcreate"; "LV3"; "VG2"; "50"];
867 ["lvcreate"; "LV4"; "VG2"; "50"];
868 ["lvcreate"; "LV5"; "VG2"; "50"];
870 ["/dev/VG1/LV1"; "/dev/VG1/LV2";
871 "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
872 "create an LVM volume group",
874 This creates an LVM volume group called C<logvol>
875 on the volume group C<volgroup>, with C<size> megabytes.");
877 ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [],
878 [InitEmpty, TestOutput (
879 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
880 ["mkfs"; "ext2"; "/dev/sda1"];
881 ["mount"; "/dev/sda1"; "/"];
882 ["write_file"; "/new"; "new file contents"; "0"];
883 ["cat"; "/new"]], "new file contents")],
886 This creates a filesystem on C<device> (usually a partition
887 of LVM logical volume). The filesystem type is C<fstype>, for
890 ("sfdisk", (RErr, [String "device";
891 Int "cyls"; Int "heads"; Int "sectors";
892 StringList "lines"]), 43, [DangerWillRobinson],
894 "create partitions on a block device",
896 This is a direct interface to the L<sfdisk(8)> program for creating
897 partitions on block devices.
899 C<device> should be a block device, for example C</dev/sda>.
901 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
902 and sectors on the device, which are passed directly to sfdisk as
903 the I<-C>, I<-H> and I<-S> parameters. If you pass C<0> for any
904 of these, then the corresponding parameter is omitted. Usually for
905 'large' disks, you can just pass C<0> for these, but for small
906 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
907 out the right geometry and you will need to tell it.
909 C<lines> is a list of lines that we feed to C<sfdisk>. For more
910 information refer to the L<sfdisk(8)> manpage.
912 To create a single partition occupying the whole disk, you would
913 pass C<lines> as a single element list, when the single element being
914 the string C<,> (comma).");
916 ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
917 [InitEmpty, TestOutput (
918 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
919 ["mkfs"; "ext2"; "/dev/sda1"];
920 ["mount"; "/dev/sda1"; "/"];
921 ["write_file"; "/new"; "new file contents"; "0"];
922 ["cat"; "/new"]], "new file contents")],
925 This call creates a file called C<path>. The contents of the
926 file is the string C<content> (which can contain any 8 bit data),
929 As a special case, if C<size> is C<0>
930 then the length is calculated using C<strlen> (so in this case
931 the content cannot contain embedded ASCII NULs).");
933 ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
934 [InitEmpty, TestOutputList (
935 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
936 ["mkfs"; "ext2"; "/dev/sda1"];
937 ["mount"; "/dev/sda1"; "/"];
938 ["mounts"]], ["/dev/sda1"]);
939 InitEmpty, TestOutputList (
940 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
941 ["mkfs"; "ext2"; "/dev/sda1"];
942 ["mount"; "/dev/sda1"; "/"];
945 "unmount a filesystem",
947 This unmounts the given filesystem. The filesystem may be
948 specified either by its mountpoint (path) or the device which
949 contains the filesystem.");
951 ("mounts", (RStringList "devices", []), 46, [],
952 [InitBasicFS, TestOutputList (
953 [["mounts"]], ["/dev/sda1"])],
954 "show mounted filesystems",
956 This returns the list of currently mounted filesystems. It returns
957 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
959 Some internal mounts are not shown.");
961 ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
962 [InitBasicFS, TestOutputList (
965 "unmount all filesystems",
967 This unmounts all mounted filesystems.
969 Some internal mounts are not unmounted by this call.");
971 ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson],
973 "remove all LVM LVs, VGs and PVs",
975 This command removes all LVM logical volumes, volume groups
976 and physical volumes.");
978 ("file", (RString "description", [String "path"]), 49, [],
979 [InitBasicFS, TestOutput (
981 ["file"; "/new"]], "empty");
982 InitBasicFS, TestOutput (
983 [["write_file"; "/new"; "some content\n"; "0"];
984 ["file"; "/new"]], "ASCII text");
985 InitBasicFS, TestLastFail (
986 [["file"; "/nofile"]])],
987 "determine file type",
989 This call uses the standard L<file(1)> command to determine
990 the type or contents of the file. This also works on devices,
991 for example to find out whether a partition contains a filesystem.
993 The exact command which runs is C<file -bsL path>. Note in
994 particular that the filename is not prepended to the output
995 (the C<-b> option).");
997 ("command", (RString "output", [StringList "arguments"]), 50, [],
998 [], (* XXX how to test? *)
999 "run a command from the guest filesystem",
1001 This call runs a command from the guest filesystem. The
1002 filesystem must be mounted, and must contain a compatible
1003 operating system (ie. something Linux, with the same
1004 or compatible processor architecture).
1006 The single parameter is an argv-style list of arguments.
1007 The first element is the name of the program to run.
1008 Subsequent elements are parameters. The list must be
1009 non-empty (ie. must contain a program name).
1011 The C<$PATH> environment variable will contain at least
1012 C</usr/bin> and C</bin>. If you require a program from
1013 another location, you should provide the full path in the
1016 Shared libraries and data files required by the program
1017 must be available on filesystems which are mounted in the
1018 correct places. It is the caller's responsibility to ensure
1019 all filesystems that are needed are mounted at the right
1022 ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [],
1023 [], (* XXX how to test? *)
1024 "run a command, returning lines",
1026 This is the same as C<guestfs_command>, but splits the
1027 result into a list of lines.");
1029 ("stat", (RStat "statbuf", [String "path"]), 52, [],
1030 [InitBasicFS, TestOutputStruct (
1032 ["stat"; "/new"]], [CompareWithInt ("size", 0)])],
1033 "get file information",
1035 Returns file information for the given C<path>.
1037 This is the same as the C<stat(2)> system call.");
1039 ("lstat", (RStat "statbuf", [String "path"]), 53, [],
1040 [InitBasicFS, TestOutputStruct (
1042 ["lstat"; "/new"]], [CompareWithInt ("size", 0)])],
1043 "get file information for a symbolic link",
1045 Returns file information for the given C<path>.
1047 This is the same as C<guestfs_stat> except that if C<path>
1048 is a symbolic link, then the link is stat-ed, not the file it
1051 This is the same as the C<lstat(2)> system call.");
1053 ("statvfs", (RStatVFS "statbuf", [String "path"]), 54, [],
1054 [InitBasicFS, TestOutputStruct (
1055 [["statvfs"; "/"]], [CompareWithInt ("bfree", 487702);
1056 CompareWithInt ("blocks", 490020);
1057 CompareWithInt ("bsize", 1024)])],
1058 "get file system statistics",
1060 Returns file system statistics for any mounted file system.
1061 C<path> should be a file or directory in the mounted file system
1062 (typically it is the mount point itself, but it doesn't need to be).
1064 This is the same as the C<statvfs(2)> system call.");
1066 ("tune2fs_l", (RHashtable "superblock", [String "device"]), 55, [],
1068 "get ext2/ext3 superblock details",
1070 This returns the contents of the ext2 or ext3 filesystem superblock
1073 It is the same as running C<tune2fs -l device>. See L<tune2fs(8)>
1074 manpage for more details. The list of fields returned isn't
1075 clearly defined, and depends on both the version of C<tune2fs>
1076 that libguestfs was built against, and the filesystem itself.");
1078 ("blockdev_setro", (RErr, [String "device"]), 56, [],
1079 [InitEmpty, TestOutputTrue (
1080 [["blockdev_setro"; "/dev/sda"];
1081 ["blockdev_getro"; "/dev/sda"]])],
1082 "set block device to read-only",
1084 Sets the block device named C<device> to read-only.
1086 This uses the L<blockdev(8)> command.");
1088 ("blockdev_setrw", (RErr, [String "device"]), 57, [],
1089 [InitEmpty, TestOutputFalse (
1090 [["blockdev_setrw"; "/dev/sda"];
1091 ["blockdev_getro"; "/dev/sda"]])],
1092 "set block device to read-write",
1094 Sets the block device named C<device> to read-write.
1096 This uses the L<blockdev(8)> command.");
1098 ("blockdev_getro", (RBool "ro", [String "device"]), 58, [],
1099 [InitEmpty, TestOutputTrue (
1100 [["blockdev_setro"; "/dev/sda"];
1101 ["blockdev_getro"; "/dev/sda"]])],
1102 "is block device set to read-only",
1104 Returns a boolean indicating if the block device is read-only
1105 (true if read-only, false if not).
1107 This uses the L<blockdev(8)> command.");
1109 ("blockdev_getss", (RInt "sectorsize", [String "device"]), 59, [],
1110 [InitEmpty, TestOutputInt (
1111 [["blockdev_getss"; "/dev/sda"]], 512)],
1112 "get sectorsize of block device",
1114 This returns the size of sectors on a block device.
1115 Usually 512, but can be larger for modern devices.
1117 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
1120 This uses the L<blockdev(8)> command.");
1122 ("blockdev_getbsz", (RInt "blocksize", [String "device"]), 60, [],
1123 [InitEmpty, TestOutputInt (
1124 [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1125 "get blocksize of block device",
1127 This returns the block size of a device.
1129 (Note this is different from both I<size in blocks> and
1130 I<filesystem block size>).
1132 This uses the L<blockdev(8)> command.");
1134 ("blockdev_setbsz", (RErr, [String "device"; Int "blocksize"]), 61, [],
1136 "set blocksize of block device",
1138 This sets the block size of a device.
1140 (Note this is different from both I<size in blocks> and
1141 I<filesystem block size>).
1143 This uses the L<blockdev(8)> command.");
1145 ("blockdev_getsz", (RInt64 "sizeinsectors", [String "device"]), 62, [],
1146 [InitEmpty, TestOutputInt (
1147 [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1148 "get total size of device in 512-byte sectors",
1150 This returns the size of the device in units of 512-byte sectors
1151 (even if the sectorsize isn't 512 bytes ... weird).
1153 See also C<guestfs_blockdev_getss> for the real sector size of
1154 the device, and C<guestfs_blockdev_getsize64> for the more
1155 useful I<size in bytes>.
1157 This uses the L<blockdev(8)> command.");
1159 ("blockdev_getsize64", (RInt64 "sizeinbytes", [String "device"]), 63, [],
1160 [InitEmpty, TestOutputInt (
1161 [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1162 "get total size of device in bytes",
1164 This returns the size of the device in bytes.
1166 See also C<guestfs_blockdev_getsz>.
1168 This uses the L<blockdev(8)> command.");
1170 ("blockdev_flushbufs", (RErr, [String "device"]), 64, [],
1172 [["blockdev_flushbufs"; "/dev/sda"]]],
1173 "flush device buffers",
1175 This tells the kernel to flush internal buffers associated
1178 This uses the L<blockdev(8)> command.");
1180 ("blockdev_rereadpt", (RErr, [String "device"]), 65, [],
1182 [["blockdev_rereadpt"; "/dev/sda"]]],
1183 "reread partition table",
1185 Reread the partition table on C<device>.
1187 This uses the L<blockdev(8)> command.");
1191 let all_functions = non_daemon_functions @ daemon_functions
1193 (* In some places we want the functions to be displayed sorted
1194 * alphabetically, so this is useful:
1196 let all_functions_sorted =
1197 List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
1198 compare n1 n2) all_functions
1200 (* Column names and types from LVM PVs/VGs/LVs. *)
1209 "pv_attr", `String (* XXX *);
1210 "pv_pe_count", `Int;
1211 "pv_pe_alloc_count", `Int;
1214 "pv_mda_count", `Int;
1215 "pv_mda_free", `Bytes;
1216 (* Not in Fedora 10:
1217 "pv_mda_size", `Bytes;
1224 "vg_attr", `String (* XXX *);
1227 "vg_sysid", `String;
1228 "vg_extent_size", `Bytes;
1229 "vg_extent_count", `Int;
1230 "vg_free_count", `Int;
1238 "vg_mda_count", `Int;
1239 "vg_mda_free", `Bytes;
1240 (* Not in Fedora 10:
1241 "vg_mda_size", `Bytes;
1247 "lv_attr", `String (* XXX *);
1250 "lv_kernel_major", `Int;
1251 "lv_kernel_minor", `Int;
1255 "snap_percent", `OptPercent;
1256 "copy_percent", `OptPercent;
1259 "mirror_log", `String;
1263 (* Column names and types from stat structures.
1264 * NB. Can't use things like 'st_atime' because glibc header files
1265 * define some of these as macros. Ugh.
1282 let statvfs_cols = [
1296 (* Useful functions.
1297 * Note we don't want to use any external OCaml libraries which
1298 * makes this a bit harder than it should be.
1300 let failwithf fs = ksprintf failwith fs
1302 let replace_char s c1 c2 =
1303 let s2 = String.copy s in
1304 let r = ref false in
1305 for i = 0 to String.length s2 - 1 do
1306 if String.unsafe_get s2 i = c1 then (
1307 String.unsafe_set s2 i c2;
1311 if not !r then s else s2
1313 let rec find s sub =
1314 let len = String.length s in
1315 let sublen = String.length sub in
1317 if i <= len-sublen then (
1319 if j < sublen then (
1320 if s.[i+j] = sub.[j] then loop2 (j+1)
1326 if r = -1 then loop (i+1) else r
1332 let rec replace_str s s1 s2 =
1333 let len = String.length s in
1334 let sublen = String.length s1 in
1335 let i = find s s1 in
1338 let s' = String.sub s 0 i in
1339 let s'' = String.sub s (i+sublen) (len-i-sublen) in
1340 s' ^ s2 ^ replace_str s'' s1 s2
1343 let rec string_split sep str =
1344 let len = String.length str in
1345 let seplen = String.length sep in
1346 let i = find str sep in
1347 if i = -1 then [str]
1349 let s' = String.sub str 0 i in
1350 let s'' = String.sub str (i+seplen) (len-i-seplen) in
1351 s' :: string_split sep s''
1354 let rec find_map f = function
1355 | [] -> raise Not_found
1359 | None -> find_map f xs
1362 let rec loop i = function
1364 | x :: xs -> f i x; loop (i+1) xs
1369 let rec loop i = function
1371 | x :: xs -> let r = f i x in r :: loop (i+1) xs
1375 let name_of_argt = function
1376 | String n | OptString n | StringList n | Bool n | Int n -> n
1378 let seq_of_test = function
1379 | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
1380 | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s
1381 | TestOutputLength (s, _) | TestOutputStruct (s, _)
1382 | TestLastFail s -> s
1384 (* Check function names etc. for consistency. *)
1385 let check_functions () =
1386 let contains_uppercase str =
1387 let len = String.length str in
1389 if i >= len then false
1392 if c >= 'A' && c <= 'Z' then true
1399 (* Check function names. *)
1401 fun (name, _, _, _, _, _, _) ->
1402 if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
1403 failwithf "function name %s does not need 'guestfs' prefix" name;
1404 if contains_uppercase name then
1405 failwithf "function name %s should not contain uppercase chars" name;
1406 if String.contains name '-' then
1407 failwithf "function name %s should not contain '-', use '_' instead."
1411 (* Check function parameter/return names. *)
1413 fun (name, style, _, _, _, _, _) ->
1414 let check_arg_ret_name n =
1415 if contains_uppercase n then
1416 failwithf "%s param/ret %s should not contain uppercase chars"
1418 if String.contains n '-' || String.contains n '_' then
1419 failwithf "%s param/ret %s should not contain '-' or '_'"
1422 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;
1423 if n = "argv" || n = "args" then
1424 failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" n
1427 (match fst style with
1429 | RInt n | RInt64 n | RBool n | RConstString n | RString n
1430 | RStringList n | RPVList n | RVGList n | RLVList n
1431 | RStat n | RStatVFS n
1433 check_arg_ret_name n
1435 check_arg_ret_name n;
1436 check_arg_ret_name m
1438 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
1441 (* Check short descriptions. *)
1443 fun (name, _, _, _, _, shortdesc, _) ->
1444 if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
1445 failwithf "short description of %s should begin with lowercase." name;
1446 let c = shortdesc.[String.length shortdesc-1] in
1447 if c = '\n' || c = '.' then
1448 failwithf "short description of %s should not end with . or \\n." name
1451 (* Check long dscriptions. *)
1453 fun (name, _, _, _, _, _, longdesc) ->
1454 if longdesc.[String.length longdesc-1] = '\n' then
1455 failwithf "long description of %s should not end with \\n." name
1458 (* Check proc_nrs. *)
1460 fun (name, _, proc_nr, _, _, _, _) ->
1461 if proc_nr <= 0 then
1462 failwithf "daemon function %s should have proc_nr > 0" name
1466 fun (name, _, proc_nr, _, _, _, _) ->
1467 if proc_nr <> -1 then
1468 failwithf "non-daemon function %s should have proc_nr -1" name
1469 ) non_daemon_functions;
1472 List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
1475 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
1476 let rec loop = function
1479 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
1481 | (name1,nr1) :: (name2,nr2) :: _ ->
1482 failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
1490 (* Ignore functions that have no tests. We generate a
1491 * warning when the user does 'make check' instead.
1493 | name, _, _, _, [], _, _ -> ()
1494 | name, _, _, _, tests, _, _ ->
1498 match seq_of_test test with
1500 failwithf "%s has a test containing an empty sequence" name
1501 | cmds -> List.map List.hd cmds
1503 let funcs = List.flatten funcs in
1505 let tested = List.mem name funcs in
1508 failwithf "function %s has tests but does not test itself" name
1511 (* 'pr' prints to the current output file. *)
1512 let chan = ref stdout
1513 let pr fs = ksprintf (output_string !chan) fs
1515 (* Generate a header block in a number of standard styles. *)
1516 type comment_style = CStyle | HashStyle | OCamlStyle
1517 type license = GPLv2 | LGPLv2
1519 let generate_header comment license =
1520 let c = match comment with
1521 | CStyle -> pr "/* "; " *"
1522 | HashStyle -> pr "# "; "#"
1523 | OCamlStyle -> pr "(* "; " *" in
1524 pr "libguestfs generated file\n";
1525 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
1526 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
1528 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
1532 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
1533 pr "%s it under the terms of the GNU General Public License as published by\n" c;
1534 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
1535 pr "%s (at your option) any later version.\n" c;
1537 pr "%s This program is distributed in the hope that it will be useful,\n" c;
1538 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1539 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
1540 pr "%s GNU General Public License for more details.\n" c;
1542 pr "%s You should have received a copy of the GNU General Public License along\n" c;
1543 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
1544 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
1547 pr "%s This library is free software; you can redistribute it and/or\n" c;
1548 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
1549 pr "%s License as published by the Free Software Foundation; either\n" c;
1550 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
1552 pr "%s This library is distributed in the hope that it will be useful,\n" c;
1553 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1554 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
1555 pr "%s Lesser General Public License for more details.\n" c;
1557 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
1558 pr "%s License along with this library; if not, write to the Free Software\n" c;
1559 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
1562 | CStyle -> pr " */\n"
1564 | OCamlStyle -> pr " *)\n"
1568 (* Start of main code generation functions below this line. *)
1570 (* Generate the pod documentation for the C API. *)
1571 let rec generate_actions_pod () =
1573 fun (shortname, style, _, flags, _, _, longdesc) ->
1574 let name = "guestfs_" ^ shortname in
1575 pr "=head2 %s\n\n" name;
1577 generate_prototype ~extern:false ~handle:"handle" name style;
1579 pr "%s\n\n" longdesc;
1580 (match fst style with
1582 pr "This function returns 0 on success or -1 on error.\n\n"
1584 pr "On error this function returns -1.\n\n"
1586 pr "On error this function returns -1.\n\n"
1588 pr "This function returns a C truth value on success or -1 on error.\n\n"
1590 pr "This function returns a string, or NULL on error.
1591 The string is owned by the guest handle and must I<not> be freed.\n\n"
1593 pr "This function returns a string, or NULL on error.
1594 I<The caller must free the returned string after use>.\n\n"
1596 pr "This function returns a NULL-terminated array of strings
1597 (like L<environ(3)>), or NULL if there was an error.
1598 I<The caller must free the strings and the array after use>.\n\n"
1600 pr "This function returns a C<struct guestfs_int_bool *>,
1601 or NULL if there was an error.
1602 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
1604 pr "This function returns a C<struct guestfs_lvm_pv_list *>
1605 (see E<lt>guestfs-structs.hE<gt>),
1606 or NULL if there was an error.
1607 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
1609 pr "This function returns a C<struct guestfs_lvm_vg_list *>
1610 (see E<lt>guestfs-structs.hE<gt>),
1611 or NULL if there was an error.
1612 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
1614 pr "This function returns a C<struct guestfs_lvm_lv_list *>
1615 (see E<lt>guestfs-structs.hE<gt>),
1616 or NULL if there was an error.
1617 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
1619 pr "This function returns a C<struct guestfs_stat *>
1620 (see L<stat(2)> and E<lt>guestfs-structs.hE<gt>),
1621 or NULL if there was an error.
1622 I<The caller must call C<free> after use>.\n\n"
1624 pr "This function returns a C<struct guestfs_statvfs *>
1625 (see L<statvfs(2)> and E<lt>guestfs-structs.hE<gt>),
1626 or NULL if there was an error.
1627 I<The caller must call C<free> after use>.\n\n"
1629 pr "This function returns a NULL-terminated array of
1630 strings, or NULL if there was an error.
1631 The array of strings will always have length C<2n+1>, where
1632 C<n> keys and values alternate, followed by the trailing NULL entry.
1633 I<The caller must free the strings and the array after use>.\n\n"
1635 if List.mem ProtocolLimitWarning flags then
1636 pr "%s\n\n" protocol_limit_warning;
1637 if List.mem DangerWillRobinson flags then
1638 pr "%s\n\n" danger_will_robinson;
1639 ) all_functions_sorted
1641 and generate_structs_pod () =
1642 (* LVM structs documentation. *)
1645 pr "=head2 guestfs_lvm_%s\n" typ;
1647 pr " struct guestfs_lvm_%s {\n" typ;
1650 | name, `String -> pr " char *%s;\n" name
1652 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
1653 pr " char %s[32];\n" name
1654 | name, `Bytes -> pr " uint64_t %s;\n" name
1655 | name, `Int -> pr " int64_t %s;\n" name
1656 | name, `OptPercent ->
1657 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
1658 pr " float %s;\n" name
1661 pr " struct guestfs_lvm_%s_list {\n" typ;
1662 pr " uint32_t len; /* Number of elements in list. */\n";
1663 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
1666 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
1669 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1671 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
1672 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
1674 * We have to use an underscore instead of a dash because otherwise
1675 * rpcgen generates incorrect code.
1677 * This header is NOT exported to clients, but see also generate_structs_h.
1679 and generate_xdr () =
1680 generate_header CStyle LGPLv2;
1682 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
1683 pr "typedef string str<>;\n";
1686 (* LVM internal structures. *)
1690 pr "struct guestfs_lvm_int_%s {\n" typ;
1692 | name, `String -> pr " string %s<>;\n" name
1693 | name, `UUID -> pr " opaque %s[32];\n" name
1694 | name, `Bytes -> pr " hyper %s;\n" name
1695 | name, `Int -> pr " hyper %s;\n" name
1696 | name, `OptPercent -> pr " float %s;\n" name
1700 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
1702 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1704 (* Stat internal structures. *)
1708 pr "struct guestfs_int_%s {\n" typ;
1710 | name, `Int -> pr " hyper %s;\n" name
1714 ) ["stat", stat_cols; "statvfs", statvfs_cols];
1717 fun (shortname, style, _, _, _, _, _) ->
1718 let name = "guestfs_" ^ shortname in
1720 (match snd style with
1723 pr "struct %s_args {\n" name;
1726 | String n -> pr " string %s<>;\n" n
1727 | OptString n -> pr " str *%s;\n" n
1728 | StringList n -> pr " str %s<>;\n" n
1729 | Bool n -> pr " bool %s;\n" n
1730 | Int n -> pr " int %s;\n" n
1734 (match fst style with
1737 pr "struct %s_ret {\n" name;
1741 pr "struct %s_ret {\n" name;
1742 pr " hyper %s;\n" n;
1745 pr "struct %s_ret {\n" name;
1749 failwithf "RConstString cannot be returned from a daemon function"
1751 pr "struct %s_ret {\n" name;
1752 pr " string %s<>;\n" n;
1755 pr "struct %s_ret {\n" name;
1756 pr " str %s<>;\n" n;
1759 pr "struct %s_ret {\n" name;
1764 pr "struct %s_ret {\n" name;
1765 pr " guestfs_lvm_int_pv_list %s;\n" n;
1768 pr "struct %s_ret {\n" name;
1769 pr " guestfs_lvm_int_vg_list %s;\n" n;
1772 pr "struct %s_ret {\n" name;
1773 pr " guestfs_lvm_int_lv_list %s;\n" n;
1776 pr "struct %s_ret {\n" name;
1777 pr " guestfs_int_stat %s;\n" n;
1780 pr "struct %s_ret {\n" name;
1781 pr " guestfs_int_statvfs %s;\n" n;
1784 pr "struct %s_ret {\n" name;
1785 pr " str %s<>;\n" n;
1790 (* Table of procedure numbers. *)
1791 pr "enum guestfs_procedure {\n";
1793 fun (shortname, _, proc_nr, _, _, _, _) ->
1794 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
1796 pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
1800 (* Having to choose a maximum message size is annoying for several
1801 * reasons (it limits what we can do in the API), but it (a) makes
1802 * the protocol a lot simpler, and (b) provides a bound on the size
1803 * of the daemon which operates in limited memory space. For large
1804 * file transfers you should use FTP.
1806 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
1809 (* Message header, etc. *)
1811 const GUESTFS_PROGRAM = 0x2000F5F5;
1812 const GUESTFS_PROTOCOL_VERSION = 1;
1814 enum guestfs_message_direction {
1815 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
1816 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
1819 enum guestfs_message_status {
1820 GUESTFS_STATUS_OK = 0,
1821 GUESTFS_STATUS_ERROR = 1
1824 const GUESTFS_ERROR_LEN = 256;
1826 struct guestfs_message_error {
1827 string error<GUESTFS_ERROR_LEN>; /* error message */
1830 struct guestfs_message_header {
1831 unsigned prog; /* GUESTFS_PROGRAM */
1832 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
1833 guestfs_procedure proc; /* GUESTFS_PROC_x */
1834 guestfs_message_direction direction;
1835 unsigned serial; /* message serial number */
1836 guestfs_message_status status;
1840 (* Generate the guestfs-structs.h file. *)
1841 and generate_structs_h () =
1842 generate_header CStyle LGPLv2;
1844 (* This is a public exported header file containing various
1845 * structures. The structures are carefully written to have
1846 * exactly the same in-memory format as the XDR structures that
1847 * we use on the wire to the daemon. The reason for creating
1848 * copies of these structures here is just so we don't have to
1849 * export the whole of guestfs_protocol.h (which includes much
1850 * unrelated and XDR-dependent stuff that we don't want to be
1851 * public, or required by clients).
1853 * To reiterate, we will pass these structures to and from the
1854 * client with a simple assignment or memcpy, so the format
1855 * must be identical to what rpcgen / the RFC defines.
1858 (* guestfs_int_bool structure. *)
1859 pr "struct guestfs_int_bool {\n";
1865 (* LVM public structures. *)
1869 pr "struct guestfs_lvm_%s {\n" typ;
1872 | name, `String -> pr " char *%s;\n" name
1873 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
1874 | name, `Bytes -> pr " uint64_t %s;\n" name
1875 | name, `Int -> pr " int64_t %s;\n" name
1876 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
1880 pr "struct guestfs_lvm_%s_list {\n" typ;
1881 pr " uint32_t len;\n";
1882 pr " struct guestfs_lvm_%s *val;\n" typ;
1885 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1887 (* Stat structures. *)
1891 pr "struct guestfs_%s {\n" typ;
1894 | name, `Int -> pr " int64_t %s;\n" name
1898 ) ["stat", stat_cols; "statvfs", statvfs_cols]
1900 (* Generate the guestfs-actions.h file. *)
1901 and generate_actions_h () =
1902 generate_header CStyle LGPLv2;
1904 fun (shortname, style, _, _, _, _, _) ->
1905 let name = "guestfs_" ^ shortname in
1906 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
1910 (* Generate the client-side dispatch stubs. *)
1911 and generate_client_actions () =
1912 generate_header CStyle LGPLv2;
1914 (* Client-side stubs for each function. *)
1916 fun (shortname, style, _, _, _, _, _) ->
1917 let name = "guestfs_" ^ shortname in
1919 (* Generate the return value struct. *)
1920 pr "struct %s_rv {\n" shortname;
1921 pr " int cb_done; /* flag to indicate callback was called */\n";
1922 pr " struct guestfs_message_header hdr;\n";
1923 pr " struct guestfs_message_error err;\n";
1924 (match fst style with
1927 failwithf "RConstString cannot be returned from a daemon function"
1929 | RBool _ | RString _ | RStringList _
1931 | RPVList _ | RVGList _ | RLVList _
1932 | RStat _ | RStatVFS _
1934 pr " struct %s_ret ret;\n" name
1938 (* Generate the callback function. *)
1939 pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
1941 pr " struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
1943 pr " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
1944 pr " error (g, \"%s: failed to parse reply header\");\n" name;
1947 pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
1948 pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
1949 pr " error (g, \"%s: failed to parse reply error\");\n" name;
1955 (match fst style with
1958 failwithf "RConstString cannot be returned from a daemon function"
1960 | RBool _ | RString _ | RStringList _
1962 | RPVList _ | RVGList _ | RLVList _
1963 | RStat _ | RStatVFS _
1965 pr " if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
1966 pr " error (g, \"%s: failed to parse reply\");\n" name;
1972 pr " rv->cb_done = 1;\n";
1973 pr " main_loop.main_loop_quit (g);\n";
1976 (* Generate the action stub. *)
1977 generate_prototype ~extern:false ~semicolon:false ~newline:true
1978 ~handle:"g" name style;
1981 match fst style with
1982 | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
1984 failwithf "RConstString cannot be returned from a daemon function"
1985 | RString _ | RStringList _ | RIntBool _
1986 | RPVList _ | RVGList _ | RLVList _
1987 | RStat _ | RStatVFS _
1993 (match snd style with
1995 | _ -> pr " struct %s_args args;\n" name
1998 pr " struct %s_rv rv;\n" shortname;
1999 pr " int serial;\n";
2001 pr " if (g->state != READY) {\n";
2002 pr " error (g, \"%s called from the wrong state, %%d != READY\",\n"
2005 pr " return %s;\n" error_code;
2008 pr " memset (&rv, 0, sizeof rv);\n";
2011 (match snd style with
2013 pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
2014 (String.uppercase shortname)
2019 pr " args.%s = (char *) %s;\n" n n
2021 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
2023 pr " args.%s.%s_val = (char **) %s;\n" n n n;
2024 pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
2026 pr " args.%s = %s;\n" n n
2028 pr " args.%s = %s;\n" n n
2030 pr " serial = dispatch (g, GUESTFS_PROC_%s,\n"
2031 (String.uppercase shortname);
2032 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
2035 pr " if (serial == -1)\n";
2036 pr " return %s;\n" error_code;
2039 pr " rv.cb_done = 0;\n";
2040 pr " g->reply_cb_internal = %s_cb;\n" shortname;
2041 pr " g->reply_cb_internal_data = &rv;\n";
2042 pr " main_loop.main_loop_run (g);\n";
2043 pr " g->reply_cb_internal = NULL;\n";
2044 pr " g->reply_cb_internal_data = NULL;\n";
2045 pr " if (!rv.cb_done) {\n";
2046 pr " error (g, \"%s failed, see earlier error messages\");\n" name;
2047 pr " return %s;\n" error_code;
2051 pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
2052 (String.uppercase shortname);
2053 pr " return %s;\n" error_code;
2056 pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
2057 pr " error (g, \"%%s\", rv.err.error);\n";
2058 pr " return %s;\n" error_code;
2062 (match fst style with
2063 | RErr -> pr " return 0;\n"
2064 | RInt n | RInt64 n | RBool n ->
2065 pr " return rv.ret.%s;\n" n
2067 failwithf "RConstString cannot be returned from a daemon function"
2069 pr " return rv.ret.%s; /* caller will free */\n" n
2070 | RStringList n | RHashtable n ->
2071 pr " /* caller will free this, but we need to add a NULL entry */\n";
2072 pr " rv.ret.%s.%s_val =" n n;
2073 pr " safe_realloc (g, rv.ret.%s.%s_val,\n" n n;
2074 pr " sizeof (char *) * (rv.ret.%s.%s_len + 1));\n"
2076 pr " rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
2077 pr " return rv.ret.%s.%s_val;\n" n n
2079 pr " /* caller with free this */\n";
2080 pr " return safe_memdup (g, &rv.ret, sizeof (rv.ret));\n"
2081 | RPVList n | RVGList n | RLVList n
2082 | RStat n | RStatVFS n ->
2083 pr " /* caller will free this */\n";
2084 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
2090 (* Generate daemon/actions.h. *)
2091 and generate_daemon_actions_h () =
2092 generate_header CStyle GPLv2;
2094 pr "#include \"../src/guestfs_protocol.h\"\n";
2098 fun (name, style, _, _, _, _, _) ->
2100 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
2104 (* Generate the server-side stubs. *)
2105 and generate_daemon_actions () =
2106 generate_header CStyle GPLv2;
2108 pr "#define _GNU_SOURCE // for strchrnul\n";
2110 pr "#include <stdio.h>\n";
2111 pr "#include <stdlib.h>\n";
2112 pr "#include <string.h>\n";
2113 pr "#include <inttypes.h>\n";
2114 pr "#include <ctype.h>\n";
2115 pr "#include <rpc/types.h>\n";
2116 pr "#include <rpc/xdr.h>\n";
2118 pr "#include \"daemon.h\"\n";
2119 pr "#include \"../src/guestfs_protocol.h\"\n";
2120 pr "#include \"actions.h\"\n";
2124 fun (name, style, _, _, _, _, _) ->
2125 (* Generate server-side stubs. *)
2126 pr "static void %s_stub (XDR *xdr_in)\n" name;
2129 match fst style with
2130 | RErr | RInt _ -> pr " int r;\n"; "-1"
2131 | RInt64 _ -> pr " int64_t r;\n"; "-1"
2132 | RBool _ -> pr " int r;\n"; "-1"
2134 failwithf "RConstString cannot be returned from a daemon function"
2135 | RString _ -> pr " char *r;\n"; "NULL"
2136 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
2137 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
2138 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
2139 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
2140 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL"
2141 | RStat _ -> pr " guestfs_int_stat *r;\n"; "NULL"
2142 | RStatVFS _ -> pr " guestfs_int_statvfs *r;\n"; "NULL" in
2144 (match snd style with
2147 pr " struct guestfs_%s_args args;\n" name;
2151 | OptString n -> pr " const char *%s;\n" n
2152 | StringList n -> pr " char **%s;\n" n
2153 | Bool n -> pr " int %s;\n" n
2154 | Int n -> pr " int %s;\n" n
2159 (match snd style with
2162 pr " memset (&args, 0, sizeof args);\n";
2164 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
2165 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
2170 | String n -> pr " %s = args.%s;\n" n n
2171 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
2173 pr " args.%s.%s_val = realloc (args.%s.%s_val, sizeof (char *) * (args.%s.%s_len+1));\n" n n n n n n;
2174 pr " args.%s.%s_val[args.%s.%s_len] = NULL;\n" n n n n;
2175 pr " %s = args.%s.%s_val;\n" n n n
2176 | Bool n -> pr " %s = args.%s;\n" n n
2177 | Int n -> pr " %s = args.%s;\n" n n
2182 pr " r = do_%s " name;
2183 generate_call_args style;
2186 pr " if (r == %s)\n" error_code;
2187 pr " /* do_%s has already called reply_with_error */\n" name;
2191 (match fst style with
2192 | RErr -> pr " reply (NULL, NULL);\n"
2193 | RInt n | RInt64 n | RBool n ->
2194 pr " struct guestfs_%s_ret ret;\n" name;
2195 pr " ret.%s = r;\n" n;
2196 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
2198 failwithf "RConstString cannot be returned from a daemon function"
2200 pr " struct guestfs_%s_ret ret;\n" name;
2201 pr " ret.%s = r;\n" n;
2202 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
2204 | RStringList n | RHashtable n ->
2205 pr " struct guestfs_%s_ret ret;\n" name;
2206 pr " ret.%s.%s_len = count_strings (r);\n" n n;
2207 pr " ret.%s.%s_val = r;\n" n n;
2208 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
2209 pr " free_strings (r);\n"
2211 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name;
2212 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
2213 | RPVList n | RVGList n | RLVList n
2214 | RStat n | RStatVFS n ->
2215 pr " struct guestfs_%s_ret ret;\n" name;
2216 pr " ret.%s = *r;\n" n;
2217 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
2218 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
2221 (* Free the args. *)
2222 (match snd style with
2227 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
2234 (* Dispatch function. *)
2235 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
2237 pr " switch (proc_nr) {\n";
2240 fun (name, style, _, _, _, _, _) ->
2241 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
2242 pr " %s_stub (xdr_in);\n" name;
2247 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
2252 (* LVM columns and tokenization functions. *)
2253 (* XXX This generates crap code. We should rethink how we
2259 pr "static const char *lvm_%s_cols = \"%s\";\n"
2260 typ (String.concat "," (List.map fst cols));
2263 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
2265 pr " char *tok, *p, *next;\n";
2269 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
2272 pr " if (!str) {\n";
2273 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
2276 pr " if (!*str || isspace (*str)) {\n";
2277 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
2282 fun (name, coltype) ->
2283 pr " if (!tok) {\n";
2284 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
2287 pr " p = strchrnul (tok, ',');\n";
2288 pr " if (*p) next = p+1; else next = NULL;\n";
2289 pr " *p = '\\0';\n";
2292 pr " r->%s = strdup (tok);\n" name;
2293 pr " if (r->%s == NULL) {\n" name;
2294 pr " perror (\"strdup\");\n";
2298 pr " for (i = j = 0; i < 32; ++j) {\n";
2299 pr " if (tok[j] == '\\0') {\n";
2300 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
2302 pr " } else if (tok[j] != '-')\n";
2303 pr " r->%s[i++] = tok[j];\n" name;
2306 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
2307 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2311 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
2312 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2316 pr " if (tok[0] == '\\0')\n";
2317 pr " r->%s = -1;\n" name;
2318 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
2319 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2323 pr " tok = next;\n";
2326 pr " if (tok != NULL) {\n";
2327 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
2334 pr "guestfs_lvm_int_%s_list *\n" typ;
2335 pr "parse_command_line_%ss (void)\n" typ;
2337 pr " char *out, *err;\n";
2338 pr " char *p, *pend;\n";
2340 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
2341 pr " void *newp;\n";
2343 pr " ret = malloc (sizeof *ret);\n";
2344 pr " if (!ret) {\n";
2345 pr " reply_with_perror (\"malloc\");\n";
2346 pr " return NULL;\n";
2349 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
2350 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
2352 pr " r = command (&out, &err,\n";
2353 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
2354 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
2355 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
2356 pr " if (r == -1) {\n";
2357 pr " reply_with_error (\"%%s\", err);\n";
2358 pr " free (out);\n";
2359 pr " free (err);\n";
2360 pr " return NULL;\n";
2363 pr " free (err);\n";
2365 pr " /* Tokenize each line of the output. */\n";
2368 pr " while (p) {\n";
2369 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
2370 pr " if (pend) {\n";
2371 pr " *pend = '\\0';\n";
2375 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
2378 pr " if (!*p) { /* Empty line? Skip it. */\n";
2383 pr " /* Allocate some space to store this next entry. */\n";
2384 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
2385 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
2386 pr " if (newp == NULL) {\n";
2387 pr " reply_with_perror (\"realloc\");\n";
2388 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2389 pr " free (ret);\n";
2390 pr " free (out);\n";
2391 pr " return NULL;\n";
2393 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
2395 pr " /* Tokenize the next entry. */\n";
2396 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
2397 pr " if (r == -1) {\n";
2398 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
2399 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2400 pr " free (ret);\n";
2401 pr " free (out);\n";
2402 pr " return NULL;\n";
2409 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
2411 pr " free (out);\n";
2412 pr " return ret;\n";
2415 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2417 (* Generate the tests. *)
2418 and generate_tests () =
2419 generate_header CStyle GPLv2;
2426 #include <sys/types.h>
2429 #include \"guestfs.h\"
2431 static guestfs_h *g;
2432 static int suppress_error = 0;
2434 static void print_error (guestfs_h *g, void *data, const char *msg)
2436 if (!suppress_error)
2437 fprintf (stderr, \"%%s\\n\", msg);
2440 static void print_strings (char * const * const argv)
2444 for (argc = 0; argv[argc] != NULL; ++argc)
2445 printf (\"\\t%%s\\n\", argv[argc]);
2449 static void print_table (char * const * const argv)
2453 for (i = 0; argv[i] != NULL; i += 2)
2454 printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
2458 static void no_test_warnings (void)
2464 | name, _, _, _, [], _, _ ->
2465 pr " fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
2466 | name, _, _, _, tests, _, _ -> ()
2472 (* Generate the actual tests. Note that we generate the tests
2473 * in reverse order, deliberately, so that (in general) the
2474 * newest tests run first. This makes it quicker and easier to
2479 fun (name, _, _, _, tests, _, _) ->
2480 mapi (generate_one_test name) tests
2481 ) (List.rev all_functions) in
2482 let test_names = List.concat test_names in
2483 let nr_tests = List.length test_names in
2486 int main (int argc, char *argv[])
2493 int nr_tests, test_num = 0;
2495 no_test_warnings ();
2497 g = guestfs_create ();
2499 printf (\"guestfs_create FAILED\\n\");
2503 guestfs_set_error_handler (g, print_error, NULL);
2505 srcdir = getenv (\"srcdir\");
2506 if (!srcdir) srcdir = \".\";
2507 guestfs_set_path (g, srcdir);
2509 snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);
2510 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2515 if (lseek (fd, %d, SEEK_SET) == -1) {
2521 if (write (fd, &c, 1) == -1) {
2527 if (close (fd) == -1) {
2532 if (guestfs_add_drive (g, buf) == -1) {
2533 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2537 snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);
2538 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2543 if (lseek (fd, %d, SEEK_SET) == -1) {
2549 if (write (fd, &c, 1) == -1) {
2555 if (close (fd) == -1) {
2560 if (guestfs_add_drive (g, buf) == -1) {
2561 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2565 snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);
2566 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2571 if (lseek (fd, %d, SEEK_SET) == -1) {
2577 if (write (fd, &c, 1) == -1) {
2583 if (close (fd) == -1) {
2588 if (guestfs_add_drive (g, buf) == -1) {
2589 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2593 if (guestfs_launch (g) == -1) {
2594 printf (\"guestfs_launch FAILED\\n\");
2597 if (guestfs_wait_ready (g) == -1) {
2598 printf (\"guestfs_wait_ready FAILED\\n\");
2604 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
2608 pr " test_num++;\n";
2609 pr " printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
2610 pr " if (%s () == -1) {\n" test_name;
2611 pr " printf (\"%s FAILED\\n\");\n" test_name;
2617 pr " guestfs_close (g);\n";
2618 pr " snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);\n";
2619 pr " unlink (buf);\n";
2620 pr " snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);\n";
2621 pr " unlink (buf);\n";
2622 pr " snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);\n";
2623 pr " unlink (buf);\n";
2626 pr " if (failed > 0) {\n";
2627 pr " printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n";
2635 and generate_one_test name i (init, test) =
2636 let test_name = sprintf "test_%s_%d" name i in
2638 pr "static int %s (void)\n" test_name;
2644 pr " /* InitEmpty for %s (%d) */\n" name i;
2645 List.iter (generate_test_command_call test_name)
2649 pr " /* InitBasicFS for %s (%d): create ext2 on /dev/sda1 */\n" name i;
2650 List.iter (generate_test_command_call test_name)
2653 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2654 ["mkfs"; "ext2"; "/dev/sda1"];
2655 ["mount"; "/dev/sda1"; "/"]]
2656 | InitBasicFSonLVM ->
2657 pr " /* InitBasicFSonLVM for %s (%d): create ext2 on /dev/VG/LV */\n"
2659 List.iter (generate_test_command_call test_name)
2662 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2663 ["pvcreate"; "/dev/sda1"];
2664 ["vgcreate"; "VG"; "/dev/sda1"];
2665 ["lvcreate"; "LV"; "VG"; "8"];
2666 ["mkfs"; "ext2"; "/dev/VG/LV"];
2667 ["mount"; "/dev/VG/LV"; "/"]]
2670 let get_seq_last = function
2672 failwithf "%s: you cannot use [] (empty list) when expecting a command"
2675 let seq = List.rev seq in
2676 List.rev (List.tl seq), List.hd seq
2681 pr " /* TestRun for %s (%d) */\n" name i;
2682 List.iter (generate_test_command_call test_name) seq
2683 | TestOutput (seq, expected) ->
2684 pr " /* TestOutput for %s (%d) */\n" name i;
2685 let seq, last = get_seq_last seq in
2687 pr " if (strcmp (r, \"%s\") != 0) {\n" (c_quote expected);
2688 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r);\n" test_name (c_quote expected);
2692 List.iter (generate_test_command_call test_name) seq;
2693 generate_test_command_call ~test test_name last
2694 | TestOutputList (seq, expected) ->
2695 pr " /* TestOutputList for %s (%d) */\n" name i;
2696 let seq, last = get_seq_last seq in
2700 pr " if (!r[%d]) {\n" i;
2701 pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
2702 pr " print_strings (r);\n";
2705 pr " if (strcmp (r[%d], \"%s\") != 0) {\n" i (c_quote str);
2706 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r[%d]);\n" test_name (c_quote str) i;
2710 pr " if (r[%d] != NULL) {\n" (List.length expected);
2711 pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
2713 pr " print_strings (r);\n";
2717 List.iter (generate_test_command_call test_name) seq;
2718 generate_test_command_call ~test test_name last
2719 | TestOutputInt (seq, expected) ->
2720 pr " /* TestOutputInt for %s (%d) */\n" name i;
2721 let seq, last = get_seq_last seq in
2723 pr " if (r != %d) {\n" expected;
2724 pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\","
2730 List.iter (generate_test_command_call test_name) seq;
2731 generate_test_command_call ~test test_name last
2732 | TestOutputTrue seq ->
2733 pr " /* TestOutputTrue for %s (%d) */\n" name i;
2734 let seq, last = get_seq_last seq in
2737 pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n"
2742 List.iter (generate_test_command_call test_name) seq;
2743 generate_test_command_call ~test test_name last
2744 | TestOutputFalse seq ->
2745 pr " /* TestOutputFalse for %s (%d) */\n" name i;
2746 let seq, last = get_seq_last seq in
2749 pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n"
2754 List.iter (generate_test_command_call test_name) seq;
2755 generate_test_command_call ~test test_name last
2756 | TestOutputLength (seq, expected) ->
2757 pr " /* TestOutputLength for %s (%d) */\n" name i;
2758 let seq, last = get_seq_last seq in
2761 pr " for (j = 0; j < %d; ++j)\n" expected;
2762 pr " if (r[j] == NULL) {\n";
2763 pr " fprintf (stderr, \"%s: short list returned\\n\");\n"
2765 pr " print_strings (r);\n";
2768 pr " if (r[j] != NULL) {\n";
2769 pr " fprintf (stderr, \"%s: long list returned\\n\");\n"
2771 pr " print_strings (r);\n";
2775 List.iter (generate_test_command_call test_name) seq;
2776 generate_test_command_call ~test test_name last
2777 | TestOutputStruct (seq, checks) ->
2778 pr " /* TestOutputStruct for %s (%d) */\n" name i;
2779 let seq, last = get_seq_last seq in
2783 | CompareWithInt (field, expected) ->
2784 pr " if (r->%s != %d) {\n" field expected;
2785 pr " fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
2786 test_name field expected;
2787 pr " (int) r->%s);\n" field;
2790 | CompareWithString (field, expected) ->
2791 pr " if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
2792 pr " fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
2793 test_name field expected;
2794 pr " r->%s);\n" field;
2797 | CompareFieldsIntEq (field1, field2) ->
2798 pr " if (r->%s != r->%s) {\n" field1 field2;
2799 pr " fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
2800 test_name field1 field2;
2801 pr " (int) r->%s, (int) r->%s);\n" field1 field2;
2804 | CompareFieldsStrEq (field1, field2) ->
2805 pr " if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
2806 pr " fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
2807 test_name field1 field2;
2808 pr " r->%s, r->%s);\n" field1 field2;
2813 List.iter (generate_test_command_call test_name) seq;
2814 generate_test_command_call ~test test_name last
2815 | TestLastFail seq ->
2816 pr " /* TestLastFail for %s (%d) */\n" name i;
2817 let seq, last = get_seq_last seq in
2818 List.iter (generate_test_command_call test_name) seq;
2819 generate_test_command_call test_name ~expect_error:true last
2827 (* Generate the code to run a command, leaving the result in 'r'.
2828 * If you expect to get an error then you should set expect_error:true.
2830 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
2832 | [] -> assert false
2834 (* Look up the command to find out what args/ret it has. *)
2837 let _, style, _, _, _, _, _ =
2838 List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
2841 failwithf "%s: in test, command %s was not found" test_name name in
2843 if List.length (snd style) <> List.length args then
2844 failwithf "%s: in test, wrong number of args given to %s"
2855 | StringList n, arg ->
2856 pr " char *%s[] = {\n" n;
2857 let strs = string_split " " arg in
2859 fun str -> pr " \"%s\",\n" (c_quote str)
2863 ) (List.combine (snd style) args);
2866 match fst style with
2867 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
2868 | RInt64 _ -> pr " int64_t r;\n"; "-1"
2869 | RConstString _ -> pr " const char *r;\n"; "NULL"
2870 | RString _ -> pr " char *r;\n"; "NULL"
2871 | RStringList _ | RHashtable _ ->
2876 pr " struct guestfs_int_bool *r;\n"; "NULL"
2878 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
2880 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
2882 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
2884 pr " struct guestfs_stat *r;\n"; "NULL"
2886 pr " struct guestfs_statvfs *r;\n"; "NULL" in
2888 pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
2889 pr " r = guestfs_%s (g" name;
2891 (* Generate the parameters. *)
2894 | String _, arg -> pr ", \"%s\"" (c_quote arg)
2895 | OptString _, arg ->
2896 if arg = "NULL" then pr ", NULL" else pr ", \"%s\"" (c_quote arg)
2897 | StringList n, _ ->
2901 try int_of_string arg
2902 with Failure "int_of_string" ->
2903 failwithf "%s: expecting an int, but got '%s'" test_name arg in
2906 let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
2907 ) (List.combine (snd style) args);
2910 if not expect_error then
2911 pr " if (r == %s)\n" error_code
2913 pr " if (r != %s)\n" error_code;
2916 (* Insert the test code. *)
2922 (match fst style with
2923 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ -> ()
2924 | RString _ -> pr " free (r);\n"
2925 | RStringList _ | RHashtable _ ->
2926 pr " for (i = 0; r[i] != NULL; ++i)\n";
2927 pr " free (r[i]);\n";
2930 pr " guestfs_free_int_bool (r);\n"
2932 pr " guestfs_free_lvm_pv_list (r);\n"
2934 pr " guestfs_free_lvm_vg_list (r);\n"
2936 pr " guestfs_free_lvm_lv_list (r);\n"
2937 | RStat _ | RStatVFS _ ->
2944 let str = replace_str str "\r" "\\r" in
2945 let str = replace_str str "\n" "\\n" in
2946 let str = replace_str str "\t" "\\t" in
2949 (* Generate a lot of different functions for guestfish. *)
2950 and generate_fish_cmds () =
2951 generate_header CStyle GPLv2;
2955 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
2957 let all_functions_sorted =
2959 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
2960 ) all_functions_sorted in
2962 pr "#include <stdio.h>\n";
2963 pr "#include <stdlib.h>\n";
2964 pr "#include <string.h>\n";
2965 pr "#include <inttypes.h>\n";
2967 pr "#include <guestfs.h>\n";
2968 pr "#include \"fish.h\"\n";
2971 (* list_commands function, which implements guestfish -h *)
2972 pr "void list_commands (void)\n";
2974 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
2975 pr " list_builtin_commands ();\n";
2977 fun (name, _, _, flags, _, shortdesc, _) ->
2978 let name = replace_char name '_' '-' in
2979 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
2981 ) all_functions_sorted;
2982 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
2986 (* display_command function, which implements guestfish -h cmd *)
2987 pr "void display_command (const char *cmd)\n";
2990 fun (name, style, _, flags, _, shortdesc, longdesc) ->
2991 let name2 = replace_char name '_' '-' in
2993 try find_map (function FishAlias n -> Some n | _ -> None) flags
2994 with Not_found -> name in
2995 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
2997 match snd style with
3001 name2 (String.concat "> <" (List.map name_of_argt args)) in
3004 if List.mem ProtocolLimitWarning flags then
3005 ("\n\n" ^ protocol_limit_warning)
3008 (* For DangerWillRobinson commands, we should probably have
3009 * guestfish prompt before allowing you to use them (especially
3010 * in interactive mode). XXX
3014 if List.mem DangerWillRobinson flags then
3015 ("\n\n" ^ danger_will_robinson)
3018 let describe_alias =
3019 if name <> alias then
3020 sprintf "\n\nYou can use '%s' as an alias for this command." alias
3024 pr "strcasecmp (cmd, \"%s\") == 0" name;
3025 if name <> name2 then
3026 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
3027 if name <> alias then
3028 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
3030 pr " pod2text (\"%s - %s\", %S);\n"
3032 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
3035 pr " display_builtin_command (cmd);\n";
3039 (* print_{pv,vg,lv}_list functions *)
3043 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
3050 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
3052 pr " printf (\"%s: \");\n" name;
3053 pr " for (i = 0; i < 32; ++i)\n";
3054 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
3055 pr " printf (\"\\n\");\n"
3057 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
3059 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
3060 | name, `OptPercent ->
3061 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
3062 typ name name typ name;
3063 pr " else printf (\"%s: \\n\");\n" name
3067 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
3072 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
3073 pr " print_%s (&%ss->val[i]);\n" typ typ;
3076 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3078 (* print_{stat,statvfs} functions *)
3082 pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
3087 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
3091 ) ["stat", stat_cols; "statvfs", statvfs_cols];
3093 (* run_<action> actions *)
3095 fun (name, style, _, flags, _, _, _) ->
3096 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
3098 (match fst style with
3101 | RBool _ -> pr " int r;\n"
3102 | RInt64 _ -> pr " int64_t r;\n"
3103 | RConstString _ -> pr " const char *r;\n"
3104 | RString _ -> pr " char *r;\n"
3105 | RStringList _ | RHashtable _ -> pr " char **r;\n"
3106 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
3107 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
3108 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
3109 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
3110 | RStat _ -> pr " struct guestfs_stat *r;\n"
3111 | RStatVFS _ -> pr " struct guestfs_statvfs *r;\n"
3116 | OptString n -> pr " const char *%s;\n" n
3117 | StringList n -> pr " char **%s;\n" n
3118 | Bool n -> pr " int %s;\n" n
3119 | Int n -> pr " int %s;\n" n
3122 (* Check and convert parameters. *)
3123 let argc_expected = List.length (snd style) in
3124 pr " if (argc != %d) {\n" argc_expected;
3125 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
3127 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
3133 | String name -> pr " %s = argv[%d];\n" name i
3135 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
3137 | StringList name ->
3138 pr " %s = parse_string_list (argv[%d]);\n" name i
3140 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
3142 pr " %s = atoi (argv[%d]);\n" name i
3145 (* Call C API function. *)
3147 try find_map (function FishAction n -> Some n | _ -> None) flags
3148 with Not_found -> sprintf "guestfs_%s" name in
3150 generate_call_args ~handle:"g" style;
3153 (* Check return value for errors and display command results. *)
3154 (match fst style with
3155 | RErr -> pr " return r;\n"
3157 pr " if (r == -1) return -1;\n";
3158 pr " printf (\"%%d\\n\", r);\n";
3161 pr " if (r == -1) return -1;\n";
3162 pr " printf (\"%%\" PRIi64 \"\\n\", r);\n";
3165 pr " if (r == -1) return -1;\n";
3166 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
3169 pr " if (r == NULL) return -1;\n";
3170 pr " printf (\"%%s\\n\", r);\n";
3173 pr " if (r == NULL) return -1;\n";
3174 pr " printf (\"%%s\\n\", r);\n";
3178 pr " if (r == NULL) return -1;\n";
3179 pr " print_strings (r);\n";
3180 pr " free_strings (r);\n";
3183 pr " if (r == NULL) return -1;\n";
3184 pr " printf (\"%%d, %%s\\n\", r->i,\n";
3185 pr " r->b ? \"true\" : \"false\");\n";
3186 pr " guestfs_free_int_bool (r);\n";
3189 pr " if (r == NULL) return -1;\n";
3190 pr " print_pv_list (r);\n";
3191 pr " guestfs_free_lvm_pv_list (r);\n";
3194 pr " if (r == NULL) return -1;\n";
3195 pr " print_vg_list (r);\n";
3196 pr " guestfs_free_lvm_vg_list (r);\n";
3199 pr " if (r == NULL) return -1;\n";
3200 pr " print_lv_list (r);\n";
3201 pr " guestfs_free_lvm_lv_list (r);\n";
3204 pr " if (r == NULL) return -1;\n";
3205 pr " print_stat (r);\n";
3209 pr " if (r == NULL) return -1;\n";
3210 pr " print_statvfs (r);\n";
3214 pr " if (r == NULL) return -1;\n";
3215 pr " print_table (r);\n";
3216 pr " free_strings (r);\n";
3223 (* run_action function *)
3224 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
3227 fun (name, _, _, flags, _, _, _) ->
3228 let name2 = replace_char name '_' '-' in
3230 try find_map (function FishAlias n -> Some n | _ -> None) flags
3231 with Not_found -> name in
3233 pr "strcasecmp (cmd, \"%s\") == 0" name;
3234 if name <> name2 then
3235 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
3236 if name <> alias then
3237 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
3239 pr " return run_%s (cmd, argc, argv);\n" name;
3243 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
3250 (* Readline completion for guestfish. *)
3251 and generate_fish_completion () =
3252 generate_header CStyle GPLv2;
3256 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3266 #ifdef HAVE_LIBREADLINE
3267 #include <readline/readline.h>
3272 #ifdef HAVE_LIBREADLINE
3274 static const char *commands[] = {
3277 (* Get the commands and sort them, including the aliases. *)
3280 fun (name, _, _, flags, _, _, _) ->
3281 let name2 = replace_char name '_' '-' in
3283 try find_map (function FishAlias n -> Some n | _ -> None) flags
3284 with Not_found -> name in
3286 if name <> alias then [name2; alias] else [name2]
3288 let commands = List.flatten commands in
3289 let commands = List.sort compare commands in
3291 List.iter (pr " \"%s\",\n") commands;
3297 generator (const char *text, int state)
3299 static int index, len;
3304 len = strlen (text);
3307 while ((name = commands[index]) != NULL) {
3309 if (strncasecmp (name, text, len) == 0)
3310 return strdup (name);
3316 #endif /* HAVE_LIBREADLINE */
3318 char **do_completion (const char *text, int start, int end)
3320 char **matches = NULL;
3322 #ifdef HAVE_LIBREADLINE
3324 matches = rl_completion_matches (text, generator);
3331 (* Generate the POD documentation for guestfish. *)
3332 and generate_fish_actions_pod () =
3333 let all_functions_sorted =
3335 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3336 ) all_functions_sorted in
3339 fun (name, style, _, flags, _, _, longdesc) ->
3340 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
3341 let name = replace_char name '_' '-' in
3343 try find_map (function FishAlias n -> Some n | _ -> None) flags
3344 with Not_found -> name in
3346 pr "=head2 %s" name;
3347 if name <> alias then
3354 | String n -> pr " %s" n
3355 | OptString n -> pr " %s" n
3356 | StringList n -> pr " %s,..." n
3357 | Bool _ -> pr " true|false"
3358 | Int n -> pr " %s" n
3362 pr "%s\n\n" longdesc;
3364 if List.mem ProtocolLimitWarning flags then
3365 pr "%s\n\n" protocol_limit_warning;
3367 if List.mem DangerWillRobinson flags then
3368 pr "%s\n\n" danger_will_robinson
3369 ) all_functions_sorted
3371 (* Generate a C function prototype. *)
3372 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
3373 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
3375 ?handle name style =
3376 if extern then pr "extern ";
3377 if static then pr "static ";
3378 (match fst style with
3380 | RInt _ -> pr "int "
3381 | RInt64 _ -> pr "int64_t "
3382 | RBool _ -> pr "int "
3383 | RConstString _ -> pr "const char *"
3384 | RString _ -> pr "char *"
3385 | RStringList _ | RHashtable _ -> pr "char **"
3387 if not in_daemon then pr "struct guestfs_int_bool *"
3388 else pr "guestfs_%s_ret *" name
3390 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
3391 else pr "guestfs_lvm_int_pv_list *"
3393 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
3394 else pr "guestfs_lvm_int_vg_list *"
3396 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
3397 else pr "guestfs_lvm_int_lv_list *"
3399 if not in_daemon then pr "struct guestfs_stat *"
3400 else pr "guestfs_int_stat *"
3402 if not in_daemon then pr "struct guestfs_statvfs *"
3403 else pr "guestfs_int_statvfs *"
3405 pr "%s%s (" prefix name;
3406 if handle = None && List.length (snd style) = 0 then
3409 let comma = ref false in
3412 | Some handle -> pr "guestfs_h *%s" handle; comma := true
3416 if single_line then pr ", " else pr ",\n\t\t"
3422 | String n -> next (); pr "const char *%s" n
3423 | OptString n -> next (); pr "const char *%s" n
3424 | StringList n -> next (); pr "char * const* const %s" n
3425 | Bool n -> next (); pr "int %s" n
3426 | Int n -> next (); pr "int %s" n
3430 if semicolon then pr ";";
3431 if newline then pr "\n"
3433 (* Generate C call arguments, eg "(handle, foo, bar)" *)
3434 and generate_call_args ?handle style =
3436 let comma = ref false in
3439 | Some handle -> pr "%s" handle; comma := true
3443 if !comma then pr ", ";
3450 | Int n -> pr "%s" n
3454 (* Generate the OCaml bindings interface. *)
3455 and generate_ocaml_mli () =
3456 generate_header OCamlStyle LGPLv2;
3459 (** For API documentation you should refer to the C API
3460 in the guestfs(3) manual page. The OCaml API uses almost
3461 exactly the same calls. *)
3464 (** A [guestfs_h] handle. *)
3466 exception Error of string
3467 (** This exception is raised when there is an error. *)
3469 val create : unit -> t
3471 val close : t -> unit
3472 (** Handles are closed by the garbage collector when they become
3473 unreferenced, but callers can also call this in order to
3474 provide predictable cleanup. *)
3477 generate_ocaml_lvm_structure_decls ();
3479 generate_ocaml_stat_structure_decls ();
3483 fun (name, style, _, _, _, shortdesc, _) ->
3484 generate_ocaml_prototype name style;
3485 pr "(** %s *)\n" shortdesc;
3489 (* Generate the OCaml bindings implementation. *)
3490 and generate_ocaml_ml () =
3491 generate_header OCamlStyle LGPLv2;
3495 exception Error of string
3496 external create : unit -> t = \"ocaml_guestfs_create\"
3497 external close : t -> unit = \"ocaml_guestfs_close\"
3500 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
3504 generate_ocaml_lvm_structure_decls ();
3506 generate_ocaml_stat_structure_decls ();
3510 fun (name, style, _, _, _, shortdesc, _) ->
3511 generate_ocaml_prototype ~is_external:true name style;
3514 (* Generate the OCaml bindings C implementation. *)
3515 and generate_ocaml_c () =
3516 generate_header CStyle LGPLv2;
3523 #include <caml/config.h>
3524 #include <caml/alloc.h>
3525 #include <caml/callback.h>
3526 #include <caml/fail.h>
3527 #include <caml/memory.h>
3528 #include <caml/mlvalues.h>
3529 #include <caml/signals.h>
3531 #include <guestfs.h>
3533 #include \"guestfs_c.h\"
3535 /* Copy a hashtable of string pairs into an assoc-list. We return
3536 * the list in reverse order, but hashtables aren't supposed to be
3539 static CAMLprim value
3540 copy_table (char * const * argv)
3543 CAMLlocal5 (rv, pairv, kv, vv, cons);
3547 for (i = 0; argv[i] != NULL; i += 2) {
3548 kv = caml_copy_string (argv[i]);
3549 vv = caml_copy_string (argv[i+1]);
3550 pairv = caml_alloc (2, 0);
3551 Store_field (pairv, 0, kv);
3552 Store_field (pairv, 1, vv);
3553 cons = caml_alloc (2, 0);
3554 Store_field (cons, 1, rv);
3556 Store_field (cons, 0, pairv);
3564 (* LVM struct copy functions. *)
3567 let has_optpercent_col =
3568 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
3570 pr "static CAMLprim value\n";
3571 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
3573 pr " CAMLparam0 ();\n";
3574 if has_optpercent_col then
3575 pr " CAMLlocal3 (rv, v, v2);\n"
3577 pr " CAMLlocal2 (rv, v);\n";
3579 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
3584 pr " v = caml_copy_string (%s->%s);\n" typ name
3586 pr " v = caml_alloc_string (32);\n";
3587 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
3590 pr " v = caml_copy_int64 (%s->%s);\n" typ name
3591 | name, `OptPercent ->
3592 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
3593 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
3594 pr " v = caml_alloc (1, 0);\n";
3595 pr " Store_field (v, 0, v2);\n";
3596 pr " } else /* None */\n";
3597 pr " v = Val_int (0);\n";
3599 pr " Store_field (rv, %d, v);\n" i
3601 pr " CAMLreturn (rv);\n";
3605 pr "static CAMLprim value\n";
3606 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
3609 pr " CAMLparam0 ();\n";
3610 pr " CAMLlocal2 (rv, v);\n";
3613 pr " if (%ss->len == 0)\n" typ;
3614 pr " CAMLreturn (Atom (0));\n";
3616 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
3617 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
3618 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
3619 pr " caml_modify (&Field (rv, i), v);\n";
3621 pr " CAMLreturn (rv);\n";
3625 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3627 (* Stat copy functions. *)
3630 pr "static CAMLprim value\n";
3631 pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
3633 pr " CAMLparam0 ();\n";
3634 pr " CAMLlocal2 (rv, v);\n";
3636 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
3641 pr " v = caml_copy_int64 (%s->%s);\n" typ name
3643 pr " Store_field (rv, %d, v);\n" i
3645 pr " CAMLreturn (rv);\n";
3648 ) ["stat", stat_cols; "statvfs", statvfs_cols];
3652 fun (name, style, _, _, _, _, _) ->
3654 "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
3656 pr "CAMLprim value\n";
3657 pr "ocaml_guestfs_%s (value %s" name (List.hd params);
3658 List.iter (pr ", value %s") (List.tl params);
3663 | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
3664 pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
3665 pr " CAMLxparam%d (%s);\n"
3666 (List.length rest) (String.concat ", " rest)
3668 pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
3670 pr " CAMLlocal1 (rv);\n";
3673 pr " guestfs_h *g = Guestfs_val (gv);\n";
3674 pr " if (g == NULL)\n";
3675 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
3681 pr " const char *%s = String_val (%sv);\n" n n
3683 pr " const char *%s =\n" n;
3684 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
3687 pr " char **%s = ocaml_guestfs_strings_val (%sv);\n" n n
3689 pr " int %s = Bool_val (%sv);\n" n n
3691 pr " int %s = Int_val (%sv);\n" n n
3694 match fst style with
3695 | RErr -> pr " int r;\n"; "-1"
3696 | RInt _ -> pr " int r;\n"; "-1"
3697 | RInt64 _ -> pr " int64_t r;\n"; "-1"
3698 | RBool _ -> pr " int r;\n"; "-1"
3699 | RConstString _ -> pr " const char *r;\n"; "NULL"
3700 | RString _ -> pr " char *r;\n"; "NULL"
3706 pr " struct guestfs_int_bool *r;\n"; "NULL"
3708 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
3710 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
3712 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
3714 pr " struct guestfs_stat *r;\n"; "NULL"
3716 pr " struct guestfs_statvfs *r;\n"; "NULL"
3723 pr " caml_enter_blocking_section ();\n";
3724 pr " r = guestfs_%s " name;
3725 generate_call_args ~handle:"g" style;
3727 pr " caml_leave_blocking_section ();\n";
3732 pr " ocaml_guestfs_free_strings (%s);\n" n;
3733 | String _ | OptString _ | Bool _ | Int _ -> ()
3736 pr " if (r == %s)\n" error_code;
3737 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
3740 (match fst style with
3741 | RErr -> pr " rv = Val_unit;\n"
3742 | RInt _ -> pr " rv = Val_int (r);\n"
3744 pr " rv = caml_copy_int64 (r);\n"
3745 | RBool _ -> pr " rv = Val_bool (r);\n"
3746 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
3748 pr " rv = caml_copy_string (r);\n";
3751 pr " rv = caml_copy_string_array ((const char **) r);\n";
3752 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
3755 pr " rv = caml_alloc (2, 0);\n";
3756 pr " Store_field (rv, 0, Val_int (r->i));\n";
3757 pr " Store_field (rv, 1, Val_bool (r->b));\n";
3758 pr " guestfs_free_int_bool (r);\n";
3760 pr " rv = copy_lvm_pv_list (r);\n";
3761 pr " guestfs_free_lvm_pv_list (r);\n";
3763 pr " rv = copy_lvm_vg_list (r);\n";
3764 pr " guestfs_free_lvm_vg_list (r);\n";
3766 pr " rv = copy_lvm_lv_list (r);\n";
3767 pr " guestfs_free_lvm_lv_list (r);\n";
3769 pr " rv = copy_stat (r);\n";
3772 pr " rv = copy_statvfs (r);\n";
3775 pr " rv = copy_table (r);\n";
3776 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
3780 pr " CAMLreturn (rv);\n";
3784 if List.length params > 5 then (
3785 pr "CAMLprim value\n";
3786 pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
3788 pr " return ocaml_guestfs_%s (argv[0]" name;
3789 iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
3796 and generate_ocaml_lvm_structure_decls () =
3799 pr "type lvm_%s = {\n" typ;
3802 | name, `String -> pr " %s : string;\n" name
3803 | name, `UUID -> pr " %s : string;\n" name
3804 | name, `Bytes -> pr " %s : int64;\n" name
3805 | name, `Int -> pr " %s : int64;\n" name
3806 | name, `OptPercent -> pr " %s : float option;\n" name
3810 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
3812 and generate_ocaml_stat_structure_decls () =
3815 pr "type %s = {\n" typ;
3818 | name, `Int -> pr " %s : int64;\n" name
3822 ) ["stat", stat_cols; "statvfs", statvfs_cols]
3824 and generate_ocaml_prototype ?(is_external = false) name style =
3825 if is_external then pr "external " else pr "val ";
3826 pr "%s : t -> " name;
3829 | String _ -> pr "string -> "
3830 | OptString _ -> pr "string option -> "
3831 | StringList _ -> pr "string array -> "
3832 | Bool _ -> pr "bool -> "
3833 | Int _ -> pr "int -> "
3835 (match fst style with
3836 | RErr -> pr "unit" (* all errors are turned into exceptions *)
3837 | RInt _ -> pr "int"
3838 | RInt64 _ -> pr "int64"
3839 | RBool _ -> pr "bool"
3840 | RConstString _ -> pr "string"
3841 | RString _ -> pr "string"
3842 | RStringList _ -> pr "string array"
3843 | RIntBool _ -> pr "int * bool"
3844 | RPVList _ -> pr "lvm_pv array"
3845 | RVGList _ -> pr "lvm_vg array"
3846 | RLVList _ -> pr "lvm_lv array"
3847 | RStat _ -> pr "stat"
3848 | RStatVFS _ -> pr "statvfs"
3849 | RHashtable _ -> pr "(string * string) list"
3851 if is_external then (
3853 if List.length (snd style) + 1 > 5 then
3854 pr "\"ocaml_guestfs_%s_byte\" " name;
3855 pr "\"ocaml_guestfs_%s\"" name
3859 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
3860 and generate_perl_xs () =
3861 generate_header CStyle LGPLv2;
3864 #include \"EXTERN.h\"
3868 #include <guestfs.h>
3871 #define PRId64 \"lld\"
3875 my_newSVll(long long val) {
3876 #ifdef USE_64_BIT_ALL
3877 return newSViv(val);
3881 len = snprintf(buf, 100, \"%%\" PRId64, val);
3882 return newSVpv(buf, len);
3887 #define PRIu64 \"llu\"
3891 my_newSVull(unsigned long long val) {
3892 #ifdef USE_64_BIT_ALL
3893 return newSVuv(val);
3897 len = snprintf(buf, 100, \"%%\" PRIu64, val);
3898 return newSVpv(buf, len);
3902 /* http://www.perlmonks.org/?node_id=680842 */
3904 XS_unpack_charPtrPtr (SV *arg) {
3909 if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV) {
3910 croak (\"array reference expected\");
3913 av = (AV *)SvRV (arg);
3914 ret = (char **)malloc (av_len (av) + 1 + 1);
3916 for (i = 0; i <= av_len (av); i++) {
3917 SV **elem = av_fetch (av, i, 0);
3919 if (!elem || !*elem)
3920 croak (\"missing element in list\");
3922 ret[i] = SvPV_nolen (*elem);
3930 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
3935 RETVAL = guestfs_create ();
3937 croak (\"could not create guestfs handle\");
3938 guestfs_set_error_handler (RETVAL, NULL, NULL);
3951 fun (name, style, _, _, _, _, _) ->
3952 (match fst style with
3953 | RErr -> pr "void\n"
3954 | RInt _ -> pr "SV *\n"
3955 | RInt64 _ -> pr "SV *\n"
3956 | RBool _ -> pr "SV *\n"
3957 | RConstString _ -> pr "SV *\n"
3958 | RString _ -> pr "SV *\n"
3961 | RPVList _ | RVGList _ | RLVList _
3962 | RStat _ | RStatVFS _
3964 pr "void\n" (* all lists returned implictly on the stack *)
3966 (* Call and arguments. *)
3968 generate_call_args ~handle:"g" style;
3970 pr " guestfs_h *g;\n";
3973 | String n -> pr " char *%s;\n" n
3974 | OptString n -> pr " char *%s;\n" n
3975 | StringList n -> pr " char **%s;\n" n
3976 | Bool n -> pr " int %s;\n" n
3977 | Int n -> pr " int %s;\n" n
3980 let do_cleanups () =
3987 | StringList n -> pr " free (%s);\n" n
3992 (match fst style with
3997 pr " r = guestfs_%s " name;
3998 generate_call_args ~handle:"g" style;
4001 pr " if (r == -1)\n";
4002 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4008 pr " %s = guestfs_%s " n name;
4009 generate_call_args ~handle:"g" style;
4012 pr " if (%s == -1)\n" n;
4013 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4014 pr " RETVAL = newSViv (%s);\n" n;
4019 pr " int64_t %s;\n" n;
4021 pr " %s = guestfs_%s " n name;
4022 generate_call_args ~handle:"g" style;
4025 pr " if (%s == -1)\n" n;
4026 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4027 pr " RETVAL = my_newSVll (%s);\n" n;
4032 pr " const char *%s;\n" n;
4034 pr " %s = guestfs_%s " n name;
4035 generate_call_args ~handle:"g" style;
4038 pr " if (%s == NULL)\n" n;
4039 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4040 pr " RETVAL = newSVpv (%s, 0);\n" n;
4045 pr " char *%s;\n" n;
4047 pr " %s = guestfs_%s " n name;
4048 generate_call_args ~handle:"g" style;
4051 pr " if (%s == NULL)\n" n;
4052 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4053 pr " RETVAL = newSVpv (%s, 0);\n" n;
4054 pr " free (%s);\n" n;
4057 | RStringList n | RHashtable n ->
4059 pr " char **%s;\n" n;
4062 pr " %s = guestfs_%s " n name;
4063 generate_call_args ~handle:"g" style;
4066 pr " if (%s == NULL)\n" n;
4067 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4068 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
4069 pr " EXTEND (SP, n);\n";
4070 pr " for (i = 0; i < n; ++i) {\n";
4071 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
4072 pr " free (%s[i]);\n" n;
4074 pr " free (%s);\n" n;
4077 pr " struct guestfs_int_bool *r;\n";
4079 pr " r = guestfs_%s " name;
4080 generate_call_args ~handle:"g" style;
4083 pr " if (r == NULL)\n";
4084 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4085 pr " EXTEND (SP, 2);\n";
4086 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
4087 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
4088 pr " guestfs_free_int_bool (r);\n";
4090 generate_perl_lvm_code "pv" pv_cols name style n do_cleanups
4092 generate_perl_lvm_code "vg" vg_cols name style n do_cleanups
4094 generate_perl_lvm_code "lv" lv_cols name style n do_cleanups
4096 generate_perl_stat_code "stat" stat_cols name style n do_cleanups
4098 generate_perl_stat_code
4099 "statvfs" statvfs_cols name style n do_cleanups
4105 and generate_perl_lvm_code typ cols name style n do_cleanups =
4107 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
4111 pr " %s = guestfs_%s " n name;
4112 generate_call_args ~handle:"g" style;
4115 pr " if (%s == NULL)\n" n;
4116 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4117 pr " EXTEND (SP, %s->len);\n" n;
4118 pr " for (i = 0; i < %s->len; ++i) {\n" n;
4119 pr " hv = newHV ();\n";
4123 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
4124 name (String.length name) n name
4126 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
4127 name (String.length name) n name
4129 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
4130 name (String.length name) n name
4132 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
4133 name (String.length name) n name
4134 | name, `OptPercent ->
4135 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
4136 name (String.length name) n name
4138 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
4140 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
4142 and generate_perl_stat_code typ cols name style n do_cleanups =
4144 pr " struct guestfs_%s *%s;\n" typ n;
4146 pr " %s = guestfs_%s " n name;
4147 generate_call_args ~handle:"g" style;
4150 pr " if (%s == NULL)\n" n;
4151 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
4152 pr " EXTEND (SP, %d);\n" (List.length cols);
4156 pr " PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n" n name
4158 pr " free (%s);\n" n
4160 (* Generate Sys/Guestfs.pm. *)
4161 and generate_perl_pm () =
4162 generate_header HashStyle LGPLv2;
4169 Sys::Guestfs - Perl bindings for libguestfs
4175 my $h = Sys::Guestfs->new ();
4176 $h->add_drive ('guest.img');
4179 $h->mount ('/dev/sda1', '/');
4180 $h->touch ('/hello');
4185 The C<Sys::Guestfs> module provides a Perl XS binding to the
4186 libguestfs API for examining and modifying virtual machine
4189 Amongst the things this is good for: making batch configuration
4190 changes to guests, getting disk used/free statistics (see also:
4191 virt-df), migrating between virtualization systems (see also:
4192 virt-p2v), performing partial backups, performing partial guest
4193 clones, cloning guests and changing registry/UUID/hostname info, and
4196 Libguestfs uses Linux kernel and qemu code, and can access any type of
4197 guest filesystem that Linux and qemu can, including but not limited
4198 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
4199 schemes, qcow, qcow2, vmdk.
4201 Libguestfs provides ways to enumerate guest storage (eg. partitions,
4202 LVs, what filesystem is in each LV, etc.). It can also run commands
4203 in the context of the guest. Also you can access filesystems over FTP.
4207 All errors turn into calls to C<croak> (see L<Carp(3)>).
4215 package Sys::Guestfs;
4221 XSLoader::load ('Sys::Guestfs');
4223 =item $h = Sys::Guestfs->new ();
4225 Create a new guestfs handle.
4231 my $class = ref ($proto) || $proto;
4233 my $self = Sys::Guestfs::_create ();
4234 bless $self, $class;
4240 (* Actions. We only need to print documentation for these as
4241 * they are pulled in from the XS code automatically.
4244 fun (name, style, _, flags, _, _, longdesc) ->
4245 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
4247 generate_perl_prototype name style;
4249 pr "%s\n\n" longdesc;
4250 if List.mem ProtocolLimitWarning flags then
4251 pr "%s\n\n" protocol_limit_warning;
4252 if List.mem DangerWillRobinson flags then
4253 pr "%s\n\n" danger_will_robinson
4254 ) all_functions_sorted;
4266 Copyright (C) 2009 Red Hat Inc.
4270 Please see the file COPYING.LIB for the full license.
4274 L<guestfs(3)>, L<guestfish(1)>.
4279 and generate_perl_prototype name style =
4280 (match fst style with
4286 | RString n -> pr "$%s = " n
4287 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
4291 | RLVList n -> pr "@%s = " n
4294 | RHashtable n -> pr "%%%s = " n
4297 let comma = ref false in
4300 if !comma then pr ", ";
4303 | String n | OptString n | Bool n | Int n ->
4310 (* Generate Python C module. *)
4311 and generate_python_c () =
4312 generate_header CStyle LGPLv2;
4321 #include \"guestfs.h\"
4329 get_handle (PyObject *obj)
4332 assert (obj != Py_None);
4333 return ((Pyguestfs_Object *) obj)->g;
4337 put_handle (guestfs_h *g)
4341 PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
4344 /* This list should be freed (but not the strings) after use. */
4345 static const char **
4346 get_string_list (PyObject *obj)
4353 if (!PyList_Check (obj)) {
4354 PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
4358 len = PyList_Size (obj);
4359 r = malloc (sizeof (char *) * (len+1));
4361 PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
4365 for (i = 0; i < len; ++i)
4366 r[i] = PyString_AsString (PyList_GetItem (obj, i));
4373 put_string_list (char * const * const argv)
4378 for (argc = 0; argv[argc] != NULL; ++argc)
4381 list = PyList_New (argc);
4382 for (i = 0; i < argc; ++i)
4383 PyList_SetItem (list, i, PyString_FromString (argv[i]));
4389 put_table (char * const * const argv)
4391 PyObject *list, *item;
4394 for (argc = 0; argv[argc] != NULL; ++argc)
4397 list = PyList_New (argc >> 1);
4398 for (i = 0; i < argc; i += 2) {
4400 item = PyTuple_New (2);
4401 PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
4402 PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
4403 PyList_SetItem (list, i >> 1, item);
4410 free_strings (char **argv)
4414 for (argc = 0; argv[argc] != NULL; ++argc)
4420 py_guestfs_create (PyObject *self, PyObject *args)
4424 g = guestfs_create ();
4426 PyErr_SetString (PyExc_RuntimeError,
4427 \"guestfs.create: failed to allocate handle\");
4430 guestfs_set_error_handler (g, NULL, NULL);
4431 return put_handle (g);
4435 py_guestfs_close (PyObject *self, PyObject *args)
4440 if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
4442 g = get_handle (py_g);
4446 Py_INCREF (Py_None);
4452 (* LVM structures, turned into Python dictionaries. *)
4455 pr "static PyObject *\n";
4456 pr "put_lvm_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
4458 pr " PyObject *dict;\n";
4460 pr " dict = PyDict_New ();\n";
4464 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4465 pr " PyString_FromString (%s->%s));\n"
4468 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4469 pr " PyString_FromStringAndSize (%s->%s, 32));\n"
4472 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4473 pr " PyLong_FromUnsignedLongLong (%s->%s));\n"
4476 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4477 pr " PyLong_FromLongLong (%s->%s));\n"
4479 | name, `OptPercent ->
4480 pr " if (%s->%s >= 0)\n" typ name;
4481 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4482 pr " PyFloat_FromDouble ((double) %s->%s));\n"
4485 pr " Py_INCREF (Py_None);\n";
4486 pr " PyDict_SetItemString (dict, \"%s\", Py_None);" name;
4489 pr " return dict;\n";
4493 pr "static PyObject *\n";
4494 pr "put_lvm_%s_list (struct guestfs_lvm_%s_list *%ss)\n" typ typ typ;
4496 pr " PyObject *list;\n";
4499 pr " list = PyList_New (%ss->len);\n" typ;
4500 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
4501 pr " PyList_SetItem (list, i, put_lvm_%s (&%ss->val[i]));\n" typ typ;
4502 pr " return list;\n";
4505 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
4507 (* Stat structures, turned into Python dictionaries. *)
4510 pr "static PyObject *\n";
4511 pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
4513 pr " PyObject *dict;\n";
4515 pr " dict = PyDict_New ();\n";
4519 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4520 pr " PyLong_FromLongLong (%s->%s));\n"
4523 pr " return dict;\n";
4526 ) ["stat", stat_cols; "statvfs", statvfs_cols];
4528 (* Python wrapper functions. *)
4530 fun (name, style, _, _, _, _, _) ->
4531 pr "static PyObject *\n";
4532 pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
4535 pr " PyObject *py_g;\n";
4536 pr " guestfs_h *g;\n";
4537 pr " PyObject *py_r;\n";
4540 match fst style with
4541 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
4542 | RInt64 _ -> pr " int64_t r;\n"; "-1"
4543 | RConstString _ -> pr " const char *r;\n"; "NULL"
4544 | RString _ -> pr " char *r;\n"; "NULL"
4545 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
4546 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
4547 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
4548 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
4549 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
4550 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
4551 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
4555 | String n -> pr " const char *%s;\n" n
4556 | OptString n -> pr " const char *%s;\n" n
4558 pr " PyObject *py_%s;\n" n;
4559 pr " const char **%s;\n" n
4560 | Bool n -> pr " int %s;\n" n
4561 | Int n -> pr " int %s;\n" n
4566 (* Convert the parameters. *)
4567 pr " if (!PyArg_ParseTuple (args, (char *) \"O";
4570 | String _ -> pr "s"
4571 | OptString _ -> pr "z"
4572 | StringList _ -> pr "O"
4573 | Bool _ -> pr "i" (* XXX Python has booleans? *)
4576 pr ":guestfs_%s\",\n" name;
4580 | String n -> pr ", &%s" n
4581 | OptString n -> pr ", &%s" n
4582 | StringList n -> pr ", &py_%s" n
4583 | Bool n -> pr ", &%s" n
4584 | Int n -> pr ", &%s" n
4588 pr " return NULL;\n";
4590 pr " g = get_handle (py_g);\n";
4593 | String _ | OptString _ | Bool _ | Int _ -> ()
4595 pr " %s = get_string_list (py_%s);\n" n n;
4596 pr " if (!%s) return NULL;\n" n
4601 pr " r = guestfs_%s " name;
4602 generate_call_args ~handle:"g" style;
4607 | String _ | OptString _ | Bool _ | Int _ -> ()
4609 pr " free (%s);\n" n
4612 pr " if (r == %s) {\n" error_code;
4613 pr " PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
4614 pr " return NULL;\n";
4618 (match fst style with
4620 pr " Py_INCREF (Py_None);\n";
4621 pr " py_r = Py_None;\n"
4623 | RBool _ -> pr " py_r = PyInt_FromLong ((long) r);\n"
4624 | RInt64 _ -> pr " py_r = PyLong_FromLongLong (r);\n"
4625 | RConstString _ -> pr " py_r = PyString_FromString (r);\n"
4627 pr " py_r = PyString_FromString (r);\n";
4630 pr " py_r = put_string_list (r);\n";
4631 pr " free_strings (r);\n"
4633 pr " py_r = PyTuple_New (2);\n";
4634 pr " PyTuple_SetItem (py_r, 0, PyInt_FromLong ((long) r->i));\n";
4635 pr " PyTuple_SetItem (py_r, 1, PyInt_FromLong ((long) r->b));\n";
4636 pr " guestfs_free_int_bool (r);\n"
4638 pr " py_r = put_lvm_pv_list (r);\n";
4639 pr " guestfs_free_lvm_pv_list (r);\n"
4641 pr " py_r = put_lvm_vg_list (r);\n";
4642 pr " guestfs_free_lvm_vg_list (r);\n"
4644 pr " py_r = put_lvm_lv_list (r);\n";
4645 pr " guestfs_free_lvm_lv_list (r);\n"
4647 pr " py_r = put_stat (r);\n";
4650 pr " py_r = put_statvfs (r);\n";
4653 pr " py_r = put_table (r);\n";
4654 pr " free_strings (r);\n"
4657 pr " return py_r;\n";
4662 (* Table of functions. *)
4663 pr "static PyMethodDef methods[] = {\n";
4664 pr " { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
4665 pr " { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
4667 fun (name, _, _, _, _, _, _) ->
4668 pr " { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
4671 pr " { NULL, NULL, 0, NULL }\n";
4675 (* Init function. *)
4678 initlibguestfsmod (void)
4680 static int initialized = 0;
4682 if (initialized) return;
4683 Py_InitModule ((char *) \"libguestfsmod\", methods);
4688 (* Generate Python module. *)
4689 and generate_python_py () =
4690 generate_header HashStyle LGPLv2;
4692 pr "import libguestfsmod\n";
4694 pr "class GuestFS:\n";
4695 pr " def __init__ (self):\n";
4696 pr " self._o = libguestfsmod.create ()\n";
4698 pr " def __del__ (self):\n";
4699 pr " libguestfsmod.close (self._o)\n";
4703 fun (name, style, _, _, _, _, _) ->
4705 generate_call_args ~handle:"self" style;
4707 pr " return libguestfsmod.%s " name;
4708 generate_call_args ~handle:"self._o" style;
4713 let output_to filename =
4714 let filename_new = filename ^ ".new" in
4715 chan := open_out filename_new;
4719 Unix.rename filename_new filename;
4720 printf "written %s\n%!" filename;
4728 if not (Sys.file_exists "configure.ac") then (
4730 You are probably running this from the wrong directory.
4731 Run it from the top source directory using the command
4737 let close = output_to "src/guestfs_protocol.x" in
4741 let close = output_to "src/guestfs-structs.h" in
4742 generate_structs_h ();
4745 let close = output_to "src/guestfs-actions.h" in
4746 generate_actions_h ();
4749 let close = output_to "src/guestfs-actions.c" in
4750 generate_client_actions ();
4753 let close = output_to "daemon/actions.h" in
4754 generate_daemon_actions_h ();
4757 let close = output_to "daemon/stubs.c" in
4758 generate_daemon_actions ();
4761 let close = output_to "tests.c" in
4765 let close = output_to "fish/cmds.c" in
4766 generate_fish_cmds ();
4769 let close = output_to "fish/completion.c" in
4770 generate_fish_completion ();
4773 let close = output_to "guestfs-structs.pod" in
4774 generate_structs_pod ();
4777 let close = output_to "guestfs-actions.pod" in
4778 generate_actions_pod ();
4781 let close = output_to "guestfish-actions.pod" in
4782 generate_fish_actions_pod ();
4785 let close = output_to "ocaml/guestfs.mli" in
4786 generate_ocaml_mli ();
4789 let close = output_to "ocaml/guestfs.ml" in
4790 generate_ocaml_ml ();
4793 let close = output_to "ocaml/guestfs_c_actions.c" in
4794 generate_ocaml_c ();
4797 let close = output_to "perl/Guestfs.xs" in
4798 generate_perl_xs ();
4801 let close = output_to "perl/lib/Sys/Guestfs.pm" in
4802 generate_perl_pm ();
4805 let close = output_to "python/guestfs-py.c" in
4806 generate_python_c ();
4809 let close = output_to "python/guestfs.py" in
4810 generate_python_py ();