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. *)
71 (* Key-value pairs of untyped strings. Turns into a hashtable or
72 * dictionary in languages which support it. DON'T use this as a
73 * general "bucket" for results. Prefer a stronger typed return
74 * value if one is available, or write a custom struct. Don't use
75 * this if the list could potentially be very long, since it is
76 * inefficient. Keys should be unique. NULLs are not permitted.
78 | RHashtable of string
80 and args = argt list (* Function parameters, guestfs handle is implicit. *)
82 (* Note in future we should allow a "variable args" parameter as
83 * the final parameter, to allow commands like
84 * chmod mode file [file(s)...]
85 * This is not implemented yet, but many commands (such as chmod)
86 * are currently defined with the argument order keeping this future
87 * possibility in mind.
90 | String of string (* const char *name, cannot be NULL *)
91 | OptString of string (* const char *name, may be NULL *)
92 | StringList of string(* list of strings (each string cannot be NULL) *)
93 | Bool of string (* boolean *)
94 | Int of string (* int (smallish ints, signed, <= 31 bits) *)
97 | ProtocolLimitWarning (* display warning about protocol size limits *)
98 | DangerWillRobinson (* flags particularly dangerous commands *)
99 | FishAlias of string (* provide an alias for this cmd in guestfish *)
100 | FishAction of string (* call this function in guestfish *)
101 | NotInFish (* do not export via guestfish *)
103 let protocol_limit_warning =
104 "Because of the message protocol, there is a transfer limit
105 of somewhere between 2MB and 4MB. To transfer large files you should use
108 let danger_will_robinson =
109 "B<This command is dangerous. Without careful use you
110 can easily destroy all your data>."
112 (* You can supply zero or as many tests as you want per API call.
114 * Note that the test environment has 3 block devices, of size 500MB,
115 * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc).
116 * Note for partitioning purposes, the 500MB device has 63 cylinders.
118 * To be able to run the tests in a reasonable amount of time,
119 * the virtual machine and block devices are reused between tests.
120 * So don't try testing kill_subprocess :-x
122 * Between each test we umount-all and lvm-remove-all (except InitNone).
124 * Don't assume anything about the previous contents of the block
125 * devices. Use 'Init*' to create some initial scenarios.
127 type tests = (test_init * test) list
129 (* Run the command sequence and just expect nothing to fail. *)
131 (* Run the command sequence and expect the output of the final
132 * command to be the string.
134 | TestOutput of seq * string
135 (* Run the command sequence and expect the output of the final
136 * command to be the list of strings.
138 | TestOutputList of seq * string list
139 (* Run the command sequence and expect the output of the final
140 * command to be the integer.
142 | TestOutputInt of seq * int
143 (* Run the command sequence and expect the output of the final
144 * command to be a true value (!= 0 or != NULL).
146 | TestOutputTrue of seq
147 (* Run the command sequence and expect the output of the final
148 * command to be a false value (== 0 or == NULL, but not an error).
150 | TestOutputFalse of seq
151 (* Run the command sequence and expect the output of the final
152 * command to be a list of the given length (but don't care about
155 | TestOutputLength of seq * int
156 (* Run the command sequence and expect the output of the final
157 * command to be a structure.
159 | TestOutputStruct of seq * test_field_compare list
160 (* Run the command sequence and expect the final command (only)
163 | TestLastFail of seq
165 and test_field_compare =
166 | CompareWithInt of string * int
167 | CompareWithString of string * string
168 | CompareFieldsIntEq of string * string
169 | CompareFieldsStrEq of string * string
171 (* Some initial scenarios for testing. *)
173 (* Do nothing, block devices could contain random stuff including
174 * LVM PVs, and some filesystems might be mounted. This is usually
178 (* Block devices are empty and no filesystems are mounted. *)
180 (* /dev/sda contains a single partition /dev/sda1, which is formatted
181 * as ext2, empty [except for lost+found] and mounted on /.
182 * /dev/sdb and /dev/sdc may have random content.
187 * /dev/sda1 (is a PV):
188 * /dev/VG/LV (size 8MB):
189 * formatted as ext2, empty [except for lost+found], mounted on /
190 * /dev/sdb and /dev/sdc may have random content.
194 (* Sequence of commands for testing. *)
196 and cmd = string list
198 (* Note about long descriptions: When referring to another
199 * action, use the format C<guestfs_other> (ie. the full name of
200 * the C function). This will be replaced as appropriate in other
203 * Apart from that, long descriptions are just perldoc paragraphs.
206 let non_daemon_functions = [
207 ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
209 "launch the qemu subprocess",
211 Internally libguestfs is implemented by running a virtual machine
214 You should call this after configuring the handle
215 (eg. adding drives) but before performing any actions.");
217 ("wait_ready", (RErr, []), -1, [NotInFish],
219 "wait until the qemu subprocess launches",
221 Internally libguestfs is implemented by running a virtual machine
224 You should call this after C<guestfs_launch> to wait for the launch
227 ("kill_subprocess", (RErr, []), -1, [],
229 "kill the qemu subprocess",
231 This kills the qemu subprocess. You should never need to call this.");
233 ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
235 "add an image to examine or modify",
237 This function adds a virtual machine disk image C<filename> to the
238 guest. The first time you call this function, the disk appears as IDE
239 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
242 You don't necessarily need to be root when using libguestfs. However
243 you obviously do need sufficient permissions to access the filename
244 for whatever operations you want to perform (ie. read access if you
245 just want to read the image or write access if you want to modify the
248 This is equivalent to the qemu parameter C<-drive file=filename>.");
250 ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
252 "add a CD-ROM disk image to examine",
254 This function adds a virtual CD-ROM disk image to the guest.
256 This is equivalent to the qemu parameter C<-cdrom filename>.");
258 ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
260 "add qemu parameters",
262 This can be used to add arbitrary qemu command line parameters
263 of the form C<-param value>. Actually it's not quite arbitrary - we
264 prevent you from setting some parameters which would interfere with
265 parameters that we use.
267 The first character of C<param> string must be a C<-> (dash).
269 C<value> can be NULL.");
271 ("set_path", (RErr, [String "path"]), -1, [FishAlias "path"],
273 "set the search path",
275 Set the path that libguestfs searches for kernel and initrd.img.
277 The default is C<$libdir/guestfs> unless overridden by setting
278 C<LIBGUESTFS_PATH> environment variable.
280 The string C<path> is stashed in the libguestfs handle, so the caller
281 must make sure it remains valid for the lifetime of the handle.
283 Setting C<path> to C<NULL> restores the default path.");
285 ("get_path", (RConstString "path", []), -1, [],
287 "get the search path",
289 Return the current search path.
291 This is always non-NULL. If it wasn't set already, then this will
292 return the default path.");
294 ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
298 If C<autosync> is true, this enables autosync. Libguestfs will make a
299 best effort attempt to run C<guestfs_sync> when the handle is closed
300 (also if the program exits without closing handles).");
302 ("get_autosync", (RBool "autosync", []), -1, [],
306 Get the autosync flag.");
308 ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
312 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
314 Verbose messages are disabled unless the environment variable
315 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
317 ("get_verbose", (RBool "verbose", []), -1, [],
321 This returns the verbose messages flag.")
324 let daemon_functions = [
325 ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
326 [InitEmpty, TestOutput (
327 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
328 ["mkfs"; "ext2"; "/dev/sda1"];
329 ["mount"; "/dev/sda1"; "/"];
330 ["write_file"; "/new"; "new file contents"; "0"];
331 ["cat"; "/new"]], "new file contents")],
332 "mount a guest disk at a position in the filesystem",
334 Mount a guest disk at a position in the filesystem. Block devices
335 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
336 the guest. If those block devices contain partitions, they will have
337 the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
340 The rules are the same as for L<mount(2)>: A filesystem must
341 first be mounted on C</> before others can be mounted. Other
342 filesystems can only be mounted on directories which already
345 The mounted filesystem is writable, if we have sufficient permissions
346 on the underlying device.
348 The filesystem options C<sync> and C<noatime> are set with this
349 call, in order to improve reliability.");
351 ("sync", (RErr, []), 2, [],
352 [ InitEmpty, TestRun [["sync"]]],
353 "sync disks, writes are flushed through to the disk image",
355 This syncs the disk, so that any writes are flushed through to the
356 underlying disk image.
358 You should always call this if you have modified a disk image, before
359 closing the handle.");
361 ("touch", (RErr, [String "path"]), 3, [],
362 [InitBasicFS, TestOutputTrue (
364 ["exists"; "/new"]])],
365 "update file timestamps or create a new file",
367 Touch acts like the L<touch(1)> command. It can be used to
368 update the timestamps on a file, or, if the file does not exist,
369 to create a new zero-length file.");
371 ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
372 [InitBasicFS, TestOutput (
373 [["write_file"; "/new"; "new file contents"; "0"];
374 ["cat"; "/new"]], "new file contents")],
375 "list the contents of a file",
377 Return the contents of the file named C<path>.
379 Note that this function cannot correctly handle binary files
380 (specifically, files containing C<\\0> character which is treated
381 as end of string). For those you need to use the C<guestfs_read_file>
382 function which has a more complex interface.");
384 ("ll", (RString "listing", [String "directory"]), 5, [],
385 [], (* XXX Tricky to test because it depends on the exact format
386 * of the 'ls -l' command, which changes between F10 and F11.
388 "list the files in a directory (long format)",
390 List the files in C<directory> (relative to the root directory,
391 there is no cwd) in the format of 'ls -la'.
393 This command is mostly useful for interactive sessions. It
394 is I<not> intended that you try to parse the output string.");
396 ("ls", (RStringList "listing", [String "directory"]), 6, [],
397 [InitBasicFS, TestOutputList (
400 ["touch"; "/newest"];
401 ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
402 "list the files in a directory",
404 List the files in C<directory> (relative to the root directory,
405 there is no cwd). The '.' and '..' entries are not returned, but
406 hidden files are shown.
408 This command is mostly useful for interactive sessions. Programs
409 should probably use C<guestfs_readdir> instead.");
411 ("list_devices", (RStringList "devices", []), 7, [],
412 [InitEmpty, TestOutputList (
413 [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"])],
414 "list the block devices",
416 List all the block devices.
418 The full block device names are returned, eg. C</dev/sda>");
420 ("list_partitions", (RStringList "partitions", []), 8, [],
421 [InitBasicFS, TestOutputList (
422 [["list_partitions"]], ["/dev/sda1"]);
423 InitEmpty, TestOutputList (
424 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
425 ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
426 "list the partitions",
428 List all the partitions detected on all block devices.
430 The full partition device names are returned, eg. C</dev/sda1>
432 This does not return logical volumes. For that you will need to
433 call C<guestfs_lvs>.");
435 ("pvs", (RStringList "physvols", []), 9, [],
436 [InitBasicFSonLVM, TestOutputList (
437 [["pvs"]], ["/dev/sda1"]);
438 InitEmpty, TestOutputList (
439 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
440 ["pvcreate"; "/dev/sda1"];
441 ["pvcreate"; "/dev/sda2"];
442 ["pvcreate"; "/dev/sda3"];
443 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
444 "list the LVM physical volumes (PVs)",
446 List all the physical volumes detected. This is the equivalent
447 of the L<pvs(8)> command.
449 This returns a list of just the device names that contain
450 PVs (eg. C</dev/sda2>).
452 See also C<guestfs_pvs_full>.");
454 ("vgs", (RStringList "volgroups", []), 10, [],
455 [InitBasicFSonLVM, TestOutputList (
457 InitEmpty, TestOutputList (
458 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
459 ["pvcreate"; "/dev/sda1"];
460 ["pvcreate"; "/dev/sda2"];
461 ["pvcreate"; "/dev/sda3"];
462 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
463 ["vgcreate"; "VG2"; "/dev/sda3"];
464 ["vgs"]], ["VG1"; "VG2"])],
465 "list the LVM volume groups (VGs)",
467 List all the volumes groups detected. This is the equivalent
468 of the L<vgs(8)> command.
470 This returns a list of just the volume group names that were
471 detected (eg. C<VolGroup00>).
473 See also C<guestfs_vgs_full>.");
475 ("lvs", (RStringList "logvols", []), 11, [],
476 [InitBasicFSonLVM, TestOutputList (
477 [["lvs"]], ["/dev/VG/LV"]);
478 InitEmpty, TestOutputList (
479 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
480 ["pvcreate"; "/dev/sda1"];
481 ["pvcreate"; "/dev/sda2"];
482 ["pvcreate"; "/dev/sda3"];
483 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
484 ["vgcreate"; "VG2"; "/dev/sda3"];
485 ["lvcreate"; "LV1"; "VG1"; "50"];
486 ["lvcreate"; "LV2"; "VG1"; "50"];
487 ["lvcreate"; "LV3"; "VG2"; "50"];
488 ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
489 "list the LVM logical volumes (LVs)",
491 List all the logical volumes detected. This is the equivalent
492 of the L<lvs(8)> command.
494 This returns a list of the logical volume device names
495 (eg. C</dev/VolGroup00/LogVol00>).
497 See also C<guestfs_lvs_full>.");
499 ("pvs_full", (RPVList "physvols", []), 12, [],
500 [], (* XXX how to test? *)
501 "list the LVM physical volumes (PVs)",
503 List all the physical volumes detected. This is the equivalent
504 of the L<pvs(8)> command. The \"full\" version includes all fields.");
506 ("vgs_full", (RVGList "volgroups", []), 13, [],
507 [], (* XXX how to test? *)
508 "list the LVM volume groups (VGs)",
510 List all the volumes groups detected. This is the equivalent
511 of the L<vgs(8)> command. The \"full\" version includes all fields.");
513 ("lvs_full", (RLVList "logvols", []), 14, [],
514 [], (* XXX how to test? *)
515 "list the LVM logical volumes (LVs)",
517 List all the logical volumes detected. This is the equivalent
518 of the L<lvs(8)> command. The \"full\" version includes all fields.");
520 ("read_lines", (RStringList "lines", [String "path"]), 15, [],
521 [InitBasicFS, TestOutputList (
522 [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
523 ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);
524 InitBasicFS, TestOutputList (
525 [["write_file"; "/new"; ""; "0"];
526 ["read_lines"; "/new"]], [])],
527 "read file as lines",
529 Return the contents of the file named C<path>.
531 The file contents are returned as a list of lines. Trailing
532 C<LF> and C<CRLF> character sequences are I<not> returned.
534 Note that this function cannot correctly handle binary files
535 (specifically, files containing C<\\0> character which is treated
536 as end of line). For those you need to use the C<guestfs_read_file>
537 function which has a more complex interface.");
539 ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [],
540 [], (* XXX Augeas code needs tests. *)
541 "create a new Augeas handle",
543 Create a new Augeas handle for editing configuration files.
544 If there was any previous Augeas handle associated with this
545 guestfs session, then it is closed.
547 You must call this before using any other C<guestfs_aug_*>
550 C<root> is the filesystem root. C<root> must not be NULL,
553 The flags are the same as the flags defined in
554 E<lt>augeas.hE<gt>, the logical I<or> of the following
559 =item C<AUG_SAVE_BACKUP> = 1
561 Keep the original file with a C<.augsave> extension.
563 =item C<AUG_SAVE_NEWFILE> = 2
565 Save changes into a file with extension C<.augnew>, and
566 do not overwrite original. Overrides C<AUG_SAVE_BACKUP>.
568 =item C<AUG_TYPE_CHECK> = 4
570 Typecheck lenses (can be expensive).
572 =item C<AUG_NO_STDINC> = 8
574 Do not use standard load path for modules.
576 =item C<AUG_SAVE_NOOP> = 16
578 Make save a no-op, just record what would have been changed.
580 =item C<AUG_NO_LOAD> = 32
582 Do not load the tree in C<guestfs_aug_init>.
586 To close the handle, you can call C<guestfs_aug_close>.
588 To find out more about Augeas, see L<http://augeas.net/>.");
590 ("aug_close", (RErr, []), 26, [],
591 [], (* XXX Augeas code needs tests. *)
592 "close the current Augeas handle",
594 Close the current Augeas handle and free up any resources
595 used by it. After calling this, you have to call
596 C<guestfs_aug_init> again before you can use any other
599 ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
600 [], (* XXX Augeas code needs tests. *)
601 "define an Augeas variable",
603 Defines an Augeas variable C<name> whose value is the result
604 of evaluating C<expr>. If C<expr> is NULL, then C<name> is
607 On success this returns the number of nodes in C<expr>, or
608 C<0> if C<expr> evaluates to something which is not a nodeset.");
610 ("aug_defnode", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [],
611 [], (* XXX Augeas code needs tests. *)
612 "define an Augeas node",
614 Defines a variable C<name> whose value is the result of
617 If C<expr> evaluates to an empty nodeset, a node is created,
618 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
619 C<name> will be the nodeset containing that single node.
621 On success this returns a pair containing the
622 number of nodes in the nodeset, and a boolean flag
623 if a node was created.");
625 ("aug_get", (RString "val", [String "path"]), 19, [],
626 [], (* XXX Augeas code needs tests. *)
627 "look up the value of an Augeas path",
629 Look up the value associated with C<path>. If C<path>
630 matches exactly one node, the C<value> is returned.");
632 ("aug_set", (RErr, [String "path"; String "val"]), 20, [],
633 [], (* XXX Augeas code needs tests. *)
634 "set Augeas path to value",
636 Set the value associated with C<path> to C<value>.");
638 ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [],
639 [], (* XXX Augeas code needs tests. *)
640 "insert a sibling Augeas node",
642 Create a new sibling C<label> for C<path>, inserting it into
643 the tree before or after C<path> (depending on the boolean
646 C<path> must match exactly one existing node in the tree, and
647 C<label> must be a label, ie. not contain C</>, C<*> or end
648 with a bracketed index C<[N]>.");
650 ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
651 [], (* XXX Augeas code needs tests. *)
652 "remove an Augeas path",
654 Remove C<path> and all of its children.
656 On success this returns the number of entries which were removed.");
658 ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [],
659 [], (* XXX Augeas code needs tests. *)
662 Move the node C<src> to C<dest>. C<src> must match exactly
663 one node. C<dest> is overwritten if it exists.");
665 ("aug_match", (RStringList "matches", [String "path"]), 24, [],
666 [], (* XXX Augeas code needs tests. *)
667 "return Augeas nodes which match path",
669 Returns a list of paths which match the path expression C<path>.
670 The returned paths are sufficiently qualified so that they match
671 exactly one node in the current tree.");
673 ("aug_save", (RErr, []), 25, [],
674 [], (* XXX Augeas code needs tests. *)
675 "write all pending Augeas changes to disk",
677 This writes all pending changes to disk.
679 The flags which were passed to C<guestfs_aug_init> affect exactly
680 how files are saved.");
682 ("aug_load", (RErr, []), 27, [],
683 [], (* XXX Augeas code needs tests. *)
684 "load files into the tree",
686 Load files into the tree.
688 See C<aug_load> in the Augeas documentation for the full gory
691 ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
692 [], (* XXX Augeas code needs tests. *)
693 "list Augeas nodes under a path",
695 This is just a shortcut for listing C<guestfs_aug_match>
696 C<path/*> and sorting the resulting nodes into alphabetical order.");
698 ("rm", (RErr, [String "path"]), 29, [],
699 [InitBasicFS, TestRun
702 InitBasicFS, TestLastFail
704 InitBasicFS, TestLastFail
709 Remove the single file C<path>.");
711 ("rmdir", (RErr, [String "path"]), 30, [],
712 [InitBasicFS, TestRun
715 InitBasicFS, TestLastFail
717 InitBasicFS, TestLastFail
720 "remove a directory",
722 Remove the single directory C<path>.");
724 ("rm_rf", (RErr, [String "path"]), 31, [],
725 [InitBasicFS, TestOutputFalse
727 ["mkdir"; "/new/foo"];
728 ["touch"; "/new/foo/bar"];
730 ["exists"; "/new"]]],
731 "remove a file or directory recursively",
733 Remove the file or directory C<path>, recursively removing the
734 contents if its a directory. This is like the C<rm -rf> shell
737 ("mkdir", (RErr, [String "path"]), 32, [],
738 [InitBasicFS, TestOutputTrue
741 InitBasicFS, TestLastFail
742 [["mkdir"; "/new/foo/bar"]]],
743 "create a directory",
745 Create a directory named C<path>.");
747 ("mkdir_p", (RErr, [String "path"]), 33, [],
748 [InitBasicFS, TestOutputTrue
749 [["mkdir_p"; "/new/foo/bar"];
750 ["is_dir"; "/new/foo/bar"]];
751 InitBasicFS, TestOutputTrue
752 [["mkdir_p"; "/new/foo/bar"];
753 ["is_dir"; "/new/foo"]];
754 InitBasicFS, TestOutputTrue
755 [["mkdir_p"; "/new/foo/bar"];
756 ["is_dir"; "/new"]]],
757 "create a directory and parents",
759 Create a directory named C<path>, creating any parent directories
760 as necessary. This is like the C<mkdir -p> shell command.");
762 ("chmod", (RErr, [Int "mode"; String "path"]), 34, [],
763 [], (* XXX Need stat command to test *)
766 Change the mode (permissions) of C<path> to C<mode>. Only
767 numeric modes are supported.");
769 ("chown", (RErr, [Int "owner"; Int "group"; String "path"]), 35, [],
770 [], (* XXX Need stat command to test *)
771 "change file owner and group",
773 Change the file owner to C<owner> and group to C<group>.
775 Only numeric uid and gid are supported. If you want to use
776 names, you will need to locate and parse the password file
777 yourself (Augeas support makes this relatively easy).");
779 ("exists", (RBool "existsflag", [String "path"]), 36, [],
780 [InitBasicFS, TestOutputTrue (
782 ["exists"; "/new"]]);
783 InitBasicFS, TestOutputTrue (
785 ["exists"; "/new"]])],
786 "test if file or directory exists",
788 This returns C<true> if and only if there is a file, directory
789 (or anything) with the given C<path> name.
791 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
793 ("is_file", (RBool "fileflag", [String "path"]), 37, [],
794 [InitBasicFS, TestOutputTrue (
796 ["is_file"; "/new"]]);
797 InitBasicFS, TestOutputFalse (
799 ["is_file"; "/new"]])],
800 "test if file exists",
802 This returns C<true> if and only if there is a file
803 with the given C<path> name. Note that it returns false for
804 other objects like directories.
806 See also C<guestfs_stat>.");
808 ("is_dir", (RBool "dirflag", [String "path"]), 38, [],
809 [InitBasicFS, TestOutputFalse (
811 ["is_dir"; "/new"]]);
812 InitBasicFS, TestOutputTrue (
814 ["is_dir"; "/new"]])],
815 "test if file exists",
817 This returns C<true> if and only if there is a directory
818 with the given C<path> name. Note that it returns false for
819 other objects like files.
821 See also C<guestfs_stat>.");
823 ("pvcreate", (RErr, [String "device"]), 39, [],
824 [InitEmpty, TestOutputList (
825 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
826 ["pvcreate"; "/dev/sda1"];
827 ["pvcreate"; "/dev/sda2"];
828 ["pvcreate"; "/dev/sda3"];
829 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
830 "create an LVM physical volume",
832 This creates an LVM physical volume on the named C<device>,
833 where C<device> should usually be a partition name such
836 ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
837 [InitEmpty, TestOutputList (
838 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
839 ["pvcreate"; "/dev/sda1"];
840 ["pvcreate"; "/dev/sda2"];
841 ["pvcreate"; "/dev/sda3"];
842 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
843 ["vgcreate"; "VG2"; "/dev/sda3"];
844 ["vgs"]], ["VG1"; "VG2"])],
845 "create an LVM volume group",
847 This creates an LVM volume group called C<volgroup>
848 from the non-empty list of physical volumes C<physvols>.");
850 ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [],
851 [InitEmpty, TestOutputList (
852 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
853 ["pvcreate"; "/dev/sda1"];
854 ["pvcreate"; "/dev/sda2"];
855 ["pvcreate"; "/dev/sda3"];
856 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
857 ["vgcreate"; "VG2"; "/dev/sda3"];
858 ["lvcreate"; "LV1"; "VG1"; "50"];
859 ["lvcreate"; "LV2"; "VG1"; "50"];
860 ["lvcreate"; "LV3"; "VG2"; "50"];
861 ["lvcreate"; "LV4"; "VG2"; "50"];
862 ["lvcreate"; "LV5"; "VG2"; "50"];
864 ["/dev/VG1/LV1"; "/dev/VG1/LV2";
865 "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
866 "create an LVM volume group",
868 This creates an LVM volume group called C<logvol>
869 on the volume group C<volgroup>, with C<size> megabytes.");
871 ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [],
872 [InitEmpty, TestOutput (
873 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
874 ["mkfs"; "ext2"; "/dev/sda1"];
875 ["mount"; "/dev/sda1"; "/"];
876 ["write_file"; "/new"; "new file contents"; "0"];
877 ["cat"; "/new"]], "new file contents")],
880 This creates a filesystem on C<device> (usually a partition
881 of LVM logical volume). The filesystem type is C<fstype>, for
884 ("sfdisk", (RErr, [String "device";
885 Int "cyls"; Int "heads"; Int "sectors";
886 StringList "lines"]), 43, [DangerWillRobinson],
888 "create partitions on a block device",
890 This is a direct interface to the L<sfdisk(8)> program for creating
891 partitions on block devices.
893 C<device> should be a block device, for example C</dev/sda>.
895 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
896 and sectors on the device, which are passed directly to sfdisk as
897 the I<-C>, I<-H> and I<-S> parameters. If you pass C<0> for any
898 of these, then the corresponding parameter is omitted. Usually for
899 'large' disks, you can just pass C<0> for these, but for small
900 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
901 out the right geometry and you will need to tell it.
903 C<lines> is a list of lines that we feed to C<sfdisk>. For more
904 information refer to the L<sfdisk(8)> manpage.
906 To create a single partition occupying the whole disk, you would
907 pass C<lines> as a single element list, when the single element being
908 the string C<,> (comma).");
910 ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
911 [InitEmpty, TestOutput (
912 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
913 ["mkfs"; "ext2"; "/dev/sda1"];
914 ["mount"; "/dev/sda1"; "/"];
915 ["write_file"; "/new"; "new file contents"; "0"];
916 ["cat"; "/new"]], "new file contents")],
919 This call creates a file called C<path>. The contents of the
920 file is the string C<content> (which can contain any 8 bit data),
923 As a special case, if C<size> is C<0>
924 then the length is calculated using C<strlen> (so in this case
925 the content cannot contain embedded ASCII NULs).");
927 ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
928 [InitEmpty, TestOutputList (
929 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
930 ["mkfs"; "ext2"; "/dev/sda1"];
931 ["mount"; "/dev/sda1"; "/"];
932 ["mounts"]], ["/dev/sda1"]);
933 InitEmpty, TestOutputList (
934 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
935 ["mkfs"; "ext2"; "/dev/sda1"];
936 ["mount"; "/dev/sda1"; "/"];
939 "unmount a filesystem",
941 This unmounts the given filesystem. The filesystem may be
942 specified either by its mountpoint (path) or the device which
943 contains the filesystem.");
945 ("mounts", (RStringList "devices", []), 46, [],
946 [InitBasicFS, TestOutputList (
947 [["mounts"]], ["/dev/sda1"])],
948 "show mounted filesystems",
950 This returns the list of currently mounted filesystems. It returns
951 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
953 Some internal mounts are not shown.");
955 ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
956 [InitBasicFS, TestOutputList (
959 "unmount all filesystems",
961 This unmounts all mounted filesystems.
963 Some internal mounts are not unmounted by this call.");
965 ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson],
967 "remove all LVM LVs, VGs and PVs",
969 This command removes all LVM logical volumes, volume groups
970 and physical volumes.");
972 ("file", (RString "description", [String "path"]), 49, [],
973 [InitBasicFS, TestOutput (
975 ["file"; "/new"]], "empty");
976 InitBasicFS, TestOutput (
977 [["write_file"; "/new"; "some content\n"; "0"];
978 ["file"; "/new"]], "ASCII text");
979 InitBasicFS, TestLastFail (
980 [["file"; "/nofile"]])],
981 "determine file type",
983 This call uses the standard L<file(1)> command to determine
984 the type or contents of the file. This also works on devices,
985 for example to find out whether a partition contains a filesystem.
987 The exact command which runs is C<file -bsL path>. Note in
988 particular that the filename is not prepended to the output
989 (the C<-b> option).");
991 ("command", (RString "output", [StringList "arguments"]), 50, [],
992 [], (* XXX how to test? *)
993 "run a command from the guest filesystem",
995 This call runs a command from the guest filesystem. The
996 filesystem must be mounted, and must contain a compatible
997 operating system (ie. something Linux, with the same
998 or compatible processor architecture).
1000 The single parameter is an argv-style list of arguments.
1001 The first element is the name of the program to run.
1002 Subsequent elements are parameters. The list must be
1003 non-empty (ie. must contain a program name).
1005 The C<$PATH> environment variable will contain at least
1006 C</usr/bin> and C</bin>. If you require a program from
1007 another location, you should provide the full path in the
1010 Shared libraries and data files required by the program
1011 must be available on filesystems which are mounted in the
1012 correct places. It is the caller's responsibility to ensure
1013 all filesystems that are needed are mounted at the right
1016 ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [],
1017 [], (* XXX how to test? *)
1018 "run a command, returning lines",
1020 This is the same as C<guestfs_command>, but splits the
1021 result into a list of lines.");
1023 ("stat", (RStat "statbuf", [String "path"]), 52, [],
1024 [InitBasicFS, TestOutputStruct (
1026 ["stat"; "/new"]], [CompareWithInt ("size", 0)])],
1027 "get file information",
1029 Returns file information for the given C<path>.
1031 This is the same as the C<stat(2)> system call.");
1033 ("lstat", (RStat "statbuf", [String "path"]), 53, [],
1034 [InitBasicFS, TestOutputStruct (
1036 ["lstat"; "/new"]], [CompareWithInt ("size", 0)])],
1037 "get file information for a symbolic link",
1039 Returns file information for the given C<path>.
1041 This is the same as C<guestfs_stat> except that if C<path>
1042 is a symbolic link, then the link is stat-ed, not the file it
1045 This is the same as the C<lstat(2)> system call.");
1047 ("statvfs", (RStatVFS "statbuf", [String "path"]), 54, [],
1048 [InitBasicFS, TestOutputStruct (
1049 [["statvfs"; "/"]], [CompareWithInt ("bfree", 487702);
1050 CompareWithInt ("blocks", 490020);
1051 CompareWithInt ("bsize", 1024)])],
1052 "get file system statistics",
1054 Returns file system statistics for any mounted file system.
1055 C<path> should be a file or directory in the mounted file system
1056 (typically it is the mount point itself, but it doesn't need to be).
1058 This is the same as the C<statvfs(2)> system call.");
1060 ("tune2fs_l", (RHashtable "superblock", [String "device"]), 55, [],
1062 "get ext2/ext3 superblock details",
1064 This returns the contents of the ext2 or ext3 filesystem superblock
1067 It is the same as running C<tune2fs -l device>. See L<tune2fs(8)>
1068 manpage for more details. The list of fields returned isn't
1069 clearly defined, and depends on both the version of C<tune2fs>
1070 that libguestfs was built against, and the filesystem itself.");
1074 let all_functions = non_daemon_functions @ daemon_functions
1076 (* In some places we want the functions to be displayed sorted
1077 * alphabetically, so this is useful:
1079 let all_functions_sorted =
1080 List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
1081 compare n1 n2) all_functions
1083 (* Column names and types from LVM PVs/VGs/LVs. *)
1092 "pv_attr", `String (* XXX *);
1093 "pv_pe_count", `Int;
1094 "pv_pe_alloc_count", `Int;
1097 "pv_mda_count", `Int;
1098 "pv_mda_free", `Bytes;
1099 (* Not in Fedora 10:
1100 "pv_mda_size", `Bytes;
1107 "vg_attr", `String (* XXX *);
1110 "vg_sysid", `String;
1111 "vg_extent_size", `Bytes;
1112 "vg_extent_count", `Int;
1113 "vg_free_count", `Int;
1121 "vg_mda_count", `Int;
1122 "vg_mda_free", `Bytes;
1123 (* Not in Fedora 10:
1124 "vg_mda_size", `Bytes;
1130 "lv_attr", `String (* XXX *);
1133 "lv_kernel_major", `Int;
1134 "lv_kernel_minor", `Int;
1138 "snap_percent", `OptPercent;
1139 "copy_percent", `OptPercent;
1142 "mirror_log", `String;
1146 (* Column names and types from stat structures.
1147 * NB. Can't use things like 'st_atime' because glibc header files
1148 * define some of these as macros. Ugh.
1165 let statvfs_cols = [
1179 (* Useful functions.
1180 * Note we don't want to use any external OCaml libraries which
1181 * makes this a bit harder than it should be.
1183 let failwithf fs = ksprintf failwith fs
1185 let replace_char s c1 c2 =
1186 let s2 = String.copy s in
1187 let r = ref false in
1188 for i = 0 to String.length s2 - 1 do
1189 if String.unsafe_get s2 i = c1 then (
1190 String.unsafe_set s2 i c2;
1194 if not !r then s else s2
1196 let rec find s sub =
1197 let len = String.length s in
1198 let sublen = String.length sub in
1200 if i <= len-sublen then (
1202 if j < sublen then (
1203 if s.[i+j] = sub.[j] then loop2 (j+1)
1209 if r = -1 then loop (i+1) else r
1215 let rec replace_str s s1 s2 =
1216 let len = String.length s in
1217 let sublen = String.length s1 in
1218 let i = find s s1 in
1221 let s' = String.sub s 0 i in
1222 let s'' = String.sub s (i+sublen) (len-i-sublen) in
1223 s' ^ s2 ^ replace_str s'' s1 s2
1226 let rec string_split sep str =
1227 let len = String.length str in
1228 let seplen = String.length sep in
1229 let i = find str sep in
1230 if i = -1 then [str]
1232 let s' = String.sub str 0 i in
1233 let s'' = String.sub str (i+seplen) (len-i-seplen) in
1234 s' :: string_split sep s''
1237 let rec find_map f = function
1238 | [] -> raise Not_found
1242 | None -> find_map f xs
1245 let rec loop i = function
1247 | x :: xs -> f i x; loop (i+1) xs
1252 let rec loop i = function
1254 | x :: xs -> let r = f i x in r :: loop (i+1) xs
1258 let name_of_argt = function
1259 | String n | OptString n | StringList n | Bool n | Int n -> n
1261 let seq_of_test = function
1262 | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
1263 | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s
1264 | TestOutputLength (s, _) | TestOutputStruct (s, _)
1265 | TestLastFail s -> s
1267 (* Check function names etc. for consistency. *)
1268 let check_functions () =
1269 let contains_uppercase str =
1270 let len = String.length str in
1272 if i >= len then false
1275 if c >= 'A' && c <= 'Z' then true
1282 (* Check function names. *)
1284 fun (name, _, _, _, _, _, _) ->
1285 if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
1286 failwithf "function name %s does not need 'guestfs' prefix" name;
1287 if contains_uppercase name then
1288 failwithf "function name %s should not contain uppercase chars" name;
1289 if String.contains name '-' then
1290 failwithf "function name %s should not contain '-', use '_' instead."
1294 (* Check function parameter/return names. *)
1296 fun (name, style, _, _, _, _, _) ->
1297 let check_arg_ret_name n =
1298 if contains_uppercase n then
1299 failwithf "%s param/ret %s should not contain uppercase chars"
1301 if String.contains n '-' || String.contains n '_' then
1302 failwithf "%s param/ret %s should not contain '-' or '_'"
1305 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;
1306 if n = "argv" || n = "args" then
1307 failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" n
1310 (match fst style with
1312 | RInt n | RBool n | RConstString n | RString n
1313 | RStringList n | RPVList n | RVGList n | RLVList n
1314 | RStat n | RStatVFS n
1316 check_arg_ret_name n
1318 check_arg_ret_name n;
1319 check_arg_ret_name m
1321 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
1324 (* Check short descriptions. *)
1326 fun (name, _, _, _, _, shortdesc, _) ->
1327 if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
1328 failwithf "short description of %s should begin with lowercase." name;
1329 let c = shortdesc.[String.length shortdesc-1] in
1330 if c = '\n' || c = '.' then
1331 failwithf "short description of %s should not end with . or \\n." name
1334 (* Check long dscriptions. *)
1336 fun (name, _, _, _, _, _, longdesc) ->
1337 if longdesc.[String.length longdesc-1] = '\n' then
1338 failwithf "long description of %s should not end with \\n." name
1341 (* Check proc_nrs. *)
1343 fun (name, _, proc_nr, _, _, _, _) ->
1344 if proc_nr <= 0 then
1345 failwithf "daemon function %s should have proc_nr > 0" name
1349 fun (name, _, proc_nr, _, _, _, _) ->
1350 if proc_nr <> -1 then
1351 failwithf "non-daemon function %s should have proc_nr -1" name
1352 ) non_daemon_functions;
1355 List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
1358 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
1359 let rec loop = function
1362 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
1364 | (name1,nr1) :: (name2,nr2) :: _ ->
1365 failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
1373 (* Ignore functions that have no tests. We generate a
1374 * warning when the user does 'make check' instead.
1376 | name, _, _, _, [], _, _ -> ()
1377 | name, _, _, _, tests, _, _ ->
1381 match seq_of_test test with
1383 failwithf "%s has a test containing an empty sequence" name
1384 | cmds -> List.map List.hd cmds
1386 let funcs = List.flatten funcs in
1388 let tested = List.mem name funcs in
1391 failwithf "function %s has tests but does not test itself" name
1394 (* 'pr' prints to the current output file. *)
1395 let chan = ref stdout
1396 let pr fs = ksprintf (output_string !chan) fs
1398 (* Generate a header block in a number of standard styles. *)
1399 type comment_style = CStyle | HashStyle | OCamlStyle
1400 type license = GPLv2 | LGPLv2
1402 let generate_header comment license =
1403 let c = match comment with
1404 | CStyle -> pr "/* "; " *"
1405 | HashStyle -> pr "# "; "#"
1406 | OCamlStyle -> pr "(* "; " *" in
1407 pr "libguestfs generated file\n";
1408 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
1409 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
1411 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
1415 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
1416 pr "%s it under the terms of the GNU General Public License as published by\n" c;
1417 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
1418 pr "%s (at your option) any later version.\n" c;
1420 pr "%s This program is distributed in the hope that it will be useful,\n" c;
1421 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1422 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
1423 pr "%s GNU General Public License for more details.\n" c;
1425 pr "%s You should have received a copy of the GNU General Public License along\n" c;
1426 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
1427 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
1430 pr "%s This library is free software; you can redistribute it and/or\n" c;
1431 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
1432 pr "%s License as published by the Free Software Foundation; either\n" c;
1433 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
1435 pr "%s This library is distributed in the hope that it will be useful,\n" c;
1436 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1437 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
1438 pr "%s Lesser General Public License for more details.\n" c;
1440 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
1441 pr "%s License along with this library; if not, write to the Free Software\n" c;
1442 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
1445 | CStyle -> pr " */\n"
1447 | OCamlStyle -> pr " *)\n"
1451 (* Start of main code generation functions below this line. *)
1453 (* Generate the pod documentation for the C API. *)
1454 let rec generate_actions_pod () =
1456 fun (shortname, style, _, flags, _, _, longdesc) ->
1457 let name = "guestfs_" ^ shortname in
1458 pr "=head2 %s\n\n" name;
1460 generate_prototype ~extern:false ~handle:"handle" name style;
1462 pr "%s\n\n" longdesc;
1463 (match fst style with
1465 pr "This function returns 0 on success or -1 on error.\n\n"
1467 pr "On error this function returns -1.\n\n"
1469 pr "This function returns a C truth value on success or -1 on error.\n\n"
1471 pr "This function returns a string, or NULL on error.
1472 The string is owned by the guest handle and must I<not> be freed.\n\n"
1474 pr "This function returns a string, or NULL on error.
1475 I<The caller must free the returned string after use>.\n\n"
1477 pr "This function returns a NULL-terminated array of strings
1478 (like L<environ(3)>), or NULL if there was an error.
1479 I<The caller must free the strings and the array after use>.\n\n"
1481 pr "This function returns a C<struct guestfs_int_bool *>,
1482 or NULL if there was an error.
1483 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
1485 pr "This function returns a C<struct guestfs_lvm_pv_list *>
1486 (see E<lt>guestfs-structs.hE<gt>),
1487 or NULL if there was an error.
1488 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
1490 pr "This function returns a C<struct guestfs_lvm_vg_list *>
1491 (see E<lt>guestfs-structs.hE<gt>),
1492 or NULL if there was an error.
1493 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
1495 pr "This function returns a C<struct guestfs_lvm_lv_list *>
1496 (see E<lt>guestfs-structs.hE<gt>),
1497 or NULL if there was an error.
1498 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
1500 pr "This function returns a C<struct guestfs_stat *>
1501 (see L<stat(2)> and E<lt>guestfs-structs.hE<gt>),
1502 or NULL if there was an error.
1503 I<The caller must call C<free> after use>.\n\n"
1505 pr "This function returns a C<struct guestfs_statvfs *>
1506 (see L<statvfs(2)> and E<lt>guestfs-structs.hE<gt>),
1507 or NULL if there was an error.
1508 I<The caller must call C<free> after use>.\n\n"
1510 pr "This function returns a NULL-terminated array of
1511 strings, or NULL if there was an error.
1512 The array of strings will always have length C<2n+1>, where
1513 C<n> keys and values alternate, followed by the trailing NULL entry.
1514 I<The caller must free the strings and the array after use>.\n\n"
1516 if List.mem ProtocolLimitWarning flags then
1517 pr "%s\n\n" protocol_limit_warning;
1518 if List.mem DangerWillRobinson flags then
1519 pr "%s\n\n" danger_will_robinson;
1520 ) all_functions_sorted
1522 and generate_structs_pod () =
1523 (* LVM structs documentation. *)
1526 pr "=head2 guestfs_lvm_%s\n" typ;
1528 pr " struct guestfs_lvm_%s {\n" typ;
1531 | name, `String -> pr " char *%s;\n" name
1533 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
1534 pr " char %s[32];\n" name
1535 | name, `Bytes -> pr " uint64_t %s;\n" name
1536 | name, `Int -> pr " int64_t %s;\n" name
1537 | name, `OptPercent ->
1538 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
1539 pr " float %s;\n" name
1542 pr " struct guestfs_lvm_%s_list {\n" typ;
1543 pr " uint32_t len; /* Number of elements in list. */\n";
1544 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
1547 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
1550 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1552 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
1553 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
1555 * We have to use an underscore instead of a dash because otherwise
1556 * rpcgen generates incorrect code.
1558 * This header is NOT exported to clients, but see also generate_structs_h.
1560 and generate_xdr () =
1561 generate_header CStyle LGPLv2;
1563 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
1564 pr "typedef string str<>;\n";
1567 (* LVM internal structures. *)
1571 pr "struct guestfs_lvm_int_%s {\n" typ;
1573 | name, `String -> pr " string %s<>;\n" name
1574 | name, `UUID -> pr " opaque %s[32];\n" name
1575 | name, `Bytes -> pr " hyper %s;\n" name
1576 | name, `Int -> pr " hyper %s;\n" name
1577 | name, `OptPercent -> pr " float %s;\n" name
1581 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
1583 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1585 (* Stat internal structures. *)
1589 pr "struct guestfs_int_%s {\n" typ;
1591 | name, `Int -> pr " hyper %s;\n" name
1595 ) ["stat", stat_cols; "statvfs", statvfs_cols];
1598 fun (shortname, style, _, _, _, _, _) ->
1599 let name = "guestfs_" ^ shortname in
1601 (match snd style with
1604 pr "struct %s_args {\n" name;
1607 | String n -> pr " string %s<>;\n" n
1608 | OptString n -> pr " str *%s;\n" n
1609 | StringList n -> pr " str %s<>;\n" n
1610 | Bool n -> pr " bool %s;\n" n
1611 | Int n -> pr " int %s;\n" n
1615 (match fst style with
1618 pr "struct %s_ret {\n" name;
1622 pr "struct %s_ret {\n" name;
1626 failwithf "RConstString cannot be returned from a daemon function"
1628 pr "struct %s_ret {\n" name;
1629 pr " string %s<>;\n" n;
1632 pr "struct %s_ret {\n" name;
1633 pr " str %s<>;\n" n;
1636 pr "struct %s_ret {\n" name;
1641 pr "struct %s_ret {\n" name;
1642 pr " guestfs_lvm_int_pv_list %s;\n" n;
1645 pr "struct %s_ret {\n" name;
1646 pr " guestfs_lvm_int_vg_list %s;\n" n;
1649 pr "struct %s_ret {\n" name;
1650 pr " guestfs_lvm_int_lv_list %s;\n" n;
1653 pr "struct %s_ret {\n" name;
1654 pr " guestfs_int_stat %s;\n" n;
1657 pr "struct %s_ret {\n" name;
1658 pr " guestfs_int_statvfs %s;\n" n;
1661 pr "struct %s_ret {\n" name;
1662 pr " str %s<>;\n" n;
1667 (* Table of procedure numbers. *)
1668 pr "enum guestfs_procedure {\n";
1670 fun (shortname, _, proc_nr, _, _, _, _) ->
1671 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
1673 pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
1677 (* Having to choose a maximum message size is annoying for several
1678 * reasons (it limits what we can do in the API), but it (a) makes
1679 * the protocol a lot simpler, and (b) provides a bound on the size
1680 * of the daemon which operates in limited memory space. For large
1681 * file transfers you should use FTP.
1683 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
1686 (* Message header, etc. *)
1688 const GUESTFS_PROGRAM = 0x2000F5F5;
1689 const GUESTFS_PROTOCOL_VERSION = 1;
1691 enum guestfs_message_direction {
1692 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
1693 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
1696 enum guestfs_message_status {
1697 GUESTFS_STATUS_OK = 0,
1698 GUESTFS_STATUS_ERROR = 1
1701 const GUESTFS_ERROR_LEN = 256;
1703 struct guestfs_message_error {
1704 string error<GUESTFS_ERROR_LEN>; /* error message */
1707 struct guestfs_message_header {
1708 unsigned prog; /* GUESTFS_PROGRAM */
1709 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
1710 guestfs_procedure proc; /* GUESTFS_PROC_x */
1711 guestfs_message_direction direction;
1712 unsigned serial; /* message serial number */
1713 guestfs_message_status status;
1717 (* Generate the guestfs-structs.h file. *)
1718 and generate_structs_h () =
1719 generate_header CStyle LGPLv2;
1721 (* This is a public exported header file containing various
1722 * structures. The structures are carefully written to have
1723 * exactly the same in-memory format as the XDR structures that
1724 * we use on the wire to the daemon. The reason for creating
1725 * copies of these structures here is just so we don't have to
1726 * export the whole of guestfs_protocol.h (which includes much
1727 * unrelated and XDR-dependent stuff that we don't want to be
1728 * public, or required by clients).
1730 * To reiterate, we will pass these structures to and from the
1731 * client with a simple assignment or memcpy, so the format
1732 * must be identical to what rpcgen / the RFC defines.
1735 (* guestfs_int_bool structure. *)
1736 pr "struct guestfs_int_bool {\n";
1742 (* LVM public structures. *)
1746 pr "struct guestfs_lvm_%s {\n" typ;
1749 | name, `String -> pr " char *%s;\n" name
1750 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
1751 | name, `Bytes -> pr " uint64_t %s;\n" name
1752 | name, `Int -> pr " int64_t %s;\n" name
1753 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
1757 pr "struct guestfs_lvm_%s_list {\n" typ;
1758 pr " uint32_t len;\n";
1759 pr " struct guestfs_lvm_%s *val;\n" typ;
1762 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1764 (* Stat structures. *)
1768 pr "struct guestfs_%s {\n" typ;
1771 | name, `Int -> pr " int64_t %s;\n" name
1775 ) ["stat", stat_cols; "statvfs", statvfs_cols]
1777 (* Generate the guestfs-actions.h file. *)
1778 and generate_actions_h () =
1779 generate_header CStyle LGPLv2;
1781 fun (shortname, style, _, _, _, _, _) ->
1782 let name = "guestfs_" ^ shortname in
1783 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
1787 (* Generate the client-side dispatch stubs. *)
1788 and generate_client_actions () =
1789 generate_header CStyle LGPLv2;
1791 (* Client-side stubs for each function. *)
1793 fun (shortname, style, _, _, _, _, _) ->
1794 let name = "guestfs_" ^ shortname in
1796 (* Generate the return value struct. *)
1797 pr "struct %s_rv {\n" shortname;
1798 pr " int cb_done; /* flag to indicate callback was called */\n";
1799 pr " struct guestfs_message_header hdr;\n";
1800 pr " struct guestfs_message_error err;\n";
1801 (match fst style with
1804 failwithf "RConstString cannot be returned from a daemon function"
1806 | RBool _ | RString _ | RStringList _
1808 | RPVList _ | RVGList _ | RLVList _
1809 | RStat _ | RStatVFS _
1811 pr " struct %s_ret ret;\n" name
1815 (* Generate the callback function. *)
1816 pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
1818 pr " struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
1820 pr " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
1821 pr " error (g, \"%s: failed to parse reply header\");\n" name;
1824 pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
1825 pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
1826 pr " error (g, \"%s: failed to parse reply error\");\n" name;
1832 (match fst style with
1835 failwithf "RConstString cannot be returned from a daemon function"
1837 | RBool _ | RString _ | RStringList _
1839 | RPVList _ | RVGList _ | RLVList _
1840 | RStat _ | RStatVFS _
1842 pr " if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
1843 pr " error (g, \"%s: failed to parse reply\");\n" name;
1849 pr " rv->cb_done = 1;\n";
1850 pr " main_loop.main_loop_quit (g);\n";
1853 (* Generate the action stub. *)
1854 generate_prototype ~extern:false ~semicolon:false ~newline:true
1855 ~handle:"g" name style;
1858 match fst style with
1859 | RErr | RInt _ | RBool _ -> "-1"
1861 failwithf "RConstString cannot be returned from a daemon function"
1862 | RString _ | RStringList _ | RIntBool _
1863 | RPVList _ | RVGList _ | RLVList _
1864 | RStat _ | RStatVFS _
1870 (match snd style with
1872 | _ -> pr " struct %s_args args;\n" name
1875 pr " struct %s_rv rv;\n" shortname;
1876 pr " int serial;\n";
1878 pr " if (g->state != READY) {\n";
1879 pr " error (g, \"%s called from the wrong state, %%d != READY\",\n"
1882 pr " return %s;\n" error_code;
1885 pr " memset (&rv, 0, sizeof rv);\n";
1888 (match snd style with
1890 pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
1891 (String.uppercase shortname)
1896 pr " args.%s = (char *) %s;\n" n n
1898 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
1900 pr " args.%s.%s_val = (char **) %s;\n" n n n;
1901 pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
1903 pr " args.%s = %s;\n" n n
1905 pr " args.%s = %s;\n" n n
1907 pr " serial = dispatch (g, GUESTFS_PROC_%s,\n"
1908 (String.uppercase shortname);
1909 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
1912 pr " if (serial == -1)\n";
1913 pr " return %s;\n" error_code;
1916 pr " rv.cb_done = 0;\n";
1917 pr " g->reply_cb_internal = %s_cb;\n" shortname;
1918 pr " g->reply_cb_internal_data = &rv;\n";
1919 pr " main_loop.main_loop_run (g);\n";
1920 pr " g->reply_cb_internal = NULL;\n";
1921 pr " g->reply_cb_internal_data = NULL;\n";
1922 pr " if (!rv.cb_done) {\n";
1923 pr " error (g, \"%s failed, see earlier error messages\");\n" name;
1924 pr " return %s;\n" error_code;
1928 pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
1929 (String.uppercase shortname);
1930 pr " return %s;\n" error_code;
1933 pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
1934 pr " error (g, \"%%s\", rv.err.error);\n";
1935 pr " return %s;\n" error_code;
1939 (match fst style with
1940 | RErr -> pr " return 0;\n"
1942 | RBool n -> pr " return rv.ret.%s;\n" n
1944 failwithf "RConstString cannot be returned from a daemon function"
1946 pr " return rv.ret.%s; /* caller will free */\n" n
1947 | RStringList n | RHashtable n ->
1948 pr " /* caller will free this, but we need to add a NULL entry */\n";
1949 pr " rv.ret.%s.%s_val =" n n;
1950 pr " safe_realloc (g, rv.ret.%s.%s_val,\n" n n;
1951 pr " sizeof (char *) * (rv.ret.%s.%s_len + 1));\n"
1953 pr " rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
1954 pr " return rv.ret.%s.%s_val;\n" n n
1956 pr " /* caller with free this */\n";
1957 pr " return safe_memdup (g, &rv.ret, sizeof (rv.ret));\n"
1958 | RPVList n | RVGList n | RLVList n
1959 | RStat n | RStatVFS n ->
1960 pr " /* caller will free this */\n";
1961 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1967 (* Generate daemon/actions.h. *)
1968 and generate_daemon_actions_h () =
1969 generate_header CStyle GPLv2;
1971 pr "#include \"../src/guestfs_protocol.h\"\n";
1975 fun (name, style, _, _, _, _, _) ->
1977 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
1981 (* Generate the server-side stubs. *)
1982 and generate_daemon_actions () =
1983 generate_header CStyle GPLv2;
1985 pr "#define _GNU_SOURCE // for strchrnul\n";
1987 pr "#include <stdio.h>\n";
1988 pr "#include <stdlib.h>\n";
1989 pr "#include <string.h>\n";
1990 pr "#include <inttypes.h>\n";
1991 pr "#include <ctype.h>\n";
1992 pr "#include <rpc/types.h>\n";
1993 pr "#include <rpc/xdr.h>\n";
1995 pr "#include \"daemon.h\"\n";
1996 pr "#include \"../src/guestfs_protocol.h\"\n";
1997 pr "#include \"actions.h\"\n";
2001 fun (name, style, _, _, _, _, _) ->
2002 (* Generate server-side stubs. *)
2003 pr "static void %s_stub (XDR *xdr_in)\n" name;
2006 match fst style with
2007 | RErr | RInt _ -> pr " int r;\n"; "-1"
2008 | RBool _ -> pr " int r;\n"; "-1"
2010 failwithf "RConstString cannot be returned from a daemon function"
2011 | RString _ -> pr " char *r;\n"; "NULL"
2012 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
2013 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
2014 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
2015 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
2016 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL"
2017 | RStat _ -> pr " guestfs_int_stat *r;\n"; "NULL"
2018 | RStatVFS _ -> pr " guestfs_int_statvfs *r;\n"; "NULL" in
2020 (match snd style with
2023 pr " struct guestfs_%s_args args;\n" name;
2027 | OptString n -> pr " const char *%s;\n" n
2028 | StringList n -> pr " char **%s;\n" n
2029 | Bool n -> pr " int %s;\n" n
2030 | Int n -> pr " int %s;\n" n
2035 (match snd style with
2038 pr " memset (&args, 0, sizeof args);\n";
2040 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
2041 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
2046 | String n -> pr " %s = args.%s;\n" n n
2047 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
2049 pr " args.%s.%s_val = realloc (args.%s.%s_val, sizeof (char *) * (args.%s.%s_len+1));\n" n n n n n n;
2050 pr " args.%s.%s_val[args.%s.%s_len] = NULL;\n" n n n n;
2051 pr " %s = args.%s.%s_val;\n" n n n
2052 | Bool n -> pr " %s = args.%s;\n" n n
2053 | Int n -> pr " %s = args.%s;\n" n n
2058 pr " r = do_%s " name;
2059 generate_call_args style;
2062 pr " if (r == %s)\n" error_code;
2063 pr " /* do_%s has already called reply_with_error */\n" name;
2067 (match fst style with
2068 | RErr -> pr " reply (NULL, NULL);\n"
2070 pr " struct guestfs_%s_ret ret;\n" name;
2071 pr " ret.%s = r;\n" n;
2072 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
2074 pr " struct guestfs_%s_ret ret;\n" name;
2075 pr " ret.%s = r;\n" n;
2076 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
2078 failwithf "RConstString cannot be returned from a daemon function"
2080 pr " struct guestfs_%s_ret ret;\n" name;
2081 pr " ret.%s = r;\n" n;
2082 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
2084 | RStringList n | RHashtable n ->
2085 pr " struct guestfs_%s_ret ret;\n" name;
2086 pr " ret.%s.%s_len = count_strings (r);\n" n n;
2087 pr " ret.%s.%s_val = r;\n" n n;
2088 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
2089 pr " free_strings (r);\n"
2091 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name;
2092 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
2093 | RPVList n | RVGList n | RLVList n
2094 | RStat n | RStatVFS n ->
2095 pr " struct guestfs_%s_ret ret;\n" name;
2096 pr " ret.%s = *r;\n" n;
2097 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
2098 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
2101 (* Free the args. *)
2102 (match snd style with
2107 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
2114 (* Dispatch function. *)
2115 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
2117 pr " switch (proc_nr) {\n";
2120 fun (name, style, _, _, _, _, _) ->
2121 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
2122 pr " %s_stub (xdr_in);\n" name;
2127 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
2132 (* LVM columns and tokenization functions. *)
2133 (* XXX This generates crap code. We should rethink how we
2139 pr "static const char *lvm_%s_cols = \"%s\";\n"
2140 typ (String.concat "," (List.map fst cols));
2143 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
2145 pr " char *tok, *p, *next;\n";
2149 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
2152 pr " if (!str) {\n";
2153 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
2156 pr " if (!*str || isspace (*str)) {\n";
2157 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
2162 fun (name, coltype) ->
2163 pr " if (!tok) {\n";
2164 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
2167 pr " p = strchrnul (tok, ',');\n";
2168 pr " if (*p) next = p+1; else next = NULL;\n";
2169 pr " *p = '\\0';\n";
2172 pr " r->%s = strdup (tok);\n" name;
2173 pr " if (r->%s == NULL) {\n" name;
2174 pr " perror (\"strdup\");\n";
2178 pr " for (i = j = 0; i < 32; ++j) {\n";
2179 pr " if (tok[j] == '\\0') {\n";
2180 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
2182 pr " } else if (tok[j] != '-')\n";
2183 pr " r->%s[i++] = tok[j];\n" name;
2186 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
2187 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2191 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
2192 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2196 pr " if (tok[0] == '\\0')\n";
2197 pr " r->%s = -1;\n" name;
2198 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
2199 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2203 pr " tok = next;\n";
2206 pr " if (tok != NULL) {\n";
2207 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
2214 pr "guestfs_lvm_int_%s_list *\n" typ;
2215 pr "parse_command_line_%ss (void)\n" typ;
2217 pr " char *out, *err;\n";
2218 pr " char *p, *pend;\n";
2220 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
2221 pr " void *newp;\n";
2223 pr " ret = malloc (sizeof *ret);\n";
2224 pr " if (!ret) {\n";
2225 pr " reply_with_perror (\"malloc\");\n";
2226 pr " return NULL;\n";
2229 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
2230 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
2232 pr " r = command (&out, &err,\n";
2233 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
2234 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
2235 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
2236 pr " if (r == -1) {\n";
2237 pr " reply_with_error (\"%%s\", err);\n";
2238 pr " free (out);\n";
2239 pr " free (err);\n";
2240 pr " return NULL;\n";
2243 pr " free (err);\n";
2245 pr " /* Tokenize each line of the output. */\n";
2248 pr " while (p) {\n";
2249 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
2250 pr " if (pend) {\n";
2251 pr " *pend = '\\0';\n";
2255 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
2258 pr " if (!*p) { /* Empty line? Skip it. */\n";
2263 pr " /* Allocate some space to store this next entry. */\n";
2264 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
2265 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
2266 pr " if (newp == NULL) {\n";
2267 pr " reply_with_perror (\"realloc\");\n";
2268 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2269 pr " free (ret);\n";
2270 pr " free (out);\n";
2271 pr " return NULL;\n";
2273 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
2275 pr " /* Tokenize the next entry. */\n";
2276 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
2277 pr " if (r == -1) {\n";
2278 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
2279 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2280 pr " free (ret);\n";
2281 pr " free (out);\n";
2282 pr " return NULL;\n";
2289 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
2291 pr " free (out);\n";
2292 pr " return ret;\n";
2295 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2297 (* Generate the tests. *)
2298 and generate_tests () =
2299 generate_header CStyle GPLv2;
2306 #include <sys/types.h>
2309 #include \"guestfs.h\"
2311 static guestfs_h *g;
2312 static int suppress_error = 0;
2314 static void print_error (guestfs_h *g, void *data, const char *msg)
2316 if (!suppress_error)
2317 fprintf (stderr, \"%%s\\n\", msg);
2320 static void print_strings (char * const * const argv)
2324 for (argc = 0; argv[argc] != NULL; ++argc)
2325 printf (\"\\t%%s\\n\", argv[argc]);
2328 static void print_table (char * const * const argv)
2332 for (i = 0; argv[i] != NULL; i += 2)
2333 printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
2336 static void no_test_warnings (void)
2342 | name, _, _, _, [], _, _ ->
2343 pr " fprintf (stderr, \"warning: \\\"%s\\\" has no tests\\n\");\n" name
2344 | name, _, _, _, tests, _, _ -> ()
2352 fun (name, _, _, _, tests, _, _) ->
2353 mapi (generate_one_test name) tests
2355 let test_names = List.concat test_names in
2356 let nr_tests = List.length test_names in
2359 int main (int argc, char *argv[])
2368 no_test_warnings ();
2370 g = guestfs_create ();
2372 printf (\"guestfs_create FAILED\\n\");
2376 guestfs_set_error_handler (g, print_error, NULL);
2378 srcdir = getenv (\"srcdir\");
2379 if (!srcdir) srcdir = \".\";
2380 guestfs_set_path (g, srcdir);
2382 snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);
2383 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2388 if (lseek (fd, %d, SEEK_SET) == -1) {
2394 if (write (fd, &c, 1) == -1) {
2400 if (close (fd) == -1) {
2405 if (guestfs_add_drive (g, buf) == -1) {
2406 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2410 snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);
2411 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2416 if (lseek (fd, %d, SEEK_SET) == -1) {
2422 if (write (fd, &c, 1) == -1) {
2428 if (close (fd) == -1) {
2433 if (guestfs_add_drive (g, buf) == -1) {
2434 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2438 snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);
2439 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2444 if (lseek (fd, %d, SEEK_SET) == -1) {
2450 if (write (fd, &c, 1) == -1) {
2456 if (close (fd) == -1) {
2461 if (guestfs_add_drive (g, buf) == -1) {
2462 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2466 if (guestfs_launch (g) == -1) {
2467 printf (\"guestfs_launch FAILED\\n\");
2470 if (guestfs_wait_ready (g) == -1) {
2471 printf (\"guestfs_wait_ready FAILED\\n\");
2476 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
2480 pr " printf (\"%3d/%%3d %s\\n\", nr_tests);\n" (i+1) test_name;
2481 pr " if (%s () == -1) {\n" test_name;
2482 pr " printf (\"%s FAILED\\n\");\n" test_name;
2488 pr " guestfs_close (g);\n";
2489 pr " snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);\n";
2490 pr " unlink (buf);\n";
2491 pr " snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);\n";
2492 pr " unlink (buf);\n";
2493 pr " snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);\n";
2494 pr " unlink (buf);\n";
2497 pr " if (failed > 0) {\n";
2498 pr " printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n";
2506 and generate_one_test name i (init, test) =
2507 let test_name = sprintf "test_%s_%d" name i in
2509 pr "static int %s (void)\n" test_name;
2515 pr " /* InitEmpty for %s (%d) */\n" name i;
2516 List.iter (generate_test_command_call test_name)
2520 pr " /* InitBasicFS for %s (%d): create ext2 on /dev/sda1 */\n" name i;
2521 List.iter (generate_test_command_call test_name)
2524 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2525 ["mkfs"; "ext2"; "/dev/sda1"];
2526 ["mount"; "/dev/sda1"; "/"]]
2527 | InitBasicFSonLVM ->
2528 pr " /* InitBasicFSonLVM for %s (%d): create ext2 on /dev/VG/LV */\n"
2530 List.iter (generate_test_command_call test_name)
2533 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2534 ["pvcreate"; "/dev/sda1"];
2535 ["vgcreate"; "VG"; "/dev/sda1"];
2536 ["lvcreate"; "LV"; "VG"; "8"];
2537 ["mkfs"; "ext2"; "/dev/VG/LV"];
2538 ["mount"; "/dev/VG/LV"; "/"]]
2541 let get_seq_last = function
2543 failwithf "%s: you cannot use [] (empty list) when expecting a command"
2546 let seq = List.rev seq in
2547 List.rev (List.tl seq), List.hd seq
2552 pr " /* TestRun for %s (%d) */\n" name i;
2553 List.iter (generate_test_command_call test_name) seq
2554 | TestOutput (seq, expected) ->
2555 pr " /* TestOutput for %s (%d) */\n" name i;
2556 let seq, last = get_seq_last seq in
2558 pr " if (strcmp (r, \"%s\") != 0) {\n" (c_quote expected);
2559 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r);\n" test_name (c_quote expected);
2563 List.iter (generate_test_command_call test_name) seq;
2564 generate_test_command_call ~test test_name last
2565 | TestOutputList (seq, expected) ->
2566 pr " /* TestOutputList for %s (%d) */\n" name i;
2567 let seq, last = get_seq_last seq in
2571 pr " if (!r[%d]) {\n" i;
2572 pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
2573 pr " print_strings (r);\n";
2576 pr " if (strcmp (r[%d], \"%s\") != 0) {\n" i (c_quote str);
2577 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r[%d]);\n" test_name (c_quote str) i;
2581 pr " if (r[%d] != NULL) {\n" (List.length expected);
2582 pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
2584 pr " print_strings (r);\n";
2588 List.iter (generate_test_command_call test_name) seq;
2589 generate_test_command_call ~test test_name last
2590 | TestOutputInt (seq, expected) ->
2591 pr " /* TestOutputInt for %s (%d) */\n" name i;
2592 let seq, last = get_seq_last seq in
2594 pr " if (r != %d) {\n" expected;
2595 pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\", r);\n"
2600 List.iter (generate_test_command_call test_name) seq;
2601 generate_test_command_call ~test test_name last
2602 | TestOutputTrue seq ->
2603 pr " /* TestOutputTrue for %s (%d) */\n" name i;
2604 let seq, last = get_seq_last seq in
2607 pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n"
2612 List.iter (generate_test_command_call test_name) seq;
2613 generate_test_command_call ~test test_name last
2614 | TestOutputFalse seq ->
2615 pr " /* TestOutputFalse for %s (%d) */\n" name i;
2616 let seq, last = get_seq_last seq in
2619 pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n"
2624 List.iter (generate_test_command_call test_name) seq;
2625 generate_test_command_call ~test test_name last
2626 | TestOutputLength (seq, expected) ->
2627 pr " /* TestOutputLength for %s (%d) */\n" name i;
2628 let seq, last = get_seq_last seq in
2631 pr " for (j = 0; j < %d; ++j)\n" expected;
2632 pr " if (r[j] == NULL) {\n";
2633 pr " fprintf (stderr, \"%s: short list returned\\n\");\n"
2635 pr " print_strings (r);\n";
2638 pr " if (r[j] != NULL) {\n";
2639 pr " fprintf (stderr, \"%s: long list returned\\n\");\n"
2641 pr " print_strings (r);\n";
2645 List.iter (generate_test_command_call test_name) seq;
2646 generate_test_command_call ~test test_name last
2647 | TestOutputStruct (seq, checks) ->
2648 pr " /* TestOutputStruct for %s (%d) */\n" name i;
2649 let seq, last = get_seq_last seq in
2653 | CompareWithInt (field, expected) ->
2654 pr " if (r->%s != %d) {\n" field expected;
2655 pr " fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
2656 test_name field expected;
2657 pr " (int) r->%s);\n" field;
2660 | CompareWithString (field, expected) ->
2661 pr " if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
2662 pr " fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
2663 test_name field expected;
2664 pr " r->%s);\n" field;
2667 | CompareFieldsIntEq (field1, field2) ->
2668 pr " if (r->%s != r->%s) {\n" field1 field2;
2669 pr " fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
2670 test_name field1 field2;
2671 pr " (int) r->%s, (int) r->%s);\n" field1 field2;
2674 | CompareFieldsStrEq (field1, field2) ->
2675 pr " if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
2676 pr " fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
2677 test_name field1 field2;
2678 pr " r->%s, r->%s);\n" field1 field2;
2683 List.iter (generate_test_command_call test_name) seq;
2684 generate_test_command_call ~test test_name last
2685 | TestLastFail seq ->
2686 pr " /* TestLastFail for %s (%d) */\n" name i;
2687 let seq, last = get_seq_last seq in
2688 List.iter (generate_test_command_call test_name) seq;
2689 generate_test_command_call test_name ~expect_error:true last
2697 (* Generate the code to run a command, leaving the result in 'r'.
2698 * If you expect to get an error then you should set expect_error:true.
2700 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
2702 | [] -> assert false
2704 (* Look up the command to find out what args/ret it has. *)
2707 let _, style, _, _, _, _, _ =
2708 List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
2711 failwithf "%s: in test, command %s was not found" test_name name in
2713 if List.length (snd style) <> List.length args then
2714 failwithf "%s: in test, wrong number of args given to %s"
2725 | StringList n, arg ->
2726 pr " char *%s[] = {\n" n;
2727 let strs = string_split " " arg in
2729 fun str -> pr " \"%s\",\n" (c_quote str)
2733 ) (List.combine (snd style) args);
2736 match fst style with
2737 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
2738 | RConstString _ -> pr " const char *r;\n"; "NULL"
2739 | RString _ -> pr " char *r;\n"; "NULL"
2740 | RStringList _ | RHashtable _ ->
2745 pr " struct guestfs_int_bool *r;\n"; "NULL"
2747 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
2749 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
2751 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
2753 pr " struct guestfs_stat *r;\n"; "NULL"
2755 pr " struct guestfs_statvfs *r;\n"; "NULL" in
2757 pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
2758 pr " r = guestfs_%s (g" name;
2760 (* Generate the parameters. *)
2763 | String _, arg -> pr ", \"%s\"" (c_quote arg)
2764 | OptString _, arg ->
2765 if arg = "NULL" then pr ", NULL" else pr ", \"%s\"" (c_quote arg)
2766 | StringList n, _ ->
2770 try int_of_string arg
2771 with Failure "int_of_string" ->
2772 failwithf "%s: expecting an int, but got '%s'" test_name arg in
2775 let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
2776 ) (List.combine (snd style) args);
2779 if not expect_error then
2780 pr " if (r == %s)\n" error_code
2782 pr " if (r != %s)\n" error_code;
2785 (* Insert the test code. *)
2791 (match fst style with
2792 | RErr | RInt _ | RBool _ | RConstString _ -> ()
2793 | RString _ -> pr " free (r);\n"
2794 | RStringList _ | RHashtable _ ->
2795 pr " for (i = 0; r[i] != NULL; ++i)\n";
2796 pr " free (r[i]);\n";
2799 pr " guestfs_free_int_bool (r);\n"
2801 pr " guestfs_free_lvm_pv_list (r);\n"
2803 pr " guestfs_free_lvm_vg_list (r);\n"
2805 pr " guestfs_free_lvm_lv_list (r);\n"
2806 | RStat _ | RStatVFS _ ->
2813 let str = replace_str str "\r" "\\r" in
2814 let str = replace_str str "\n" "\\n" in
2815 let str = replace_str str "\t" "\\t" in
2818 (* Generate a lot of different functions for guestfish. *)
2819 and generate_fish_cmds () =
2820 generate_header CStyle GPLv2;
2824 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
2826 let all_functions_sorted =
2828 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
2829 ) all_functions_sorted in
2831 pr "#include <stdio.h>\n";
2832 pr "#include <stdlib.h>\n";
2833 pr "#include <string.h>\n";
2834 pr "#include <inttypes.h>\n";
2836 pr "#include <guestfs.h>\n";
2837 pr "#include \"fish.h\"\n";
2840 (* list_commands function, which implements guestfish -h *)
2841 pr "void list_commands (void)\n";
2843 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
2844 pr " list_builtin_commands ();\n";
2846 fun (name, _, _, flags, _, shortdesc, _) ->
2847 let name = replace_char name '_' '-' in
2848 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
2850 ) all_functions_sorted;
2851 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
2855 (* display_command function, which implements guestfish -h cmd *)
2856 pr "void display_command (const char *cmd)\n";
2859 fun (name, style, _, flags, _, shortdesc, longdesc) ->
2860 let name2 = replace_char name '_' '-' in
2862 try find_map (function FishAlias n -> Some n | _ -> None) flags
2863 with Not_found -> name in
2864 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
2866 match snd style with
2870 name2 (String.concat "> <" (List.map name_of_argt args)) in
2873 if List.mem ProtocolLimitWarning flags then
2874 ("\n\n" ^ protocol_limit_warning)
2877 (* For DangerWillRobinson commands, we should probably have
2878 * guestfish prompt before allowing you to use them (especially
2879 * in interactive mode). XXX
2883 if List.mem DangerWillRobinson flags then
2884 ("\n\n" ^ danger_will_robinson)
2887 let describe_alias =
2888 if name <> alias then
2889 sprintf "\n\nYou can use '%s' as an alias for this command." alias
2893 pr "strcasecmp (cmd, \"%s\") == 0" name;
2894 if name <> name2 then
2895 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
2896 if name <> alias then
2897 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
2899 pr " pod2text (\"%s - %s\", %S);\n"
2901 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
2904 pr " display_builtin_command (cmd);\n";
2908 (* print_{pv,vg,lv}_list functions *)
2912 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
2919 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
2921 pr " printf (\"%s: \");\n" name;
2922 pr " for (i = 0; i < 32; ++i)\n";
2923 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
2924 pr " printf (\"\\n\");\n"
2926 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
2928 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
2929 | name, `OptPercent ->
2930 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
2931 typ name name typ name;
2932 pr " else printf (\"%s: \\n\");\n" name
2936 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
2941 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
2942 pr " print_%s (&%ss->val[i]);\n" typ typ;
2945 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2947 (* print_{stat,statvfs} functions *)
2951 pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
2956 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
2960 ) ["stat", stat_cols; "statvfs", statvfs_cols];
2962 (* run_<action> actions *)
2964 fun (name, style, _, flags, _, _, _) ->
2965 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
2967 (match fst style with
2970 | RBool _ -> pr " int r;\n"
2971 | RConstString _ -> pr " const char *r;\n"
2972 | RString _ -> pr " char *r;\n"
2973 | RStringList _ | RHashtable _ -> pr " char **r;\n"
2974 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
2975 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
2976 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
2977 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
2978 | RStat _ -> pr " struct guestfs_stat *r;\n"
2979 | RStatVFS _ -> pr " struct guestfs_statvfs *r;\n"
2984 | OptString n -> pr " const char *%s;\n" n
2985 | StringList n -> pr " char **%s;\n" n
2986 | Bool n -> pr " int %s;\n" n
2987 | Int n -> pr " int %s;\n" n
2990 (* Check and convert parameters. *)
2991 let argc_expected = List.length (snd style) in
2992 pr " if (argc != %d) {\n" argc_expected;
2993 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
2995 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
3001 | String name -> pr " %s = argv[%d];\n" name i
3003 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
3005 | StringList name ->
3006 pr " %s = parse_string_list (argv[%d]);\n" name i
3008 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
3010 pr " %s = atoi (argv[%d]);\n" name i
3013 (* Call C API function. *)
3015 try find_map (function FishAction n -> Some n | _ -> None) flags
3016 with Not_found -> sprintf "guestfs_%s" name in
3018 generate_call_args ~handle:"g" style;
3021 (* Check return value for errors and display command results. *)
3022 (match fst style with
3023 | RErr -> pr " return r;\n"
3025 pr " if (r == -1) return -1;\n";
3026 pr " if (r) printf (\"%%d\\n\", r);\n";
3029 pr " if (r == -1) return -1;\n";
3030 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
3033 pr " if (r == NULL) return -1;\n";
3034 pr " printf (\"%%s\\n\", r);\n";
3037 pr " if (r == NULL) return -1;\n";
3038 pr " printf (\"%%s\\n\", r);\n";
3042 pr " if (r == NULL) return -1;\n";
3043 pr " print_strings (r);\n";
3044 pr " free_strings (r);\n";
3047 pr " if (r == NULL) return -1;\n";
3048 pr " printf (\"%%d, %%s\\n\", r->i,\n";
3049 pr " r->b ? \"true\" : \"false\");\n";
3050 pr " guestfs_free_int_bool (r);\n";
3053 pr " if (r == NULL) return -1;\n";
3054 pr " print_pv_list (r);\n";
3055 pr " guestfs_free_lvm_pv_list (r);\n";
3058 pr " if (r == NULL) return -1;\n";
3059 pr " print_vg_list (r);\n";
3060 pr " guestfs_free_lvm_vg_list (r);\n";
3063 pr " if (r == NULL) return -1;\n";
3064 pr " print_lv_list (r);\n";
3065 pr " guestfs_free_lvm_lv_list (r);\n";
3068 pr " if (r == NULL) return -1;\n";
3069 pr " print_stat (r);\n";
3073 pr " if (r == NULL) return -1;\n";
3074 pr " print_statvfs (r);\n";
3078 pr " if (r == NULL) return -1;\n";
3079 pr " print_table (r);\n";
3080 pr " free_strings (r);\n";
3087 (* run_action function *)
3088 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
3091 fun (name, _, _, flags, _, _, _) ->
3092 let name2 = replace_char name '_' '-' in
3094 try find_map (function FishAlias n -> Some n | _ -> None) flags
3095 with Not_found -> name in
3097 pr "strcasecmp (cmd, \"%s\") == 0" name;
3098 if name <> name2 then
3099 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
3100 if name <> alias then
3101 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
3103 pr " return run_%s (cmd, argc, argv);\n" name;
3107 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
3114 (* Readline completion for guestfish. *)
3115 and generate_fish_completion () =
3116 generate_header CStyle GPLv2;
3120 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3130 #ifdef HAVE_LIBREADLINE
3131 #include <readline/readline.h>
3136 #ifdef HAVE_LIBREADLINE
3138 static const char *commands[] = {
3141 (* Get the commands and sort them, including the aliases. *)
3144 fun (name, _, _, flags, _, _, _) ->
3145 let name2 = replace_char name '_' '-' in
3147 try find_map (function FishAlias n -> Some n | _ -> None) flags
3148 with Not_found -> name in
3150 if name <> alias then [name2; alias] else [name2]
3152 let commands = List.flatten commands in
3153 let commands = List.sort compare commands in
3155 List.iter (pr " \"%s\",\n") commands;
3161 generator (const char *text, int state)
3163 static int index, len;
3168 len = strlen (text);
3171 while ((name = commands[index]) != NULL) {
3173 if (strncasecmp (name, text, len) == 0)
3174 return strdup (name);
3180 #endif /* HAVE_LIBREADLINE */
3182 char **do_completion (const char *text, int start, int end)
3184 char **matches = NULL;
3186 #ifdef HAVE_LIBREADLINE
3188 matches = rl_completion_matches (text, generator);
3195 (* Generate the POD documentation for guestfish. *)
3196 and generate_fish_actions_pod () =
3197 let all_functions_sorted =
3199 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
3200 ) all_functions_sorted in
3203 fun (name, style, _, flags, _, _, longdesc) ->
3204 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
3205 let name = replace_char name '_' '-' in
3207 try find_map (function FishAlias n -> Some n | _ -> None) flags
3208 with Not_found -> name in
3210 pr "=head2 %s" name;
3211 if name <> alias then
3218 | String n -> pr " %s" n
3219 | OptString n -> pr " %s" n
3220 | StringList n -> pr " %s,..." n
3221 | Bool _ -> pr " true|false"
3222 | Int n -> pr " %s" n
3226 pr "%s\n\n" longdesc;
3228 if List.mem ProtocolLimitWarning flags then
3229 pr "%s\n\n" protocol_limit_warning;
3231 if List.mem DangerWillRobinson flags then
3232 pr "%s\n\n" danger_will_robinson
3233 ) all_functions_sorted
3235 (* Generate a C function prototype. *)
3236 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
3237 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
3239 ?handle name style =
3240 if extern then pr "extern ";
3241 if static then pr "static ";
3242 (match fst style with
3244 | RInt _ -> pr "int "
3245 | RBool _ -> pr "int "
3246 | RConstString _ -> pr "const char *"
3247 | RString _ -> pr "char *"
3248 | RStringList _ | RHashtable _ -> pr "char **"
3250 if not in_daemon then pr "struct guestfs_int_bool *"
3251 else pr "guestfs_%s_ret *" name
3253 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
3254 else pr "guestfs_lvm_int_pv_list *"
3256 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
3257 else pr "guestfs_lvm_int_vg_list *"
3259 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
3260 else pr "guestfs_lvm_int_lv_list *"
3262 if not in_daemon then pr "struct guestfs_stat *"
3263 else pr "guestfs_int_stat *"
3265 if not in_daemon then pr "struct guestfs_statvfs *"
3266 else pr "guestfs_int_statvfs *"
3268 pr "%s%s (" prefix name;
3269 if handle = None && List.length (snd style) = 0 then
3272 let comma = ref false in
3275 | Some handle -> pr "guestfs_h *%s" handle; comma := true
3279 if single_line then pr ", " else pr ",\n\t\t"
3285 | String n -> next (); pr "const char *%s" n
3286 | OptString n -> next (); pr "const char *%s" n
3287 | StringList n -> next (); pr "char * const* const %s" n
3288 | Bool n -> next (); pr "int %s" n
3289 | Int n -> next (); pr "int %s" n
3293 if semicolon then pr ";";
3294 if newline then pr "\n"
3296 (* Generate C call arguments, eg "(handle, foo, bar)" *)
3297 and generate_call_args ?handle style =
3299 let comma = ref false in
3302 | Some handle -> pr "%s" handle; comma := true
3306 if !comma then pr ", ";
3313 | Int n -> pr "%s" n
3317 (* Generate the OCaml bindings interface. *)
3318 and generate_ocaml_mli () =
3319 generate_header OCamlStyle LGPLv2;
3322 (** For API documentation you should refer to the C API
3323 in the guestfs(3) manual page. The OCaml API uses almost
3324 exactly the same calls. *)
3327 (** A [guestfs_h] handle. *)
3329 exception Error of string
3330 (** This exception is raised when there is an error. *)
3332 val create : unit -> t
3334 val close : t -> unit
3335 (** Handles are closed by the garbage collector when they become
3336 unreferenced, but callers can also call this in order to
3337 provide predictable cleanup. *)
3340 generate_ocaml_lvm_structure_decls ();
3342 generate_ocaml_stat_structure_decls ();
3346 fun (name, style, _, _, _, shortdesc, _) ->
3347 generate_ocaml_prototype name style;
3348 pr "(** %s *)\n" shortdesc;
3352 (* Generate the OCaml bindings implementation. *)
3353 and generate_ocaml_ml () =
3354 generate_header OCamlStyle LGPLv2;
3358 exception Error of string
3359 external create : unit -> t = \"ocaml_guestfs_create\"
3360 external close : t -> unit = \"ocaml_guestfs_close\"
3363 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
3367 generate_ocaml_lvm_structure_decls ();
3369 generate_ocaml_stat_structure_decls ();
3373 fun (name, style, _, _, _, shortdesc, _) ->
3374 generate_ocaml_prototype ~is_external:true name style;
3377 (* Generate the OCaml bindings C implementation. *)
3378 and generate_ocaml_c () =
3379 generate_header CStyle LGPLv2;
3386 #include <caml/config.h>
3387 #include <caml/alloc.h>
3388 #include <caml/callback.h>
3389 #include <caml/fail.h>
3390 #include <caml/memory.h>
3391 #include <caml/mlvalues.h>
3392 #include <caml/signals.h>
3394 #include <guestfs.h>
3396 #include \"guestfs_c.h\"
3398 /* Copy a hashtable of string pairs into an assoc-list. We return
3399 * the list in reverse order, but hashtables aren't supposed to be
3402 static CAMLprim value
3403 copy_table (char * const * argv)
3406 CAMLlocal5 (rv, pairv, kv, vv, cons);
3410 for (i = 0; argv[i] != NULL; i += 2) {
3411 kv = caml_copy_string (argv[i]);
3412 vv = caml_copy_string (argv[i+1]);
3413 pairv = caml_alloc (2, 0);
3414 Store_field (pairv, 0, kv);
3415 Store_field (pairv, 1, vv);
3416 cons = caml_alloc (2, 0);
3417 Store_field (cons, 1, rv);
3419 Store_field (cons, 0, pairv);
3427 (* LVM struct copy functions. *)
3430 let has_optpercent_col =
3431 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
3433 pr "static CAMLprim value\n";
3434 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
3436 pr " CAMLparam0 ();\n";
3437 if has_optpercent_col then
3438 pr " CAMLlocal3 (rv, v, v2);\n"
3440 pr " CAMLlocal2 (rv, v);\n";
3442 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
3447 pr " v = caml_copy_string (%s->%s);\n" typ name
3449 pr " v = caml_alloc_string (32);\n";
3450 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
3453 pr " v = caml_copy_int64 (%s->%s);\n" typ name
3454 | name, `OptPercent ->
3455 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
3456 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
3457 pr " v = caml_alloc (1, 0);\n";
3458 pr " Store_field (v, 0, v2);\n";
3459 pr " } else /* None */\n";
3460 pr " v = Val_int (0);\n";
3462 pr " Store_field (rv, %d, v);\n" i
3464 pr " CAMLreturn (rv);\n";
3468 pr "static CAMLprim value\n";
3469 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
3472 pr " CAMLparam0 ();\n";
3473 pr " CAMLlocal2 (rv, v);\n";
3476 pr " if (%ss->len == 0)\n" typ;
3477 pr " CAMLreturn (Atom (0));\n";
3479 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
3480 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
3481 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
3482 pr " caml_modify (&Field (rv, i), v);\n";
3484 pr " CAMLreturn (rv);\n";
3488 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3490 (* Stat copy functions. *)
3493 pr "static CAMLprim value\n";
3494 pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
3496 pr " CAMLparam0 ();\n";
3497 pr " CAMLlocal2 (rv, v);\n";
3499 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
3504 pr " v = caml_copy_int64 (%s->%s);\n" typ name
3506 pr " Store_field (rv, %d, v);\n" i
3508 pr " CAMLreturn (rv);\n";
3511 ) ["stat", stat_cols; "statvfs", statvfs_cols];
3515 fun (name, style, _, _, _, _, _) ->
3517 "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
3519 pr "CAMLprim value\n";
3520 pr "ocaml_guestfs_%s (value %s" name (List.hd params);
3521 List.iter (pr ", value %s") (List.tl params);
3526 | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
3527 pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
3528 pr " CAMLxparam%d (%s);\n"
3529 (List.length rest) (String.concat ", " rest)
3531 pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
3533 pr " CAMLlocal1 (rv);\n";
3536 pr " guestfs_h *g = Guestfs_val (gv);\n";
3537 pr " if (g == NULL)\n";
3538 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
3544 pr " const char *%s = String_val (%sv);\n" n n
3546 pr " const char *%s =\n" n;
3547 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
3550 pr " char **%s = ocaml_guestfs_strings_val (%sv);\n" n n
3552 pr " int %s = Bool_val (%sv);\n" n n
3554 pr " int %s = Int_val (%sv);\n" n n
3557 match fst style with
3558 | RErr -> pr " int r;\n"; "-1"
3559 | RInt _ -> pr " int r;\n"; "-1"
3560 | RBool _ -> pr " int r;\n"; "-1"
3561 | RConstString _ -> pr " const char *r;\n"; "NULL"
3562 | RString _ -> pr " char *r;\n"; "NULL"
3568 pr " struct guestfs_int_bool *r;\n"; "NULL"
3570 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
3572 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
3574 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
3576 pr " struct guestfs_stat *r;\n"; "NULL"
3578 pr " struct guestfs_statvfs *r;\n"; "NULL"
3585 pr " caml_enter_blocking_section ();\n";
3586 pr " r = guestfs_%s " name;
3587 generate_call_args ~handle:"g" style;
3589 pr " caml_leave_blocking_section ();\n";
3594 pr " ocaml_guestfs_free_strings (%s);\n" n;
3595 | String _ | OptString _ | Bool _ | Int _ -> ()
3598 pr " if (r == %s)\n" error_code;
3599 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
3602 (match fst style with
3603 | RErr -> pr " rv = Val_unit;\n"
3604 | RInt _ -> pr " rv = Val_int (r);\n"
3605 | RBool _ -> pr " rv = Val_bool (r);\n"
3606 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
3608 pr " rv = caml_copy_string (r);\n";
3611 pr " rv = caml_copy_string_array ((const char **) r);\n";
3612 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
3615 pr " rv = caml_alloc (2, 0);\n";
3616 pr " Store_field (rv, 0, Val_int (r->i));\n";
3617 pr " Store_field (rv, 1, Val_bool (r->b));\n";
3618 pr " guestfs_free_int_bool (r);\n";
3620 pr " rv = copy_lvm_pv_list (r);\n";
3621 pr " guestfs_free_lvm_pv_list (r);\n";
3623 pr " rv = copy_lvm_vg_list (r);\n";
3624 pr " guestfs_free_lvm_vg_list (r);\n";
3626 pr " rv = copy_lvm_lv_list (r);\n";
3627 pr " guestfs_free_lvm_lv_list (r);\n";
3629 pr " rv = copy_stat (r);\n";
3632 pr " rv = copy_statvfs (r);\n";
3635 pr " rv = copy_table (r);\n";
3636 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
3640 pr " CAMLreturn (rv);\n";
3644 if List.length params > 5 then (
3645 pr "CAMLprim value\n";
3646 pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
3648 pr " return ocaml_guestfs_%s (argv[0]" name;
3649 iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
3656 and generate_ocaml_lvm_structure_decls () =
3659 pr "type lvm_%s = {\n" typ;
3662 | name, `String -> pr " %s : string;\n" name
3663 | name, `UUID -> pr " %s : string;\n" name
3664 | name, `Bytes -> pr " %s : int64;\n" name
3665 | name, `Int -> pr " %s : int64;\n" name
3666 | name, `OptPercent -> pr " %s : float option;\n" name
3670 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
3672 and generate_ocaml_stat_structure_decls () =
3675 pr "type %s = {\n" typ;
3678 | name, `Int -> pr " %s : int64;\n" name
3682 ) ["stat", stat_cols; "statvfs", statvfs_cols]
3684 and generate_ocaml_prototype ?(is_external = false) name style =
3685 if is_external then pr "external " else pr "val ";
3686 pr "%s : t -> " name;
3689 | String _ -> pr "string -> "
3690 | OptString _ -> pr "string option -> "
3691 | StringList _ -> pr "string array -> "
3692 | Bool _ -> pr "bool -> "
3693 | Int _ -> pr "int -> "
3695 (match fst style with
3696 | RErr -> pr "unit" (* all errors are turned into exceptions *)
3697 | RInt _ -> pr "int"
3698 | RBool _ -> pr "bool"
3699 | RConstString _ -> pr "string"
3700 | RString _ -> pr "string"
3701 | RStringList _ -> pr "string array"
3702 | RIntBool _ -> pr "int * bool"
3703 | RPVList _ -> pr "lvm_pv array"
3704 | RVGList _ -> pr "lvm_vg array"
3705 | RLVList _ -> pr "lvm_lv array"
3706 | RStat _ -> pr "stat"
3707 | RStatVFS _ -> pr "statvfs"
3708 | RHashtable _ -> pr "(string * string) list"
3710 if is_external then (
3712 if List.length (snd style) + 1 > 5 then
3713 pr "\"ocaml_guestfs_%s_byte\" " name;
3714 pr "\"ocaml_guestfs_%s\"" name
3718 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
3719 and generate_perl_xs () =
3720 generate_header CStyle LGPLv2;
3723 #include \"EXTERN.h\"
3727 #include <guestfs.h>
3730 #define PRId64 \"lld\"
3734 my_newSVll(long long val) {
3735 #ifdef USE_64_BIT_ALL
3736 return newSViv(val);
3740 len = snprintf(buf, 100, \"%%\" PRId64, val);
3741 return newSVpv(buf, len);
3746 #define PRIu64 \"llu\"
3750 my_newSVull(unsigned long long val) {
3751 #ifdef USE_64_BIT_ALL
3752 return newSVuv(val);
3756 len = snprintf(buf, 100, \"%%\" PRIu64, val);
3757 return newSVpv(buf, len);
3761 /* http://www.perlmonks.org/?node_id=680842 */
3763 XS_unpack_charPtrPtr (SV *arg) {
3768 if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV) {
3769 croak (\"array reference expected\");
3772 av = (AV *)SvRV (arg);
3773 ret = (char **)malloc (av_len (av) + 1 + 1);
3775 for (i = 0; i <= av_len (av); i++) {
3776 SV **elem = av_fetch (av, i, 0);
3778 if (!elem || !*elem)
3779 croak (\"missing element in list\");
3781 ret[i] = SvPV_nolen (*elem);
3789 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
3794 RETVAL = guestfs_create ();
3796 croak (\"could not create guestfs handle\");
3797 guestfs_set_error_handler (RETVAL, NULL, NULL);
3810 fun (name, style, _, _, _, _, _) ->
3811 (match fst style with
3812 | RErr -> pr "void\n"
3813 | RInt _ -> pr "SV *\n"
3814 | RBool _ -> pr "SV *\n"
3815 | RConstString _ -> pr "SV *\n"
3816 | RString _ -> pr "SV *\n"
3819 | RPVList _ | RVGList _ | RLVList _
3820 | RStat _ | RStatVFS _
3822 pr "void\n" (* all lists returned implictly on the stack *)
3824 (* Call and arguments. *)
3826 generate_call_args ~handle:"g" style;
3828 pr " guestfs_h *g;\n";
3831 | String n -> pr " char *%s;\n" n
3832 | OptString n -> pr " char *%s;\n" n
3833 | StringList n -> pr " char **%s;\n" n
3834 | Bool n -> pr " int %s;\n" n
3835 | Int n -> pr " int %s;\n" n
3838 let do_cleanups () =
3845 | StringList n -> pr " free (%s);\n" n
3850 (match fst style with
3855 pr " r = guestfs_%s " name;
3856 generate_call_args ~handle:"g" style;
3859 pr " if (r == -1)\n";
3860 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3866 pr " %s = guestfs_%s " n name;
3867 generate_call_args ~handle:"g" style;
3870 pr " if (%s == -1)\n" n;
3871 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3872 pr " RETVAL = newSViv (%s);\n" n;
3877 pr " const char *%s;\n" n;
3879 pr " %s = guestfs_%s " n name;
3880 generate_call_args ~handle:"g" style;
3883 pr " if (%s == NULL)\n" n;
3884 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3885 pr " RETVAL = newSVpv (%s, 0);\n" n;
3890 pr " char *%s;\n" n;
3892 pr " %s = guestfs_%s " n name;
3893 generate_call_args ~handle:"g" style;
3896 pr " if (%s == NULL)\n" n;
3897 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3898 pr " RETVAL = newSVpv (%s, 0);\n" n;
3899 pr " free (%s);\n" n;
3902 | RStringList n | RHashtable n ->
3904 pr " char **%s;\n" n;
3907 pr " %s = guestfs_%s " n name;
3908 generate_call_args ~handle:"g" style;
3911 pr " if (%s == NULL)\n" n;
3912 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3913 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
3914 pr " EXTEND (SP, n);\n";
3915 pr " for (i = 0; i < n; ++i) {\n";
3916 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
3917 pr " free (%s[i]);\n" n;
3919 pr " free (%s);\n" n;
3922 pr " struct guestfs_int_bool *r;\n";
3924 pr " r = guestfs_%s " name;
3925 generate_call_args ~handle:"g" style;
3928 pr " if (r == NULL)\n";
3929 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3930 pr " EXTEND (SP, 2);\n";
3931 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
3932 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
3933 pr " guestfs_free_int_bool (r);\n";
3935 generate_perl_lvm_code "pv" pv_cols name style n do_cleanups
3937 generate_perl_lvm_code "vg" vg_cols name style n do_cleanups
3939 generate_perl_lvm_code "lv" lv_cols name style n do_cleanups
3941 generate_perl_stat_code "stat" stat_cols name style n do_cleanups
3943 generate_perl_stat_code
3944 "statvfs" statvfs_cols name style n do_cleanups
3950 and generate_perl_lvm_code typ cols name style n do_cleanups =
3952 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
3956 pr " %s = guestfs_%s " n name;
3957 generate_call_args ~handle:"g" style;
3960 pr " if (%s == NULL)\n" n;
3961 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3962 pr " EXTEND (SP, %s->len);\n" n;
3963 pr " for (i = 0; i < %s->len; ++i) {\n" n;
3964 pr " hv = newHV ();\n";
3968 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
3969 name (String.length name) n name
3971 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
3972 name (String.length name) n name
3974 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
3975 name (String.length name) n name
3977 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
3978 name (String.length name) n name
3979 | name, `OptPercent ->
3980 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
3981 name (String.length name) n name
3983 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
3985 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
3987 and generate_perl_stat_code typ cols name style n do_cleanups =
3989 pr " struct guestfs_%s *%s;\n" typ n;
3991 pr " %s = guestfs_%s " n name;
3992 generate_call_args ~handle:"g" style;
3995 pr " if (%s == NULL)\n" n;
3996 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3997 pr " EXTEND (SP, %d);\n" (List.length cols);
4001 pr " PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n" n name
4003 pr " free (%s);\n" n
4005 (* Generate Sys/Guestfs.pm. *)
4006 and generate_perl_pm () =
4007 generate_header HashStyle LGPLv2;
4014 Sys::Guestfs - Perl bindings for libguestfs
4020 my $h = Sys::Guestfs->new ();
4021 $h->add_drive ('guest.img');
4024 $h->mount ('/dev/sda1', '/');
4025 $h->touch ('/hello');
4030 The C<Sys::Guestfs> module provides a Perl XS binding to the
4031 libguestfs API for examining and modifying virtual machine
4034 Amongst the things this is good for: making batch configuration
4035 changes to guests, getting disk used/free statistics (see also:
4036 virt-df), migrating between virtualization systems (see also:
4037 virt-p2v), performing partial backups, performing partial guest
4038 clones, cloning guests and changing registry/UUID/hostname info, and
4041 Libguestfs uses Linux kernel and qemu code, and can access any type of
4042 guest filesystem that Linux and qemu can, including but not limited
4043 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
4044 schemes, qcow, qcow2, vmdk.
4046 Libguestfs provides ways to enumerate guest storage (eg. partitions,
4047 LVs, what filesystem is in each LV, etc.). It can also run commands
4048 in the context of the guest. Also you can access filesystems over FTP.
4052 All errors turn into calls to C<croak> (see L<Carp(3)>).
4060 package Sys::Guestfs;
4066 XSLoader::load ('Sys::Guestfs');
4068 =item $h = Sys::Guestfs->new ();
4070 Create a new guestfs handle.
4076 my $class = ref ($proto) || $proto;
4078 my $self = Sys::Guestfs::_create ();
4079 bless $self, $class;
4085 (* Actions. We only need to print documentation for these as
4086 * they are pulled in from the XS code automatically.
4089 fun (name, style, _, flags, _, _, longdesc) ->
4090 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
4092 generate_perl_prototype name style;
4094 pr "%s\n\n" longdesc;
4095 if List.mem ProtocolLimitWarning flags then
4096 pr "%s\n\n" protocol_limit_warning;
4097 if List.mem DangerWillRobinson flags then
4098 pr "%s\n\n" danger_will_robinson
4099 ) all_functions_sorted;
4111 Copyright (C) 2009 Red Hat Inc.
4115 Please see the file COPYING.LIB for the full license.
4119 L<guestfs(3)>, L<guestfish(1)>.
4124 and generate_perl_prototype name style =
4125 (match fst style with
4130 | RString n -> pr "$%s = " n
4131 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
4135 | RLVList n -> pr "@%s = " n
4138 | RHashtable n -> pr "%%%s = " n
4141 let comma = ref false in
4144 if !comma then pr ", ";
4147 | String n | OptString n | Bool n | Int n ->
4154 (* Generate Python C module. *)
4155 and generate_python_c () =
4156 generate_header CStyle LGPLv2;
4165 #include \"guestfs.h\"
4173 get_handle (PyObject *obj)
4176 assert (obj != Py_None);
4177 return ((Pyguestfs_Object *) obj)->g;
4181 put_handle (guestfs_h *g)
4185 PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
4188 /* This list should be freed (but not the strings) after use. */
4189 static const char **
4190 get_string_list (PyObject *obj)
4197 if (!PyList_Check (obj)) {
4198 PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
4202 len = PyList_Size (obj);
4203 r = malloc (sizeof (char *) * (len+1));
4205 PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
4209 for (i = 0; i < len; ++i)
4210 r[i] = PyString_AsString (PyList_GetItem (obj, i));
4217 put_string_list (char * const * const argv)
4222 for (argc = 0; argv[argc] != NULL; ++argc)
4225 list = PyList_New (argc);
4226 for (i = 0; i < argc; ++i)
4227 PyList_SetItem (list, i, PyString_FromString (argv[i]));
4233 put_table (char * const * const argv)
4235 PyObject *list, *item;
4238 for (argc = 0; argv[argc] != NULL; ++argc)
4241 list = PyList_New (argc >> 1);
4242 for (i = 0; i < argc; i += 2) {
4244 item = PyTuple_New (2);
4245 PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
4246 PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
4247 PyList_SetItem (list, i >> 1, item);
4254 free_strings (char **argv)
4258 for (argc = 0; argv[argc] != NULL; ++argc)
4264 py_guestfs_create (PyObject *self, PyObject *args)
4268 g = guestfs_create ();
4270 PyErr_SetString (PyExc_RuntimeError,
4271 \"guestfs.create: failed to allocate handle\");
4274 guestfs_set_error_handler (g, NULL, NULL);
4275 return put_handle (g);
4279 py_guestfs_close (PyObject *self, PyObject *args)
4284 if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
4286 g = get_handle (py_g);
4290 Py_INCREF (Py_None);
4296 (* LVM structures, turned into Python dictionaries. *)
4299 pr "static PyObject *\n";
4300 pr "put_lvm_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
4302 pr " PyObject *dict;\n";
4304 pr " dict = PyDict_New ();\n";
4308 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4309 pr " PyString_FromString (%s->%s));\n"
4312 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4313 pr " PyString_FromStringAndSize (%s->%s, 32));\n"
4316 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4317 pr " PyLong_FromUnsignedLongLong (%s->%s));\n"
4320 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4321 pr " PyLong_FromLongLong (%s->%s));\n"
4323 | name, `OptPercent ->
4324 pr " if (%s->%s >= 0)\n" typ name;
4325 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4326 pr " PyFloat_FromDouble ((double) %s->%s));\n"
4329 pr " Py_INCREF (Py_None);\n";
4330 pr " PyDict_SetItemString (dict, \"%s\", Py_None);" name;
4333 pr " return dict;\n";
4337 pr "static PyObject *\n";
4338 pr "put_lvm_%s_list (struct guestfs_lvm_%s_list *%ss)\n" typ typ typ;
4340 pr " PyObject *list;\n";
4343 pr " list = PyList_New (%ss->len);\n" typ;
4344 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
4345 pr " PyList_SetItem (list, i, put_lvm_%s (&%ss->val[i]));\n" typ typ;
4346 pr " return list;\n";
4349 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
4351 (* Stat structures, turned into Python dictionaries. *)
4354 pr "static PyObject *\n";
4355 pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
4357 pr " PyObject *dict;\n";
4359 pr " dict = PyDict_New ();\n";
4363 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
4364 pr " PyLong_FromLongLong (%s->%s));\n"
4367 pr " return dict;\n";
4370 ) ["stat", stat_cols; "statvfs", statvfs_cols];
4372 (* Python wrapper functions. *)
4374 fun (name, style, _, _, _, _, _) ->
4375 pr "static PyObject *\n";
4376 pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
4379 pr " PyObject *py_g;\n";
4380 pr " guestfs_h *g;\n";
4381 pr " PyObject *py_r;\n";
4384 match fst style with
4385 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
4386 | RConstString _ -> pr " const char *r;\n"; "NULL"
4387 | RString _ -> pr " char *r;\n"; "NULL"
4388 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
4389 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
4390 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
4391 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
4392 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
4393 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
4394 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
4398 | String n -> pr " const char *%s;\n" n
4399 | OptString n -> pr " const char *%s;\n" n
4401 pr " PyObject *py_%s;\n" n;
4402 pr " const char **%s;\n" n
4403 | Bool n -> pr " int %s;\n" n
4404 | Int n -> pr " int %s;\n" n
4409 (* Convert the parameters. *)
4410 pr " if (!PyArg_ParseTuple (args, (char *) \"O";
4413 | String _ -> pr "s"
4414 | OptString _ -> pr "z"
4415 | StringList _ -> pr "O"
4416 | Bool _ -> pr "i" (* XXX Python has booleans? *)
4419 pr ":guestfs_%s\",\n" name;
4423 | String n -> pr ", &%s" n
4424 | OptString n -> pr ", &%s" n
4425 | StringList n -> pr ", &py_%s" n
4426 | Bool n -> pr ", &%s" n
4427 | Int n -> pr ", &%s" n
4431 pr " return NULL;\n";
4433 pr " g = get_handle (py_g);\n";
4436 | String _ | OptString _ | Bool _ | Int _ -> ()
4438 pr " %s = get_string_list (py_%s);\n" n n;
4439 pr " if (!%s) return NULL;\n" n
4444 pr " r = guestfs_%s " name;
4445 generate_call_args ~handle:"g" style;
4450 | String _ | OptString _ | Bool _ | Int _ -> ()
4452 pr " free (%s);\n" n
4455 pr " if (r == %s) {\n" error_code;
4456 pr " PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
4457 pr " return NULL;\n";
4461 (match fst style with
4463 pr " Py_INCREF (Py_None);\n";
4464 pr " py_r = Py_None;\n"
4466 | RBool _ -> pr " py_r = PyInt_FromLong ((long) r);\n"
4467 | RConstString _ -> pr " py_r = PyString_FromString (r);\n"
4469 pr " py_r = PyString_FromString (r);\n";
4472 pr " py_r = put_string_list (r);\n";
4473 pr " free_strings (r);\n"
4475 pr " py_r = PyTuple_New (2);\n";
4476 pr " PyTuple_SetItem (py_r, 0, PyInt_FromLong ((long) r->i));\n";
4477 pr " PyTuple_SetItem (py_r, 1, PyInt_FromLong ((long) r->b));\n";
4478 pr " guestfs_free_int_bool (r);\n"
4480 pr " py_r = put_lvm_pv_list (r);\n";
4481 pr " guestfs_free_lvm_pv_list (r);\n"
4483 pr " py_r = put_lvm_vg_list (r);\n";
4484 pr " guestfs_free_lvm_vg_list (r);\n"
4486 pr " py_r = put_lvm_lv_list (r);\n";
4487 pr " guestfs_free_lvm_lv_list (r);\n"
4489 pr " py_r = put_stat (r);\n";
4492 pr " py_r = put_statvfs (r);\n";
4495 pr " py_r = put_table (r);\n";
4496 pr " free_strings (r);\n"
4499 pr " return py_r;\n";
4504 (* Table of functions. *)
4505 pr "static PyMethodDef methods[] = {\n";
4506 pr " { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
4507 pr " { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
4509 fun (name, _, _, _, _, _, _) ->
4510 pr " { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
4513 pr " { NULL, NULL, 0, NULL }\n";
4517 (* Init function. *)
4520 initlibguestfsmod (void)
4522 static int initialized = 0;
4524 if (initialized) return;
4525 Py_InitModule ((char *) \"libguestfsmod\", methods);
4530 (* Generate Python module. *)
4531 and generate_python_py () =
4532 generate_header HashStyle LGPLv2;
4534 pr "import libguestfsmod\n";
4536 pr "class GuestFS:\n";
4537 pr " def __init__ (self):\n";
4538 pr " self._o = libguestfsmod.create ()\n";
4540 pr " def __del__ (self):\n";
4541 pr " libguestfsmod.close (self._o)\n";
4545 fun (name, style, _, _, _, _, _) ->
4547 generate_call_args ~handle:"self" style;
4549 pr " return libguestfsmod.%s " name;
4550 generate_call_args ~handle:"self._o" style;
4555 let output_to filename =
4556 let filename_new = filename ^ ".new" in
4557 chan := open_out filename_new;
4561 Unix.rename filename_new filename;
4562 printf "written %s\n%!" filename;
4570 if not (Sys.file_exists "configure.ac") then (
4572 You are probably running this from the wrong directory.
4573 Run it from the top source directory using the command
4579 let close = output_to "src/guestfs_protocol.x" in
4583 let close = output_to "src/guestfs-structs.h" in
4584 generate_structs_h ();
4587 let close = output_to "src/guestfs-actions.h" in
4588 generate_actions_h ();
4591 let close = output_to "src/guestfs-actions.c" in
4592 generate_client_actions ();
4595 let close = output_to "daemon/actions.h" in
4596 generate_daemon_actions_h ();
4599 let close = output_to "daemon/stubs.c" in
4600 generate_daemon_actions ();
4603 let close = output_to "tests.c" in
4607 let close = output_to "fish/cmds.c" in
4608 generate_fish_cmds ();
4611 let close = output_to "fish/completion.c" in
4612 generate_fish_completion ();
4615 let close = output_to "guestfs-structs.pod" in
4616 generate_structs_pod ();
4619 let close = output_to "guestfs-actions.pod" in
4620 generate_actions_pod ();
4623 let close = output_to "guestfish-actions.pod" in
4624 generate_fish_actions_pod ();
4627 let close = output_to "ocaml/guestfs.mli" in
4628 generate_ocaml_mli ();
4631 let close = output_to "ocaml/guestfs.ml" in
4632 generate_ocaml_ml ();
4635 let close = output_to "ocaml/guestfs_c_actions.c" in
4636 generate_ocaml_c ();
4639 let close = output_to "perl/Guestfs.xs" in
4640 generate_perl_xs ();
4643 let close = output_to "perl/lib/Sys/Guestfs.pm" in
4644 generate_perl_pm ();
4647 let close = output_to "python/guestfs-py.c" in
4648 generate_python_c ();
4651 let close = output_to "python/guestfs.py" in
4652 generate_python_py ();