3 * Copyright (C) 2009 Red Hat Inc.
5 * This program is free software; you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation; either version 2 of the License, or
8 * (at your option) any later version.
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
15 * You should have received a copy of the GNU General Public License
16 * along with this program; if not, write to the Free Software
17 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
20 (* This script generates a large amount of code and documentation for
21 * all the daemon actions.
23 * To add a new action there are only two files you need to change,
24 * this one to describe the interface (see the big table below), and
25 * daemon/<somefile>.c to write the implementation.
27 * After editing this file, run it (./src/generator.ml) to regenerate
28 * all the output files.
30 * IMPORTANT: This script should NOT print any warnings. If it prints
31 * warnings, you should treat them as errors.
32 * [Need to add -warn-error to ocaml command line]
39 type style = ret * args
41 (* "RErr" as a return value means an int used as a simple error
42 * indication, ie. 0 or -1.
45 (* "RInt" as a return value means an int which is -1 for error
46 * or any value >= 0 on success.
49 (* "RBool" is a bool return value which can be true/false or
53 (* "RConstString" is a string that refers to a constant value.
54 * Try to avoid using this. In particular you cannot use this
55 * for values returned from the daemon, because there is no
56 * thread-safe way to return them in the C API.
58 | RConstString of string
59 (* "RString" and "RStringList" are caller-frees. *)
61 | RStringList of string
62 (* Some limited tuples are possible: *)
63 | RIntBool of string * string
64 (* LVM PVs, VGs and LVs. *)
68 and args = argt list (* Function parameters, guestfs handle is implicit. *)
70 (* Note in future we should allow a "variable args" parameter as
71 * the final parameter, to allow commands like
72 * chmod mode file [file(s)...]
73 * This is not implemented yet, but many commands (such as chmod)
74 * are currently defined with the argument order keeping this future
75 * possibility in mind.
78 | String of string (* const char *name, cannot be NULL *)
79 | OptString of string (* const char *name, may be NULL *)
80 | StringList of string(* list of strings (each string cannot be NULL) *)
81 | Bool of string (* boolean *)
82 | Int of string (* int (smallish ints, signed, <= 31 bits) *)
85 | ProtocolLimitWarning (* display warning about protocol size limits *)
86 | DangerWillRobinson (* flags particularly dangerous commands *)
87 | FishAlias of string (* provide an alias for this cmd in guestfish *)
88 | FishAction of string (* call this function in guestfish *)
89 | NotInFish (* do not export via guestfish *)
91 let protocol_limit_warning =
92 "Because of the message protocol, there is a transfer limit
93 of somewhere between 2MB and 4MB. To transfer large files you should use
96 let danger_will_robinson =
97 "B<This command is dangerous. Without careful use you
98 can easily destroy all your data>."
100 (* You can supply zero or as many tests as you want per API call.
102 * Note that the test environment has 3 block devices, of size 500MB,
103 * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc).
104 * Note for partitioning purposes, the 500MB device has 63 cylinders.
106 * To be able to run the tests in a reasonable amount of time,
107 * the virtual machine and block devices are reused between tests.
108 * So don't try testing kill_subprocess :-x
110 * Between each test we umount-all and lvm-remove-all.
112 * Don't assume anything about the previous contents of the block
113 * devices. Use 'Init*' to create some initial scenarios.
115 type tests = (test_init * test) list
117 (* Run the command sequence and just expect nothing to fail. *)
119 (* Run the command sequence and expect the output of the final
120 * command to be the string.
122 | TestOutput of seq * string
123 (* Run the command sequence and expect the output of the final
124 * command to be the list of strings.
126 | TestOutputList of seq * string list
127 (* Run the command sequence and expect the output of the final
128 * command to be the integer.
130 | TestOutputInt of seq * int
131 (* Run the command sequence and expect the output of the final
132 * command to be a true value (!= 0 or != NULL).
134 | TestOutputTrue of seq
135 (* Run the command sequence and expect the output of the final
136 * command to be a false value (== 0 or == NULL, but not an error).
138 | TestOutputFalse of seq
139 (* Run the command sequence and expect the output of the final
140 * command to be a list of the given length (but don't care about
143 | TestOutputLength of seq * int
144 (* Run the command sequence and expect the final command (only)
147 | TestLastFail of seq
149 (* Some initial scenarios for testing. *)
151 (* Do nothing, block devices could contain random stuff including
152 * LVM PVs, and some filesystems might be mounted. This is usually
156 (* Block devices are empty and no filesystems are mounted. *)
158 (* /dev/sda contains a single partition /dev/sda1, which is formatted
159 * as ext2, empty [except for lost+found] and mounted on /.
160 * /dev/sdb and /dev/sdc may have random content.
165 * /dev/sda1 (is a PV):
166 * /dev/VG/LV (size 8MB):
167 * formatted as ext2, empty [except for lost+found], mounted on /
168 * /dev/sdb and /dev/sdc may have random content.
172 (* Sequence of commands for testing. *)
174 and cmd = string list
176 (* Note about long descriptions: When referring to another
177 * action, use the format C<guestfs_other> (ie. the full name of
178 * the C function). This will be replaced as appropriate in other
181 * Apart from that, long descriptions are just perldoc paragraphs.
184 let non_daemon_functions = [
185 ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
187 "launch the qemu subprocess",
189 Internally libguestfs is implemented by running a virtual machine
192 You should call this after configuring the handle
193 (eg. adding drives) but before performing any actions.");
195 ("wait_ready", (RErr, []), -1, [NotInFish],
197 "wait until the qemu subprocess launches",
199 Internally libguestfs is implemented by running a virtual machine
202 You should call this after C<guestfs_launch> to wait for the launch
205 ("kill_subprocess", (RErr, []), -1, [],
207 "kill the qemu subprocess",
209 This kills the qemu subprocess. You should never need to call this.");
211 ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
213 "add an image to examine or modify",
215 This function adds a virtual machine disk image C<filename> to the
216 guest. The first time you call this function, the disk appears as IDE
217 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
220 You don't necessarily need to be root when using libguestfs. However
221 you obviously do need sufficient permissions to access the filename
222 for whatever operations you want to perform (ie. read access if you
223 just want to read the image or write access if you want to modify the
226 This is equivalent to the qemu parameter C<-drive file=filename>.");
228 ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
230 "add a CD-ROM disk image to examine",
232 This function adds a virtual CD-ROM disk image to the guest.
234 This is equivalent to the qemu parameter C<-cdrom filename>.");
236 ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
238 "add qemu parameters",
240 This can be used to add arbitrary qemu command line parameters
241 of the form C<-param value>. Actually it's not quite arbitrary - we
242 prevent you from setting some parameters which would interfere with
243 parameters that we use.
245 The first character of C<param> string must be a C<-> (dash).
247 C<value> can be NULL.");
249 ("set_path", (RErr, [String "path"]), -1, [FishAlias "path"],
251 "set the search path",
253 Set the path that libguestfs searches for kernel and initrd.img.
255 The default is C<$libdir/guestfs> unless overridden by setting
256 C<LIBGUESTFS_PATH> environment variable.
258 The string C<path> is stashed in the libguestfs handle, so the caller
259 must make sure it remains valid for the lifetime of the handle.
261 Setting C<path> to C<NULL> restores the default path.");
263 ("get_path", (RConstString "path", []), -1, [],
265 "get the search path",
267 Return the current search path.
269 This is always non-NULL. If it wasn't set already, then this will
270 return the default path.");
272 ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
276 If C<autosync> is true, this enables autosync. Libguestfs will make a
277 best effort attempt to run C<guestfs_sync> when the handle is closed
278 (also if the program exits without closing handles).");
280 ("get_autosync", (RBool "autosync", []), -1, [],
284 Get the autosync flag.");
286 ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
290 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
292 Verbose messages are disabled unless the environment variable
293 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
295 ("get_verbose", (RBool "verbose", []), -1, [],
299 This returns the verbose messages flag.")
302 let daemon_functions = [
303 ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
304 [InitEmpty, TestOutput (
305 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
306 ["mkfs"; "ext2"; "/dev/sda1"];
307 ["mount"; "/dev/sda1"; "/"];
308 ["write_file"; "/new"; "new file contents"; "0"];
309 ["cat"; "/new"]], "new file contents")],
310 "mount a guest disk at a position in the filesystem",
312 Mount a guest disk at a position in the filesystem. Block devices
313 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
314 the guest. If those block devices contain partitions, they will have
315 the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
318 The rules are the same as for L<mount(2)>: A filesystem must
319 first be mounted on C</> before others can be mounted. Other
320 filesystems can only be mounted on directories which already
323 The mounted filesystem is writable, if we have sufficient permissions
324 on the underlying device.
326 The filesystem options C<sync> and C<noatime> are set with this
327 call, in order to improve reliability.");
329 ("sync", (RErr, []), 2, [],
330 [ InitEmpty, TestRun [["sync"]]],
331 "sync disks, writes are flushed through to the disk image",
333 This syncs the disk, so that any writes are flushed through to the
334 underlying disk image.
336 You should always call this if you have modified a disk image, before
337 closing the handle.");
339 ("touch", (RErr, [String "path"]), 3, [],
340 [InitBasicFS, TestOutputTrue (
342 ["exists"; "/new"]])],
343 "update file timestamps or create a new file",
345 Touch acts like the L<touch(1)> command. It can be used to
346 update the timestamps on a file, or, if the file does not exist,
347 to create a new zero-length file.");
349 ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
350 [InitBasicFS, TestOutput (
351 [["write_file"; "/new"; "new file contents"; "0"];
352 ["cat"; "/new"]], "new file contents")],
353 "list the contents of a file",
355 Return the contents of the file named C<path>.
357 Note that this function cannot correctly handle binary files
358 (specifically, files containing C<\\0> character which is treated
359 as end of string). For those you need to use the C<guestfs_read_file>
360 function which has a more complex interface.");
362 ("ll", (RString "listing", [String "directory"]), 5, [],
363 [], (* XXX Tricky to test because it depends on the exact format
364 * of the 'ls -l' command, which changes between F10 and F11.
366 "list the files in a directory (long format)",
368 List the files in C<directory> (relative to the root directory,
369 there is no cwd) in the format of 'ls -la'.
371 This command is mostly useful for interactive sessions. It
372 is I<not> intended that you try to parse the output string.");
374 ("ls", (RStringList "listing", [String "directory"]), 6, [],
375 [InitBasicFS, TestOutputList (
378 ["touch"; "/newest"];
379 ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
380 "list the files in a directory",
382 List the files in C<directory> (relative to the root directory,
383 there is no cwd). The '.' and '..' entries are not returned, but
384 hidden files are shown.
386 This command is mostly useful for interactive sessions. Programs
387 should probably use C<guestfs_readdir> instead.");
389 ("list_devices", (RStringList "devices", []), 7, [],
390 [InitEmpty, TestOutputList (
391 [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"])],
392 "list the block devices",
394 List all the block devices.
396 The full block device names are returned, eg. C</dev/sda>");
398 ("list_partitions", (RStringList "partitions", []), 8, [],
399 [InitBasicFS, TestOutputList (
400 [["list_partitions"]], ["/dev/sda1"]);
401 InitEmpty, TestOutputList (
402 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
403 ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
404 "list the partitions",
406 List all the partitions detected on all block devices.
408 The full partition device names are returned, eg. C</dev/sda1>
410 This does not return logical volumes. For that you will need to
411 call C<guestfs_lvs>.");
413 ("pvs", (RStringList "physvols", []), 9, [],
414 [InitBasicFSonLVM, TestOutputList (
415 [["pvs"]], ["/dev/sda1"]);
416 InitEmpty, TestOutputList (
417 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
418 ["pvcreate"; "/dev/sda1"];
419 ["pvcreate"; "/dev/sda2"];
420 ["pvcreate"; "/dev/sda3"];
421 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
422 "list the LVM physical volumes (PVs)",
424 List all the physical volumes detected. This is the equivalent
425 of the L<pvs(8)> command.
427 This returns a list of just the device names that contain
428 PVs (eg. C</dev/sda2>).
430 See also C<guestfs_pvs_full>.");
432 ("vgs", (RStringList "volgroups", []), 10, [],
433 [InitBasicFSonLVM, TestOutputList (
435 InitEmpty, TestOutputList (
436 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
437 ["pvcreate"; "/dev/sda1"];
438 ["pvcreate"; "/dev/sda2"];
439 ["pvcreate"; "/dev/sda3"];
440 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
441 ["vgcreate"; "VG2"; "/dev/sda3"];
442 ["vgs"]], ["VG1"; "VG2"])],
443 "list the LVM volume groups (VGs)",
445 List all the volumes groups detected. This is the equivalent
446 of the L<vgs(8)> command.
448 This returns a list of just the volume group names that were
449 detected (eg. C<VolGroup00>).
451 See also C<guestfs_vgs_full>.");
453 ("lvs", (RStringList "logvols", []), 11, [],
454 [InitBasicFSonLVM, TestOutputList (
455 [["lvs"]], ["/dev/VG/LV"]);
456 InitEmpty, TestOutputList (
457 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
458 ["pvcreate"; "/dev/sda1"];
459 ["pvcreate"; "/dev/sda2"];
460 ["pvcreate"; "/dev/sda3"];
461 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
462 ["vgcreate"; "VG2"; "/dev/sda3"];
463 ["lvcreate"; "LV1"; "VG1"; "50"];
464 ["lvcreate"; "LV2"; "VG1"; "50"];
465 ["lvcreate"; "LV3"; "VG2"; "50"];
466 ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
467 "list the LVM logical volumes (LVs)",
469 List all the logical volumes detected. This is the equivalent
470 of the L<lvs(8)> command.
472 This returns a list of the logical volume device names
473 (eg. C</dev/VolGroup00/LogVol00>).
475 See also C<guestfs_lvs_full>.");
477 ("pvs_full", (RPVList "physvols", []), 12, [],
478 [InitBasicFSonLVM, TestOutputLength (
480 "list the LVM physical volumes (PVs)",
482 List all the physical volumes detected. This is the equivalent
483 of the L<pvs(8)> command. The \"full\" version includes all fields.");
485 ("vgs_full", (RVGList "volgroups", []), 13, [],
486 [InitBasicFSonLVM, TestOutputLength (
488 "list the LVM volume groups (VGs)",
490 List all the volumes groups detected. This is the equivalent
491 of the L<vgs(8)> command. The \"full\" version includes all fields.");
493 ("lvs_full", (RLVList "logvols", []), 14, [],
494 [InitBasicFSonLVM, TestOutputLength (
496 "list the LVM logical volumes (LVs)",
498 List all the logical volumes detected. This is the equivalent
499 of the L<lvs(8)> command. The \"full\" version includes all fields.");
501 ("read_lines", (RStringList "lines", [String "path"]), 15, [],
502 [InitBasicFS, TestOutputList (
503 [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
504 ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);
505 InitBasicFS, TestOutputList (
506 [["write_file"; "/new"; ""; "0"];
507 ["read_lines"; "/new"]], [])],
508 "read file as lines",
510 Return the contents of the file named C<path>.
512 The file contents are returned as a list of lines. Trailing
513 C<LF> and C<CRLF> character sequences are I<not> returned.
515 Note that this function cannot correctly handle binary files
516 (specifically, files containing C<\\0> character which is treated
517 as end of line). For those you need to use the C<guestfs_read_file>
518 function which has a more complex interface.");
520 ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [],
521 [], (* XXX Augeas code needs tests. *)
522 "create a new Augeas handle",
524 Create a new Augeas handle for editing configuration files.
525 If there was any previous Augeas handle associated with this
526 guestfs session, then it is closed.
528 You must call this before using any other C<guestfs_aug_*>
531 C<root> is the filesystem root. C<root> must not be NULL,
534 The flags are the same as the flags defined in
535 E<lt>augeas.hE<gt>, the logical I<or> of the following
540 =item C<AUG_SAVE_BACKUP> = 1
542 Keep the original file with a C<.augsave> extension.
544 =item C<AUG_SAVE_NEWFILE> = 2
546 Save changes into a file with extension C<.augnew>, and
547 do not overwrite original. Overrides C<AUG_SAVE_BACKUP>.
549 =item C<AUG_TYPE_CHECK> = 4
551 Typecheck lenses (can be expensive).
553 =item C<AUG_NO_STDINC> = 8
555 Do not use standard load path for modules.
557 =item C<AUG_SAVE_NOOP> = 16
559 Make save a no-op, just record what would have been changed.
561 =item C<AUG_NO_LOAD> = 32
563 Do not load the tree in C<guestfs_aug_init>.
567 To close the handle, you can call C<guestfs_aug_close>.
569 To find out more about Augeas, see L<http://augeas.net/>.");
571 ("aug_close", (RErr, []), 26, [],
572 [], (* XXX Augeas code needs tests. *)
573 "close the current Augeas handle",
575 Close the current Augeas handle and free up any resources
576 used by it. After calling this, you have to call
577 C<guestfs_aug_init> again before you can use any other
580 ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
581 [], (* XXX Augeas code needs tests. *)
582 "define an Augeas variable",
584 Defines an Augeas variable C<name> whose value is the result
585 of evaluating C<expr>. If C<expr> is NULL, then C<name> is
588 On success this returns the number of nodes in C<expr>, or
589 C<0> if C<expr> evaluates to something which is not a nodeset.");
591 ("aug_defnode", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [],
592 [], (* XXX Augeas code needs tests. *)
593 "define an Augeas node",
595 Defines a variable C<name> whose value is the result of
598 If C<expr> evaluates to an empty nodeset, a node is created,
599 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
600 C<name> will be the nodeset containing that single node.
602 On success this returns a pair containing the
603 number of nodes in the nodeset, and a boolean flag
604 if a node was created.");
606 ("aug_get", (RString "val", [String "path"]), 19, [],
607 [], (* XXX Augeas code needs tests. *)
608 "look up the value of an Augeas path",
610 Look up the value associated with C<path>. If C<path>
611 matches exactly one node, the C<value> is returned.");
613 ("aug_set", (RErr, [String "path"; String "val"]), 20, [],
614 [], (* XXX Augeas code needs tests. *)
615 "set Augeas path to value",
617 Set the value associated with C<path> to C<value>.");
619 ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [],
620 [], (* XXX Augeas code needs tests. *)
621 "insert a sibling Augeas node",
623 Create a new sibling C<label> for C<path>, inserting it into
624 the tree before or after C<path> (depending on the boolean
627 C<path> must match exactly one existing node in the tree, and
628 C<label> must be a label, ie. not contain C</>, C<*> or end
629 with a bracketed index C<[N]>.");
631 ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
632 [], (* XXX Augeas code needs tests. *)
633 "remove an Augeas path",
635 Remove C<path> and all of its children.
637 On success this returns the number of entries which were removed.");
639 ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [],
640 [], (* XXX Augeas code needs tests. *)
643 Move the node C<src> to C<dest>. C<src> must match exactly
644 one node. C<dest> is overwritten if it exists.");
646 ("aug_match", (RStringList "matches", [String "path"]), 24, [],
647 [], (* XXX Augeas code needs tests. *)
648 "return Augeas nodes which match path",
650 Returns a list of paths which match the path expression C<path>.
651 The returned paths are sufficiently qualified so that they match
652 exactly one node in the current tree.");
654 ("aug_save", (RErr, []), 25, [],
655 [], (* XXX Augeas code needs tests. *)
656 "write all pending Augeas changes to disk",
658 This writes all pending changes to disk.
660 The flags which were passed to C<guestfs_aug_init> affect exactly
661 how files are saved.");
663 ("aug_load", (RErr, []), 27, [],
664 [], (* XXX Augeas code needs tests. *)
665 "load files into the tree",
667 Load files into the tree.
669 See C<aug_load> in the Augeas documentation for the full gory
672 ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
673 [], (* XXX Augeas code needs tests. *)
674 "list Augeas nodes under a path",
676 This is just a shortcut for listing C<guestfs_aug_match>
677 C<path/*> and sorting the resulting nodes into alphabetical order.");
679 ("rm", (RErr, [String "path"]), 29, [],
680 [InitBasicFS, TestRun
683 InitBasicFS, TestLastFail
685 InitBasicFS, TestLastFail
690 Remove the single file C<path>.");
692 ("rmdir", (RErr, [String "path"]), 30, [],
693 [InitBasicFS, TestRun
696 InitBasicFS, TestLastFail
698 InitBasicFS, TestLastFail
701 "remove a directory",
703 Remove the single directory C<path>.");
705 ("rm_rf", (RErr, [String "path"]), 31, [],
706 [InitBasicFS, TestOutputFalse
708 ["mkdir"; "/new/foo"];
709 ["touch"; "/new/foo/bar"];
711 ["exists"; "/new"]]],
712 "remove a file or directory recursively",
714 Remove the file or directory C<path>, recursively removing the
715 contents if its a directory. This is like the C<rm -rf> shell
718 ("mkdir", (RErr, [String "path"]), 32, [],
719 [InitBasicFS, TestOutputTrue
722 InitBasicFS, TestLastFail
723 [["mkdir"; "/new/foo/bar"]]],
724 "create a directory",
726 Create a directory named C<path>.");
728 ("mkdir_p", (RErr, [String "path"]), 33, [],
729 [InitBasicFS, TestOutputTrue
730 [["mkdir_p"; "/new/foo/bar"];
731 ["is_dir"; "/new/foo/bar"]];
732 InitBasicFS, TestOutputTrue
733 [["mkdir_p"; "/new/foo/bar"];
734 ["is_dir"; "/new/foo"]];
735 InitBasicFS, TestOutputTrue
736 [["mkdir_p"; "/new/foo/bar"];
737 ["is_dir"; "/new"]]],
738 "create a directory and parents",
740 Create a directory named C<path>, creating any parent directories
741 as necessary. This is like the C<mkdir -p> shell command.");
743 ("chmod", (RErr, [Int "mode"; String "path"]), 34, [],
744 [], (* XXX Need stat command to test *)
747 Change the mode (permissions) of C<path> to C<mode>. Only
748 numeric modes are supported.");
750 ("chown", (RErr, [Int "owner"; Int "group"; String "path"]), 35, [],
751 [], (* XXX Need stat command to test *)
752 "change file owner and group",
754 Change the file owner to C<owner> and group to C<group>.
756 Only numeric uid and gid are supported. If you want to use
757 names, you will need to locate and parse the password file
758 yourself (Augeas support makes this relatively easy).");
760 ("exists", (RBool "existsflag", [String "path"]), 36, [],
761 [InitBasicFS, TestOutputTrue (
763 ["exists"; "/new"]]);
764 InitBasicFS, TestOutputTrue (
766 ["exists"; "/new"]])],
767 "test if file or directory exists",
769 This returns C<true> if and only if there is a file, directory
770 (or anything) with the given C<path> name.
772 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
774 ("is_file", (RBool "fileflag", [String "path"]), 37, [],
775 [InitBasicFS, TestOutputTrue (
777 ["is_file"; "/new"]]);
778 InitBasicFS, TestOutputFalse (
780 ["is_file"; "/new"]])],
781 "test if file exists",
783 This returns C<true> if and only if there is a file
784 with the given C<path> name. Note that it returns false for
785 other objects like directories.
787 See also C<guestfs_stat>.");
789 ("is_dir", (RBool "dirflag", [String "path"]), 38, [],
790 [InitBasicFS, TestOutputFalse (
792 ["is_dir"; "/new"]]);
793 InitBasicFS, TestOutputTrue (
795 ["is_dir"; "/new"]])],
796 "test if file exists",
798 This returns C<true> if and only if there is a directory
799 with the given C<path> name. Note that it returns false for
800 other objects like files.
802 See also C<guestfs_stat>.");
804 ("pvcreate", (RErr, [String "device"]), 39, [],
805 [InitEmpty, TestOutputList (
806 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
807 ["pvcreate"; "/dev/sda1"];
808 ["pvcreate"; "/dev/sda2"];
809 ["pvcreate"; "/dev/sda3"];
810 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
811 "create an LVM physical volume",
813 This creates an LVM physical volume on the named C<device>,
814 where C<device> should usually be a partition name such
817 ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
818 [InitEmpty, TestOutputList (
819 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
820 ["pvcreate"; "/dev/sda1"];
821 ["pvcreate"; "/dev/sda2"];
822 ["pvcreate"; "/dev/sda3"];
823 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
824 ["vgcreate"; "VG2"; "/dev/sda3"];
825 ["vgs"]], ["VG1"; "VG2"])],
826 "create an LVM volume group",
828 This creates an LVM volume group called C<volgroup>
829 from the non-empty list of physical volumes C<physvols>.");
831 ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [],
832 [InitEmpty, TestOutputList (
833 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
834 ["pvcreate"; "/dev/sda1"];
835 ["pvcreate"; "/dev/sda2"];
836 ["pvcreate"; "/dev/sda3"];
837 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
838 ["vgcreate"; "VG2"; "/dev/sda3"];
839 ["lvcreate"; "LV1"; "VG1"; "50"];
840 ["lvcreate"; "LV2"; "VG1"; "50"];
841 ["lvcreate"; "LV3"; "VG2"; "50"];
842 ["lvcreate"; "LV4"; "VG2"; "50"];
843 ["lvcreate"; "LV5"; "VG2"; "50"];
845 ["/dev/VG1/LV1"; "/dev/VG1/LV2";
846 "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
847 "create an LVM volume group",
849 This creates an LVM volume group called C<logvol>
850 on the volume group C<volgroup>, with C<size> megabytes.");
852 ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [],
853 [InitEmpty, TestOutput (
854 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
855 ["mkfs"; "ext2"; "/dev/sda1"];
856 ["mount"; "/dev/sda1"; "/"];
857 ["write_file"; "/new"; "new file contents"; "0"];
858 ["cat"; "/new"]], "new file contents")],
861 This creates a filesystem on C<device> (usually a partition
862 of LVM logical volume). The filesystem type is C<fstype>, for
865 ("sfdisk", (RErr, [String "device";
866 Int "cyls"; Int "heads"; Int "sectors";
867 StringList "lines"]), 43, [DangerWillRobinson],
869 "create partitions on a block device",
871 This is a direct interface to the L<sfdisk(8)> program for creating
872 partitions on block devices.
874 C<device> should be a block device, for example C</dev/sda>.
876 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
877 and sectors on the device, which are passed directly to sfdisk as
878 the I<-C>, I<-H> and I<-S> parameters. If you pass C<0> for any
879 of these, then the corresponding parameter is omitted. Usually for
880 'large' disks, you can just pass C<0> for these, but for small
881 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
882 out the right geometry and you will need to tell it.
884 C<lines> is a list of lines that we feed to C<sfdisk>. For more
885 information refer to the L<sfdisk(8)> manpage.
887 To create a single partition occupying the whole disk, you would
888 pass C<lines> as a single element list, when the single element being
889 the string C<,> (comma).");
891 ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
892 [InitEmpty, TestOutput (
893 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
894 ["mkfs"; "ext2"; "/dev/sda1"];
895 ["mount"; "/dev/sda1"; "/"];
896 ["write_file"; "/new"; "new file contents"; "0"];
897 ["cat"; "/new"]], "new file contents")],
900 This call creates a file called C<path>. The contents of the
901 file is the string C<content> (which can contain any 8 bit data),
904 As a special case, if C<size> is C<0>
905 then the length is calculated using C<strlen> (so in this case
906 the content cannot contain embedded ASCII NULs).");
908 ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
909 [InitEmpty, TestOutputList (
910 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
911 ["mkfs"; "ext2"; "/dev/sda1"];
912 ["mount"; "/dev/sda1"; "/"];
913 ["mounts"]], ["/dev/sda1"]);
914 InitEmpty, TestOutputList (
915 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
916 ["mkfs"; "ext2"; "/dev/sda1"];
917 ["mount"; "/dev/sda1"; "/"];
920 "unmount a filesystem",
922 This unmounts the given filesystem. The filesystem may be
923 specified either by its mountpoint (path) or the device which
924 contains the filesystem.");
926 ("mounts", (RStringList "devices", []), 46, [],
927 [InitBasicFS, TestOutputList (
928 [["mounts"]], ["/dev/sda1"])],
929 "show mounted filesystems",
931 This returns the list of currently mounted filesystems. It returns
932 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
934 Some internal mounts are not shown.");
936 ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
937 [InitBasicFS, TestOutputList (
940 "unmount all filesystems",
942 This unmounts all mounted filesystems.
944 Some internal mounts are not unmounted by this call.");
946 ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson],
948 "remove all LVM LVs, VGs and PVs",
950 This command removes all LVM logical volumes, volume groups
951 and physical volumes.");
953 ("file", (RString "description", [String "path"]), 49, [],
954 [InitBasicFS, TestOutput (
956 ["file"; "/new"]], "empty");
957 InitBasicFS, TestOutput (
958 [["write_file"; "/new"; "some content\n"; "0"];
959 ["file"; "/new"]], "ASCII text");
960 InitBasicFS, TestLastFail (
961 [["file"; "/nofile"]])],
962 "determine file type",
964 This call uses the standard L<file(1)> command to determine
965 the type or contents of the file. This also works on devices,
966 for example to find out whether a partition contains a filesystem.
968 The exact command which runs is C<file -bsL path>. Note in
969 particular that the filename is not prepended to the output
970 (the C<-b> option).");
972 ("command", (RString "output", [StringList "arguments"]), 50, [],
973 [], (* XXX how to test? *)
974 "run a command from the guest filesystem",
976 This calls runs a command from the guest filesystem. The
977 filesystem must be mounted, and must contain a compatible
978 operating system (ie. something Linux, with the same
979 or compatible processor architecture).
981 The single parameter is an argv-style list of arguments.
982 The first element is the name of the program to run.
983 Subsequent elements are parameters. The list must be
984 non-empty (ie. must contain a program name).
986 The C<$PATH> environment variable will contain at least
987 C</usr/bin> and C</bin>. If you require a program from
988 another location, you should provide the full path in the
991 Shared libraries and data files required by the program
992 must be available on filesystems which are mounted in the
993 correct places. It is the caller's responsibility to ensure
994 all filesystems that are needed are mounted at the right
997 ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [],
998 [], (* XXX how to test? *)
999 "run a command, returning lines",
1001 This is the same as C<guestfs_command>, but splits the
1002 result into a list of lines.");
1006 let all_functions = non_daemon_functions @ daemon_functions
1008 (* In some places we want the functions to be displayed sorted
1009 * alphabetically, so this is useful:
1011 let all_functions_sorted =
1012 List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
1013 compare n1 n2) all_functions
1015 (* Column names and types from LVM PVs/VGs/LVs. *)
1024 "pv_attr", `String (* XXX *);
1025 "pv_pe_count", `Int;
1026 "pv_pe_alloc_count", `Int;
1029 "pv_mda_count", `Int;
1030 "pv_mda_free", `Bytes;
1031 (* Not in Fedora 10:
1032 "pv_mda_size", `Bytes;
1039 "vg_attr", `String (* XXX *);
1042 "vg_sysid", `String;
1043 "vg_extent_size", `Bytes;
1044 "vg_extent_count", `Int;
1045 "vg_free_count", `Int;
1053 "vg_mda_count", `Int;
1054 "vg_mda_free", `Bytes;
1055 (* Not in Fedora 10:
1056 "vg_mda_size", `Bytes;
1062 "lv_attr", `String (* XXX *);
1065 "lv_kernel_major", `Int;
1066 "lv_kernel_minor", `Int;
1070 "snap_percent", `OptPercent;
1071 "copy_percent", `OptPercent;
1074 "mirror_log", `String;
1078 (* Useful functions.
1079 * Note we don't want to use any external OCaml libraries which
1080 * makes this a bit harder than it should be.
1082 let failwithf fs = ksprintf failwith fs
1084 let replace_char s c1 c2 =
1085 let s2 = String.copy s in
1086 let r = ref false in
1087 for i = 0 to String.length s2 - 1 do
1088 if String.unsafe_get s2 i = c1 then (
1089 String.unsafe_set s2 i c2;
1093 if not !r then s else s2
1095 let rec find s sub =
1096 let len = String.length s in
1097 let sublen = String.length sub in
1099 if i <= len-sublen then (
1101 if j < sublen then (
1102 if s.[i+j] = sub.[j] then loop2 (j+1)
1108 if r = -1 then loop (i+1) else r
1114 let rec replace_str s s1 s2 =
1115 let len = String.length s in
1116 let sublen = String.length s1 in
1117 let i = find s s1 in
1120 let s' = String.sub s 0 i in
1121 let s'' = String.sub s (i+sublen) (len-i-sublen) in
1122 s' ^ s2 ^ replace_str s'' s1 s2
1125 let rec string_split sep str =
1126 let len = String.length str in
1127 let seplen = String.length sep in
1128 let i = find str sep in
1129 if i = -1 then [str]
1131 let s' = String.sub str 0 i in
1132 let s'' = String.sub str (i+seplen) (len-i-seplen) in
1133 s' :: string_split sep s''
1136 let rec find_map f = function
1137 | [] -> raise Not_found
1141 | None -> find_map f xs
1144 let rec loop i = function
1146 | x :: xs -> f i x; loop (i+1) xs
1151 let rec loop i = function
1153 | x :: xs -> let r = f i x in r :: loop (i+1) xs
1157 let name_of_argt = function
1158 | String n | OptString n | StringList n | Bool n | Int n -> n
1160 (* Check function names etc. for consistency. *)
1161 let check_functions () =
1162 let contains_uppercase str =
1163 let len = String.length str in
1165 if i >= len then false
1168 if c >= 'A' && c <= 'Z' then true
1175 (* Check function names. *)
1177 fun (name, _, _, _, _, _, _) ->
1178 if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
1179 failwithf "function name %s does not need 'guestfs' prefix" name;
1180 if contains_uppercase name then
1181 failwithf "function name %s should not contain uppercase chars" name;
1182 if String.contains name '-' then
1183 failwithf "function name %s should not contain '-', use '_' instead."
1187 (* Check function parameter/return names. *)
1189 fun (name, style, _, _, _, _, _) ->
1190 let check_arg_ret_name n =
1191 if contains_uppercase n then
1192 failwithf "%s param/ret %s should not contain uppercase chars"
1194 if String.contains n '-' || String.contains n '_' then
1195 failwithf "%s param/ret %s should not contain '-' or '_'"
1198 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;
1199 if n = "argv" || n = "args" then
1200 failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" n
1203 (match fst style with
1205 | RInt n | RBool n | RConstString n | RString n
1206 | RStringList n | RPVList n | RVGList n | RLVList n ->
1207 check_arg_ret_name n
1209 check_arg_ret_name n;
1210 check_arg_ret_name m
1212 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
1215 (* Check short descriptions. *)
1217 fun (name, _, _, _, _, shortdesc, _) ->
1218 if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
1219 failwithf "short description of %s should begin with lowercase." name;
1220 let c = shortdesc.[String.length shortdesc-1] in
1221 if c = '\n' || c = '.' then
1222 failwithf "short description of %s should not end with . or \\n." name
1225 (* Check long dscriptions. *)
1227 fun (name, _, _, _, _, _, longdesc) ->
1228 if longdesc.[String.length longdesc-1] = '\n' then
1229 failwithf "long description of %s should not end with \\n." name
1232 (* Check proc_nrs. *)
1234 fun (name, _, proc_nr, _, _, _, _) ->
1235 if proc_nr <= 0 then
1236 failwithf "daemon function %s should have proc_nr > 0" name
1240 fun (name, _, proc_nr, _, _, _, _) ->
1241 if proc_nr <> -1 then
1242 failwithf "non-daemon function %s should have proc_nr -1" name
1243 ) non_daemon_functions;
1246 List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
1249 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
1250 let rec loop = function
1253 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
1255 | (name1,nr1) :: (name2,nr2) :: _ ->
1256 failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
1261 (* 'pr' prints to the current output file. *)
1262 let chan = ref stdout
1263 let pr fs = ksprintf (output_string !chan) fs
1265 (* Generate a header block in a number of standard styles. *)
1266 type comment_style = CStyle | HashStyle | OCamlStyle
1267 type license = GPLv2 | LGPLv2
1269 let generate_header comment license =
1270 let c = match comment with
1271 | CStyle -> pr "/* "; " *"
1272 | HashStyle -> pr "# "; "#"
1273 | OCamlStyle -> pr "(* "; " *" in
1274 pr "libguestfs generated file\n";
1275 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
1276 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
1278 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
1282 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
1283 pr "%s it under the terms of the GNU General Public License as published by\n" c;
1284 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
1285 pr "%s (at your option) any later version.\n" c;
1287 pr "%s This program is distributed in the hope that it will be useful,\n" c;
1288 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1289 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
1290 pr "%s GNU General Public License for more details.\n" c;
1292 pr "%s You should have received a copy of the GNU General Public License along\n" c;
1293 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
1294 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
1297 pr "%s This library is free software; you can redistribute it and/or\n" c;
1298 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
1299 pr "%s License as published by the Free Software Foundation; either\n" c;
1300 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
1302 pr "%s This library is distributed in the hope that it will be useful,\n" c;
1303 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
1304 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
1305 pr "%s Lesser General Public License for more details.\n" c;
1307 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
1308 pr "%s License along with this library; if not, write to the Free Software\n" c;
1309 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
1312 | CStyle -> pr " */\n"
1314 | OCamlStyle -> pr " *)\n"
1318 (* Start of main code generation functions below this line. *)
1320 (* Generate the pod documentation for the C API. *)
1321 let rec generate_actions_pod () =
1323 fun (shortname, style, _, flags, _, _, longdesc) ->
1324 let name = "guestfs_" ^ shortname in
1325 pr "=head2 %s\n\n" name;
1327 generate_prototype ~extern:false ~handle:"handle" name style;
1329 pr "%s\n\n" longdesc;
1330 (match fst style with
1332 pr "This function returns 0 on success or -1 on error.\n\n"
1334 pr "On error this function returns -1.\n\n"
1336 pr "This function returns a C truth value on success or -1 on error.\n\n"
1338 pr "This function returns a string or NULL on error.
1339 The string is owned by the guest handle and must I<not> be freed.\n\n"
1341 pr "This function returns a string or NULL on error.
1342 I<The caller must free the returned string after use>.\n\n"
1344 pr "This function returns a NULL-terminated array of strings
1345 (like L<environ(3)>), or NULL if there was an error.
1346 I<The caller must free the strings and the array after use>.\n\n"
1348 pr "This function returns a C<struct guestfs_int_bool *>.
1349 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
1351 pr "This function returns a C<struct guestfs_lvm_pv_list *>.
1352 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
1354 pr "This function returns a C<struct guestfs_lvm_vg_list *>.
1355 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
1357 pr "This function returns a C<struct guestfs_lvm_lv_list *>.
1358 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
1360 if List.mem ProtocolLimitWarning flags then
1361 pr "%s\n\n" protocol_limit_warning;
1362 if List.mem DangerWillRobinson flags then
1363 pr "%s\n\n" danger_will_robinson;
1364 ) all_functions_sorted
1366 and generate_structs_pod () =
1367 (* LVM structs documentation. *)
1370 pr "=head2 guestfs_lvm_%s\n" typ;
1372 pr " struct guestfs_lvm_%s {\n" typ;
1375 | name, `String -> pr " char *%s;\n" name
1377 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
1378 pr " char %s[32];\n" name
1379 | name, `Bytes -> pr " uint64_t %s;\n" name
1380 | name, `Int -> pr " int64_t %s;\n" name
1381 | name, `OptPercent ->
1382 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
1383 pr " float %s;\n" name
1386 pr " struct guestfs_lvm_%s_list {\n" typ;
1387 pr " uint32_t len; /* Number of elements in list. */\n";
1388 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
1391 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
1394 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1396 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
1397 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
1399 * We have to use an underscore instead of a dash because otherwise
1400 * rpcgen generates incorrect code.
1402 * This header is NOT exported to clients, but see also generate_structs_h.
1404 and generate_xdr () =
1405 generate_header CStyle LGPLv2;
1407 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
1408 pr "typedef string str<>;\n";
1411 (* LVM internal structures. *)
1415 pr "struct guestfs_lvm_int_%s {\n" typ;
1417 | name, `String -> pr " string %s<>;\n" name
1418 | name, `UUID -> pr " opaque %s[32];\n" name
1419 | name, `Bytes -> pr " hyper %s;\n" name
1420 | name, `Int -> pr " hyper %s;\n" name
1421 | name, `OptPercent -> pr " float %s;\n" name
1425 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
1427 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1430 fun (shortname, style, _, _, _, _, _) ->
1431 let name = "guestfs_" ^ shortname in
1433 (match snd style with
1436 pr "struct %s_args {\n" name;
1439 | String n -> pr " string %s<>;\n" n
1440 | OptString n -> pr " str *%s;\n" n
1441 | StringList n -> pr " str %s<>;\n" n
1442 | Bool n -> pr " bool %s;\n" n
1443 | Int n -> pr " int %s;\n" n
1447 (match fst style with
1450 pr "struct %s_ret {\n" name;
1454 pr "struct %s_ret {\n" name;
1458 failwithf "RConstString cannot be returned from a daemon function"
1460 pr "struct %s_ret {\n" name;
1461 pr " string %s<>;\n" n;
1464 pr "struct %s_ret {\n" name;
1465 pr " str %s<>;\n" n;
1468 pr "struct %s_ret {\n" name;
1473 pr "struct %s_ret {\n" name;
1474 pr " guestfs_lvm_int_pv_list %s;\n" n;
1477 pr "struct %s_ret {\n" name;
1478 pr " guestfs_lvm_int_vg_list %s;\n" n;
1481 pr "struct %s_ret {\n" name;
1482 pr " guestfs_lvm_int_lv_list %s;\n" n;
1487 (* Table of procedure numbers. *)
1488 pr "enum guestfs_procedure {\n";
1490 fun (shortname, _, proc_nr, _, _, _, _) ->
1491 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
1493 pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
1497 (* Having to choose a maximum message size is annoying for several
1498 * reasons (it limits what we can do in the API), but it (a) makes
1499 * the protocol a lot simpler, and (b) provides a bound on the size
1500 * of the daemon which operates in limited memory space. For large
1501 * file transfers you should use FTP.
1503 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
1506 (* Message header, etc. *)
1508 const GUESTFS_PROGRAM = 0x2000F5F5;
1509 const GUESTFS_PROTOCOL_VERSION = 1;
1511 enum guestfs_message_direction {
1512 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
1513 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
1516 enum guestfs_message_status {
1517 GUESTFS_STATUS_OK = 0,
1518 GUESTFS_STATUS_ERROR = 1
1521 const GUESTFS_ERROR_LEN = 256;
1523 struct guestfs_message_error {
1524 string error<GUESTFS_ERROR_LEN>; /* error message */
1527 struct guestfs_message_header {
1528 unsigned prog; /* GUESTFS_PROGRAM */
1529 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
1530 guestfs_procedure proc; /* GUESTFS_PROC_x */
1531 guestfs_message_direction direction;
1532 unsigned serial; /* message serial number */
1533 guestfs_message_status status;
1537 (* Generate the guestfs-structs.h file. *)
1538 and generate_structs_h () =
1539 generate_header CStyle LGPLv2;
1541 (* This is a public exported header file containing various
1542 * structures. The structures are carefully written to have
1543 * exactly the same in-memory format as the XDR structures that
1544 * we use on the wire to the daemon. The reason for creating
1545 * copies of these structures here is just so we don't have to
1546 * export the whole of guestfs_protocol.h (which includes much
1547 * unrelated and XDR-dependent stuff that we don't want to be
1548 * public, or required by clients).
1550 * To reiterate, we will pass these structures to and from the
1551 * client with a simple assignment or memcpy, so the format
1552 * must be identical to what rpcgen / the RFC defines.
1555 (* guestfs_int_bool structure. *)
1556 pr "struct guestfs_int_bool {\n";
1562 (* LVM public structures. *)
1566 pr "struct guestfs_lvm_%s {\n" typ;
1569 | name, `String -> pr " char *%s;\n" name
1570 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
1571 | name, `Bytes -> pr " uint64_t %s;\n" name
1572 | name, `Int -> pr " int64_t %s;\n" name
1573 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
1577 pr "struct guestfs_lvm_%s_list {\n" typ;
1578 pr " uint32_t len;\n";
1579 pr " struct guestfs_lvm_%s *val;\n" typ;
1582 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1584 (* Generate the guestfs-actions.h file. *)
1585 and generate_actions_h () =
1586 generate_header CStyle LGPLv2;
1588 fun (shortname, style, _, _, _, _, _) ->
1589 let name = "guestfs_" ^ shortname in
1590 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
1594 (* Generate the client-side dispatch stubs. *)
1595 and generate_client_actions () =
1596 generate_header CStyle LGPLv2;
1598 (* Client-side stubs for each function. *)
1600 fun (shortname, style, _, _, _, _, _) ->
1601 let name = "guestfs_" ^ shortname in
1603 (* Generate the return value struct. *)
1604 pr "struct %s_rv {\n" shortname;
1605 pr " int cb_done; /* flag to indicate callback was called */\n";
1606 pr " struct guestfs_message_header hdr;\n";
1607 pr " struct guestfs_message_error err;\n";
1608 (match fst style with
1611 failwithf "RConstString cannot be returned from a daemon function"
1613 | RBool _ | RString _ | RStringList _
1615 | RPVList _ | RVGList _ | RLVList _ ->
1616 pr " struct %s_ret ret;\n" name
1620 (* Generate the callback function. *)
1621 pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
1623 pr " struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
1625 pr " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
1626 pr " error (g, \"%s: failed to parse reply header\");\n" name;
1629 pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
1630 pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
1631 pr " error (g, \"%s: failed to parse reply error\");\n" name;
1637 (match fst style with
1640 failwithf "RConstString cannot be returned from a daemon function"
1642 | RBool _ | RString _ | RStringList _
1644 | RPVList _ | RVGList _ | RLVList _ ->
1645 pr " if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
1646 pr " error (g, \"%s: failed to parse reply\");\n" name;
1652 pr " rv->cb_done = 1;\n";
1653 pr " main_loop.main_loop_quit (g);\n";
1656 (* Generate the action stub. *)
1657 generate_prototype ~extern:false ~semicolon:false ~newline:true
1658 ~handle:"g" name style;
1661 match fst style with
1662 | RErr | RInt _ | RBool _ -> "-1"
1664 failwithf "RConstString cannot be returned from a daemon function"
1665 | RString _ | RStringList _ | RIntBool _
1666 | RPVList _ | RVGList _ | RLVList _ ->
1671 (match snd style with
1673 | _ -> pr " struct %s_args args;\n" name
1676 pr " struct %s_rv rv;\n" shortname;
1677 pr " int serial;\n";
1679 pr " if (g->state != READY) {\n";
1680 pr " error (g, \"%s called from the wrong state, %%d != READY\",\n"
1683 pr " return %s;\n" error_code;
1686 pr " memset (&rv, 0, sizeof rv);\n";
1689 (match snd style with
1691 pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
1692 (String.uppercase shortname)
1697 pr " args.%s = (char *) %s;\n" n n
1699 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
1701 pr " args.%s.%s_val = (char **) %s;\n" n n n;
1702 pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
1704 pr " args.%s = %s;\n" n n
1706 pr " args.%s = %s;\n" n n
1708 pr " serial = dispatch (g, GUESTFS_PROC_%s,\n"
1709 (String.uppercase shortname);
1710 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
1713 pr " if (serial == -1)\n";
1714 pr " return %s;\n" error_code;
1717 pr " rv.cb_done = 0;\n";
1718 pr " g->reply_cb_internal = %s_cb;\n" shortname;
1719 pr " g->reply_cb_internal_data = &rv;\n";
1720 pr " main_loop.main_loop_run (g);\n";
1721 pr " g->reply_cb_internal = NULL;\n";
1722 pr " g->reply_cb_internal_data = NULL;\n";
1723 pr " if (!rv.cb_done) {\n";
1724 pr " error (g, \"%s failed, see earlier error messages\");\n" name;
1725 pr " return %s;\n" error_code;
1729 pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
1730 (String.uppercase shortname);
1731 pr " return %s;\n" error_code;
1734 pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
1735 pr " error (g, \"%%s\", rv.err.error);\n";
1736 pr " return %s;\n" error_code;
1740 (match fst style with
1741 | RErr -> pr " return 0;\n"
1743 | RBool n -> pr " return rv.ret.%s;\n" n
1745 failwithf "RConstString cannot be returned from a daemon function"
1747 pr " return rv.ret.%s; /* caller will free */\n" n
1749 pr " /* caller will free this, but we need to add a NULL entry */\n";
1750 pr " rv.ret.%s.%s_val =" n n;
1751 pr " safe_realloc (g, rv.ret.%s.%s_val,\n" n n;
1752 pr " sizeof (char *) * (rv.ret.%s.%s_len + 1));\n"
1754 pr " rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
1755 pr " return rv.ret.%s.%s_val;\n" n n
1757 pr " /* caller with free this */\n";
1758 pr " return safe_memdup (g, &rv.ret, sizeof (rv.ret));\n"
1760 pr " /* caller will free this */\n";
1761 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1763 pr " /* caller will free this */\n";
1764 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1766 pr " /* caller will free this */\n";
1767 pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
1773 (* Generate daemon/actions.h. *)
1774 and generate_daemon_actions_h () =
1775 generate_header CStyle GPLv2;
1777 pr "#include \"../src/guestfs_protocol.h\"\n";
1781 fun (name, style, _, _, _, _, _) ->
1783 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
1787 (* Generate the server-side stubs. *)
1788 and generate_daemon_actions () =
1789 generate_header CStyle GPLv2;
1791 pr "#define _GNU_SOURCE // for strchrnul\n";
1793 pr "#include <stdio.h>\n";
1794 pr "#include <stdlib.h>\n";
1795 pr "#include <string.h>\n";
1796 pr "#include <inttypes.h>\n";
1797 pr "#include <ctype.h>\n";
1798 pr "#include <rpc/types.h>\n";
1799 pr "#include <rpc/xdr.h>\n";
1801 pr "#include \"daemon.h\"\n";
1802 pr "#include \"../src/guestfs_protocol.h\"\n";
1803 pr "#include \"actions.h\"\n";
1807 fun (name, style, _, _, _, _, _) ->
1808 (* Generate server-side stubs. *)
1809 pr "static void %s_stub (XDR *xdr_in)\n" name;
1812 match fst style with
1813 | RErr | RInt _ -> pr " int r;\n"; "-1"
1814 | RBool _ -> pr " int r;\n"; "-1"
1816 failwithf "RConstString cannot be returned from a daemon function"
1817 | RString _ -> pr " char *r;\n"; "NULL"
1818 | RStringList _ -> pr " char **r;\n"; "NULL"
1819 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
1820 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
1821 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
1822 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL" in
1824 (match snd style with
1827 pr " struct guestfs_%s_args args;\n" name;
1831 | OptString n -> pr " const char *%s;\n" n
1832 | StringList n -> pr " char **%s;\n" n
1833 | Bool n -> pr " int %s;\n" n
1834 | Int n -> pr " int %s;\n" n
1839 (match snd style with
1842 pr " memset (&args, 0, sizeof args);\n";
1844 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
1845 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
1850 | String n -> pr " %s = args.%s;\n" n n
1851 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
1853 pr " args.%s.%s_val = realloc (args.%s.%s_val, sizeof (char *) * (args.%s.%s_len+1));\n" n n n n n n;
1854 pr " args.%s.%s_val[args.%s.%s_len] = NULL;\n" n n n n;
1855 pr " %s = args.%s.%s_val;\n" n n n
1856 | Bool n -> pr " %s = args.%s;\n" n n
1857 | Int n -> pr " %s = args.%s;\n" n n
1862 pr " r = do_%s " name;
1863 generate_call_args style;
1866 pr " if (r == %s)\n" error_code;
1867 pr " /* do_%s has already called reply_with_error */\n" name;
1871 (match fst style with
1872 | RErr -> pr " reply (NULL, NULL);\n"
1874 pr " struct guestfs_%s_ret ret;\n" name;
1875 pr " ret.%s = r;\n" n;
1876 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1878 pr " struct guestfs_%s_ret ret;\n" name;
1879 pr " ret.%s = r;\n" n;
1880 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
1882 failwithf "RConstString cannot be returned from a daemon function"
1884 pr " struct guestfs_%s_ret ret;\n" name;
1885 pr " ret.%s = r;\n" n;
1886 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1889 pr " struct guestfs_%s_ret ret;\n" name;
1890 pr " ret.%s.%s_len = count_strings (r);\n" n n;
1891 pr " ret.%s.%s_val = r;\n" n n;
1892 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1893 pr " free_strings (r);\n"
1895 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name;
1896 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
1898 pr " struct guestfs_%s_ret ret;\n" name;
1899 pr " ret.%s = *r;\n" n;
1900 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1901 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1903 pr " struct guestfs_%s_ret ret;\n" name;
1904 pr " ret.%s = *r;\n" n;
1905 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1906 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1908 pr " struct guestfs_%s_ret ret;\n" name;
1909 pr " ret.%s = *r;\n" n;
1910 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
1911 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
1914 (* Free the args. *)
1915 (match snd style with
1920 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
1927 (* Dispatch function. *)
1928 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
1930 pr " switch (proc_nr) {\n";
1933 fun (name, style, _, _, _, _, _) ->
1934 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
1935 pr " %s_stub (xdr_in);\n" name;
1940 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
1945 (* LVM columns and tokenization functions. *)
1946 (* XXX This generates crap code. We should rethink how we
1952 pr "static const char *lvm_%s_cols = \"%s\";\n"
1953 typ (String.concat "," (List.map fst cols));
1956 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
1958 pr " char *tok, *p, *next;\n";
1962 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
1965 pr " if (!str) {\n";
1966 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
1969 pr " if (!*str || isspace (*str)) {\n";
1970 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
1975 fun (name, coltype) ->
1976 pr " if (!tok) {\n";
1977 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
1980 pr " p = strchrnul (tok, ',');\n";
1981 pr " if (*p) next = p+1; else next = NULL;\n";
1982 pr " *p = '\\0';\n";
1985 pr " r->%s = strdup (tok);\n" name;
1986 pr " if (r->%s == NULL) {\n" name;
1987 pr " perror (\"strdup\");\n";
1991 pr " for (i = j = 0; i < 32; ++j) {\n";
1992 pr " if (tok[j] == '\\0') {\n";
1993 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
1995 pr " } else if (tok[j] != '-')\n";
1996 pr " r->%s[i++] = tok[j];\n" name;
1999 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
2000 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2004 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
2005 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2009 pr " if (tok[0] == '\\0')\n";
2010 pr " r->%s = -1;\n" name;
2011 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
2012 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
2016 pr " tok = next;\n";
2019 pr " if (tok != NULL) {\n";
2020 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
2027 pr "guestfs_lvm_int_%s_list *\n" typ;
2028 pr "parse_command_line_%ss (void)\n" typ;
2030 pr " char *out, *err;\n";
2031 pr " char *p, *pend;\n";
2033 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
2034 pr " void *newp;\n";
2036 pr " ret = malloc (sizeof *ret);\n";
2037 pr " if (!ret) {\n";
2038 pr " reply_with_perror (\"malloc\");\n";
2039 pr " return NULL;\n";
2042 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
2043 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
2045 pr " r = command (&out, &err,\n";
2046 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
2047 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
2048 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
2049 pr " if (r == -1) {\n";
2050 pr " reply_with_error (\"%%s\", err);\n";
2051 pr " free (out);\n";
2052 pr " free (err);\n";
2053 pr " return NULL;\n";
2056 pr " free (err);\n";
2058 pr " /* Tokenize each line of the output. */\n";
2061 pr " while (p) {\n";
2062 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
2063 pr " if (pend) {\n";
2064 pr " *pend = '\\0';\n";
2068 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
2071 pr " if (!*p) { /* Empty line? Skip it. */\n";
2076 pr " /* Allocate some space to store this next entry. */\n";
2077 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
2078 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
2079 pr " if (newp == NULL) {\n";
2080 pr " reply_with_perror (\"realloc\");\n";
2081 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2082 pr " free (ret);\n";
2083 pr " free (out);\n";
2084 pr " return NULL;\n";
2086 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
2088 pr " /* Tokenize the next entry. */\n";
2089 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
2090 pr " if (r == -1) {\n";
2091 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
2092 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
2093 pr " free (ret);\n";
2094 pr " free (out);\n";
2095 pr " return NULL;\n";
2102 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
2104 pr " free (out);\n";
2105 pr " return ret;\n";
2108 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2110 (* Generate the tests. *)
2111 and generate_tests () =
2112 generate_header CStyle GPLv2;
2119 #include <sys/types.h>
2122 #include \"guestfs.h\"
2124 static guestfs_h *g;
2125 static int suppress_error = 0;
2127 static void print_error (guestfs_h *g, void *data, const char *msg)
2129 if (!suppress_error)
2130 fprintf (stderr, \"%%s\\n\", msg);
2133 static void print_strings (char * const * const argv)
2137 for (argc = 0; argv[argc] != NULL; ++argc)
2138 printf (\"\\t%%s\\n\", argv[argc]);
2145 fun (name, _, _, _, tests, _, _) ->
2146 mapi (generate_one_test name) tests
2148 let test_names = List.concat test_names in
2149 let nr_tests = List.length test_names in
2152 int main (int argc, char *argv[])
2160 g = guestfs_create ();
2162 printf (\"guestfs_create FAILED\\n\");
2166 guestfs_set_error_handler (g, print_error, NULL);
2168 srcdir = getenv (\"srcdir\");
2169 if (!srcdir) srcdir = \".\";
2170 guestfs_set_path (g, srcdir);
2172 snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);
2173 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2178 if (lseek (fd, %d, SEEK_SET) == -1) {
2184 if (write (fd, &c, 1) == -1) {
2190 if (close (fd) == -1) {
2195 if (guestfs_add_drive (g, buf) == -1) {
2196 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2200 snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);
2201 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2206 if (lseek (fd, %d, SEEK_SET) == -1) {
2212 if (write (fd, &c, 1) == -1) {
2218 if (close (fd) == -1) {
2223 if (guestfs_add_drive (g, buf) == -1) {
2224 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2228 snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);
2229 fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
2234 if (lseek (fd, %d, SEEK_SET) == -1) {
2240 if (write (fd, &c, 1) == -1) {
2246 if (close (fd) == -1) {
2251 if (guestfs_add_drive (g, buf) == -1) {
2252 printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
2256 if (guestfs_launch (g) == -1) {
2257 printf (\"guestfs_launch FAILED\\n\");
2260 if (guestfs_wait_ready (g) == -1) {
2261 printf (\"guestfs_wait_ready FAILED\\n\");
2265 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024);
2269 pr " printf (\"%3d/%3d %s\\n\");\n" (i+1) nr_tests test_name;
2270 pr " if (%s () == -1) {\n" test_name;
2271 pr " printf (\"%s FAILED\\n\");\n" test_name;
2277 pr " guestfs_close (g);\n";
2278 pr " snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);\n";
2279 pr " unlink (buf);\n";
2280 pr " snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);\n";
2281 pr " unlink (buf);\n";
2282 pr " snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);\n";
2283 pr " unlink (buf);\n";
2286 pr " if (failed > 0) {\n";
2287 pr " printf (\"***** %%d / %d tests FAILED *****\\n\", failed);\n"
2296 and generate_one_test name i (init, test) =
2297 let test_name = sprintf "test_%s_%d" name i in
2299 pr "static int %s (void)\n" test_name;
2305 pr " /* InitEmpty for %s (%d) */\n" name i;
2306 List.iter (generate_test_command_call test_name)
2310 pr " /* InitBasicFS for %s (%d): create ext2 on /dev/sda1 */\n" name i;
2311 List.iter (generate_test_command_call test_name)
2314 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2315 ["mkfs"; "ext2"; "/dev/sda1"];
2316 ["mount"; "/dev/sda1"; "/"]]
2317 | InitBasicFSonLVM ->
2318 pr " /* InitBasicFSonLVM for %s (%d): create ext2 on /dev/VG/LV */\n"
2320 List.iter (generate_test_command_call test_name)
2323 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2324 ["pvcreate"; "/dev/sda1"];
2325 ["vgcreate"; "VG"; "/dev/sda1"];
2326 ["lvcreate"; "LV"; "VG"; "8"];
2327 ["mkfs"; "ext2"; "/dev/VG/LV"];
2328 ["mount"; "/dev/VG/LV"; "/"]]
2331 let get_seq_last = function
2333 failwithf "%s: you cannot use [] (empty list) when expecting a command"
2336 let seq = List.rev seq in
2337 List.rev (List.tl seq), List.hd seq
2342 pr " /* TestRun for %s (%d) */\n" name i;
2343 List.iter (generate_test_command_call test_name) seq
2344 | TestOutput (seq, expected) ->
2345 pr " /* TestOutput for %s (%d) */\n" name i;
2346 let seq, last = get_seq_last seq in
2348 pr " if (strcmp (r, \"%s\") != 0) {\n" (c_quote expected);
2349 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r);\n" test_name (c_quote expected);
2353 List.iter (generate_test_command_call test_name) seq;
2354 generate_test_command_call ~test test_name last
2355 | TestOutputList (seq, expected) ->
2356 pr " /* TestOutputList for %s (%d) */\n" name i;
2357 let seq, last = get_seq_last seq in
2361 pr " if (!r[%d]) {\n" i;
2362 pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
2363 pr " print_strings (r);\n";
2366 pr " if (strcmp (r[%d], \"%s\") != 0) {\n" i (c_quote str);
2367 pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r[%d]);\n" test_name (c_quote str) i;
2371 pr " if (r[%d] != NULL) {\n" (List.length expected);
2372 pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
2374 pr " print_strings (r);\n";
2378 List.iter (generate_test_command_call test_name) seq;
2379 generate_test_command_call ~test test_name last
2380 | TestOutputInt (seq, expected) ->
2381 pr " /* TestOutputInt for %s (%d) */\n" name i;
2382 let seq, last = get_seq_last seq in
2384 pr " if (r != %d) {\n" expected;
2385 pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\", r);\n"
2390 List.iter (generate_test_command_call test_name) seq;
2391 generate_test_command_call ~test test_name last
2392 | TestOutputTrue seq ->
2393 pr " /* TestOutputTrue for %s (%d) */\n" name i;
2394 let seq, last = get_seq_last seq in
2397 pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n"
2402 List.iter (generate_test_command_call test_name) seq;
2403 generate_test_command_call ~test test_name last
2404 | TestOutputFalse seq ->
2405 pr " /* TestOutputFalse for %s (%d) */\n" name i;
2406 let seq, last = get_seq_last seq in
2409 pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n"
2414 List.iter (generate_test_command_call test_name) seq;
2415 generate_test_command_call ~test test_name last
2416 | TestOutputLength (seq, expected) ->
2417 pr " /* TestOutputLength for %s (%d) */\n" name i;
2418 let seq, last = get_seq_last seq in
2421 pr " for (j = 0; j < %d; ++j)\n" expected;
2422 pr " if (r[j] == NULL) {\n";
2423 pr " fprintf (stderr, \"%s: short list returned\\n\");\n"
2425 pr " print_strings (r);\n";
2428 pr " if (r[j] != NULL) {\n";
2429 pr " fprintf (stderr, \"%s: long list returned\\n\");\n"
2431 pr " print_strings (r);\n";
2435 List.iter (generate_test_command_call test_name) seq;
2436 generate_test_command_call ~test test_name last
2437 | TestLastFail seq ->
2438 pr " /* TestLastFail for %s (%d) */\n" name i;
2439 let seq, last = get_seq_last seq in
2440 List.iter (generate_test_command_call test_name) seq;
2441 generate_test_command_call test_name ~expect_error:true last
2449 (* Generate the code to run a command, leaving the result in 'r'.
2450 * If you expect to get an error then you should set expect_error:true.
2452 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
2454 | [] -> assert false
2456 (* Look up the command to find out what args/ret it has. *)
2459 let _, style, _, _, _, _, _ =
2460 List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
2463 failwithf "%s: in test, command %s was not found" test_name name in
2465 if List.length (snd style) <> List.length args then
2466 failwithf "%s: in test, wrong number of args given to %s"
2477 | StringList n, arg ->
2478 pr " char *%s[] = {\n" n;
2479 let strs = string_split " " arg in
2481 fun str -> pr " \"%s\",\n" (c_quote str)
2485 ) (List.combine (snd style) args);
2488 match fst style with
2489 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
2490 | RConstString _ -> pr " const char *r;\n"; "NULL"
2491 | RString _ -> pr " char *r;\n"; "NULL"
2497 pr " struct guestfs_int_bool *r;\n";
2500 pr " struct guestfs_lvm_pv_list *r;\n";
2503 pr " struct guestfs_lvm_vg_list *r;\n";
2506 pr " struct guestfs_lvm_lv_list *r;\n";
2509 pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
2510 pr " r = guestfs_%s (g" name;
2512 (* Generate the parameters. *)
2515 | String _, arg -> pr ", \"%s\"" (c_quote arg)
2516 | OptString _, arg ->
2517 if arg = "NULL" then pr ", NULL" else pr ", \"%s\"" (c_quote arg)
2518 | StringList n, _ ->
2522 try int_of_string arg
2523 with Failure "int_of_string" ->
2524 failwithf "%s: expecting an int, but got '%s'" test_name arg in
2527 let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
2528 ) (List.combine (snd style) args);
2531 if not expect_error then
2532 pr " if (r == %s)\n" error_code
2534 pr " if (r != %s)\n" error_code;
2537 (* Insert the test code. *)
2543 (match fst style with
2544 | RErr | RInt _ | RBool _ | RConstString _ -> ()
2545 | RString _ -> pr " free (r);\n"
2547 pr " for (i = 0; r[i] != NULL; ++i)\n";
2548 pr " free (r[i]);\n";
2551 pr " guestfs_free_int_bool (r);\n"
2553 pr " guestfs_free_lvm_pv_list (r);\n"
2555 pr " guestfs_free_lvm_vg_list (r);\n"
2557 pr " guestfs_free_lvm_lv_list (r);\n"
2563 let str = replace_str str "\r" "\\r" in
2564 let str = replace_str str "\n" "\\n" in
2565 let str = replace_str str "\t" "\\t" in
2568 (* Generate a lot of different functions for guestfish. *)
2569 and generate_fish_cmds () =
2570 generate_header CStyle GPLv2;
2574 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
2576 let all_functions_sorted =
2578 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
2579 ) all_functions_sorted in
2581 pr "#include <stdio.h>\n";
2582 pr "#include <stdlib.h>\n";
2583 pr "#include <string.h>\n";
2584 pr "#include <inttypes.h>\n";
2586 pr "#include <guestfs.h>\n";
2587 pr "#include \"fish.h\"\n";
2590 (* list_commands function, which implements guestfish -h *)
2591 pr "void list_commands (void)\n";
2593 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
2594 pr " list_builtin_commands ();\n";
2596 fun (name, _, _, flags, _, shortdesc, _) ->
2597 let name = replace_char name '_' '-' in
2598 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
2600 ) all_functions_sorted;
2601 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
2605 (* display_command function, which implements guestfish -h cmd *)
2606 pr "void display_command (const char *cmd)\n";
2609 fun (name, style, _, flags, _, shortdesc, longdesc) ->
2610 let name2 = replace_char name '_' '-' in
2612 try find_map (function FishAlias n -> Some n | _ -> None) flags
2613 with Not_found -> name in
2614 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
2616 match snd style with
2620 name2 (String.concat "> <" (List.map name_of_argt args)) in
2623 if List.mem ProtocolLimitWarning flags then
2624 ("\n\n" ^ protocol_limit_warning)
2627 (* For DangerWillRobinson commands, we should probably have
2628 * guestfish prompt before allowing you to use them (especially
2629 * in interactive mode). XXX
2633 if List.mem DangerWillRobinson flags then
2634 ("\n\n" ^ danger_will_robinson)
2637 let describe_alias =
2638 if name <> alias then
2639 sprintf "\n\nYou can use '%s' as an alias for this command." alias
2643 pr "strcasecmp (cmd, \"%s\") == 0" name;
2644 if name <> name2 then
2645 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
2646 if name <> alias then
2647 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
2649 pr " pod2text (\"%s - %s\", %S);\n"
2651 (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
2654 pr " display_builtin_command (cmd);\n";
2658 (* print_{pv,vg,lv}_list functions *)
2662 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
2669 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
2671 pr " printf (\"%s: \");\n" name;
2672 pr " for (i = 0; i < 32; ++i)\n";
2673 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
2674 pr " printf (\"\\n\");\n"
2676 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
2678 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
2679 | name, `OptPercent ->
2680 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
2681 typ name name typ name;
2682 pr " else printf (\"%s: \\n\");\n" name
2686 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
2691 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
2692 pr " print_%s (&%ss->val[i]);\n" typ typ;
2695 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2697 (* run_<action> actions *)
2699 fun (name, style, _, flags, _, _, _) ->
2700 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
2702 (match fst style with
2705 | RBool _ -> pr " int r;\n"
2706 | RConstString _ -> pr " const char *r;\n"
2707 | RString _ -> pr " char *r;\n"
2708 | RStringList _ -> pr " char **r;\n"
2709 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
2710 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
2711 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
2712 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
2717 | OptString n -> pr " const char *%s;\n" n
2718 | StringList n -> pr " char **%s;\n" n
2719 | Bool n -> pr " int %s;\n" n
2720 | Int n -> pr " int %s;\n" n
2723 (* Check and convert parameters. *)
2724 let argc_expected = List.length (snd style) in
2725 pr " if (argc != %d) {\n" argc_expected;
2726 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
2728 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
2734 | String name -> pr " %s = argv[%d];\n" name i
2736 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
2738 | StringList name ->
2739 pr " %s = parse_string_list (argv[%d]);\n" name i
2741 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
2743 pr " %s = atoi (argv[%d]);\n" name i
2746 (* Call C API function. *)
2748 try find_map (function FishAction n -> Some n | _ -> None) flags
2749 with Not_found -> sprintf "guestfs_%s" name in
2751 generate_call_args ~handle:"g" style;
2754 (* Check return value for errors and display command results. *)
2755 (match fst style with
2756 | RErr -> pr " return r;\n"
2758 pr " if (r == -1) return -1;\n";
2759 pr " if (r) printf (\"%%d\\n\", r);\n";
2762 pr " if (r == -1) return -1;\n";
2763 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
2766 pr " if (r == NULL) return -1;\n";
2767 pr " printf (\"%%s\\n\", r);\n";
2770 pr " if (r == NULL) return -1;\n";
2771 pr " printf (\"%%s\\n\", r);\n";
2775 pr " if (r == NULL) return -1;\n";
2776 pr " print_strings (r);\n";
2777 pr " free_strings (r);\n";
2780 pr " if (r == NULL) return -1;\n";
2781 pr " printf (\"%%d, %%s\\n\", r->i,\n";
2782 pr " r->b ? \"true\" : \"false\");\n";
2783 pr " guestfs_free_int_bool (r);\n";
2786 pr " if (r == NULL) return -1;\n";
2787 pr " print_pv_list (r);\n";
2788 pr " guestfs_free_lvm_pv_list (r);\n";
2791 pr " if (r == NULL) return -1;\n";
2792 pr " print_vg_list (r);\n";
2793 pr " guestfs_free_lvm_vg_list (r);\n";
2796 pr " if (r == NULL) return -1;\n";
2797 pr " print_lv_list (r);\n";
2798 pr " guestfs_free_lvm_lv_list (r);\n";
2805 (* run_action function *)
2806 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
2809 fun (name, _, _, flags, _, _, _) ->
2810 let name2 = replace_char name '_' '-' in
2812 try find_map (function FishAlias n -> Some n | _ -> None) flags
2813 with Not_found -> name in
2815 pr "strcasecmp (cmd, \"%s\") == 0" name;
2816 if name <> name2 then
2817 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
2818 if name <> alias then
2819 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
2821 pr " return run_%s (cmd, argc, argv);\n" name;
2825 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
2832 (* Generate the POD documentation for guestfish. *)
2833 and generate_fish_actions_pod () =
2834 let all_functions_sorted =
2836 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
2837 ) all_functions_sorted in
2840 fun (name, style, _, flags, _, _, longdesc) ->
2841 let longdesc = replace_str longdesc "C<guestfs_" "C<" in
2842 let name = replace_char name '_' '-' in
2844 try find_map (function FishAlias n -> Some n | _ -> None) flags
2845 with Not_found -> name in
2847 pr "=head2 %s" name;
2848 if name <> alias then
2855 | String n -> pr " %s" n
2856 | OptString n -> pr " %s" n
2857 | StringList n -> pr " %s,..." n
2858 | Bool _ -> pr " true|false"
2859 | Int n -> pr " %s" n
2863 pr "%s\n\n" longdesc;
2865 if List.mem ProtocolLimitWarning flags then
2866 pr "%s\n\n" protocol_limit_warning;
2868 if List.mem DangerWillRobinson flags then
2869 pr "%s\n\n" danger_will_robinson
2870 ) all_functions_sorted
2872 (* Generate a C function prototype. *)
2873 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
2874 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
2876 ?handle name style =
2877 if extern then pr "extern ";
2878 if static then pr "static ";
2879 (match fst style with
2881 | RInt _ -> pr "int "
2882 | RBool _ -> pr "int "
2883 | RConstString _ -> pr "const char *"
2884 | RString _ -> pr "char *"
2885 | RStringList _ -> pr "char **"
2887 if not in_daemon then pr "struct guestfs_int_bool *"
2888 else pr "guestfs_%s_ret *" name
2890 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
2891 else pr "guestfs_lvm_int_pv_list *"
2893 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
2894 else pr "guestfs_lvm_int_vg_list *"
2896 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
2897 else pr "guestfs_lvm_int_lv_list *"
2899 pr "%s%s (" prefix name;
2900 if handle = None && List.length (snd style) = 0 then
2903 let comma = ref false in
2906 | Some handle -> pr "guestfs_h *%s" handle; comma := true
2910 if single_line then pr ", " else pr ",\n\t\t"
2916 | String n -> next (); pr "const char *%s" n
2917 | OptString n -> next (); pr "const char *%s" n
2918 | StringList n -> next (); pr "char * const* const %s" n
2919 | Bool n -> next (); pr "int %s" n
2920 | Int n -> next (); pr "int %s" n
2924 if semicolon then pr ";";
2925 if newline then pr "\n"
2927 (* Generate C call arguments, eg "(handle, foo, bar)" *)
2928 and generate_call_args ?handle style =
2930 let comma = ref false in
2933 | Some handle -> pr "%s" handle; comma := true
2937 if !comma then pr ", ";
2944 | Int n -> pr "%s" n
2948 (* Generate the OCaml bindings interface. *)
2949 and generate_ocaml_mli () =
2950 generate_header OCamlStyle LGPLv2;
2953 (** For API documentation you should refer to the C API
2954 in the guestfs(3) manual page. The OCaml API uses almost
2955 exactly the same calls. *)
2958 (** A [guestfs_h] handle. *)
2960 exception Error of string
2961 (** This exception is raised when there is an error. *)
2963 val create : unit -> t
2965 val close : t -> unit
2966 (** Handles are closed by the garbage collector when they become
2967 unreferenced, but callers can also call this in order to
2968 provide predictable cleanup. *)
2971 generate_ocaml_lvm_structure_decls ();
2975 fun (name, style, _, _, _, shortdesc, _) ->
2976 generate_ocaml_prototype name style;
2977 pr "(** %s *)\n" shortdesc;
2981 (* Generate the OCaml bindings implementation. *)
2982 and generate_ocaml_ml () =
2983 generate_header OCamlStyle LGPLv2;
2987 exception Error of string
2988 external create : unit -> t = \"ocaml_guestfs_create\"
2989 external close : t -> unit = \"ocaml_guestfs_close\"
2992 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
2996 generate_ocaml_lvm_structure_decls ();
3000 fun (name, style, _, _, _, shortdesc, _) ->
3001 generate_ocaml_prototype ~is_external:true name style;
3004 (* Generate the OCaml bindings C implementation. *)
3005 and generate_ocaml_c () =
3006 generate_header CStyle LGPLv2;
3008 pr "#include <stdio.h>\n";
3009 pr "#include <stdlib.h>\n";
3010 pr "#include <string.h>\n";
3012 pr "#include <caml/config.h>\n";
3013 pr "#include <caml/alloc.h>\n";
3014 pr "#include <caml/callback.h>\n";
3015 pr "#include <caml/fail.h>\n";
3016 pr "#include <caml/memory.h>\n";
3017 pr "#include <caml/mlvalues.h>\n";
3018 pr "#include <caml/signals.h>\n";
3020 pr "#include <guestfs.h>\n";
3022 pr "#include \"guestfs_c.h\"\n";
3025 (* LVM struct copy functions. *)
3028 let has_optpercent_col =
3029 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
3031 pr "static CAMLprim value\n";
3032 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
3034 pr " CAMLparam0 ();\n";
3035 if has_optpercent_col then
3036 pr " CAMLlocal3 (rv, v, v2);\n"
3038 pr " CAMLlocal2 (rv, v);\n";
3040 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
3045 pr " v = caml_copy_string (%s->%s);\n" typ name
3047 pr " v = caml_alloc_string (32);\n";
3048 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
3051 pr " v = caml_copy_int64 (%s->%s);\n" typ name
3052 | name, `OptPercent ->
3053 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
3054 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
3055 pr " v = caml_alloc (1, 0);\n";
3056 pr " Store_field (v, 0, v2);\n";
3057 pr " } else /* None */\n";
3058 pr " v = Val_int (0);\n";
3060 pr " Store_field (rv, %d, v);\n" i
3062 pr " CAMLreturn (rv);\n";
3066 pr "static CAMLprim value\n";
3067 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
3070 pr " CAMLparam0 ();\n";
3071 pr " CAMLlocal2 (rv, v);\n";
3074 pr " if (%ss->len == 0)\n" typ;
3075 pr " CAMLreturn (Atom (0));\n";
3077 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
3078 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
3079 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
3080 pr " caml_modify (&Field (rv, i), v);\n";
3082 pr " CAMLreturn (rv);\n";
3086 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3089 fun (name, style, _, _, _, _, _) ->
3091 "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
3093 pr "CAMLprim value\n";
3094 pr "ocaml_guestfs_%s (value %s" name (List.hd params);
3095 List.iter (pr ", value %s") (List.tl params);
3100 | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
3101 pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
3102 pr " CAMLxparam%d (%s);\n"
3103 (List.length rest) (String.concat ", " rest)
3105 pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
3107 pr " CAMLlocal1 (rv);\n";
3110 pr " guestfs_h *g = Guestfs_val (gv);\n";
3111 pr " if (g == NULL)\n";
3112 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
3118 pr " const char *%s = String_val (%sv);\n" n n
3120 pr " const char *%s =\n" n;
3121 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
3124 pr " char **%s = ocaml_guestfs_strings_val (%sv);\n" n n
3126 pr " int %s = Bool_val (%sv);\n" n n
3128 pr " int %s = Int_val (%sv);\n" n n
3131 match fst style with
3132 | RErr -> pr " int r;\n"; "-1"
3133 | RInt _ -> pr " int r;\n"; "-1"
3134 | RBool _ -> pr " int r;\n"; "-1"
3135 | RConstString _ -> pr " const char *r;\n"; "NULL"
3136 | RString _ -> pr " char *r;\n"; "NULL"
3142 pr " struct guestfs_int_bool *r;\n";
3145 pr " struct guestfs_lvm_pv_list *r;\n";
3148 pr " struct guestfs_lvm_vg_list *r;\n";
3151 pr " struct guestfs_lvm_lv_list *r;\n";
3155 pr " caml_enter_blocking_section ();\n";
3156 pr " r = guestfs_%s " name;
3157 generate_call_args ~handle:"g" style;
3159 pr " caml_leave_blocking_section ();\n";
3164 pr " ocaml_guestfs_free_strings (%s);\n" n;
3165 | String _ | OptString _ | Bool _ | Int _ -> ()
3168 pr " if (r == %s)\n" error_code;
3169 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
3172 (match fst style with
3173 | RErr -> pr " rv = Val_unit;\n"
3174 | RInt _ -> pr " rv = Val_int (r);\n"
3175 | RBool _ -> pr " rv = Val_bool (r);\n"
3176 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
3178 pr " rv = caml_copy_string (r);\n";
3181 pr " rv = caml_copy_string_array ((const char **) r);\n";
3182 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
3185 pr " rv = caml_alloc (2, 0);\n";
3186 pr " Store_field (rv, 0, Val_int (r->i));\n";
3187 pr " Store_field (rv, 1, Val_bool (r->b));\n";
3188 pr " guestfs_free_int_bool (r);\n";
3190 pr " rv = copy_lvm_pv_list (r);\n";
3191 pr " guestfs_free_lvm_pv_list (r);\n";
3193 pr " rv = copy_lvm_vg_list (r);\n";
3194 pr " guestfs_free_lvm_vg_list (r);\n";
3196 pr " rv = copy_lvm_lv_list (r);\n";
3197 pr " guestfs_free_lvm_lv_list (r);\n";
3200 pr " CAMLreturn (rv);\n";
3204 if List.length params > 5 then (
3205 pr "CAMLprim value\n";
3206 pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
3208 pr " return ocaml_guestfs_%s (argv[0]" name;
3209 iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
3216 and generate_ocaml_lvm_structure_decls () =
3219 pr "type lvm_%s = {\n" typ;
3222 | name, `String -> pr " %s : string;\n" name
3223 | name, `UUID -> pr " %s : string;\n" name
3224 | name, `Bytes -> pr " %s : int64;\n" name
3225 | name, `Int -> pr " %s : int64;\n" name
3226 | name, `OptPercent -> pr " %s : float option;\n" name
3230 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
3232 and generate_ocaml_prototype ?(is_external = false) name style =
3233 if is_external then pr "external " else pr "val ";
3234 pr "%s : t -> " name;
3237 | String _ -> pr "string -> "
3238 | OptString _ -> pr "string option -> "
3239 | StringList _ -> pr "string array -> "
3240 | Bool _ -> pr "bool -> "
3241 | Int _ -> pr "int -> "
3243 (match fst style with
3244 | RErr -> pr "unit" (* all errors are turned into exceptions *)
3245 | RInt _ -> pr "int"
3246 | RBool _ -> pr "bool"
3247 | RConstString _ -> pr "string"
3248 | RString _ -> pr "string"
3249 | RStringList _ -> pr "string array"
3250 | RIntBool _ -> pr "int * bool"
3251 | RPVList _ -> pr "lvm_pv array"
3252 | RVGList _ -> pr "lvm_vg array"
3253 | RLVList _ -> pr "lvm_lv array"
3255 if is_external then (
3257 if List.length (snd style) + 1 > 5 then
3258 pr "\"ocaml_guestfs_%s_byte\" " name;
3259 pr "\"ocaml_guestfs_%s\"" name
3263 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
3264 and generate_perl_xs () =
3265 generate_header CStyle LGPLv2;
3268 #include \"EXTERN.h\"
3272 #include <guestfs.h>
3275 #define PRId64 \"lld\"
3279 my_newSVll(long long val) {
3280 #ifdef USE_64_BIT_ALL
3281 return newSViv(val);
3285 len = snprintf(buf, 100, \"%%\" PRId64, val);
3286 return newSVpv(buf, len);
3291 #define PRIu64 \"llu\"
3295 my_newSVull(unsigned long long val) {
3296 #ifdef USE_64_BIT_ALL
3297 return newSVuv(val);
3301 len = snprintf(buf, 100, \"%%\" PRIu64, val);
3302 return newSVpv(buf, len);
3306 /* http://www.perlmonks.org/?node_id=680842 */
3308 XS_unpack_charPtrPtr (SV *arg) {
3313 if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV) {
3314 croak (\"array reference expected\");
3317 av = (AV *)SvRV (arg);
3318 ret = (char **)malloc (av_len (av) + 1 + 1);
3320 for (i = 0; i <= av_len (av); i++) {
3321 SV **elem = av_fetch (av, i, 0);
3323 if (!elem || !*elem)
3324 croak (\"missing element in list\");
3326 ret[i] = SvPV_nolen (*elem);
3334 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
3339 RETVAL = guestfs_create ();
3341 croak (\"could not create guestfs handle\");
3342 guestfs_set_error_handler (RETVAL, NULL, NULL);
3355 fun (name, style, _, _, _, _, _) ->
3356 (match fst style with
3357 | RErr -> pr "void\n"
3358 | RInt _ -> pr "SV *\n"
3359 | RBool _ -> pr "SV *\n"
3360 | RConstString _ -> pr "SV *\n"
3361 | RString _ -> pr "SV *\n"
3364 | RPVList _ | RVGList _ | RLVList _ ->
3365 pr "void\n" (* all lists returned implictly on the stack *)
3367 (* Call and arguments. *)
3369 generate_call_args ~handle:"g" style;
3371 pr " guestfs_h *g;\n";
3374 | String n -> pr " char *%s;\n" n
3375 | OptString n -> pr " char *%s;\n" n
3376 | StringList n -> pr " char **%s;\n" n
3377 | Bool n -> pr " int %s;\n" n
3378 | Int n -> pr " int %s;\n" n
3381 let do_cleanups () =
3388 | StringList n -> pr " free (%s);\n" n
3393 (match fst style with
3398 pr " r = guestfs_%s " name;
3399 generate_call_args ~handle:"g" style;
3402 pr " if (r == -1)\n";
3403 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3409 pr " %s = guestfs_%s " n name;
3410 generate_call_args ~handle:"g" style;
3413 pr " if (%s == -1)\n" n;
3414 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3415 pr " RETVAL = newSViv (%s);\n" n;
3420 pr " const char *%s;\n" n;
3422 pr " %s = guestfs_%s " n name;
3423 generate_call_args ~handle:"g" style;
3426 pr " if (%s == NULL)\n" n;
3427 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3428 pr " RETVAL = newSVpv (%s, 0);\n" n;
3433 pr " char *%s;\n" n;
3435 pr " %s = guestfs_%s " n name;
3436 generate_call_args ~handle:"g" style;
3439 pr " if (%s == NULL)\n" n;
3440 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3441 pr " RETVAL = newSVpv (%s, 0);\n" n;
3442 pr " free (%s);\n" n;
3447 pr " char **%s;\n" n;
3450 pr " %s = guestfs_%s " n name;
3451 generate_call_args ~handle:"g" style;
3454 pr " if (%s == NULL)\n" n;
3455 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3456 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
3457 pr " EXTEND (SP, n);\n";
3458 pr " for (i = 0; i < n; ++i) {\n";
3459 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
3460 pr " free (%s[i]);\n" n;
3462 pr " free (%s);\n" n;
3465 pr " struct guestfs_int_bool *r;\n";
3467 pr " r = guestfs_%s " name;
3468 generate_call_args ~handle:"g" style;
3471 pr " if (r == NULL)\n";
3472 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3473 pr " EXTEND (SP, 2);\n";
3474 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
3475 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
3476 pr " guestfs_free_int_bool (r);\n";
3478 generate_perl_lvm_code "pv" pv_cols name style n do_cleanups;
3480 generate_perl_lvm_code "vg" vg_cols name style n do_cleanups;
3482 generate_perl_lvm_code "lv" lv_cols name style n do_cleanups;
3488 and generate_perl_lvm_code typ cols name style n do_cleanups =
3490 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
3494 pr " %s = guestfs_%s " n name;
3495 generate_call_args ~handle:"g" style;
3498 pr " if (%s == NULL)\n" n;
3499 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
3500 pr " EXTEND (SP, %s->len);\n" n;
3501 pr " for (i = 0; i < %s->len; ++i) {\n" n;
3502 pr " hv = newHV ();\n";
3506 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
3507 name (String.length name) n name
3509 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
3510 name (String.length name) n name
3512 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
3513 name (String.length name) n name
3515 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
3516 name (String.length name) n name
3517 | name, `OptPercent ->
3518 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
3519 name (String.length name) n name
3521 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
3523 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
3525 (* Generate Sys/Guestfs.pm. *)
3526 and generate_perl_pm () =
3527 generate_header HashStyle LGPLv2;
3534 Sys::Guestfs - Perl bindings for libguestfs
3540 my $h = Sys::Guestfs->new ();
3541 $h->add_drive ('guest.img');
3544 $h->mount ('/dev/sda1', '/');
3545 $h->touch ('/hello');
3550 The C<Sys::Guestfs> module provides a Perl XS binding to the
3551 libguestfs API for examining and modifying virtual machine
3554 Amongst the things this is good for: making batch configuration
3555 changes to guests, getting disk used/free statistics (see also:
3556 virt-df), migrating between virtualization systems (see also:
3557 virt-p2v), performing partial backups, performing partial guest
3558 clones, cloning guests and changing registry/UUID/hostname info, and
3561 Libguestfs uses Linux kernel and qemu code, and can access any type of
3562 guest filesystem that Linux and qemu can, including but not limited
3563 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
3564 schemes, qcow, qcow2, vmdk.
3566 Libguestfs provides ways to enumerate guest storage (eg. partitions,
3567 LVs, what filesystem is in each LV, etc.). It can also run commands
3568 in the context of the guest. Also you can access filesystems over FTP.
3572 All errors turn into calls to C<croak> (see L<Carp(3)>).
3580 package Sys::Guestfs;
3586 XSLoader::load ('Sys::Guestfs');
3588 =item $h = Sys::Guestfs->new ();
3590 Create a new guestfs handle.
3596 my $class = ref ($proto) || $proto;
3598 my $self = Sys::Guestfs::_create ();
3599 bless $self, $class;
3605 (* Actions. We only need to print documentation for these as
3606 * they are pulled in from the XS code automatically.
3609 fun (name, style, _, flags, _, _, longdesc) ->
3610 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
3612 generate_perl_prototype name style;
3614 pr "%s\n\n" longdesc;
3615 if List.mem ProtocolLimitWarning flags then
3616 pr "%s\n\n" protocol_limit_warning;
3617 if List.mem DangerWillRobinson flags then
3618 pr "%s\n\n" danger_will_robinson
3619 ) all_functions_sorted;
3631 Copyright (C) 2009 Red Hat Inc.
3635 Please see the file COPYING.LIB for the full license.
3639 L<guestfs(3)>, L<guestfish(1)>.
3644 and generate_perl_prototype name style =
3645 (match fst style with
3650 | RString n -> pr "$%s = " n
3651 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
3655 | RLVList n -> pr "@%s = " n
3658 let comma = ref false in
3661 if !comma then pr ", ";
3664 | String n | OptString n | Bool n | Int n ->
3671 (* Generate Python C module. *)
3672 and generate_python_c () =
3673 generate_header CStyle LGPLv2;
3682 #include \"guestfs.h\"
3690 get_handle (PyObject *obj)
3693 assert (obj != Py_None);
3694 return ((Pyguestfs_Object *) obj)->g;
3698 put_handle (guestfs_h *g)
3702 PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
3705 /* This list should be freed (but not the strings) after use. */
3706 static const char **
3707 get_string_list (PyObject *obj)
3714 if (!PyList_Check (obj)) {
3715 PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
3719 len = PyList_Size (obj);
3720 r = malloc (sizeof (char *) * (len+1));
3722 PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
3726 for (i = 0; i < len; ++i)
3727 r[i] = PyString_AsString (PyList_GetItem (obj, i));
3734 put_string_list (char * const * const argv)
3739 for (argc = 0; argv[argc] != NULL; ++argc)
3742 list = PyList_New (argc);
3743 for (i = 0; i < argc; ++i)
3744 PyList_SetItem (list, i, PyString_FromString (argv[i]));
3750 free_strings (char **argv)
3754 for (argc = 0; argv[argc] != NULL; ++argc)
3760 py_guestfs_create (PyObject *self, PyObject *args)
3764 g = guestfs_create ();
3766 PyErr_SetString (PyExc_RuntimeError,
3767 \"guestfs.create: failed to allocate handle\");
3770 guestfs_set_error_handler (g, NULL, NULL);
3771 return put_handle (g);
3775 py_guestfs_close (PyObject *self, PyObject *args)
3780 if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
3782 g = get_handle (py_g);
3786 Py_INCREF (Py_None);
3792 (* LVM structures, turned into Python dictionaries. *)
3795 pr "static PyObject *\n";
3796 pr "put_lvm_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
3798 pr " PyObject *dict;\n";
3800 pr " dict = PyDict_New ();\n";
3804 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
3805 pr " PyString_FromString (%s->%s));\n"
3808 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
3809 pr " PyString_FromStringAndSize (%s->%s, 32));\n"
3812 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
3813 pr " PyLong_FromUnsignedLongLong (%s->%s));\n"
3816 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
3817 pr " PyLong_FromLongLong (%s->%s));\n"
3819 | name, `OptPercent ->
3820 pr " if (%s->%s >= 0)\n" typ name;
3821 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
3822 pr " PyFloat_FromDouble ((double) %s->%s));\n"
3825 pr " Py_INCREF (Py_None);\n";
3826 pr " PyDict_SetItemString (dict, \"%s\", Py_None);" name;
3829 pr " return dict;\n";
3833 pr "static PyObject *\n";
3834 pr "put_lvm_%s_list (struct guestfs_lvm_%s_list *%ss)\n" typ typ typ;
3836 pr " PyObject *list;\n";
3839 pr " list = PyList_New (%ss->len);\n" typ;
3840 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
3841 pr " PyList_SetItem (list, i, put_lvm_%s (&%ss->val[i]));\n" typ typ;
3842 pr " return list;\n";
3845 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3847 (* Python wrapper functions. *)
3849 fun (name, style, _, _, _, _, _) ->
3850 pr "static PyObject *\n";
3851 pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
3854 pr " PyObject *py_g;\n";
3855 pr " guestfs_h *g;\n";
3856 pr " PyObject *py_r;\n";
3859 match fst style with
3860 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
3861 | RConstString _ -> pr " const char *r;\n"; "NULL"
3862 | RString _ -> pr " char *r;\n"; "NULL"
3863 | RStringList _ -> pr " char **r;\n"; "NULL"
3864 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
3865 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
3866 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
3867 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL" in
3871 | String n -> pr " const char *%s;\n" n
3872 | OptString n -> pr " const char *%s;\n" n
3874 pr " PyObject *py_%s;\n" n;
3875 pr " const char **%s;\n" n
3876 | Bool n -> pr " int %s;\n" n
3877 | Int n -> pr " int %s;\n" n
3882 (* Convert the parameters. *)
3883 pr " if (!PyArg_ParseTuple (args, (char *) \"O";
3886 | String _ -> pr "s"
3887 | OptString _ -> pr "z"
3888 | StringList _ -> pr "O"
3889 | Bool _ -> pr "i" (* XXX Python has booleans? *)
3892 pr ":guestfs_%s\",\n" name;
3896 | String n -> pr ", &%s" n
3897 | OptString n -> pr ", &%s" n
3898 | StringList n -> pr ", &py_%s" n
3899 | Bool n -> pr ", &%s" n
3900 | Int n -> pr ", &%s" n
3904 pr " return NULL;\n";
3906 pr " g = get_handle (py_g);\n";
3909 | String _ | OptString _ | Bool _ | Int _ -> ()
3911 pr " %s = get_string_list (py_%s);\n" n n;
3912 pr " if (!%s) return NULL;\n" n
3917 pr " r = guestfs_%s " name;
3918 generate_call_args ~handle:"g" style;
3923 | String _ | OptString _ | Bool _ | Int _ -> ()
3925 pr " free (%s);\n" n
3928 pr " if (r == %s) {\n" error_code;
3929 pr " PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
3930 pr " return NULL;\n";
3934 (match fst style with
3936 pr " Py_INCREF (Py_None);\n";
3937 pr " py_r = Py_None;\n"
3939 | RBool _ -> pr " py_r = PyInt_FromLong ((long) r);\n"
3940 | RConstString _ -> pr " py_r = PyString_FromString (r);\n"
3942 pr " py_r = PyString_FromString (r);\n";
3945 pr " py_r = put_string_list (r);\n";
3946 pr " free_strings (r);\n"
3948 pr " py_r = PyTuple_New (2);\n";
3949 pr " PyTuple_SetItem (py_r, 0, PyInt_FromLong ((long) r->i));\n";
3950 pr " PyTuple_SetItem (py_r, 1, PyInt_FromLong ((long) r->b));\n";
3951 pr " guestfs_free_int_bool (r);\n"
3953 pr " py_r = put_lvm_pv_list (r);\n";
3954 pr " guestfs_free_lvm_pv_list (r);\n"
3956 pr " py_r = put_lvm_vg_list (r);\n";
3957 pr " guestfs_free_lvm_vg_list (r);\n"
3959 pr " py_r = put_lvm_lv_list (r);\n";
3960 pr " guestfs_free_lvm_lv_list (r);\n"
3963 pr " return py_r;\n";
3968 (* Table of functions. *)
3969 pr "static PyMethodDef methods[] = {\n";
3970 pr " { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
3971 pr " { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
3973 fun (name, _, _, _, _, _, _) ->
3974 pr " { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
3977 pr " { NULL, NULL, 0, NULL }\n";
3981 (* Init function. *)
3984 initlibguestfsmod (void)
3986 static int initialized = 0;
3988 if (initialized) return;
3989 Py_InitModule ((char *) \"libguestfsmod\", methods);
3994 (* Generate Python module. *)
3995 and generate_python_py () =
3996 generate_header HashStyle LGPLv2;
3998 pr "import libguestfsmod\n";
4000 pr "class GuestFS:\n";
4001 pr " def __init__ (self):\n";
4002 pr " self._o = libguestfsmod.create ()\n";
4004 pr " def __del__ (self):\n";
4005 pr " libguestfsmod.close (self._o)\n";
4009 fun (name, style, _, _, _, _, _) ->
4011 generate_call_args ~handle:"self" style;
4013 pr " return libguestfsmod.%s " name;
4014 generate_call_args ~handle:"self._o" style;
4019 let output_to filename =
4020 let filename_new = filename ^ ".new" in
4021 chan := open_out filename_new;
4025 Unix.rename filename_new filename;
4026 printf "written %s\n%!" filename;
4034 if not (Sys.file_exists "configure.ac") then (
4036 You are probably running this from the wrong directory.
4037 Run it from the top source directory using the command
4043 let close = output_to "src/guestfs_protocol.x" in
4047 let close = output_to "src/guestfs-structs.h" in
4048 generate_structs_h ();
4051 let close = output_to "src/guestfs-actions.h" in
4052 generate_actions_h ();
4055 let close = output_to "src/guestfs-actions.c" in
4056 generate_client_actions ();
4059 let close = output_to "daemon/actions.h" in
4060 generate_daemon_actions_h ();
4063 let close = output_to "daemon/stubs.c" in
4064 generate_daemon_actions ();
4067 let close = output_to "tests.c" in
4071 let close = output_to "fish/cmds.c" in
4072 generate_fish_cmds ();
4075 let close = output_to "guestfs-structs.pod" in
4076 generate_structs_pod ();
4079 let close = output_to "guestfs-actions.pod" in
4080 generate_actions_pod ();
4083 let close = output_to "guestfish-actions.pod" in
4084 generate_fish_actions_pod ();
4087 let close = output_to "ocaml/guestfs.mli" in
4088 generate_ocaml_mli ();
4091 let close = output_to "ocaml/guestfs.ml" in
4092 generate_ocaml_ml ();
4095 let close = output_to "ocaml/guestfs_c_actions.c" in
4096 generate_ocaml_c ();
4099 let close = output_to "perl/Guestfs.xs" in
4100 generate_perl_xs ();
4103 let close = output_to "perl/lib/Sys/Guestfs.pm" in
4104 generate_perl_pm ();
4107 let close = output_to "python/guestfs-py.c" in
4108 generate_python_c ();
4111 let close = output_to "python/guestfs.py" in
4112 generate_python_py ();