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.
49 (* "RBool" is a bool return value which can be true/false or
53 (* "RConstString" is a string that refers to a constant value.
54 * Try to avoid using this. In particular you cannot use this
55 * for values returned from the daemon, because there is no
56 * thread-safe way to return them in the C API.
58 | RConstString of string
59 (* "RString" and "RStringList" are caller-frees. *)
61 | RStringList of string
62 (* Some limited tuples are possible: *)
63 | RIntBool of string * string
64 (* LVM PVs, VGs and LVs. *)
68 and args = argt list (* Function parameters, guestfs handle is implicit. *)
70 (* Note in future we should allow a "variable args" parameter as
71 * the final parameter, to allow commands like
72 * chmod mode file [file(s)...]
73 * This is not implemented yet, but many commands (such as chmod)
74 * are currently defined with the argument order keeping this future
75 * possibility in mind.
78 | String of string (* const char *name, cannot be NULL *)
79 | OptString of string (* const char *name, may be NULL *)
80 | StringList of string(* list of strings (each string cannot be NULL) *)
81 | Bool of string (* boolean *)
82 | Int of string (* int (smallish ints, signed, <= 31 bits) *)
85 | ProtocolLimitWarning (* display warning about protocol size limits *)
86 | DangerWillRobinson (* flags particularly dangerous commands *)
87 | FishAlias of string (* provide an alias for this cmd in guestfish *)
88 | FishAction of string (* call this function in guestfish *)
89 | NotInFish (* do not export via guestfish *)
91 let protocol_limit_warning =
92 "Because of the message protocol, there is a transfer limit
93 of somewhere between 2MB and 4MB. To transfer large files you should use
96 let danger_will_robinson =
97 "B<This command is dangerous. Without careful use you
98 can easily destroy all your data>."
100 (* You can supply zero or as many tests as you want per API call.
102 * Note that the test environment has 3 block devices, of size 500MB,
103 * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc).
104 * Note for partitioning purposes, the 500MB device has 63 cylinders.
106 * To be able to run the tests in a reasonable amount of time,
107 * the virtual machine and block devices are reused between tests.
108 * So don't try testing kill_subprocess :-x
110 * Between each test we umount-all and lvm-remove-all.
112 * Don't assume anything about the previous contents of the block
113 * devices. Use 'Init*' to create some initial scenarios.
115 type tests = (test_init * test) list
117 (* Run the command sequence and just expect nothing to fail. *)
119 (* Run the command sequence and expect the output of the final
120 * command to be the string.
122 | TestOutput of seq * string
123 (* Run the command sequence and expect the output of the final
124 * command to be the list of strings.
126 | TestOutputList of seq * string list
127 (* Run the command sequence and expect the output of the final
128 * command to be the integer.
130 | TestOutputInt of seq * int
131 (* Run the command sequence and expect the output of the final
132 * command to be a true value (!= 0 or != NULL).
134 | TestOutputTrue of seq
135 (* Run the command sequence and expect the output of the final
136 * command to be a false value (== 0 or == NULL, but not an error).
138 | TestOutputFalse of seq
139 (* Run the command sequence and expect the output of the final
140 * command to be a list of the given length (but don't care about
143 | TestOutputLength of seq * int
144 (* Run the command sequence and expect the final command (only)
147 | TestLastFail of seq
149 (* Some initial scenarios for testing. *)
151 (* Do nothing, block devices could contain random stuff. *)
153 (* /dev/sda contains a single partition /dev/sda1, which is formatted
154 * as ext2, empty [except for lost+found] and mounted on /.
155 * /dev/sdb and /dev/sdc may have random content.
160 * /dev/sda1 (is a PV):
161 * /dev/VG/LV (size 8MB):
162 * formatted as ext2, empty [except for lost+found], mounted on /
163 * /dev/sdb and /dev/sdc may have random content.
167 (* Sequence of commands for testing. *)
169 and cmd = string list
171 (* Note about long descriptions: When referring to another
172 * action, use the format C<guestfs_other> (ie. the full name of
173 * the C function). This will be replaced as appropriate in other
176 * Apart from that, long descriptions are just perldoc paragraphs.
179 let non_daemon_functions = [
180 ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
182 "launch the qemu subprocess",
184 Internally libguestfs is implemented by running a virtual machine
187 You should call this after configuring the handle
188 (eg. adding drives) but before performing any actions.");
190 ("wait_ready", (RErr, []), -1, [NotInFish],
192 "wait until the qemu subprocess launches",
194 Internally libguestfs is implemented by running a virtual machine
197 You should call this after C<guestfs_launch> to wait for the launch
200 ("kill_subprocess", (RErr, []), -1, [],
202 "kill the qemu subprocess",
204 This kills the qemu subprocess. You should never need to call this.");
206 ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
208 "add an image to examine or modify",
210 This function adds a virtual machine disk image C<filename> to the
211 guest. The first time you call this function, the disk appears as IDE
212 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
215 You don't necessarily need to be root when using libguestfs. However
216 you obviously do need sufficient permissions to access the filename
217 for whatever operations you want to perform (ie. read access if you
218 just want to read the image or write access if you want to modify the
221 This is equivalent to the qemu parameter C<-drive file=filename>.");
223 ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
225 "add a CD-ROM disk image to examine",
227 This function adds a virtual CD-ROM disk image to the guest.
229 This is equivalent to the qemu parameter C<-cdrom filename>.");
231 ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
233 "add qemu parameters",
235 This can be used to add arbitrary qemu command line parameters
236 of the form C<-param value>. Actually it's not quite arbitrary - we
237 prevent you from setting some parameters which would interfere with
238 parameters that we use.
240 The first character of C<param> string must be a C<-> (dash).
242 C<value> can be NULL.");
244 ("set_path", (RErr, [String "path"]), -1, [FishAlias "path"],
246 "set the search path",
248 Set the path that libguestfs searches for kernel and initrd.img.
250 The default is C<$libdir/guestfs> unless overridden by setting
251 C<LIBGUESTFS_PATH> environment variable.
253 The string C<path> is stashed in the libguestfs handle, so the caller
254 must make sure it remains valid for the lifetime of the handle.
256 Setting C<path> to C<NULL> restores the default path.");
258 ("get_path", (RConstString "path", []), -1, [],
260 "get the search path",
262 Return the current search path.
264 This is always non-NULL. If it wasn't set already, then this will
265 return the default path.");
267 ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
271 If C<autosync> is true, this enables autosync. Libguestfs will make a
272 best effort attempt to run C<guestfs_sync> when the handle is closed
273 (also if the program exits without closing handles).");
275 ("get_autosync", (RBool "autosync", []), -1, [],
279 Get the autosync flag.");
281 ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
285 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
287 Verbose messages are disabled unless the environment variable
288 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
290 ("get_verbose", (RBool "verbose", []), -1, [],
294 This returns the verbose messages flag.")
297 let daemon_functions = [
298 ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
299 [InitNone, TestOutput (
300 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
301 ["mkfs"; "ext2"; "/dev/sda1"];
302 ["mount"; "/dev/sda1"; "/"];
303 ["write_file"; "/new"; "new file contents"; "0"];
304 ["cat"; "/new"]], "new file contents")],
305 "mount a guest disk at a position in the filesystem",
307 Mount a guest disk at a position in the filesystem. Block devices
308 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
309 the guest. If those block devices contain partitions, they will have
310 the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
313 The rules are the same as for L<mount(2)>: A filesystem must
314 first be mounted on C</> before others can be mounted. Other
315 filesystems can only be mounted on directories which already
318 The mounted filesystem is writable, if we have sufficient permissions
319 on the underlying device.
321 The filesystem options C<sync> and C<noatime> are set with this
322 call, in order to improve reliability.");
324 ("sync", (RErr, []), 2, [],
325 [ InitNone, TestRun [["sync"]]],
326 "sync disks, writes are flushed through to the disk image",
328 This syncs the disk, so that any writes are flushed through to the
329 underlying disk image.
331 You should always call this if you have modified a disk image, before
332 closing the handle.");
334 ("touch", (RErr, [String "path"]), 3, [],
335 [InitEmpty, TestOutputTrue (
337 ["exists"; "/new"]])],
338 "update file timestamps or create a new file",
340 Touch acts like the L<touch(1)> command. It can be used to
341 update the timestamps on a file, or, if the file does not exist,
342 to create a new zero-length file.");
344 ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
345 [InitEmpty, TestOutput (
346 [["write_file"; "/new"; "new file contents"; "0"];
347 ["cat"; "/new"]], "new file contents")],
348 "list the contents of a file",
350 Return the contents of the file named C<path>.
352 Note that this function cannot correctly handle binary files
353 (specifically, files containing C<\\0> character which is treated
354 as end of string). For those you need to use the C<guestfs_read_file>
355 function which has a more complex interface.");
357 ("ll", (RString "listing", [String "directory"]), 5, [],
358 [], (* XXX Tricky to test because it depends on the exact format
359 * of the 'ls -l' command, which changes between F10 and F11.
361 "list the files in a directory (long format)",
363 List the files in C<directory> (relative to the root directory,
364 there is no cwd) in the format of 'ls -la'.
366 This command is mostly useful for interactive sessions. It
367 is I<not> intended that you try to parse the output string.");
369 ("ls", (RStringList "listing", [String "directory"]), 6, [],
370 [InitEmpty, TestOutputList (
373 ["touch"; "/newest"];
374 ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
375 "list the files in a directory",
377 List the files in C<directory> (relative to the root directory,
378 there is no cwd). The '.' and '..' entries are not returned, but
379 hidden files are shown.
381 This command is mostly useful for interactive sessions. Programs
382 should probably use C<guestfs_readdir> instead.");
384 ("list_devices", (RStringList "devices", []), 7, [],
385 [InitNone, TestOutputList (
386 [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"])],
387 "list the block devices",
389 List all the block devices.
391 The full block device names are returned, eg. C</dev/sda>");
393 ("list_partitions", (RStringList "partitions", []), 8, [],
394 [InitEmpty, TestOutputList (
395 [["list_partitions"]], ["/dev/sda1"]);
396 InitNone, TestOutputList (
397 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
398 ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
399 "list the partitions",
401 List all the partitions detected on all block devices.
403 The full partition device names are returned, eg. C</dev/sda1>
405 This does not return logical volumes. For that you will need to
406 call C<guestfs_lvs>.");
408 ("pvs", (RStringList "physvols", []), 9, [],
409 [InitEmptyLVM, TestOutputList (
410 [["pvs"]], ["/dev/sda1"]);
411 InitNone, TestOutputList (
412 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
413 ["pvcreate"; "/dev/sda1"];
414 ["pvcreate"; "/dev/sda2"];
415 ["pvcreate"; "/dev/sda3"];
416 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
417 "list the LVM physical volumes (PVs)",
419 List all the physical volumes detected. This is the equivalent
420 of the L<pvs(8)> command.
422 This returns a list of just the device names that contain
423 PVs (eg. C</dev/sda2>).
425 See also C<guestfs_pvs_full>.");
427 ("vgs", (RStringList "volgroups", []), 10, [],
428 [InitEmptyLVM, TestOutputList (
430 InitNone, TestOutputList (
431 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
432 ["pvcreate"; "/dev/sda1"];
433 ["pvcreate"; "/dev/sda2"];
434 ["pvcreate"; "/dev/sda3"];
435 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
436 ["vgcreate"; "VG2"; "/dev/sda3"];
437 ["vgs"]], ["VG1"; "VG2"])],
438 "list the LVM volume groups (VGs)",
440 List all the volumes groups detected. This is the equivalent
441 of the L<vgs(8)> command.
443 This returns a list of just the volume group names that were
444 detected (eg. C<VolGroup00>).
446 See also C<guestfs_vgs_full>.");
448 ("lvs", (RStringList "logvols", []), 11, [],
449 [InitEmptyLVM, TestOutputList (
450 [["lvs"]], ["/dev/VG/LV"]);
451 InitNone, TestOutputList (
452 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
453 ["pvcreate"; "/dev/sda1"];
454 ["pvcreate"; "/dev/sda2"];
455 ["pvcreate"; "/dev/sda3"];
456 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
457 ["vgcreate"; "VG2"; "/dev/sda3"];
458 ["lvcreate"; "LV1"; "VG1"; "50"];
459 ["lvcreate"; "LV2"; "VG1"; "50"];
460 ["lvcreate"; "LV3"; "VG2"; "50"];
461 ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
462 "list the LVM logical volumes (LVs)",
464 List all the logical volumes detected. This is the equivalent
465 of the L<lvs(8)> command.
467 This returns a list of the logical volume device names
468 (eg. C</dev/VolGroup00/LogVol00>).
470 See also C<guestfs_lvs_full>.");
472 ("pvs_full", (RPVList "physvols", []), 12, [],
473 [InitEmptyLVM, TestOutputLength (
475 "list the LVM physical volumes (PVs)",
477 List all the physical volumes detected. This is the equivalent
478 of the L<pvs(8)> command. The \"full\" version includes all fields.");
480 ("vgs_full", (RVGList "volgroups", []), 13, [],
481 [InitEmptyLVM, TestOutputLength (
483 "list the LVM volume groups (VGs)",
485 List all the volumes groups detected. This is the equivalent
486 of the L<vgs(8)> command. The \"full\" version includes all fields.");
488 ("lvs_full", (RLVList "logvols", []), 14, [],
489 [InitEmptyLVM, TestOutputLength (
491 "list the LVM logical volumes (LVs)",
493 List all the logical volumes detected. This is the equivalent
494 of the L<lvs(8)> command. The \"full\" version includes all fields.");
496 ("read_lines", (RStringList "lines", [String "path"]), 15, [],
497 [InitEmpty, TestOutputList (
498 [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
499 ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);
500 InitEmpty, TestOutputList (
501 [["write_file"; "/new"; ""; "0"];
502 ["read_lines"; "/new"]], [])],
503 "read file as lines",
505 Return the contents of the file named C<path>.
507 The file contents are returned as a list of lines. Trailing
508 C<LF> and C<CRLF> character sequences are I<not> returned.
510 Note that this function cannot correctly handle binary files
511 (specifically, files containing C<\\0> character which is treated
512 as end of line). For those you need to use the C<guestfs_read_file>
513 function which has a more complex interface.");
515 ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [],
516 [], (* XXX Augeas code needs tests. *)
517 "create a new Augeas handle",
519 Create a new Augeas handle for editing configuration files.
520 If there was any previous Augeas handle associated with this
521 guestfs session, then it is closed.
523 You must call this before using any other C<guestfs_aug_*>
526 C<root> is the filesystem root. C<root> must not be NULL,
529 The flags are the same as the flags defined in
530 E<lt>augeas.hE<gt>, the logical I<or> of the following
535 =item C<AUG_SAVE_BACKUP> = 1
537 Keep the original file with a C<.augsave> extension.
539 =item C<AUG_SAVE_NEWFILE> = 2
541 Save changes into a file with extension C<.augnew>, and
542 do not overwrite original. Overrides C<AUG_SAVE_BACKUP>.
544 =item C<AUG_TYPE_CHECK> = 4
546 Typecheck lenses (can be expensive).
548 =item C<AUG_NO_STDINC> = 8
550 Do not use standard load path for modules.
552 =item C<AUG_SAVE_NOOP> = 16
554 Make save a no-op, just record what would have been changed.
556 =item C<AUG_NO_LOAD> = 32
558 Do not load the tree in C<guestfs_aug_init>.
562 To close the handle, you can call C<guestfs_aug_close>.
564 To find out more about Augeas, see L<http://augeas.net/>.");
566 ("aug_close", (RErr, []), 26, [],
567 [], (* XXX Augeas code needs tests. *)
568 "close the current Augeas handle",
570 Close the current Augeas handle and free up any resources
571 used by it. After calling this, you have to call
572 C<guestfs_aug_init> again before you can use any other
575 ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
576 [], (* XXX Augeas code needs tests. *)
577 "define an Augeas variable",
579 Defines an Augeas variable C<name> whose value is the result
580 of evaluating C<expr>. If C<expr> is NULL, then C<name> is
583 On success this returns the number of nodes in C<expr>, or
584 C<0> if C<expr> evaluates to something which is not a nodeset.");
586 ("aug_defnode", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [],
587 [], (* XXX Augeas code needs tests. *)
588 "define an Augeas node",
590 Defines a variable C<name> whose value is the result of
593 If C<expr> evaluates to an empty nodeset, a node is created,
594 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
595 C<name> will be the nodeset containing that single node.
597 On success this returns a pair containing the
598 number of nodes in the nodeset, and a boolean flag
599 if a node was created.");
601 ("aug_get", (RString "val", [String "path"]), 19, [],
602 [], (* XXX Augeas code needs tests. *)
603 "look up the value of an Augeas path",
605 Look up the value associated with C<path>. If C<path>
606 matches exactly one node, the C<value> is returned.");
608 ("aug_set", (RErr, [String "path"; String "val"]), 20, [],
609 [], (* XXX Augeas code needs tests. *)
610 "set Augeas path to value",
612 Set the value associated with C<path> to C<value>.");
614 ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [],
615 [], (* XXX Augeas code needs tests. *)
616 "insert a sibling Augeas node",
618 Create a new sibling C<label> for C<path>, inserting it into
619 the tree before or after C<path> (depending on the boolean
622 C<path> must match exactly one existing node in the tree, and
623 C<label> must be a label, ie. not contain C</>, C<*> or end
624 with a bracketed index C<[N]>.");
626 ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
627 [], (* XXX Augeas code needs tests. *)
628 "remove an Augeas path",
630 Remove C<path> and all of its children.
632 On success this returns the number of entries which were removed.");
634 ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [],
635 [], (* XXX Augeas code needs tests. *)
638 Move the node C<src> to C<dest>. C<src> must match exactly
639 one node. C<dest> is overwritten if it exists.");
641 ("aug_match", (RStringList "matches", [String "path"]), 24, [],
642 [], (* XXX Augeas code needs tests. *)
643 "return Augeas nodes which match path",
645 Returns a list of paths which match the path expression C<path>.
646 The returned paths are sufficiently qualified so that they match
647 exactly one node in the current tree.");
649 ("aug_save", (RErr, []), 25, [],
650 [], (* XXX Augeas code needs tests. *)
651 "write all pending Augeas changes to disk",
653 This writes all pending changes to disk.
655 The flags which were passed to C<guestfs_aug_init> affect exactly
656 how files are saved.");
658 ("aug_load", (RErr, []), 27, [],
659 [], (* XXX Augeas code needs tests. *)
660 "load files into the tree",
662 Load files into the tree.
664 See C<aug_load> in the Augeas documentation for the full gory
667 ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
668 [], (* XXX Augeas code needs tests. *)
669 "list Augeas nodes under a path",
671 This is just a shortcut for listing C<guestfs_aug_match>
672 C<path/*> and sorting the resulting nodes into alphabetical order.");
674 ("rm", (RErr, [String "path"]), 29, [],
678 InitEmpty, TestLastFail
680 InitEmpty, TestLastFail
685 Remove the single file C<path>.");
687 ("rmdir", (RErr, [String "path"]), 30, [],
691 InitEmpty, TestLastFail
693 InitEmpty, TestLastFail
696 "remove a directory",
698 Remove the single directory C<path>.");
700 ("rm_rf", (RErr, [String "path"]), 31, [],
701 [InitEmpty, TestOutputFalse
703 ["mkdir"; "/new/foo"];
704 ["touch"; "/new/foo/bar"];
706 ["exists"; "/new"]]],
707 "remove a file or directory recursively",
709 Remove the file or directory C<path>, recursively removing the
710 contents if its a directory. This is like the C<rm -rf> shell
713 ("mkdir", (RErr, [String "path"]), 32, [],
714 [InitEmpty, TestOutputTrue
717 InitEmpty, TestLastFail
718 [["mkdir"; "/new/foo/bar"]]],
719 "create a directory",
721 Create a directory named C<path>.");
723 ("mkdir_p", (RErr, [String "path"]), 33, [],
724 [InitEmpty, TestOutputTrue
725 [["mkdir_p"; "/new/foo/bar"];
726 ["is_dir"; "/new/foo/bar"]];
727 InitEmpty, TestOutputTrue
728 [["mkdir_p"; "/new/foo/bar"];
729 ["is_dir"; "/new/foo"]];
730 InitEmpty, TestOutputTrue
731 [["mkdir_p"; "/new/foo/bar"];
732 ["is_dir"; "/new"]]],
733 "create a directory and parents",
735 Create a directory named C<path>, creating any parent directories
736 as necessary. This is like the C<mkdir -p> shell command.");
738 ("chmod", (RErr, [Int "mode"; String "path"]), 34, [],
739 [], (* XXX Need stat command to test *)
742 Change the mode (permissions) of C<path> to C<mode>. Only
743 numeric modes are supported.");
745 ("chown", (RErr, [Int "owner"; Int "group"; String "path"]), 35, [],
746 [], (* XXX Need stat command to test *)
747 "change file owner and group",
749 Change the file owner to C<owner> and group to C<group>.
751 Only numeric uid and gid are supported. If you want to use
752 names, you will need to locate and parse the password file
753 yourself (Augeas support makes this relatively easy).");
755 ("exists", (RBool "existsflag", [String "path"]), 36, [],
756 [InitEmpty, TestOutputTrue (
758 ["exists"; "/new"]]);
759 InitEmpty, TestOutputTrue (
761 ["exists"; "/new"]])],
762 "test if file or directory exists",
764 This returns C<true> if and only if there is a file, directory
765 (or anything) with the given C<path> name.
767 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
769 ("is_file", (RBool "fileflag", [String "path"]), 37, [],
770 [InitEmpty, TestOutputTrue (
772 ["is_file"; "/new"]]);
773 InitEmpty, TestOutputFalse (
775 ["is_file"; "/new"]])],
776 "test if file exists",
778 This returns C<true> if and only if there is a file
779 with the given C<path> name. Note that it returns false for
780 other objects like directories.
782 See also C<guestfs_stat>.");
784 ("is_dir", (RBool "dirflag", [String "path"]), 38, [],
785 [InitEmpty, TestOutputFalse (
787 ["is_dir"; "/new"]]);
788 InitEmpty, TestOutputTrue (
790 ["is_dir"; "/new"]])],
791 "test if file exists",
793 This returns C<true> if and only if there is a directory
794 with the given C<path> name. Note that it returns false for
795 other objects like files.
797 See also C<guestfs_stat>.");
799 ("pvcreate", (RErr, [String "device"]), 39, [],
800 [InitNone, TestOutputList (
801 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
802 ["pvcreate"; "/dev/sda1"];
803 ["pvcreate"; "/dev/sda2"];
804 ["pvcreate"; "/dev/sda3"];
805 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
806 "create an LVM physical volume",
808 This creates an LVM physical volume on the named C<device>,
809 where C<device> should usually be a partition name such
812 ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
813 [InitNone, TestOutputList (
814 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
815 ["pvcreate"; "/dev/sda1"];
816 ["pvcreate"; "/dev/sda2"];
817 ["pvcreate"; "/dev/sda3"];
818 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
819 ["vgcreate"; "VG2"; "/dev/sda3"];
820 ["vgs"]], ["VG1"; "VG2"])],
821 "create an LVM volume group",
823 This creates an LVM volume group called C<volgroup>
824 from the non-empty list of physical volumes C<physvols>.");
826 ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [],
827 [InitNone, TestOutputList (
828 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
829 ["pvcreate"; "/dev/sda1"];
830 ["pvcreate"; "/dev/sda2"];
831 ["pvcreate"; "/dev/sda3"];
832 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
833 ["vgcreate"; "VG2"; "/dev/sda3"];
834 ["lvcreate"; "LV1"; "VG1"; "50"];
835 ["lvcreate"; "LV2"; "VG1"; "50"];
836 ["lvcreate"; "LV3"; "VG2"; "50"];
837 ["lvcreate"; "LV4"; "VG2"; "50"];
838 ["lvcreate"; "LV5"; "VG2"; "50"];
840 ["/dev/VG1/LV1"; "/dev/VG1/LV2";
841 "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
842 "create an LVM volume group",
844 This creates an LVM volume group called C<logvol>
845 on the volume group C<volgroup>, with C<size> megabytes.");
847 ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [],
848 [InitNone, TestOutput (
849 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
850 ["mkfs"; "ext2"; "/dev/sda1"];
851 ["mount"; "/dev/sda1"; "/"];
852 ["write_file"; "/new"; "new file contents"; "0"];
853 ["cat"; "/new"]], "new file contents")],
856 This creates a filesystem on C<device> (usually a partition
857 of LVM logical volume). The filesystem type is C<fstype>, for
860 ("sfdisk", (RErr, [String "device";
861 Int "cyls"; Int "heads"; Int "sectors";
862 StringList "lines"]), 43, [DangerWillRobinson],
864 "create partitions on a block device",
866 This is a direct interface to the L<sfdisk(8)> program for creating
867 partitions on block devices.
869 C<device> should be a block device, for example C</dev/sda>.
871 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
872 and sectors on the device, which are passed directly to sfdisk as
873 the I<-C>, I<-H> and I<-S> parameters. If you pass C<0> for any
874 of these, then the corresponding parameter is omitted. Usually for
875 'large' disks, you can just pass C<0> for these, but for small
876 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
877 out the right geometry and you will need to tell it.
879 C<lines> is a list of lines that we feed to C<sfdisk>. For more
880 information refer to the L<sfdisk(8)> manpage.
882 To create a single partition occupying the whole disk, you would
883 pass C<lines> as a single element list, when the single element being
884 the string C<,> (comma).");
886 ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
887 [InitNone, TestOutput (
888 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
889 ["mkfs"; "ext2"; "/dev/sda1"];
890 ["mount"; "/dev/sda1"; "/"];
891 ["write_file"; "/new"; "new file contents"; "0"];
892 ["cat"; "/new"]], "new file contents")],
895 This call creates a file called C<path>. The contents of the
896 file is the string C<content> (which can contain any 8 bit data),
899 As a special case, if C<size> is C<0>
900 then the length is calculated using C<strlen> (so in this case
901 the content cannot contain embedded ASCII NULs).");
903 ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
904 [InitNone, TestOutputList (
905 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
906 ["mkfs"; "ext2"; "/dev/sda1"];
907 ["mount"; "/dev/sda1"; "/"];
908 ["mounts"]], ["/dev/sda1"]);
909 InitNone, TestOutputList (
910 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
911 ["mkfs"; "ext2"; "/dev/sda1"];
912 ["mount"; "/dev/sda1"; "/"];
915 "unmount a filesystem",
917 This unmounts the given filesystem. The filesystem may be
918 specified either by its mountpoint (path) or the device which
919 contains the filesystem.");
921 ("mounts", (RStringList "devices", []), 46, [],
922 [InitEmpty, TestOutputList (
923 [["mounts"]], ["/dev/sda1"])],
924 "show mounted filesystems",
926 This returns the list of currently mounted filesystems. It returns
927 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
929 Some internal mounts are not shown.");
931 ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
932 [InitEmpty, TestOutputList (
935 "unmount all filesystems",
937 This unmounts all mounted filesystems.
939 Some internal mounts are not unmounted by this call.");
941 ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson],
943 "remove all LVM LVs, VGs and PVs",
945 This command removes all LVM logical volumes, volume groups
946 and physical volumes.");
950 let all_functions = non_daemon_functions @ daemon_functions
952 (* In some places we want the functions to be displayed sorted
953 * alphabetically, so this is useful:
955 let all_functions_sorted =
956 List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
957 compare n1 n2) all_functions
959 (* Column names and types from LVM PVs/VGs/LVs. *)
968 "pv_attr", `String (* XXX *);
970 "pv_pe_alloc_count", `Int;
973 "pv_mda_count", `Int;
974 "pv_mda_free", `Bytes;
976 "pv_mda_size", `Bytes;
983 "vg_attr", `String (* XXX *);
987 "vg_extent_size", `Bytes;
988 "vg_extent_count", `Int;
989 "vg_free_count", `Int;
997 "vg_mda_count", `Int;
998 "vg_mda_free", `Bytes;
1000 "vg_mda_size", `Bytes;
1006 "lv_attr", `String (* XXX *);
1009 "lv_kernel_major", `Int;
1010 "lv_kernel_minor", `Int;
1014 "snap_percent", `OptPercent;
1015 "copy_percent", `OptPercent;
1018 "mirror_log", `String;
1022 (* Useful functions.
1023 * Note we don't want to use any external OCaml libraries which
1024 * makes this a bit harder than it should be.
1026 let failwithf fs = ksprintf failwith fs
1028 let replace_char s c1 c2 =
1029 let s2 = String.copy s in
1030 let r = ref false in
1031 for i = 0 to String.length s2 - 1 do
1032 if String.unsafe_get s2 i = c1 then (
1033 String.unsafe_set s2 i c2;
1037 if not !r then s else s2
1039 let rec find s sub =
1040 let len = String.length s in
1041 let sublen = String.length sub in
1043 if i <= len-sublen then (
1045 if j < sublen then (
1046 if s.[i+j] = sub.[j] then loop2 (j+1)
1052 if r = -1 then loop (i+1) else r
1058 let rec replace_str s s1 s2 =
1059 let len = String.length s in
1060 let sublen = String.length s1 in
1061 let i = find s s1 in
1064 let s' = String.sub s 0 i in
1065 let s'' = String.sub s (i+sublen) (len-i-sublen) in
1066 s' ^ s2 ^ replace_str s'' s1 s2
1069 let rec string_split sep str =
1070 let len = String.length str in
1071 let seplen = String.length sep in
1072 let i = find str sep in
1073 if i = -1 then [str]
1075 let s' = String.sub str 0 i in
1076 let s'' = String.sub str (i+seplen) (len-i-seplen) in
1077 s' :: string_split sep s''
1080 let rec find_map f = function
1081 | [] -> raise Not_found
1085 | None -> find_map f xs
1088 let rec loop i = function
1090 | x :: xs -> f i x; loop (i+1) xs
1095 let rec loop i = function
1097 | x :: xs -> let r = f i x in r :: loop (i+1) xs
1101 let name_of_argt = function
1102 | String n | OptString n | StringList n | Bool n | Int n -> n
1104 (* Check function names etc. for consistency. *)
1105 let check_functions () =
1106 let contains_uppercase str =
1107 let len = String.length str in
1109 if i >= len then false
1112 if c >= 'A' && c <= 'Z' then true
1119 (* Check function names. *)
1121 fun (name, _, _, _, _, _, _) ->
1122 if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
1123 failwithf "function name %s does not need 'guestfs' prefix" name;
1124 if contains_uppercase name then
1125 failwithf "function name %s should not contain uppercase chars" name;
1126 if String.contains name '-' then
1127 failwithf "function name %s should not contain '-', use '_' instead."
1131 (* Check function parameter/return names. *)
1133 fun (name, style, _, _, _, _, _) ->
1134 let check_arg_ret_name n =
1135 if contains_uppercase n then
1136 failwithf "%s param/ret %s should not contain uppercase chars"
1138 if String.contains n '-' || String.contains n '_' then
1139 failwithf "%s param/ret %s should not contain '-' or '_'"
1142 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
1145 (match fst style with
1147 | RInt n | RBool n | RConstString n | RString n
1148 | RStringList n | RPVList n | RVGList n | RLVList n ->
1149 check_arg_ret_name n
1151 check_arg_ret_name n;
1152 check_arg_ret_name m
1154 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
1157 (* Check short descriptions. *)
1159 fun (name, _, _, _, _, shortdesc, _) ->
1160 if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
1161 failwithf "short description of %s should begin with lowercase." name;
1162 let c = shortdesc.[String.length shortdesc-1] in
1163 if c = '\n' || c = '.' then
1164 failwithf "short description of %s should not end with . or \\n." name
1167 (* Check long dscriptions. *)
1169 fun (name, _, _, _, _, _, longdesc) ->
1170 if longdesc.[String.length longdesc-1] = '\n' then
1171 failwithf "long description of %s should not end with \\n." name
1174 (* Check proc_nrs. *)
1176 fun (name, _, proc_nr, _, _, _, _) ->
1177 if proc_nr <= 0 then
1178 failwithf "daemon function %s should have proc_nr > 0" name
1182 fun (name, _, proc_nr, _, _, _, _) ->
1183 if proc_nr <> -1 then
1184 failwithf "non-daemon function %s should have proc_nr -1" name
1185 ) non_daemon_functions;
1188 List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
1191 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
1192 let rec loop = function
1195 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
1197 | (name1,nr1) :: (name2,nr2) :: _ ->
1198 failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
1203 (* 'pr' prints to the current output file. *)
1204 let chan = ref stdout
1205 let pr fs = ksprintf (output_string !chan) fs
1207 (* Generate a header block in a number of standard styles. *)
1208 type comment_style = CStyle | HashStyle | OCamlStyle
1209 type license = GPLv2 | LGPLv2
1211 let generate_header comment license =
1212 let c = match comment with
1213 | CStyle -> pr "/* "; " *"
1214 | HashStyle -> pr "# "; "#"
1215 | OCamlStyle -> pr "(* "; " *" in
1216 pr "libguestfs generated file\n";
1217 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
1218 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
1220 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
1224 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
1225 pr "%s it under the terms of the GNU General Public License as published by\n" c;
1226 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
1227 pr "%s (at your option) any later version.\n" c;
1229 pr "%s This program is distributed in the hope that it will be useful,\n" c;
1230 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1231 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
1232 pr "%s GNU General Public License for more details.\n" c;
1234 pr "%s You should have received a copy of the GNU General Public License along\n" c;
1235 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
1236 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
1239 pr "%s This library is free software; you can redistribute it and/or\n" c;
1240 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
1241 pr "%s License as published by the Free Software Foundation; either\n" c;
1242 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
1244 pr "%s This library is distributed in the hope that it will be useful,\n" c;
1245 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1246 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
1247 pr "%s Lesser General Public License for more details.\n" c;
1249 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
1250 pr "%s License along with this library; if not, write to the Free Software\n" c;
1251 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
1254 | CStyle -> pr " */\n"
1256 | OCamlStyle -> pr " *)\n"
1260 (* Start of main code generation functions below this line. *)
1262 (* Generate the pod documentation for the C API. *)
1263 let rec generate_actions_pod () =
1265 fun (shortname, style, _, flags, _, _, longdesc) ->
1266 let name = "guestfs_" ^ shortname in
1267 pr "=head2 %s\n\n" name;
1269 generate_prototype ~extern:false ~handle:"handle" name style;
1271 pr "%s\n\n" longdesc;
1272 (match fst style with
1274 pr "This function returns 0 on success or -1 on error.\n\n"
1276 pr "On error this function returns -1.\n\n"
1278 pr "This function returns a C truth value on success or -1 on error.\n\n"
1280 pr "This function returns a string or NULL on error.
1281 The string is owned by the guest handle and must I<not> be freed.\n\n"
1283 pr "This function returns a string or NULL on error.
1284 I<The caller must free the returned string after use>.\n\n"
1286 pr "This function returns a NULL-terminated array of strings
1287 (like L<environ(3)>), or NULL if there was an error.
1288 I<The caller must free the strings and the array after use>.\n\n"
1290 pr "This function returns a C<struct guestfs_int_bool *>.
1291 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
1293 pr "This function returns a C<struct guestfs_lvm_pv_list *>.
1294 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
1296 pr "This function returns a C<struct guestfs_lvm_vg_list *>.
1297 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
1299 pr "This function returns a C<struct guestfs_lvm_lv_list *>.
1300 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
1302 if List.mem ProtocolLimitWarning flags then
1303 pr "%s\n\n" protocol_limit_warning;
1304 if List.mem DangerWillRobinson flags then
1305 pr "%s\n\n" danger_will_robinson;
1306 ) all_functions_sorted
1308 and generate_structs_pod () =
1309 (* LVM structs documentation. *)
1312 pr "=head2 guestfs_lvm_%s\n" typ;
1314 pr " struct guestfs_lvm_%s {\n" typ;
1317 | name, `String -> pr " char *%s;\n" name
1319 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
1320 pr " char %s[32];\n" name
1321 | name, `Bytes -> pr " uint64_t %s;\n" name
1322 | name, `Int -> pr " int64_t %s;\n" name
1323 | name, `OptPercent ->
1324 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
1325 pr " float %s;\n" name
1328 pr " struct guestfs_lvm_%s_list {\n" typ;
1329 pr " uint32_t len; /* Number of elements in list. */\n";
1330 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
1333 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
1336 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1338 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
1339 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
1341 * We have to use an underscore instead of a dash because otherwise
1342 * rpcgen generates incorrect code.
1344 * This header is NOT exported to clients, but see also generate_structs_h.
1346 and generate_xdr () =
1347 generate_header CStyle LGPLv2;
1349 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
1350 pr "typedef string str<>;\n";
1353 (* LVM internal structures. *)
1357 pr "struct guestfs_lvm_int_%s {\n" typ;
1359 | name, `String -> pr " string %s<>;\n" name
1360 | name, `UUID -> pr " opaque %s[32];\n" name
1361 | name, `Bytes -> pr " hyper %s;\n" name
1362 | name, `Int -> pr " hyper %s;\n" name
1363 | name, `OptPercent -> pr " float %s;\n" name
1367 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
1369 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1372 fun (shortname, style, _, _, _, _, _) ->
1373 let name = "guestfs_" ^ shortname in
1375 (match snd style with
1378 pr "struct %s_args {\n" name;
1381 | String n -> pr " string %s<>;\n" n
1382 | OptString n -> pr " str *%s;\n" n
1383 | StringList n -> pr " str %s<>;\n" n
1384 | Bool n -> pr " bool %s;\n" n
1385 | Int n -> pr " int %s;\n" n
1389 (match fst style with
1392 pr "struct %s_ret {\n" name;
1396 pr "struct %s_ret {\n" name;
1400 failwithf "RConstString cannot be returned from a daemon function"
1402 pr "struct %s_ret {\n" name;
1403 pr " string %s<>;\n" n;
1406 pr "struct %s_ret {\n" name;
1407 pr " str %s<>;\n" n;
1410 pr "struct %s_ret {\n" name;
1415 pr "struct %s_ret {\n" name;
1416 pr " guestfs_lvm_int_pv_list %s;\n" n;
1419 pr "struct %s_ret {\n" name;
1420 pr " guestfs_lvm_int_vg_list %s;\n" n;
1423 pr "struct %s_ret {\n" name;
1424 pr " guestfs_lvm_int_lv_list %s;\n" n;
1429 (* Table of procedure numbers. *)
1430 pr "enum guestfs_procedure {\n";
1432 fun (shortname, _, proc_nr, _, _, _, _) ->
1433 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
1435 pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
1439 (* Having to choose a maximum message size is annoying for several
1440 * reasons (it limits what we can do in the API), but it (a) makes
1441 * the protocol a lot simpler, and (b) provides a bound on the size
1442 * of the daemon which operates in limited memory space. For large
1443 * file transfers you should use FTP.
1445 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
1448 (* Message header, etc. *)
1450 const GUESTFS_PROGRAM = 0x2000F5F5;
1451 const GUESTFS_PROTOCOL_VERSION = 1;
1453 enum guestfs_message_direction {
1454 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
1455 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
1458 enum guestfs_message_status {
1459 GUESTFS_STATUS_OK = 0,
1460 GUESTFS_STATUS_ERROR = 1
1463 const GUESTFS_ERROR_LEN = 256;
1465 struct guestfs_message_error {
1466 string error<GUESTFS_ERROR_LEN>; /* error message */
1469 struct guestfs_message_header {
1470 unsigned prog; /* GUESTFS_PROGRAM */
1471 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
1472 guestfs_procedure proc; /* GUESTFS_PROC_x */
1473 guestfs_message_direction direction;
1474 unsigned serial; /* message serial number */
1475 guestfs_message_status status;
1479 (* Generate the guestfs-structs.h file. *)
1480 and generate_structs_h () =
1481 generate_header CStyle LGPLv2;
1483 (* This is a public exported header file containing various
1484 * structures. The structures are carefully written to have
1485 * exactly the same in-memory format as the XDR structures that
1486 * we use on the wire to the daemon. The reason for creating
1487 * copies of these structures here is just so we don't have to
1488 * export the whole of guestfs_protocol.h (which includes much
1489 * unrelated and XDR-dependent stuff that we don't want to be
1490 * public, or required by clients).
1492 * To reiterate, we will pass these structures to and from the
1493 * client with a simple assignment or memcpy, so the format
1494 * must be identical to what rpcgen / the RFC defines.
1497 (* guestfs_int_bool structure. *)
1498 pr "struct guestfs_int_bool {\n";
1504 (* LVM public structures. *)
1508 pr "struct guestfs_lvm_%s {\n" typ;
1511 | name, `String -> pr " char *%s;\n" name
1512 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
1513 | name, `Bytes -> pr " uint64_t %s;\n" name
1514 | name, `Int -> pr " int64_t %s;\n" name
1515 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
1519 pr "struct guestfs_lvm_%s_list {\n" typ;
1520 pr " uint32_t len;\n";
1521 pr " struct guestfs_lvm_%s *val;\n" typ;
1524 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1526 (* Generate the guestfs-actions.h file. *)
1527 and generate_actions_h () =
1528 generate_header CStyle LGPLv2;
1530 fun (shortname, style, _, _, _, _, _) ->
1531 let name = "guestfs_" ^ shortname in
1532 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
1536 (* Generate the client-side dispatch stubs. *)
1537 and generate_client_actions () =
1538 generate_header CStyle LGPLv2;
1540 (* Client-side stubs for each function. *)
1542 fun (shortname, style, _, _, _, _, _) ->
1543 let name = "guestfs_" ^ shortname in
1545 (* Generate the return value struct. *)
1546 pr "struct %s_rv {\n" shortname;
1547 pr " int cb_done; /* flag to indicate callback was called */\n";
1548 pr " struct guestfs_message_header hdr;\n";
1549 pr " struct guestfs_message_error err;\n";
1550 (match fst style with
1553 failwithf "RConstString cannot be returned from a daemon function"
1555 | RBool _ | RString _ | RStringList _
1557 | RPVList _ | RVGList _ | RLVList _ ->
1558 pr " struct %s_ret ret;\n" name
1562 (* Generate the callback function. *)
1563 pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
1565 pr " struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
1567 pr " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
1568 pr " error (g, \"%s: failed to parse reply header\");\n" name;
1571 pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
1572 pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
1573 pr " error (g, \"%s: failed to parse reply error\");\n" name;
1579 (match fst style with
1582 failwithf "RConstString cannot be returned from a daemon function"
1584 | RBool _ | RString _ | RStringList _
1586 | RPVList _ | RVGList _ | RLVList _ ->
1587 pr " if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
1588 pr " error (g, \"%s: failed to parse reply\");\n" name;
1594 pr " rv->cb_done = 1;\n";
1595 pr " main_loop.main_loop_quit (g);\n";
1598 (* Generate the action stub. *)
1599 generate_prototype ~extern:false ~semicolon:false ~newline:true
1600 ~handle:"g" name style;
1603 match fst style with
1604 | RErr | RInt _ | RBool _ -> "-1"
1606 failwithf "RConstString cannot be returned from a daemon function"
1607 | RString _ | RStringList _ | RIntBool _
1608 | RPVList _ | RVGList _ | RLVList _ ->
1613 (match snd style with
1615 | _ -> pr " struct %s_args args;\n" name
1618 pr " struct %s_rv rv;\n" shortname;
1619 pr " int serial;\n";
1621 pr " if (g->state != READY) {\n";
1622 pr " error (g, \"%s called from the wrong state, %%d != READY\",\n"
1625 pr " return %s;\n" error_code;
1628 pr " memset (&rv, 0, sizeof rv);\n";
1631 (match snd style with
1633 pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
1634 (String.uppercase shortname)
1639 pr " args.%s = (char *) %s;\n" n n
1641 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
1643 pr " args.%s.%s_val = (char **) %s;\n" n n n;
1644 pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
1646 pr " args.%s = %s;\n" n n
1648 pr " args.%s = %s;\n" n n
1650 pr " serial = dispatch (g, GUESTFS_PROC_%s,\n"
1651 (String.uppercase shortname);
1652 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
1655 pr " if (serial == -1)\n";
1656 pr " return %s;\n" error_code;
1659 pr " rv.cb_done = 0;\n";
1660 pr " g->reply_cb_internal = %s_cb;\n" shortname;
1661 pr " g->reply_cb_internal_data = &rv;\n";
1662 pr " main_loop.main_loop_run (g);\n";
1663 pr " g->reply_cb_internal = NULL;\n";
1664 pr " g->reply_cb_internal_data = NULL;\n";
1665 pr " if (!rv.cb_done) {\n";
1666 pr " error (g, \"%s failed, see earlier error messages\");\n" name;
1667 pr " return %s;\n" error_code;
1671 pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
1672 (String.uppercase shortname);
1673 pr " return %s;\n" error_code;
1676 pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
1677 pr " error (g, \"%%s\", rv.err.error);\n";
1678 pr " return %s;\n" error_code;
1682 (match fst style with
1683 | RErr -> pr " return 0;\n"
1685 | RBool n -> pr " return rv.ret.%s;\n" n
1687 failwithf "RConstString cannot be returned from a daemon function"
1689 pr " return rv.ret.%s; /* caller will free */\n" n
1691 pr " /* caller will free this, but we need to add a NULL entry */\n";
1692 pr " rv.ret.%s.%s_val =" n n;
1693 pr " safe_realloc (g, rv.ret.%s.%s_val,\n" n n;
1694 pr " sizeof (char *) * (rv.ret.%s.%s_len + 1));\n"
1696 pr " rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
1697 pr " return rv.ret.%s.%s_val;\n" n n
1699 pr " /* caller with free this */\n";
1700 pr " return safe_memdup (g, &rv.ret, sizeof (rv.ret));\n"
1702 pr " /* caller will free this */\n";
1703 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1705 pr " /* caller will free this */\n";
1706 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1708 pr " /* caller will free this */\n";
1709 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1715 (* Generate daemon/actions.h. *)
1716 and generate_daemon_actions_h () =
1717 generate_header CStyle GPLv2;
1719 pr "#include \"../src/guestfs_protocol.h\"\n";
1723 fun (name, style, _, _, _, _, _) ->
1725 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
1729 (* Generate the server-side stubs. *)
1730 and generate_daemon_actions () =
1731 generate_header CStyle GPLv2;
1733 pr "#define _GNU_SOURCE // for strchrnul\n";
1735 pr "#include <stdio.h>\n";
1736 pr "#include <stdlib.h>\n";
1737 pr "#include <string.h>\n";
1738 pr "#include <inttypes.h>\n";
1739 pr "#include <ctype.h>\n";
1740 pr "#include <rpc/types.h>\n";
1741 pr "#include <rpc/xdr.h>\n";
1743 pr "#include \"daemon.h\"\n";
1744 pr "#include \"../src/guestfs_protocol.h\"\n";
1745 pr "#include \"actions.h\"\n";
1749 fun (name, style, _, _, _, _, _) ->
1750 (* Generate server-side stubs. *)
1751 pr "static void %s_stub (XDR *xdr_in)\n" name;
1754 match fst style with
1755 | RErr | RInt _ -> pr " int r;\n"; "-1"
1756 | RBool _ -> pr " int r;\n"; "-1"
1758 failwithf "RConstString cannot be returned from a daemon function"
1759 | RString _ -> pr " char *r;\n"; "NULL"
1760 | RStringList _ -> pr " char **r;\n"; "NULL"
1761 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
1762 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
1763 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
1764 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL" in
1766 (match snd style with
1769 pr " struct guestfs_%s_args args;\n" name;
1773 | OptString n -> pr " const char *%s;\n" n
1774 | StringList n -> pr " char **%s;\n" n
1775 | Bool n -> pr " int %s;\n" n
1776 | Int n -> pr " int %s;\n" n
1781 (match snd style with
1784 pr " memset (&args, 0, sizeof args);\n";
1786 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
1787 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
1792 | String n -> pr " %s = args.%s;\n" n n
1793 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
1795 pr " args.%s.%s_val = realloc (args.%s.%s_val, sizeof (char *) * (args.%s.%s_len+1));\n" n n n n n n;
1796 pr " args.%s.%s_val[args.%s.%s_len] = NULL;\n" n n n n;
1797 pr " %s = args.%s.%s_val;\n" n n n
1798 | Bool n -> pr " %s = args.%s;\n" n n
1799 | Int n -> pr " %s = args.%s;\n" n n
1804 pr " r = do_%s " name;
1805 generate_call_args style;
1808 pr " if (r == %s)\n" error_code;
1809 pr " /* do_%s has already called reply_with_error */\n" name;
1813 (match fst style with
1814 | RErr -> pr " reply (NULL, NULL);\n"
1816 pr " struct guestfs_%s_ret ret;\n" name;
1817 pr " ret.%s = r;\n" n;
1818 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1820 pr " struct guestfs_%s_ret ret;\n" name;
1821 pr " ret.%s = r;\n" n;
1822 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1824 failwithf "RConstString cannot be returned from a daemon function"
1826 pr " struct guestfs_%s_ret ret;\n" name;
1827 pr " ret.%s = r;\n" n;
1828 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1831 pr " struct guestfs_%s_ret ret;\n" name;
1832 pr " ret.%s.%s_len = count_strings (r);\n" n n;
1833 pr " ret.%s.%s_val = r;\n" n n;
1834 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1835 pr " free_strings (r);\n"
1837 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name;
1838 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
1840 pr " struct guestfs_%s_ret ret;\n" name;
1841 pr " ret.%s = *r;\n" n;
1842 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1843 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1845 pr " struct guestfs_%s_ret ret;\n" name;
1846 pr " ret.%s = *r;\n" n;
1847 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1848 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1850 pr " struct guestfs_%s_ret ret;\n" name;
1851 pr " ret.%s = *r;\n" n;
1852 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1853 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1856 (* Free the args. *)
1857 (match snd style with
1862 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
1869 (* Dispatch function. *)
1870 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
1872 pr " switch (proc_nr) {\n";
1875 fun (name, style, _, _, _, _, _) ->
1876 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
1877 pr " %s_stub (xdr_in);\n" name;
1882 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
1887 (* LVM columns and tokenization functions. *)
1888 (* XXX This generates crap code. We should rethink how we
1894 pr "static const char *lvm_%s_cols = \"%s\";\n"
1895 typ (String.concat "," (List.map fst cols));
1898 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
1900 pr " char *tok, *p, *next;\n";
1904 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
1907 pr " if (!str) {\n";
1908 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
1911 pr " if (!*str || isspace (*str)) {\n";
1912 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
1917 fun (name, coltype) ->
1918 pr " if (!tok) {\n";
1919 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
1922 pr " p = strchrnul (tok, ',');\n";
1923 pr " if (*p) next = p+1; else next = NULL;\n";
1924 pr " *p = '\\0';\n";
1927 pr " r->%s = strdup (tok);\n" name;
1928 pr " if (r->%s == NULL) {\n" name;
1929 pr " perror (\"strdup\");\n";
1933 pr " for (i = j = 0; i < 32; ++j) {\n";
1934 pr " if (tok[j] == '\\0') {\n";
1935 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
1937 pr " } else if (tok[j] != '-')\n";
1938 pr " r->%s[i++] = tok[j];\n" name;
1941 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
1942 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1946 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
1947 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1951 pr " if (tok[0] == '\\0')\n";
1952 pr " r->%s = -1;\n" name;
1953 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
1954 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
1958 pr " tok = next;\n";
1961 pr " if (tok != NULL) {\n";
1962 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
1969 pr "guestfs_lvm_int_%s_list *\n" typ;
1970 pr "parse_command_line_%ss (void)\n" typ;
1972 pr " char *out, *err;\n";
1973 pr " char *p, *pend;\n";
1975 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
1976 pr " void *newp;\n";
1978 pr " ret = malloc (sizeof *ret);\n";
1979 pr " if (!ret) {\n";
1980 pr " reply_with_perror (\"malloc\");\n";
1981 pr " return NULL;\n";
1984 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
1985 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
1987 pr " r = command (&out, &err,\n";
1988 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
1989 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
1990 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
1991 pr " if (r == -1) {\n";
1992 pr " reply_with_error (\"%%s\", err);\n";
1993 pr " free (out);\n";
1994 pr " free (err);\n";
1995 pr " return NULL;\n";
1998 pr " free (err);\n";
2000 pr " /* Tokenize each line of the output. */\n";
2003 pr " while (p) {\n";
2004 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
2005 pr " if (pend) {\n";
2006 pr " *pend = '\\0';\n";
2010 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
2013 pr " if (!*p) { /* Empty line? Skip it. */\n";
2018 pr " /* Allocate some space to store this next entry. */\n";
2019 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
2020 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
2021 pr " if (newp == NULL) {\n";
2022 pr " reply_with_perror (\"realloc\");\n";
2023 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2024 pr " free (ret);\n";
2025 pr " free (out);\n";
2026 pr " return NULL;\n";
2028 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
2030 pr " /* Tokenize the next entry. */\n";
2031 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
2032 pr " if (r == -1) {\n";
2033 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
2034 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2035 pr " free (ret);\n";
2036 pr " free (out);\n";
2037 pr " return NULL;\n";
2044 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
2046 pr " free (out);\n";
2047 pr " return ret;\n";
2050 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2052 (* Generate the tests. *)
2053 and generate_tests () =
2054 generate_header CStyle GPLv2;
2061 #include <sys/types.h>
2064 #include \"guestfs.h\"
2066 static guestfs_h *g;
2067 static int suppress_error = 0;
2069 static void print_error (guestfs_h *g, void *data, const char *msg)
2071 if (!suppress_error)
2072 fprintf (stderr, \"%%s\\n\", msg);
2075 static void print_strings (char * const * const argv)
2079 for (argc = 0; argv[argc] != NULL; ++argc)
2080 printf (\"\\t%%s\\n\", argv[argc]);
2087 fun (name, _, _, _, tests, _, _) ->
2088 mapi (generate_one_test name) tests
2090 let test_names = List.concat test_names in
2091 let nr_tests = List.length test_names in
2094 int main (int argc, char *argv[])
2102 g = guestfs_create ();
2104 printf (\"guestfs_create FAILED\\n\");
2108 guestfs_set_error_handler (g, print_error, NULL);
2110 srcdir = getenv (\"srcdir\");
2111 if (!srcdir) srcdir = \".\";
2112 guestfs_set_path (g, srcdir);
2114 snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);
2115 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2120 if (lseek (fd, %d, SEEK_SET) == -1) {
2126 if (write (fd, &c, 1) == -1) {
2132 if (close (fd) == -1) {
2137 if (guestfs_add_drive (g, buf) == -1) {
2138 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2142 snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);
2143 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2148 if (lseek (fd, %d, SEEK_SET) == -1) {
2154 if (write (fd, &c, 1) == -1) {
2160 if (close (fd) == -1) {
2165 if (guestfs_add_drive (g, buf) == -1) {
2166 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2170 snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);
2171 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2176 if (lseek (fd, %d, SEEK_SET) == -1) {
2182 if (write (fd, &c, 1) == -1) {
2188 if (close (fd) == -1) {
2193 if (guestfs_add_drive (g, buf) == -1) {
2194 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2198 if (guestfs_launch (g) == -1) {
2199 printf (\"guestfs_launch FAILED\\n\");
2202 if (guestfs_wait_ready (g) == -1) {
2203 printf (\"guestfs_wait_ready FAILED\\n\");
2207 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024);
2211 pr " printf (\"%3d/%3d %s\\n\");\n" (i+1) nr_tests test_name;
2212 pr " if (%s () == -1) {\n" test_name;
2213 pr " printf (\"%s FAILED\\n\");\n" test_name;
2219 pr " guestfs_close (g);\n";
2220 pr " snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);\n";
2221 pr " unlink (buf);\n";
2222 pr " snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);\n";
2223 pr " unlink (buf);\n";
2224 pr " snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);\n";
2225 pr " unlink (buf);\n";
2228 pr " if (failed > 0) {\n";
2229 pr " printf (\"***** %%d / %d tests FAILED *****\\n\", failed);\n"
2238 and generate_one_test name i (init, test) =
2239 let test_name = sprintf "test_%s_%d" name i in
2241 pr "static int %s (void)\n" test_name;
2246 pr " /* InitNone for %s (%d) */\n" name i;
2247 List.iter (generate_test_command_call test_name)
2251 pr " /* InitEmpty for %s (%d): create ext2 on /dev/sda1 */\n" name i;
2252 List.iter (generate_test_command_call test_name)
2255 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2256 ["mkfs"; "ext2"; "/dev/sda1"];
2257 ["mount"; "/dev/sda1"; "/"]]
2259 pr " /* InitEmptyLVM for %s (%d): create ext2 on /dev/VG/LV */\n"
2261 List.iter (generate_test_command_call test_name)
2264 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2265 ["pvcreate"; "/dev/sda1"];
2266 ["vgcreate"; "VG"; "/dev/sda1"];
2267 ["lvcreate"; "LV"; "VG"; "8"];
2268 ["mkfs"; "ext2"; "/dev/VG/LV"];
2269 ["mount"; "/dev/VG/LV"; "/"]]
2272 let get_seq_last = function
2274 failwithf "%s: you cannot use [] (empty list) when expecting a command"
2277 let seq = List.rev seq in
2278 List.rev (List.tl seq), List.hd seq
2283 pr " /* TestRun for %s (%d) */\n" name i;
2284 List.iter (generate_test_command_call test_name) seq
2285 | TestOutput (seq, expected) ->
2286 pr " /* TestOutput for %s (%d) */\n" name i;
2287 let seq, last = get_seq_last seq in
2289 pr " if (strcmp (r, \"%s\") != 0) {\n" (c_quote expected);
2290 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r);\n" test_name (c_quote expected);
2294 List.iter (generate_test_command_call test_name) seq;
2295 generate_test_command_call ~test test_name last
2296 | TestOutputList (seq, expected) ->
2297 pr " /* TestOutputList for %s (%d) */\n" name i;
2298 let seq, last = get_seq_last seq in
2302 pr " if (!r[%d]) {\n" i;
2303 pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
2304 pr " print_strings (r);\n";
2307 pr " if (strcmp (r[%d], \"%s\") != 0) {\n" i (c_quote str);
2308 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r[%d]);\n" test_name (c_quote str) i;
2312 pr " if (r[%d] != NULL) {\n" (List.length expected);
2313 pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
2315 pr " print_strings (r);\n";
2319 List.iter (generate_test_command_call test_name) seq;
2320 generate_test_command_call ~test test_name last
2321 | TestOutputInt (seq, expected) ->
2322 pr " /* TestOutputInt for %s (%d) */\n" name i;
2323 let seq, last = get_seq_last seq in
2325 pr " if (r != %d) {\n" expected;
2326 pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\", r);\n"
2331 List.iter (generate_test_command_call test_name) seq;
2332 generate_test_command_call ~test test_name last
2333 | TestOutputTrue seq ->
2334 pr " /* TestOutputTrue for %s (%d) */\n" name i;
2335 let seq, last = get_seq_last seq in
2338 pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n"
2343 List.iter (generate_test_command_call test_name) seq;
2344 generate_test_command_call ~test test_name last
2345 | TestOutputFalse seq ->
2346 pr " /* TestOutputFalse for %s (%d) */\n" name i;
2347 let seq, last = get_seq_last seq in
2350 pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n"
2355 List.iter (generate_test_command_call test_name) seq;
2356 generate_test_command_call ~test test_name last
2357 | TestOutputLength (seq, expected) ->
2358 pr " /* TestOutputLength for %s (%d) */\n" name i;
2359 let seq, last = get_seq_last seq in
2362 pr " for (j = 0; j < %d; ++j)\n" expected;
2363 pr " if (r[j] == NULL) {\n";
2364 pr " fprintf (stderr, \"%s: short list returned\\n\");\n"
2366 pr " print_strings (r);\n";
2369 pr " if (r[j] != NULL) {\n";
2370 pr " fprintf (stderr, \"%s: long list returned\\n\");\n"
2372 pr " print_strings (r);\n";
2376 List.iter (generate_test_command_call test_name) seq;
2377 generate_test_command_call ~test test_name last
2378 | TestLastFail seq ->
2379 pr " /* TestLastFail for %s (%d) */\n" name i;
2380 let seq, last = get_seq_last seq in
2381 List.iter (generate_test_command_call test_name) seq;
2382 generate_test_command_call test_name ~expect_error:true last
2390 (* Generate the code to run a command, leaving the result in 'r'.
2391 * If you expect to get an error then you should set expect_error:true.
2393 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
2395 | [] -> assert false
2397 (* Look up the command to find out what args/ret it has. *)
2400 let _, style, _, _, _, _, _ =
2401 List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
2404 failwithf "%s: in test, command %s was not found" test_name name in
2406 if List.length (snd style) <> List.length args then
2407 failwithf "%s: in test, wrong number of args given to %s"
2418 | StringList n, arg ->
2419 pr " char *%s[] = {\n" n;
2420 let strs = string_split " " arg in
2422 fun str -> pr " \"%s\",\n" (c_quote str)
2426 ) (List.combine (snd style) args);
2429 match fst style with
2430 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
2431 | RConstString _ -> pr " const char *r;\n"; "NULL"
2432 | RString _ -> pr " char *r;\n"; "NULL"
2438 pr " struct guestfs_int_bool *r;\n";
2441 pr " struct guestfs_lvm_pv_list *r;\n";
2444 pr " struct guestfs_lvm_vg_list *r;\n";
2447 pr " struct guestfs_lvm_lv_list *r;\n";
2450 pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
2451 pr " r = guestfs_%s (g" name;
2453 (* Generate the parameters. *)
2456 | String _, arg -> pr ", \"%s\"" (c_quote arg)
2457 | OptString _, arg ->
2458 if arg = "NULL" then pr ", NULL" else pr ", \"%s\"" (c_quote arg)
2459 | StringList n, _ ->
2463 try int_of_string arg
2464 with Failure "int_of_string" ->
2465 failwithf "%s: expecting an int, but got '%s'" test_name arg in
2468 let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
2469 ) (List.combine (snd style) args);
2472 if not expect_error then
2473 pr " if (r == %s)\n" error_code
2475 pr " if (r != %s)\n" error_code;
2478 (* Insert the test code. *)
2484 (match fst style with
2485 | RErr | RInt _ | RBool _ | RConstString _ -> ()
2486 | RString _ -> pr " free (r);\n"
2488 pr " for (i = 0; r[i] != NULL; ++i)\n";
2489 pr " free (r[i]);\n";
2492 pr " guestfs_free_int_bool (r);\n"
2494 pr " guestfs_free_lvm_pv_list (r);\n"
2496 pr " guestfs_free_lvm_vg_list (r);\n"
2498 pr " guestfs_free_lvm_lv_list (r);\n"
2504 let str = replace_str str "\r" "\\r" in
2505 let str = replace_str str "\n" "\\n" in
2506 let str = replace_str str "\t" "\\t" in
2509 (* Generate a lot of different functions for guestfish. *)
2510 and generate_fish_cmds () =
2511 generate_header CStyle GPLv2;
2515 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
2517 let all_functions_sorted =
2519 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
2520 ) all_functions_sorted in
2522 pr "#include <stdio.h>\n";
2523 pr "#include <stdlib.h>\n";
2524 pr "#include <string.h>\n";
2525 pr "#include <inttypes.h>\n";
2527 pr "#include <guestfs.h>\n";
2528 pr "#include \"fish.h\"\n";
2531 (* list_commands function, which implements guestfish -h *)
2532 pr "void list_commands (void)\n";
2534 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
2535 pr " list_builtin_commands ();\n";
2537 fun (name, _, _, flags, _, shortdesc, _) ->
2538 let name = replace_char name '_' '-' in
2539 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
2541 ) all_functions_sorted;
2542 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
2546 (* display_command function, which implements guestfish -h cmd *)
2547 pr "void display_command (const char *cmd)\n";
2550 fun (name, style, _, flags, _, shortdesc, longdesc) ->
2551 let name2 = replace_char name '_' '-' in
2553 try find_map (function FishAlias n -> Some n | _ -> None) flags
2554 with Not_found -> name in
2555 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
2557 match snd style with
2561 name2 (String.concat "> <" (List.map name_of_argt args)) in
2564 if List.mem ProtocolLimitWarning flags then
2565 ("\n\n" ^ protocol_limit_warning)
2568 (* For DangerWillRobinson commands, we should probably have
2569 * guestfish prompt before allowing you to use them (especially
2570 * in interactive mode). XXX
2574 if List.mem DangerWillRobinson flags then
2575 ("\n\n" ^ danger_will_robinson)
2578 let describe_alias =
2579 if name <> alias then
2580 sprintf "\n\nYou can use '%s' as an alias for this command." alias
2584 pr "strcasecmp (cmd, \"%s\") == 0" name;
2585 if name <> name2 then
2586 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
2587 if name <> alias then
2588 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
2590 pr " pod2text (\"%s - %s\", %S);\n"
2592 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
2595 pr " display_builtin_command (cmd);\n";
2599 (* print_{pv,vg,lv}_list functions *)
2603 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
2610 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
2612 pr " printf (\"%s: \");\n" name;
2613 pr " for (i = 0; i < 32; ++i)\n";
2614 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
2615 pr " printf (\"\\n\");\n"
2617 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
2619 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
2620 | name, `OptPercent ->
2621 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
2622 typ name name typ name;
2623 pr " else printf (\"%s: \\n\");\n" name
2627 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
2632 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
2633 pr " print_%s (&%ss->val[i]);\n" typ typ;
2636 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2638 (* run_<action> actions *)
2640 fun (name, style, _, flags, _, _, _) ->
2641 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
2643 (match fst style with
2646 | RBool _ -> pr " int r;\n"
2647 | RConstString _ -> pr " const char *r;\n"
2648 | RString _ -> pr " char *r;\n"
2649 | RStringList _ -> pr " char **r;\n"
2650 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
2651 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
2652 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
2653 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
2658 | OptString n -> pr " const char *%s;\n" n
2659 | StringList n -> pr " char **%s;\n" n
2660 | Bool n -> pr " int %s;\n" n
2661 | Int n -> pr " int %s;\n" n
2664 (* Check and convert parameters. *)
2665 let argc_expected = List.length (snd style) in
2666 pr " if (argc != %d) {\n" argc_expected;
2667 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
2669 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
2675 | String name -> pr " %s = argv[%d];\n" name i
2677 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
2679 | StringList name ->
2680 pr " %s = parse_string_list (argv[%d]);\n" name i
2682 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
2684 pr " %s = atoi (argv[%d]);\n" name i
2687 (* Call C API function. *)
2689 try find_map (function FishAction n -> Some n | _ -> None) flags
2690 with Not_found -> sprintf "guestfs_%s" name in
2692 generate_call_args ~handle:"g" style;
2695 (* Check return value for errors and display command results. *)
2696 (match fst style with
2697 | RErr -> pr " return r;\n"
2699 pr " if (r == -1) return -1;\n";
2700 pr " if (r) printf (\"%%d\\n\", r);\n";
2703 pr " if (r == -1) return -1;\n";
2704 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
2707 pr " if (r == NULL) return -1;\n";
2708 pr " printf (\"%%s\\n\", r);\n";
2711 pr " if (r == NULL) return -1;\n";
2712 pr " printf (\"%%s\\n\", r);\n";
2716 pr " if (r == NULL) return -1;\n";
2717 pr " print_strings (r);\n";
2718 pr " free_strings (r);\n";
2721 pr " if (r == NULL) return -1;\n";
2722 pr " printf (\"%%d, %%s\\n\", r->i,\n";
2723 pr " r->b ? \"true\" : \"false\");\n";
2724 pr " guestfs_free_int_bool (r);\n";
2727 pr " if (r == NULL) return -1;\n";
2728 pr " print_pv_list (r);\n";
2729 pr " guestfs_free_lvm_pv_list (r);\n";
2732 pr " if (r == NULL) return -1;\n";
2733 pr " print_vg_list (r);\n";
2734 pr " guestfs_free_lvm_vg_list (r);\n";
2737 pr " if (r == NULL) return -1;\n";
2738 pr " print_lv_list (r);\n";
2739 pr " guestfs_free_lvm_lv_list (r);\n";
2746 (* run_action function *)
2747 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
2750 fun (name, _, _, flags, _, _, _) ->
2751 let name2 = replace_char name '_' '-' in
2753 try find_map (function FishAlias n -> Some n | _ -> None) flags
2754 with Not_found -> name in
2756 pr "strcasecmp (cmd, \"%s\") == 0" name;
2757 if name <> name2 then
2758 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
2759 if name <> alias then
2760 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
2762 pr " return run_%s (cmd, argc, argv);\n" name;
2766 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
2773 (* Generate the POD documentation for guestfish. *)
2774 and generate_fish_actions_pod () =
2775 let all_functions_sorted =
2777 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
2778 ) all_functions_sorted in
2781 fun (name, style, _, flags, _, _, longdesc) ->
2782 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
2783 let name = replace_char name '_' '-' in
2785 try find_map (function FishAlias n -> Some n | _ -> None) flags
2786 with Not_found -> name in
2788 pr "=head2 %s" name;
2789 if name <> alias then
2796 | String n -> pr " %s" n
2797 | OptString n -> pr " %s" n
2798 | StringList n -> pr " %s,..." n
2799 | Bool _ -> pr " true|false"
2800 | Int n -> pr " %s" n
2804 pr "%s\n\n" longdesc;
2806 if List.mem ProtocolLimitWarning flags then
2807 pr "%s\n\n" protocol_limit_warning;
2809 if List.mem DangerWillRobinson flags then
2810 pr "%s\n\n" danger_will_robinson
2811 ) all_functions_sorted
2813 (* Generate a C function prototype. *)
2814 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
2815 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
2817 ?handle name style =
2818 if extern then pr "extern ";
2819 if static then pr "static ";
2820 (match fst style with
2822 | RInt _ -> pr "int "
2823 | RBool _ -> pr "int "
2824 | RConstString _ -> pr "const char *"
2825 | RString _ -> pr "char *"
2826 | RStringList _ -> pr "char **"
2828 if not in_daemon then pr "struct guestfs_int_bool *"
2829 else pr "guestfs_%s_ret *" name
2831 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
2832 else pr "guestfs_lvm_int_pv_list *"
2834 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
2835 else pr "guestfs_lvm_int_vg_list *"
2837 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
2838 else pr "guestfs_lvm_int_lv_list *"
2840 pr "%s%s (" prefix name;
2841 if handle = None && List.length (snd style) = 0 then
2844 let comma = ref false in
2847 | Some handle -> pr "guestfs_h *%s" handle; comma := true
2851 if single_line then pr ", " else pr ",\n\t\t"
2857 | String n -> next (); pr "const char *%s" n
2858 | OptString n -> next (); pr "const char *%s" n
2859 | StringList n -> next (); pr "char * const* const %s" n
2860 | Bool n -> next (); pr "int %s" n
2861 | Int n -> next (); pr "int %s" n
2865 if semicolon then pr ";";
2866 if newline then pr "\n"
2868 (* Generate C call arguments, eg "(handle, foo, bar)" *)
2869 and generate_call_args ?handle style =
2871 let comma = ref false in
2874 | Some handle -> pr "%s" handle; comma := true
2878 if !comma then pr ", ";
2885 | Int n -> pr "%s" n
2889 (* Generate the OCaml bindings interface. *)
2890 and generate_ocaml_mli () =
2891 generate_header OCamlStyle LGPLv2;
2894 (** For API documentation you should refer to the C API
2895 in the guestfs(3) manual page. The OCaml API uses almost
2896 exactly the same calls. *)
2899 (** A [guestfs_h] handle. *)
2901 exception Error of string
2902 (** This exception is raised when there is an error. *)
2904 val create : unit -> t
2906 val close : t -> unit
2907 (** Handles are closed by the garbage collector when they become
2908 unreferenced, but callers can also call this in order to
2909 provide predictable cleanup. *)
2912 generate_ocaml_lvm_structure_decls ();
2916 fun (name, style, _, _, _, shortdesc, _) ->
2917 generate_ocaml_prototype name style;
2918 pr "(** %s *)\n" shortdesc;
2922 (* Generate the OCaml bindings implementation. *)
2923 and generate_ocaml_ml () =
2924 generate_header OCamlStyle LGPLv2;
2928 exception Error of string
2929 external create : unit -> t = \"ocaml_guestfs_create\"
2930 external close : t -> unit = \"ocaml_guestfs_close\"
2933 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
2937 generate_ocaml_lvm_structure_decls ();
2941 fun (name, style, _, _, _, shortdesc, _) ->
2942 generate_ocaml_prototype ~is_external:true name style;
2945 (* Generate the OCaml bindings C implementation. *)
2946 and generate_ocaml_c () =
2947 generate_header CStyle LGPLv2;
2949 pr "#include <stdio.h>\n";
2950 pr "#include <stdlib.h>\n";
2951 pr "#include <string.h>\n";
2953 pr "#include <caml/config.h>\n";
2954 pr "#include <caml/alloc.h>\n";
2955 pr "#include <caml/callback.h>\n";
2956 pr "#include <caml/fail.h>\n";
2957 pr "#include <caml/memory.h>\n";
2958 pr "#include <caml/mlvalues.h>\n";
2959 pr "#include <caml/signals.h>\n";
2961 pr "#include <guestfs.h>\n";
2963 pr "#include \"guestfs_c.h\"\n";
2966 (* LVM struct copy functions. *)
2969 let has_optpercent_col =
2970 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
2972 pr "static CAMLprim value\n";
2973 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
2975 pr " CAMLparam0 ();\n";
2976 if has_optpercent_col then
2977 pr " CAMLlocal3 (rv, v, v2);\n"
2979 pr " CAMLlocal2 (rv, v);\n";
2981 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
2986 pr " v = caml_copy_string (%s->%s);\n" typ name
2988 pr " v = caml_alloc_string (32);\n";
2989 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
2992 pr " v = caml_copy_int64 (%s->%s);\n" typ name
2993 | name, `OptPercent ->
2994 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
2995 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
2996 pr " v = caml_alloc (1, 0);\n";
2997 pr " Store_field (v, 0, v2);\n";
2998 pr " } else /* None */\n";
2999 pr " v = Val_int (0);\n";
3001 pr " Store_field (rv, %d, v);\n" i
3003 pr " CAMLreturn (rv);\n";
3007 pr "static CAMLprim value\n";
3008 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
3011 pr " CAMLparam0 ();\n";
3012 pr " CAMLlocal2 (rv, v);\n";
3015 pr " if (%ss->len == 0)\n" typ;
3016 pr " CAMLreturn (Atom (0));\n";
3018 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
3019 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
3020 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
3021 pr " caml_modify (&Field (rv, i), v);\n";
3023 pr " CAMLreturn (rv);\n";
3027 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3030 fun (name, style, _, _, _, _, _) ->
3032 "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
3034 pr "CAMLprim value\n";
3035 pr "ocaml_guestfs_%s (value %s" name (List.hd params);
3036 List.iter (pr ", value %s") (List.tl params);
3041 | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
3042 pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
3043 pr " CAMLxparam%d (%s);\n"
3044 (List.length rest) (String.concat ", " rest)
3046 pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
3048 pr " CAMLlocal1 (rv);\n";
3051 pr " guestfs_h *g = Guestfs_val (gv);\n";
3052 pr " if (g == NULL)\n";
3053 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
3059 pr " const char *%s = String_val (%sv);\n" n n
3061 pr " const char *%s =\n" n;
3062 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
3065 pr " char **%s = ocaml_guestfs_strings_val (%sv);\n" n n
3067 pr " int %s = Bool_val (%sv);\n" n n
3069 pr " int %s = Int_val (%sv);\n" n n
3072 match fst style with
3073 | RErr -> pr " int r;\n"; "-1"
3074 | RInt _ -> pr " int r;\n"; "-1"
3075 | RBool _ -> pr " int r;\n"; "-1"
3076 | RConstString _ -> pr " const char *r;\n"; "NULL"
3077 | RString _ -> pr " char *r;\n"; "NULL"
3083 pr " struct guestfs_int_bool *r;\n";
3086 pr " struct guestfs_lvm_pv_list *r;\n";
3089 pr " struct guestfs_lvm_vg_list *r;\n";
3092 pr " struct guestfs_lvm_lv_list *r;\n";
3096 pr " caml_enter_blocking_section ();\n";
3097 pr " r = guestfs_%s " name;
3098 generate_call_args ~handle:"g" style;
3100 pr " caml_leave_blocking_section ();\n";
3105 pr " ocaml_guestfs_free_strings (%s);\n" n;
3106 | String _ | OptString _ | Bool _ | Int _ -> ()
3109 pr " if (r == %s)\n" error_code;
3110 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
3113 (match fst style with
3114 | RErr -> pr " rv = Val_unit;\n"
3115 | RInt _ -> pr " rv = Val_int (r);\n"
3116 | RBool _ -> pr " rv = Val_bool (r);\n"
3117 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
3119 pr " rv = caml_copy_string (r);\n";
3122 pr " rv = caml_copy_string_array ((const char **) r);\n";
3123 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
3126 pr " rv = caml_alloc (2, 0);\n";
3127 pr " Store_field (rv, 0, Val_int (r->i));\n";
3128 pr " Store_field (rv, 1, Val_bool (r->b));\n";
3129 pr " guestfs_free_int_bool (r);\n";
3131 pr " rv = copy_lvm_pv_list (r);\n";
3132 pr " guestfs_free_lvm_pv_list (r);\n";
3134 pr " rv = copy_lvm_vg_list (r);\n";
3135 pr " guestfs_free_lvm_vg_list (r);\n";
3137 pr " rv = copy_lvm_lv_list (r);\n";
3138 pr " guestfs_free_lvm_lv_list (r);\n";
3141 pr " CAMLreturn (rv);\n";
3145 if List.length params > 5 then (
3146 pr "CAMLprim value\n";
3147 pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
3149 pr " return ocaml_guestfs_%s (argv[0]" name;
3150 iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
3157 and generate_ocaml_lvm_structure_decls () =
3160 pr "type lvm_%s = {\n" typ;
3163 | name, `String -> pr " %s : string;\n" name
3164 | name, `UUID -> pr " %s : string;\n" name
3165 | name, `Bytes -> pr " %s : int64;\n" name
3166 | name, `Int -> pr " %s : int64;\n" name
3167 | name, `OptPercent -> pr " %s : float option;\n" name
3171 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
3173 and generate_ocaml_prototype ?(is_external = false) name style =
3174 if is_external then pr "external " else pr "val ";
3175 pr "%s : t -> " name;
3178 | String _ -> pr "string -> "
3179 | OptString _ -> pr "string option -> "
3180 | StringList _ -> pr "string array -> "
3181 | Bool _ -> pr "bool -> "
3182 | Int _ -> pr "int -> "
3184 (match fst style with
3185 | RErr -> pr "unit" (* all errors are turned into exceptions *)
3186 | RInt _ -> pr "int"
3187 | RBool _ -> pr "bool"
3188 | RConstString _ -> pr "string"
3189 | RString _ -> pr "string"
3190 | RStringList _ -> pr "string array"
3191 | RIntBool _ -> pr "int * bool"
3192 | RPVList _ -> pr "lvm_pv array"
3193 | RVGList _ -> pr "lvm_vg array"
3194 | RLVList _ -> pr "lvm_lv array"
3196 if is_external then (
3198 if List.length (snd style) + 1 > 5 then
3199 pr "\"ocaml_guestfs_%s_byte\" " name;
3200 pr "\"ocaml_guestfs_%s\"" name
3204 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
3205 and generate_perl_xs () =
3206 generate_header CStyle LGPLv2;
3209 #include \"EXTERN.h\"
3213 #include <guestfs.h>
3216 #define PRId64 \"lld\"
3220 my_newSVll(long long val) {
3221 #ifdef USE_64_BIT_ALL
3222 return newSViv(val);
3226 len = snprintf(buf, 100, \"%%\" PRId64, val);
3227 return newSVpv(buf, len);
3232 #define PRIu64 \"llu\"
3236 my_newSVull(unsigned long long val) {
3237 #ifdef USE_64_BIT_ALL
3238 return newSVuv(val);
3242 len = snprintf(buf, 100, \"%%\" PRIu64, val);
3243 return newSVpv(buf, len);
3247 /* XXX Not thread-safe, and in general not safe if the caller is
3248 * issuing multiple requests in parallel (on different guestfs
3249 * handles). We should use the guestfs_h handle passed to the
3250 * error handle to distinguish these cases.
3252 static char *last_error = NULL;
3255 error_handler (guestfs_h *g,
3259 if (last_error != NULL) free (last_error);
3260 last_error = strdup (msg);
3263 /* http://www.perlmonks.org/?node_id=680842 */
3265 XS_unpack_charPtrPtr (SV *arg) {
3270 if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV) {
3271 croak (\"array reference expected\");
3274 av = (AV *)SvRV (arg);
3275 ret = (char **)malloc (av_len (av) + 1 + 1);
3277 for (i = 0; i <= av_len (av); i++) {
3278 SV **elem = av_fetch (av, i, 0);
3280 if (!elem || !*elem) {
3281 croak (\"missing element in list\");
3284 ret[i] = SvPV_nolen (*elem);
3292 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
3297 RETVAL = guestfs_create ();
3299 croak (\"could not create guestfs handle\");
3300 guestfs_set_error_handler (RETVAL, error_handler, NULL);
3313 fun (name, style, _, _, _, _, _) ->
3314 (match fst style with
3315 | RErr -> pr "void\n"
3316 | RInt _ -> pr "SV *\n"
3317 | RBool _ -> pr "SV *\n"
3318 | RConstString _ -> pr "SV *\n"
3319 | RString _ -> pr "SV *\n"
3322 | RPVList _ | RVGList _ | RLVList _ ->
3323 pr "void\n" (* all lists returned implictly on the stack *)
3325 (* Call and arguments. *)
3327 generate_call_args ~handle:"g" style;
3329 pr " guestfs_h *g;\n";
3332 | String n -> pr " char *%s;\n" n
3333 | OptString n -> pr " char *%s;\n" n
3334 | StringList n -> pr " char **%s;\n" n
3335 | Bool n -> pr " int %s;\n" n
3336 | Int n -> pr " int %s;\n" n
3339 let do_cleanups () =
3346 | StringList n -> pr " free (%s);\n" n
3351 (match fst style with
3354 pr " if (guestfs_%s " name;
3355 generate_call_args ~handle:"g" style;
3358 pr " croak (\"%s: %%s\", last_error);\n" name;
3365 pr " %s = guestfs_%s " n name;
3366 generate_call_args ~handle:"g" style;
3368 pr " if (%s == -1) {\n" n;
3370 pr " croak (\"%s: %%s\", last_error);\n" name;
3372 pr " RETVAL = newSViv (%s);\n" n;
3377 pr " const char *%s;\n" n;
3379 pr " %s = guestfs_%s " n name;
3380 generate_call_args ~handle:"g" style;
3382 pr " if (%s == NULL) {\n" n;
3384 pr " croak (\"%s: %%s\", last_error);\n" name;
3386 pr " RETVAL = newSVpv (%s, 0);\n" n;
3391 pr " char *%s;\n" n;
3393 pr " %s = guestfs_%s " n name;
3394 generate_call_args ~handle:"g" style;
3396 pr " if (%s == NULL) {\n" n;
3398 pr " croak (\"%s: %%s\", last_error);\n" name;
3400 pr " RETVAL = newSVpv (%s, 0);\n" n;
3401 pr " free (%s);\n" n;
3406 pr " char **%s;\n" n;
3409 pr " %s = guestfs_%s " n name;
3410 generate_call_args ~handle:"g" style;
3412 pr " if (%s == NULL) {\n" n;
3414 pr " croak (\"%s: %%s\", last_error);\n" name;
3416 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
3417 pr " EXTEND (SP, n);\n";
3418 pr " for (i = 0; i < n; ++i) {\n";
3419 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
3420 pr " free (%s[i]);\n" n;
3422 pr " free (%s);\n" n;
3425 pr " struct guestfs_int_bool *r;\n";
3427 pr " r = guestfs_%s " name;
3428 generate_call_args ~handle:"g" style;
3430 pr " if (r == NULL) {\n";
3432 pr " croak (\"%s: %%s\", last_error);\n" name;
3434 pr " EXTEND (SP, 2);\n";
3435 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
3436 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
3437 pr " guestfs_free_int_bool (r);\n";
3439 generate_perl_lvm_code "pv" pv_cols name style n;
3441 generate_perl_lvm_code "vg" vg_cols name style n;
3443 generate_perl_lvm_code "lv" lv_cols name style n;
3451 and generate_perl_lvm_code typ cols name style n =
3453 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
3457 pr " %s = guestfs_%s " n name;
3458 generate_call_args ~handle:"g" style;
3460 pr " if (%s == NULL)\n" n;
3461 pr " croak (\"%s: %%s\", last_error);\n" name;
3462 pr " EXTEND (SP, %s->len);\n" n;
3463 pr " for (i = 0; i < %s->len; ++i) {\n" n;
3464 pr " hv = newHV ();\n";
3468 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
3469 name (String.length name) n name
3471 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
3472 name (String.length name) n name
3474 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
3475 name (String.length name) n name
3477 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
3478 name (String.length name) n name
3479 | name, `OptPercent ->
3480 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
3481 name (String.length name) n name
3483 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
3485 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
3487 (* Generate Sys/Guestfs.pm. *)
3488 and generate_perl_pm () =
3489 generate_header HashStyle LGPLv2;
3496 Sys::Guestfs - Perl bindings for libguestfs
3502 my $h = Sys::Guestfs->new ();
3503 $h->add_drive ('guest.img');
3506 $h->mount ('/dev/sda1', '/');
3507 $h->touch ('/hello');
3512 The C<Sys::Guestfs> module provides a Perl XS binding to the
3513 libguestfs API for examining and modifying virtual machine
3516 Amongst the things this is good for: making batch configuration
3517 changes to guests, getting disk used/free statistics (see also:
3518 virt-df), migrating between virtualization systems (see also:
3519 virt-p2v), performing partial backups, performing partial guest
3520 clones, cloning guests and changing registry/UUID/hostname info, and
3523 Libguestfs uses Linux kernel and qemu code, and can access any type of
3524 guest filesystem that Linux and qemu can, including but not limited
3525 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
3526 schemes, qcow, qcow2, vmdk.
3528 Libguestfs provides ways to enumerate guest storage (eg. partitions,
3529 LVs, what filesystem is in each LV, etc.). It can also run commands
3530 in the context of the guest. Also you can access filesystems over FTP.
3534 All errors turn into calls to C<croak> (see L<Carp(3)>).
3542 package Sys::Guestfs;
3548 XSLoader::load ('Sys::Guestfs');
3550 =item $h = Sys::Guestfs->new ();
3552 Create a new guestfs handle.
3558 my $class = ref ($proto) || $proto;
3560 my $self = Sys::Guestfs::_create ();
3561 bless $self, $class;
3567 (* Actions. We only need to print documentation for these as
3568 * they are pulled in from the XS code automatically.
3571 fun (name, style, _, flags, _, _, longdesc) ->
3572 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
3574 generate_perl_prototype name style;
3576 pr "%s\n\n" longdesc;
3577 if List.mem ProtocolLimitWarning flags then
3578 pr "%s\n\n" protocol_limit_warning;
3579 if List.mem DangerWillRobinson flags then
3580 pr "%s\n\n" danger_will_robinson
3581 ) all_functions_sorted;
3593 Copyright (C) 2009 Red Hat Inc.
3597 Please see the file COPYING.LIB for the full license.
3601 L<guestfs(3)>, L<guestfish(1)>.
3606 and generate_perl_prototype name style =
3607 (match fst style with
3612 | RString n -> pr "$%s = " n
3613 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
3617 | RLVList n -> pr "@%s = " n
3620 let comma = ref false in
3623 if !comma then pr ", ";
3626 | String n | OptString n | Bool n | Int n ->
3633 let output_to filename =
3634 let filename_new = filename ^ ".new" in
3635 chan := open_out filename_new;
3639 Unix.rename filename_new filename;
3640 printf "written %s\n%!" filename;
3648 if not (Sys.file_exists "configure.ac") then (
3650 You are probably running this from the wrong directory.
3651 Run it from the top source directory using the command
3657 let close = output_to "src/guestfs_protocol.x" in
3661 let close = output_to "src/guestfs-structs.h" in
3662 generate_structs_h ();
3665 let close = output_to "src/guestfs-actions.h" in
3666 generate_actions_h ();
3669 let close = output_to "src/guestfs-actions.c" in
3670 generate_client_actions ();
3673 let close = output_to "daemon/actions.h" in
3674 generate_daemon_actions_h ();
3677 let close = output_to "daemon/stubs.c" in
3678 generate_daemon_actions ();
3681 let close = output_to "tests.c" in
3685 let close = output_to "fish/cmds.c" in
3686 generate_fish_cmds ();
3689 let close = output_to "guestfs-structs.pod" in
3690 generate_structs_pod ();
3693 let close = output_to "guestfs-actions.pod" in
3694 generate_actions_pod ();
3697 let close = output_to "guestfish-actions.pod" in
3698 generate_fish_actions_pod ();
3701 let close = output_to "ocaml/guestfs.mli" in
3702 generate_ocaml_mli ();
3705 let close = output_to "ocaml/guestfs.ml" in
3706 generate_ocaml_ml ();
3709 let close = output_to "ocaml/guestfs_c_actions.c" in
3710 generate_ocaml_c ();
3713 let close = output_to "perl/Guestfs.xs" in
3714 generate_perl_xs ();
3717 let close = output_to "perl/lib/Sys/Guestfs.pm" in
3718 generate_perl_pm ();