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]
40 type style = ret * args
42 (* "RErr" as a return value means an int used as a simple error
43 * indication, ie. 0 or -1.
46 (* "RInt" as a return value means an int which is -1 for error
47 * or any value >= 0 on success. Only use this for smallish
48 * positive ints (0 <= i < 2^30).
51 (* "RInt64" is the same as RInt, but is guaranteed to be able
52 * to return a full 64 bit value, _except_ that -1 means error
53 * (so -1 cannot be a valid, non-error return value).
56 (* "RBool" is a bool return value which can be true/false or
60 (* "RConstString" is a string that refers to a constant value.
61 * Try to avoid using this. In particular you cannot use this
62 * for values returned from the daemon, because there is no
63 * thread-safe way to return them in the C API.
65 | RConstString of string
66 (* "RString" and "RStringList" are caller-frees. *)
68 | RStringList of string
69 (* Some limited tuples are possible: *)
70 | RIntBool of string * string
71 (* LVM PVs, VGs and LVs. *)
78 (* Key-value pairs of untyped strings. Turns into a hashtable or
79 * dictionary in languages which support it. DON'T use this as a
80 * general "bucket" for results. Prefer a stronger typed return
81 * value if one is available, or write a custom struct. Don't use
82 * this if the list could potentially be very long, since it is
83 * inefficient. Keys should be unique. NULLs are not permitted.
85 | RHashtable of string
87 and args = argt list (* Function parameters, guestfs handle is implicit. *)
89 (* Note in future we should allow a "variable args" parameter as
90 * the final parameter, to allow commands like
91 * chmod mode file [file(s)...]
92 * This is not implemented yet, but many commands (such as chmod)
93 * are currently defined with the argument order keeping this future
94 * possibility in mind.
97 | String of string (* const char *name, cannot be NULL *)
98 | OptString of string (* const char *name, may be NULL *)
99 | StringList of string(* list of strings (each string cannot be NULL) *)
100 | Bool of string (* boolean *)
101 | Int of string (* int (smallish ints, signed, <= 31 bits) *)
102 (* These are treated as filenames (simple string parameters) in
103 * the C API and bindings. But in the RPC protocol, we transfer
104 * the actual file content up to or down from the daemon.
105 * FileIn: local machine -> daemon (in request)
106 * FileOut: daemon -> local machine (in reply)
107 * In guestfish (only), the special name "-" means read from
108 * stdin or write to stdout.
114 | ProtocolLimitWarning (* display warning about protocol size limits *)
115 | DangerWillRobinson (* flags particularly dangerous commands *)
116 | FishAlias of string (* provide an alias for this cmd in guestfish *)
117 | FishAction of string (* call this function in guestfish *)
118 | NotInFish (* do not export via guestfish *)
119 | NotInDocs (* do not add this function to documentation *)
121 let protocol_limit_warning =
122 "Because of the message protocol, there is a transfer limit
123 of somewhere between 2MB and 4MB. To transfer large files you should use
126 let danger_will_robinson =
127 "B<This command is dangerous. Without careful use you
128 can easily destroy all your data>."
130 (* You can supply zero or as many tests as you want per API call.
132 * Note that the test environment has 3 block devices, of size 500MB,
133 * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc), and
134 * a fourth squashfs block device with some known files on it (/dev/sdd).
136 * Note for partitioning purposes, the 500MB device has 63 cylinders.
138 * The squashfs block device (/dev/sdd) comes from images/test.sqsh.
140 * To be able to run the tests in a reasonable amount of time,
141 * the virtual machine and block devices are reused between tests.
142 * So don't try testing kill_subprocess :-x
144 * Between each test we blockdev-setrw, umount-all, lvm-remove-all.
146 * If the appliance is running an older Linux kernel (eg. RHEL 5) then
147 * devices are named /dev/hda etc. To cope with this, the test suite
148 * adds some hairly logic to detect this case, and then automagically
149 * replaces all strings which match "/dev/sd.*" with "/dev/hd.*".
150 * When writing test cases you shouldn't have to worry about this
153 * Don't assume anything about the previous contents of the block
154 * devices. Use 'Init*' to create some initial scenarios.
156 * You can add a prerequisite clause to any individual test. This
157 * is a run-time check, which, if it fails, causes the test to be
158 * skipped. Useful if testing a command which might not work on
159 * all variations of libguestfs builds. A test that has prerequisite
160 * of 'Always' is run unconditionally.
162 * In addition, packagers can skip individual tests by setting the
163 * environment variables: eg:
164 * SKIP_TEST_<CMD>_<NUM>=1 SKIP_TEST_COMMAND_3=1 (skips test #3 of command)
165 * SKIP_TEST_<CMD>=1 SKIP_TEST_ZEROFREE=1 (skips all zerofree tests)
167 type tests = (test_init * test_prereq * test) list
169 (* Run the command sequence and just expect nothing to fail. *)
171 (* Run the command sequence and expect the output of the final
172 * command to be the string.
174 | TestOutput of seq * string
175 (* Run the command sequence and expect the output of the final
176 * command to be the list of strings.
178 | TestOutputList of seq * string list
179 (* Run the command sequence and expect the output of the final
180 * command to be the integer.
182 | TestOutputInt of seq * int
183 (* Run the command sequence and expect the output of the final
184 * command to be a true value (!= 0 or != NULL).
186 | TestOutputTrue of seq
187 (* Run the command sequence and expect the output of the final
188 * command to be a false value (== 0 or == NULL, but not an error).
190 | TestOutputFalse of seq
191 (* Run the command sequence and expect the output of the final
192 * command to be a list of the given length (but don't care about
195 | TestOutputLength of seq * int
196 (* Run the command sequence and expect the output of the final
197 * command to be a structure.
199 | TestOutputStruct of seq * test_field_compare list
200 (* Run the command sequence and expect the final command (only)
203 | TestLastFail of seq
205 and test_field_compare =
206 | CompareWithInt of string * int
207 | CompareWithString of string * string
208 | CompareFieldsIntEq of string * string
209 | CompareFieldsStrEq of string * string
211 (* Test prerequisites. *)
213 (* Test always runs. *)
215 (* Test is currently disabled - eg. it fails, or it tests some
216 * unimplemented feature.
219 (* 'string' is some C code (a function body) that should return
220 * true or false. The test will run if the code returns true.
223 (* As for 'If' but the test runs _unless_ the code returns true. *)
226 (* Some initial scenarios for testing. *)
228 (* Do nothing, block devices could contain random stuff including
229 * LVM PVs, and some filesystems might be mounted. This is usually
233 (* Block devices are empty and no filesystems are mounted. *)
235 (* /dev/sda contains a single partition /dev/sda1, which is formatted
236 * as ext2, empty [except for lost+found] and mounted on /.
237 * /dev/sdb and /dev/sdc may have random content.
242 * /dev/sda1 (is a PV):
243 * /dev/VG/LV (size 8MB):
244 * formatted as ext2, empty [except for lost+found], mounted on /
245 * /dev/sdb and /dev/sdc may have random content.
249 (* Sequence of commands for testing. *)
251 and cmd = string list
253 (* The short description is always a single, short line of plain text.
254 * Long descriptions use this limited "language" which is converted
255 * into the required formats on output (eg. perldoc, javadoc, etc.)
256 * At the top level, long descriptions are a list of paragraphs.
258 type longdesc = para list
260 | P of snippet list (* full paragraph *)
261 | Q of string (* same as P[T str] *)
262 | ItemList of (snippet list * para) list (* list of items *)
263 | BulletList of para list (* bullet point list *)
264 | Note of snippet list (* full note paragraph *)
265 | QNote of string (* same as Note[T str] *)
266 | Pre of string list (* preformatted lines *)
267 | SeeAlso of string list (* see also other commands *)
269 | T of string (* text *)
270 | C of string (* code *)
271 | A of string (* named parameter *)
272 | X of string (* cross-reference to other command *)
273 | XA of string * snippet list (* call command with args *)
274 | XU of string (* cross-reference to unimplemented *)
275 | XW of string (* cross-reference to wildcard *)
276 | Em of string (* emphasized text *)
277 | Man of string * int (* manpage (name, section) *)
278 | URL of string (* URL *)
279 | NULL (* "NULL", "undef" etc. *)
280 | NONNULL (* "non-NULL", "defined", etc. *)
282 (* These test functions are used in the language binding tests. *)
284 let test_all_args = [
287 StringList "strlist";
294 let test_all_rets = [
295 (* except for RErr, which is tested thoroughly elsewhere *)
296 "test0rint", RInt "valout";
297 "test0rint64", RInt64 "valout";
298 "test0rbool", RBool "valout";
299 "test0rconststring", RConstString "valout";
300 "test0rstring", RString "valout";
301 "test0rstringlist", RStringList "valout";
302 "test0rintbool", RIntBool ("valout", "valout");
303 "test0rpvlist", RPVList "valout";
304 "test0rvglist", RVGList "valout";
305 "test0rlvlist", RLVList "valout";
306 "test0rstat", RStat "valout";
307 "test0rstatvfs", RStatVFS "valout";
308 "test0rhashtable", RHashtable "valout";
311 let test_functions = [
312 ("test0", (RErr, test_all_args), -1, [NotInFish; NotInDocs],
314 "internal test function - do not use",
316 Q"This is an internal test function which is used to test whether
317 the automatically generated bindings can handle every possible
318 parameter type correctly.";
320 Q"It echos the contents of each parameter to stdout.";
322 Q"You probably don't want to call this function."]);
326 [(name, (ret, [String "val"]), -1, [NotInFish; NotInDocs],
328 "internal test function - do not use",
330 Q"This is an internal test function which is used to test whether
331 the automatically generated bindings can handle every possible
332 return type correctly.";
334 P[T"It converts string ";A"val";T" to the return type."];
336 Q"You probably don't want to call this function."]);
338 (name ^ "err", (ret, []), -1, [NotInFish; NotInDocs],
340 "internal test function - do not use",
342 Q"This is an internal test function which is used to test whether
343 the automatically generated bindings can handle every possible
344 return type correctly.";
346 Q"This function always returns an error.";
348 Q"You probably don't want to call this function."])]
352 (* non_daemon_functions are any functions which don't get processed
353 * in the daemon, eg. functions for setting and getting local
354 * configuration values.
357 let non_daemon_functions = test_functions @ [
358 ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
360 "launch the qemu subprocess",
362 P[T"Internally libguestfs is implemented by running a virtual machine
363 using ";Man("qemu",1);T"."];
365 Q"You should call this after configuring the handle
366 (eg. adding drives) but before performing any actions."]);
368 ("wait_ready", (RErr, []), -1, [NotInFish],
370 "wait until the qemu subprocess launches",
372 P[T"Internally libguestfs is implemented by running a virtual machine
373 using ";Man("qemu",1);T"."];
375 P[T"You should call this after ";X"launch"; T" to wait for the launch
378 ("kill_subprocess", (RErr, []), -1, [],
380 "kill the qemu subprocess",
382 Q"This kills the qemu subprocess. You should never need to call this."]);
384 ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
386 "add an image to examine or modify",
388 P[T"This function adds a virtual machine disk image ";A"filename";T" to the
389 guest. The first time you call this function, the disk appears as IDE
390 disk 0 (";C"/dev/sda";T") in the guest, the second time as ";C"/dev/sdb";T", and
393 Q"You don't necessarily need to be root when using libguestfs. However
394 you obviously do need sufficient permissions to access the filename
395 for whatever operations you want to perform (ie. read access if you
396 just want to read the image or write access if you want to modify the
399 P[T"This is equivalent to the qemu parameter ";C"-drive file=filename";T"."];
401 Note[T"Note that this call checks for the existence of ";A"filename";T". This
402 stops you from specifying other types of drive which are supported
403 by qemu such as ";C"nbd:";T" and ";C"http:";T" URLs. To specify those, use
404 the general ";X"config";T" call instead."]]);
406 ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
408 "add a CD-ROM disk image to examine",
410 Q"This function adds a virtual CD-ROM disk image to the guest.";
412 P[T"This is equivalent to the qemu parameter ";C"-cdrom filename";T"."];
414 Note[T"Note that this call checks for the existence of ";A"filename";T". This
415 stops you from specifying other types of drive which are supported
416 by qemu such as ";C"nbd:";T" and ";C"http:";T" URLs. To specify those, use
417 the general ";X"config";T" call instead."]]);
419 ("add_drive_ro", (RErr, [String "filename"]), -1, [FishAlias "add-ro"],
421 "add a drive in snapshot mode (read-only)",
423 Q"This adds a drive in snapshot mode, making it effectively
426 Q"Note that writes to the device are allowed, and will be seen for
427 the duration of the guestfs handle, but they are written
428 to a temporary file which is discarded as soon as the guestfs
429 handle is closed. We don't currently have any method to enable
430 changes to be committed, although qemu can support this.";
432 P[T"This is equivalent to the qemu parameter ";
433 C"-drive file=filename,snapshot=on";T"."];
435 Note[T"This call checks for the existence of ";A"filename";T". This
436 stops you from specifying other types of drive which are supported
437 by qemu such as ";C"nbd:";T" and ";C"http:";T" URLs. To specify those, use
438 the general ";X"config";T" call instead."]]);
440 ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
442 "add qemu parameters",
444 P[T"This can be used to add arbitrary qemu command line parameters
445 of the form ";C"-qemuparam qemuvalue";T".
446 Actually it's not quite arbitrary - we
447 prevent you from setting some parameters which would interfere with
448 parameters that we use."];
450 P[T"The first character of ";A"qemuparam";
451 T" string must be a ";C"-";T" (dash)."];
453 P[A"qemuvalue";T" can be ";NULL;T"."]]);
455 ("set_qemu", (RErr, [String "qemu"]), -1, [FishAlias "qemu"],
457 "set the qemu binary",
459 Q"Set the qemu binary that we will use.";
461 Q"The default is chosen when the library was compiled by the
464 P[T"You can also override this by setting the ";C"LIBGUESTFS_QEMU";
465 T" environment variable."];
467 P[T"Setting ";A"qemu";T" to ";NULL;T" restores the default qemu binary."]]);
469 ("get_qemu", (RConstString "qemu", []), -1, [],
471 "get the qemu binary",
473 Q"Return the current qemu binary.";
475 P[T"This is always ";NONNULL;T". If it wasn't set already, then this will
476 return the default qemu binary name."]]);
478 ("set_path", (RErr, [String "path"]), -1, [FishAlias "path"],
480 "set the search path",
482 Q"Set the path that libguestfs searches for kernel and initrd.img.";
484 P[T"The default is ";C"$libdir/guestfs";T" unless overridden by setting ";
485 C"LIBGUESTFS_PATH";T" environment variable."];
487 P[T"Setting ";A"path";T" to ";NULL;T" restores the default path."]]);
489 ("get_path", (RConstString "path", []), -1, [],
491 "get the search path",
493 Q"Return the current search path.";
495 P[T"This is always ";NONNULL;T". If it wasn't set already, then this will
496 return the default path."]]);
498 ("set_append", (RErr, [String "append"]), -1, [FishAlias "append"],
500 "add options to kernel command line",
502 Q"This function is used to add additional options to the
503 guest kernel command line.";
505 P[T"The default is ";NULL;T" unless overridden by setting ";
506 C"LIBGUESTFS_APPEND";T" environment variable."];
508 P[T"Setting ";A"append";T" to ";NULL;T" means ";Em"no";
509 T" additional options are passed
510 (libguestfs always adds a few of its own)."]]);
512 ("get_append", (RConstString "append", []), -1, [],
514 "get the additional kernel options",
516 Q"Return the additional kernel options which are added to the
517 guest kernel command line.";
519 P[T"If ";NULL;T" then no options are added."]]);
521 ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
525 P[T"If ";A"autosync";T" is true, this enables autosync. Libguestfs will make a
526 best effort attempt to run ";X"umount_all";T" followed by ";
527 X"sync";T" when the handle is closed
528 (also if the program exits without closing handles)."];
530 Q"This is disabled by default (except in guestfish where it is
531 enabled by default)."]);
533 ("get_autosync", (RBool "autosync", []), -1, [],
537 Q"Get the autosync flag."]);
539 ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
543 P[T"If ";A"verbose";T" is true, this turns on verbose messages
544 (to ";C"stderr";T")."];
546 P[T"Verbose messages are disabled unless the environment variable ";
547 C"LIBGUESTFS_DEBUG";T" is defined and set to ";C"1";T"."]]);
549 ("get_verbose", (RBool "verbose", []), -1, [],
553 Q"This returns the verbose messages flag."]);
555 ("is_ready", (RBool "ready", []), -1, [],
557 "is ready to accept commands",
559 P[T"This returns true iff this handle is ready to accept commands
560 (in the ";C"READY";T" state)."];
562 P[T"For more information on states, see ";Man("guestfs",3);T"."]]);
564 ("is_config", (RBool "config", []), -1, [],
566 "is in configuration state",
568 P[T"This returns true iff this handle is being configured
569 (in the ";C"CONFIG";T" state)."];
571 P[T"For more information on states, see ";Man("guestfs",3);T"."]]);
573 ("is_launching", (RBool "launching", []), -1, [],
575 "is launching subprocess",
577 P[T"This returns true iff this handle is launching the subprocess
578 (in the ";C"LAUNCHING";T" state)."];
580 P[T"For more information on states, see ";Man("guestfs",3);T"."]]);
582 ("is_busy", (RBool "busy", []), -1, [],
584 "is busy processing a command",
586 P[T"This returns true iff this handle is busy processing a command
587 (in the ";C"BUSY";T" state)."];
589 P[T"For more information on states, see ";Man("guestfs",3);T"."]]);
591 ("get_state", (RInt "state", []), -1, [],
593 "get the current state",
595 Q"This returns the current state as an opaque integer. This is
596 only useful for printing debug and internal error messages.";
598 P[T"For more information on states, see ";Man("guestfs",3);T"."]]);
600 ("set_busy", (RErr, []), -1, [NotInFish],
604 P[T"This sets the state to ";C"BUSY";T". This is only used when implementing
605 actions using the low-level API."];
607 P[T"For more information on states, see ";Man("guestfs",3);T"."]]);
609 ("set_ready", (RErr, []), -1, [NotInFish],
611 "set state to ready",
613 P[T"This sets the state to ";C"READY";T". This is only used when implementing
614 actions using the low-level API."];
616 P[T"For more information on states, see ";Man("guestfs",3);T"."]]);
618 ("end_busy", (RErr, []), -1, [NotInFish],
620 "leave the busy state",
622 P[T"This sets the state to ";C"READY";T", or if in ";C"CONFIG";
623 T" then it leaves the
624 state as is. This is only used when implementing
625 actions using the low-level API."];
627 P[T"For more information on states, see ";Man("guestfs",3);T"."]]);
631 (* daemon_functions are any functions which cause some action
632 * to take place in the daemon.
635 let daemon_functions = [
636 ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
637 [InitEmpty, Always, TestOutput (
638 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
639 ["mkfs"; "ext2"; "/dev/sda1"];
640 ["mount"; "/dev/sda1"; "/"];
641 ["write_file"; "/new"; "new file contents"; "0"];
642 ["cat"; "/new"]], "new file contents")],
643 "mount a guest disk at a position in the filesystem",
645 P[T"Mount a guest disk at a position in the filesystem. Block devices
646 are named ";C"/dev/sda";T", ";C"/dev/sdb";T" and so on, as they were added to
647 the guest. If those block devices contain partitions, they will have
648 the usual names (eg. ";C"/dev/sda1";T"). Also LVM ";C"/dev/VG/LV";T"-style
649 names can be used."];
651 P[T"The rules are the same as for ";Man("mount",8);T": A filesystem must
652 first be mounted on ";C"/";T" before others can be mounted. Other
653 filesystems can only be mounted on directories which already
656 Q"The mounted filesystem is writable, if we have sufficient permissions
657 on the underlying device.";
659 P[T"The filesystem options ";C"sync";T" and ";C"noatime";T" are set with this
660 call, in order to improve reliability."]]);
662 ("sync", (RErr, []), 2, [],
663 [ InitEmpty, Always, TestRun [["sync"]]],
664 "sync disks, writes are flushed through to the disk image",
666 Q"This syncs the disk, so that any writes are flushed through to the
667 underlying disk image.";
669 Q"You should always call this if you have modified a disk image, before
670 closing the handle."]);
672 ("touch", (RErr, [String "path"]), 3, [],
673 [InitBasicFS, Always, TestOutputTrue (
675 ["exists"; "/new"]])],
676 "update file timestamps or create a new file",
678 P[T"Touch acts like the ";Man("touch",1);T" command. It can be used to
679 update the timestamps on a file, or, if the file does not exist,
680 to create a new zero-length file."]]);
682 ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
683 [InitBasicFS, Always, TestOutput (
684 [["write_file"; "/new"; "new file contents"; "0"];
685 ["cat"; "/new"]], "new file contents")],
686 "list the contents of a file",
688 P[T"Return the contents of the file named ";A"path";T"."];
690 P[T"Note that this function cannot correctly handle binary files
691 (specifically, files containing ";C"\\0";T" character which is treated
692 as end of string). For those you need to use the ";X"download";
693 T" function which has a more complex interface."]]);
695 ("ll", (RString "listing", [String "directory"]), 5, [],
696 [], (* XXX Tricky to test because it depends on the exact format
697 * of the 'ls -l' command, which changes between F10 and F11.
699 "list the files in a directory (long format)",
701 P[T"List the files in ";A"directory";T" (relative to the root directory,
702 there is no cwd) in the format of ";C"ls -la";T"."];
704 P[T"This command is mostly useful for interactive sessions. It
705 is ";Em"not";T" intended that you try to parse the output string."]]);
707 ("ls", (RStringList "listing", [String "directory"]), 6, [],
708 [InitBasicFS, Always, TestOutputList (
711 ["touch"; "/newest"];
712 ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
713 "list the files in a directory",
715 P[T"List the files in ";A"directory";T" (relative to the root directory,
716 there is no cwd). The ";C".";T" and ";C"..";T" entries are not returned, but
717 hidden files are shown."]]);
719 ("list_devices", (RStringList "devices", []), 7, [],
720 [InitEmpty, Always, TestOutputList (
721 [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"; "/dev/sdd"])],
722 "list the block devices",
724 Q"List all the block devices.";
726 P[T"The full block device names are returned, eg. ";C"/dev/sda";T"."]]);
728 ("list_partitions", (RStringList "partitions", []), 8, [],
729 [InitBasicFS, Always, TestOutputList (
730 [["list_partitions"]], ["/dev/sda1"]);
731 InitEmpty, Always, TestOutputList (
732 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
733 ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
734 "list the partitions",
736 Q"List all the partitions detected on all block devices.";
738 P[T"The full partition device names are returned, eg. ";C"/dev/sda1"];
740 P[T"This does not return logical volumes. For that you will need to
741 call ";X"lvs";T"."]]);
743 ("pvs", (RStringList "physvols", []), 9, [],
744 [InitBasicFSonLVM, Always, TestOutputList (
745 [["pvs"]], ["/dev/sda1"]);
746 InitEmpty, Always, TestOutputList (
747 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
748 ["pvcreate"; "/dev/sda1"];
749 ["pvcreate"; "/dev/sda2"];
750 ["pvcreate"; "/dev/sda3"];
751 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
752 "list the LVM physical volumes (PVs)",
754 P[T"List all the physical volumes detected. This is the equivalent
755 of the ";Man("pvs",8);T" command."];
757 P[T"This returns a list of just the device names that contain
758 PVs (eg. ";C"/dev/sda2";T")."];
760 SeeAlso["pvs_full"]]);
762 ("vgs", (RStringList "volgroups", []), 10, [],
763 [InitBasicFSonLVM, Always, TestOutputList (
765 InitEmpty, Always, TestOutputList (
766 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
767 ["pvcreate"; "/dev/sda1"];
768 ["pvcreate"; "/dev/sda2"];
769 ["pvcreate"; "/dev/sda3"];
770 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
771 ["vgcreate"; "VG2"; "/dev/sda3"];
772 ["vgs"]], ["VG1"; "VG2"])],
773 "list the LVM volume groups (VGs)",
775 P[T"List all the volumes groups detected. This is the equivalent
776 of the ";Man("vgs",8);T" command."];
778 P[T"This returns a list of just the volume group names that were
779 detected (eg. ";C"VolGroup00";T")."];
781 SeeAlso["vgs_full"]]);
783 ("lvs", (RStringList "logvols", []), 11, [],
784 [InitBasicFSonLVM, Always, TestOutputList (
785 [["lvs"]], ["/dev/VG/LV"]);
786 InitEmpty, Always, TestOutputList (
787 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
788 ["pvcreate"; "/dev/sda1"];
789 ["pvcreate"; "/dev/sda2"];
790 ["pvcreate"; "/dev/sda3"];
791 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
792 ["vgcreate"; "VG2"; "/dev/sda3"];
793 ["lvcreate"; "LV1"; "VG1"; "50"];
794 ["lvcreate"; "LV2"; "VG1"; "50"];
795 ["lvcreate"; "LV3"; "VG2"; "50"];
796 ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
797 "list the LVM logical volumes (LVs)",
799 P[T"List all the logical volumes detected. This is the equivalent
800 of the ";Man("lvs",8);T" command."];
802 P[T"This returns a list of the logical volume device names
803 (eg. ";C"/dev/VolGroup00/LogVol00";T")."];
805 SeeAlso["lvs_full"]]);
807 ("pvs_full", (RPVList "physvols", []), 12, [],
808 [], (* XXX how to test? *)
809 "list the LVM physical volumes (PVs)",
811 P[T"List all the physical volumes detected. This is the equivalent
812 of the ";Man("pvs",8);T" command.
813 The \"full\" version includes all fields."]]);
815 ("vgs_full", (RVGList "volgroups", []), 13, [],
816 [], (* XXX how to test? *)
817 "list the LVM volume groups (VGs)",
819 P[T"List all the volumes groups detected. This is the equivalent
820 of the ";Man("vgs",8);T" command.
821 The \"full\" version includes all fields."]]);
823 ("lvs_full", (RLVList "logvols", []), 14, [],
824 [], (* XXX how to test? *)
825 "list the LVM logical volumes (LVs)",
827 P[T"List all the logical volumes detected. This is the equivalent
828 of the ";Man("lvs",8);T" command.
829 The \"full\" version includes all fields."]]);
831 ("read_lines", (RStringList "lines", [String "path"]), 15, [],
832 [InitBasicFS, Always, TestOutputList (
833 [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
834 ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);
835 InitBasicFS, Always, TestOutputList (
836 [["write_file"; "/new"; ""; "0"];
837 ["read_lines"; "/new"]], [])],
838 "read file as lines",
840 P[T"Return the contents of the file named ";A"path";T"."];
842 P[T"The file contents are returned as a list of lines. Trailing ";
843 C"LF";T" and ";C"CRLF";T" character sequences are ";Em"not";T" returned."];
845 P[T"Note that this function cannot correctly handle binary files
846 (specifically, files containing ";C"\\0";T" character which is treated
847 as end of line). For those you need to use the ";XU"read_file";
848 T" function which has a more complex interface."]]);
850 ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [],
851 [], (* XXX Augeas code needs tests. *)
852 "create a new Augeas handle",
854 Q"Create a new Augeas handle for editing configuration files.
855 If there was any previous Augeas handle associated with this
856 guestfs session, then it is closed.";
858 P[T"You must call this before using any other ";XW"aug_*";
861 P[A"root";T" is the filesystem root. ";A"root";T" must be ";NONNULL;T",
862 use ";C"/";T" instead."];
864 P[T"The flags are the same as the flags defined in
865 <augeas.h>, the logical OR of the following
870 [C"AUG_SAVE_BACKUP";T" = 1"],
872 P[T"Keep the original file with a ";C".augsave";T" extension."];
874 [C"AUG_SAVE_NEWFILE";T" = 2"],
876 P[T"Save changes into a file with extension ";C".augnew";T", and
877 do not overwrite original. Overrides ";C"AUG_SAVE_BACKUP";T"."];
879 [C"AUG_TYPE_CHECK";T" = 4"],
881 Q"Typecheck lenses (can be expensive).";
883 [C"AUG_NO_STDINC";T" = 8"],
885 Q"Do not use standard load path for modules.";
887 [C"AUG_SAVE_NOOP";T" = 16"],
889 Q"Make save a no-op, just record what would have been changed.";
891 [C"AUG_NO_LOAD";T" = 32"],
893 P[T"Do not load the tree in ";X"aug_init";T"."];
897 P[T"To close the handle, you can call ";X"aug_close";T"."];
899 P[T"To find out more about Augeas, see ";URL"http://augeas.net/";T"."]]);
901 ("aug_close", (RErr, []), 26, [],
902 [], (* XXX Augeas code needs tests. *)
903 "close the current Augeas handle",
905 P[T"Close the current Augeas handle and free up any resources
906 used by it. After calling this, you have to call ";
907 X"aug_init";T" again before you can use any other
908 Augeas functions."]]);
910 ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
911 [], (* XXX Augeas code needs tests. *)
912 "define an Augeas variable",
914 P[T"Defines an Augeas variable ";A"name";T" whose value is the result
915 of evaluating ";A"expr";T". If ";A"expr";T" is ";NULL;T", then ";A"name";T" is
918 P[T"On success this returns the number of nodes in ";A"expr";T", or ";
919 C"0";T" if ";A"expr";T" evaluates to something which is not a nodeset."]]);
921 ("aug_defnode", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [],
922 [], (* XXX Augeas code needs tests. *)
923 "define an Augeas node",
925 P[T"Defines a variable ";A"name";T" whose value is the result of
926 evaluating ";A"expr";T"."];
928 P[T"If ";A"expr";T" evaluates to an empty nodeset, a node is created,
929 equivalent to calling ";XA("aug_set",[A"expr";A"value"]);T". ";
930 A"name";T" will be the nodeset containing that single node."];
932 Q"On success this returns a pair containing the
933 number of nodes in the nodeset, and a boolean flag
934 if a node was created."]);
936 ("aug_get", (RString "val", [String "path"]), 19, [],
937 [], (* XXX Augeas code needs tests. *)
938 "look up the value of an Augeas path",
940 P[T"Look up the value associated with ";A"path";T". If ";A"path";
941 T" matches exactly one node, the ";C"value";T" is returned."]]);
943 ("aug_set", (RErr, [String "path"; String "val"]), 20, [],
944 [], (* XXX Augeas code needs tests. *)
945 "set Augeas path to value",
947 P[T"Set the value associated with ";A"path";T" to ";A"val";T"."]]);
949 ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [],
950 [], (* XXX Augeas code needs tests. *)
951 "insert a sibling Augeas node",
953 P[T"Create a new sibling ";A"label";T" for ";A"path";T", inserting it into
954 the tree before or after ";A"path";T" (depending on the boolean
955 flag ";A"before";T")."];
957 P[A"path";T" must match exactly one existing node in the tree, and ";
958 A"label";T" must be a label, ie. not contain ";C"/";T", ";C"*";T" or end
959 with a bracketed index ";C"[N]";T"."]]);
961 ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
962 [], (* XXX Augeas code needs tests. *)
963 "remove an Augeas path",
965 P[T"Remove ";A"path";T" and all of its children."];
967 Q"On success this returns the number of entries which were removed."]);
969 ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [],
970 [], (* XXX Augeas code needs tests. *)
973 P[T"Move the node ";A"src";T" to ";A"dest";T". ";A"src";T" must match exactly
974 one node. ";A"dest";T" is overwritten if it exists."]]);
976 ("aug_match", (RStringList "matches", [String "path"]), 24, [],
977 [], (* XXX Augeas code needs tests. *)
978 "return Augeas nodes which match path",
980 P[T"Returns a list of paths which match the path expression ";A"path";T".
981 The returned paths are sufficiently qualified so that they match
982 exactly one node in the current tree."]]);
984 ("aug_save", (RErr, []), 25, [],
985 [], (* XXX Augeas code needs tests. *)
986 "write all pending Augeas changes to disk",
988 Q"This writes all pending changes to disk.";
990 P[T"The flags which were passed to ";X"aug_init";T" affect exactly
991 how files are saved."]]);
993 ("aug_load", (RErr, []), 27, [],
994 [], (* XXX Augeas code needs tests. *)
995 "load files into the tree",
997 Q"Load files into the tree.";
999 P[T"See ";C"aug_load";T" in the Augeas documentation for the full gory
1002 ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
1003 [], (* XXX Augeas code needs tests. *)
1004 "list Augeas nodes under a path",
1006 P[T"This is just a shortcut for listing ";XA("aug_match",[C"path/*"]);
1007 T" and sorting the resulting nodes into alphabetical order."]]);
1009 ("rm", (RErr, [String "path"]), 29, [],
1010 [InitBasicFS, Always, TestRun
1013 InitBasicFS, Always, TestLastFail
1015 InitBasicFS, Always, TestLastFail
1020 P[T"Remove the single file ";A"path";T"."]]);
1022 ("rmdir", (RErr, [String "path"]), 30, [],
1023 [InitBasicFS, Always, TestRun
1026 InitBasicFS, Always, TestLastFail
1027 [["rmdir"; "/new"]];
1028 InitBasicFS, Always, TestLastFail
1030 ["rmdir"; "/new"]]],
1031 "remove a directory",
1033 P[T"Remove the single directory ";A"path";T"."]]);
1035 ("rm_rf", (RErr, [String "path"]), 31, [],
1036 [InitBasicFS, Always, TestOutputFalse
1038 ["mkdir"; "/new/foo"];
1039 ["touch"; "/new/foo/bar"];
1041 ["exists"; "/new"]]],
1042 "remove a file or directory recursively",
1044 P[T"Remove the file or directory ";A"path";T", recursively removing the
1045 contents if its a directory. This is like the ";C"rm -rf";T" shell
1048 ("mkdir", (RErr, [String "path"]), 32, [],
1049 [InitBasicFS, Always, TestOutputTrue
1051 ["is_dir"; "/new"]];
1052 InitBasicFS, Always, TestLastFail
1053 [["mkdir"; "/new/foo/bar"]]],
1054 "create a directory",
1056 P[T"Create a directory named ";A"path";T"."]]);
1058 ("mkdir_p", (RErr, [String "path"]), 33, [],
1059 [InitBasicFS, Always, TestOutputTrue
1060 [["mkdir_p"; "/new/foo/bar"];
1061 ["is_dir"; "/new/foo/bar"]];
1062 InitBasicFS, Always, TestOutputTrue
1063 [["mkdir_p"; "/new/foo/bar"];
1064 ["is_dir"; "/new/foo"]];
1065 InitBasicFS, Always, TestOutputTrue
1066 [["mkdir_p"; "/new/foo/bar"];
1067 ["is_dir"; "/new"]];
1068 (* Regression tests for RHBZ#503133: *)
1069 InitBasicFS, Always, TestRun
1071 ["mkdir_p"; "/new"]];
1072 InitBasicFS, Always, TestLastFail
1074 ["mkdir_p"; "/new"]]],
1075 "create a directory and parents",
1077 P[T"Create a directory named ";A"path";T", creating any parent directories
1078 as necessary. This is like the ";C"mkdir -p";T" shell command."]]);
1080 ("chmod", (RErr, [Int "mode"; String "path"]), 34, [],
1081 [], (* XXX Need stat command to test *)
1084 P[T"Change the mode (permissions) of ";A"path";T" to ";A"mode";T". Only
1085 numeric modes are supported."]]);
1087 ("chown", (RErr, [Int "owner"; Int "group"; String "path"]), 35, [],
1088 [], (* XXX Need stat command to test *)
1089 "change file owner and group",
1091 P[T"Change the file owner to ";A"owner";T" and group to ";A"group";T"."];
1093 QNote"Only numeric uid and gid are supported. If you want to use
1094 names, you will need to locate and parse the password file
1095 yourself (Augeas support makes this relatively easy)."]);
1097 ("exists", (RBool "existsflag", [String "path"]), 36, [],
1098 [InitBasicFS, Always, TestOutputTrue (
1100 ["exists"; "/new"]]);
1101 InitBasicFS, Always, TestOutputTrue (
1103 ["exists"; "/new"]])],
1104 "test if file or directory exists",
1106 P[T"This returns ";C"true";T" if and only if there is a file, directory
1107 (or anything) with the given ";A"path";T" name."];
1109 SeeAlso["is_file"; "is_dir"; "stat"]]);
1111 ("is_file", (RBool "fileflag", [String "path"]), 37, [],
1112 [InitBasicFS, Always, TestOutputTrue (
1114 ["is_file"; "/new"]]);
1115 InitBasicFS, Always, TestOutputFalse (
1117 ["is_file"; "/new"]])],
1118 "test if file exists",
1120 P[T"This returns ";C"true";T" if and only if there is a file
1121 with the given ";A"path";T" name. Note that it returns false for
1122 other objects like directories."];
1126 ("is_dir", (RBool "dirflag", [String "path"]), 38, [],
1127 [InitBasicFS, Always, TestOutputFalse (
1129 ["is_dir"; "/new"]]);
1130 InitBasicFS, Always, TestOutputTrue (
1132 ["is_dir"; "/new"]])],
1133 "test if file exists",
1135 P[T"This returns ";C"true";T" if and only if there is a directory
1136 with the given ";A"path";T" name. Note that it returns false for
1137 other objects like files."];
1141 ("pvcreate", (RErr, [String "device"]), 39, [],
1142 [InitEmpty, Always, TestOutputList (
1143 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
1144 ["pvcreate"; "/dev/sda1"];
1145 ["pvcreate"; "/dev/sda2"];
1146 ["pvcreate"; "/dev/sda3"];
1147 ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1148 "create an LVM physical volume",
1150 P[T"This creates an LVM physical volume on the named ";A"device";T",
1151 where ";A"device";T" should usually be a partition name such
1152 as ";C"/dev/sda1";T"."]]);
1154 ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
1155 [InitEmpty, Always, TestOutputList (
1156 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
1157 ["pvcreate"; "/dev/sda1"];
1158 ["pvcreate"; "/dev/sda2"];
1159 ["pvcreate"; "/dev/sda3"];
1160 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1161 ["vgcreate"; "VG2"; "/dev/sda3"];
1162 ["vgs"]], ["VG1"; "VG2"])],
1163 "create an LVM volume group",
1165 P[T"This creates an LVM volume group called ";A"volgroup";
1166 T" from the non-empty list of physical volumes ";A"physvols";T"."]]);
1168 ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [],
1169 [InitEmpty, Always, TestOutputList (
1170 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
1171 ["pvcreate"; "/dev/sda1"];
1172 ["pvcreate"; "/dev/sda2"];
1173 ["pvcreate"; "/dev/sda3"];
1174 ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1175 ["vgcreate"; "VG2"; "/dev/sda3"];
1176 ["lvcreate"; "LV1"; "VG1"; "50"];
1177 ["lvcreate"; "LV2"; "VG1"; "50"];
1178 ["lvcreate"; "LV3"; "VG2"; "50"];
1179 ["lvcreate"; "LV4"; "VG2"; "50"];
1180 ["lvcreate"; "LV5"; "VG2"; "50"];
1182 ["/dev/VG1/LV1"; "/dev/VG1/LV2";
1183 "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
1184 "create an LVM volume group",
1186 P[T"This creates an LVM volume group called ";A"logvol";
1187 T" on the volume group ";A"volgroup";T", with ";A"mbytes";
1188 T" size in megabytes."]]);
1190 ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [],
1191 [InitEmpty, Always, TestOutput (
1192 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1193 ["mkfs"; "ext2"; "/dev/sda1"];
1194 ["mount"; "/dev/sda1"; "/"];
1195 ["write_file"; "/new"; "new file contents"; "0"];
1196 ["cat"; "/new"]], "new file contents")],
1197 "make a filesystem",
1199 P[T"This creates a filesystem on ";A"device";T" (usually a partition
1200 or LVM logical volume). The filesystem type is ";A"fstype";T", for
1201 example ";C"ext3";T"."]]);
1203 ("sfdisk", (RErr, [String "device";
1204 Int "cyls"; Int "heads"; Int "sectors";
1205 StringList "lines"]), 43, [DangerWillRobinson],
1207 "create partitions on a block device",
1209 P[T"This is a direct interface to the ";Man("sfdisk",8);T" program for creating
1210 partitions on block devices."];
1212 P[A"device";T" should be a block device, for example ";C"/dev/sda";T"."];
1214 P[A"cyls";T", ";A"heads";T" and ";A"sectors";
1215 T" are the number of cylinders, heads
1216 and sectors on the device, which are passed directly to sfdisk as
1217 the ";C"-C";T", ";C"-H";T" and ";C"-S";T" parameters.
1218 If you pass ";C"0";T" for any
1219 of these, then the corresponding parameter is omitted. Usually for
1220 'large' disks, you can just pass ";C"0";T" for these, but for small
1221 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
1222 out the right geometry and you will need to tell it."];
1224 P[A"lines";T" is a list of lines that we feed to ";C"sfdisk";T". For more
1225 information refer to the ";Man("sfdisk",8);T" manpage."];
1227 P[T"To create a single partition occupying the whole disk, you would
1228 pass ";A"lines";T" as a single element list, when the single element being
1229 the string ";C",";T" (comma)."];
1231 SeeAlso["sfdisk_l"; "sfdisk_N"]]);
1233 ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
1234 [InitBasicFS, Always, TestOutput (
1235 [["write_file"; "/new"; "new file contents"; "0"];
1236 ["cat"; "/new"]], "new file contents");
1237 InitBasicFS, Always, TestOutput (
1238 [["write_file"; "/new"; "\nnew file contents\n"; "0"];
1239 ["cat"; "/new"]], "\nnew file contents\n");
1240 InitBasicFS, Always, TestOutput (
1241 [["write_file"; "/new"; "\n\n"; "0"];
1242 ["cat"; "/new"]], "\n\n");
1243 InitBasicFS, Always, TestOutput (
1244 [["write_file"; "/new"; ""; "0"];
1245 ["cat"; "/new"]], "");
1246 InitBasicFS, Always, TestOutput (
1247 [["write_file"; "/new"; "\n\n\n"; "0"];
1248 ["cat"; "/new"]], "\n\n\n");
1249 InitBasicFS, Always, TestOutput (
1250 [["write_file"; "/new"; "\n"; "0"];
1251 ["cat"; "/new"]], "\n")],
1254 P[T"This call creates a file called ";A"path";T". The contents of the
1255 file is the string ";A"content";T" (which can contain any 8 bit data),
1256 with length ";A"size";T"."];
1258 P[T"As a special case, if ";A"size";T" is ";C"0";
1259 T" then the length is calculated using ";Man("strlen",3);T" (so in this case
1260 the content cannot contain embedded ASCII NULs)."];
1262 Note[T"Owing to a bug, writing content containing ASCII NUL
1263 characters does ";Em"not";T" work, even if the length is specified.
1264 We hope to resolve this bug in a future version. In the meantime
1265 use ";X"upload";T"."]]);
1267 ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
1268 [InitEmpty, Always, TestOutputList (
1269 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1270 ["mkfs"; "ext2"; "/dev/sda1"];
1271 ["mount"; "/dev/sda1"; "/"];
1272 ["mounts"]], ["/dev/sda1"]);
1273 InitEmpty, Always, TestOutputList (
1274 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1275 ["mkfs"; "ext2"; "/dev/sda1"];
1276 ["mount"; "/dev/sda1"; "/"];
1279 "unmount a filesystem",
1281 Q"This unmounts the given filesystem. The filesystem may be
1282 specified either by its mountpoint (path) or the device which
1283 contains the filesystem."]);
1285 ("mounts", (RStringList "devices", []), 46, [],
1286 [InitBasicFS, Always, TestOutputList (
1287 [["mounts"]], ["/dev/sda1"])],
1288 "show mounted filesystems",
1290 P[T"This returns the list of currently mounted filesystems. It returns
1291 the list of devices (eg. ";C"/dev/sda1";T", ";C"/dev/VG/LV";T")."];
1293 Q"Some internal mounts are not shown."]);
1295 ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
1296 [InitBasicFS, Always, TestOutputList (
1299 (* check that umount_all can unmount nested mounts correctly: *)
1300 InitEmpty, Always, TestOutputList (
1301 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
1302 ["mkfs"; "ext2"; "/dev/sda1"];
1303 ["mkfs"; "ext2"; "/dev/sda2"];
1304 ["mkfs"; "ext2"; "/dev/sda3"];
1305 ["mount"; "/dev/sda1"; "/"];
1307 ["mount"; "/dev/sda2"; "/mp1"];
1308 ["mkdir"; "/mp1/mp2"];
1309 ["mount"; "/dev/sda3"; "/mp1/mp2"];
1310 ["mkdir"; "/mp1/mp2/mp3"];
1313 "unmount all filesystems",
1315 Q"This unmounts all mounted filesystems.";
1317 Q"Some internal mounts are not unmounted by this call."]);
1319 ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson],
1321 "remove all LVM LVs, VGs and PVs",
1323 Q"This command removes all LVM logical volumes, volume groups
1324 and physical volumes."]);
1326 ("file", (RString "description", [String "path"]), 49, [],
1327 [InitBasicFS, Always, TestOutput (
1329 ["file"; "/new"]], "empty");
1330 InitBasicFS, Always, TestOutput (
1331 [["write_file"; "/new"; "some content\n"; "0"];
1332 ["file"; "/new"]], "ASCII text");
1333 InitBasicFS, Always, TestLastFail (
1334 [["file"; "/nofile"]])],
1335 "determine file type",
1337 P[T"This call uses the standard ";Man("file",1);T" command to determine
1338 the type or contents of the file. This also works on devices,
1339 for example to find out whether a partition contains a filesystem."];
1341 P[T"The exact command which runs is ";C"file -bsL path";T". Note in
1342 particular that the filename is not prepended to the output
1343 (the ";C"-b";T" option)."]]);
1345 ("command", (RString "output", [StringList "arguments"]), 50, [ProtocolLimitWarning],
1346 [InitBasicFS, Always, TestOutput (
1347 [["upload"; "test-command"; "/test-command"];
1348 ["chmod"; "493"; "/test-command"];
1349 ["command"; "/test-command 1"]], "Result1");
1350 InitBasicFS, Always, TestOutput (
1351 [["upload"; "test-command"; "/test-command"];
1352 ["chmod"; "493"; "/test-command"];
1353 ["command"; "/test-command 2"]], "Result2\n");
1354 InitBasicFS, Always, TestOutput (
1355 [["upload"; "test-command"; "/test-command"];
1356 ["chmod"; "493"; "/test-command"];
1357 ["command"; "/test-command 3"]], "\nResult3");
1358 InitBasicFS, Always, TestOutput (
1359 [["upload"; "test-command"; "/test-command"];
1360 ["chmod"; "493"; "/test-command"];
1361 ["command"; "/test-command 4"]], "\nResult4\n");
1362 InitBasicFS, Always, TestOutput (
1363 [["upload"; "test-command"; "/test-command"];
1364 ["chmod"; "493"; "/test-command"];
1365 ["command"; "/test-command 5"]], "\nResult5\n\n");
1366 InitBasicFS, Always, TestOutput (
1367 [["upload"; "test-command"; "/test-command"];
1368 ["chmod"; "493"; "/test-command"];
1369 ["command"; "/test-command 6"]], "\n\nResult6\n\n");
1370 InitBasicFS, Always, TestOutput (
1371 [["upload"; "test-command"; "/test-command"];
1372 ["chmod"; "493"; "/test-command"];
1373 ["command"; "/test-command 7"]], "");
1374 InitBasicFS, Always, TestOutput (
1375 [["upload"; "test-command"; "/test-command"];
1376 ["chmod"; "493"; "/test-command"];
1377 ["command"; "/test-command 8"]], "\n");
1378 InitBasicFS, Always, TestOutput (
1379 [["upload"; "test-command"; "/test-command"];
1380 ["chmod"; "493"; "/test-command"];
1381 ["command"; "/test-command 9"]], "\n\n");
1382 InitBasicFS, Always, TestOutput (
1383 [["upload"; "test-command"; "/test-command"];
1384 ["chmod"; "493"; "/test-command"];
1385 ["command"; "/test-command 10"]], "Result10-1\nResult10-2\n");
1386 InitBasicFS, Always, TestOutput (
1387 [["upload"; "test-command"; "/test-command"];
1388 ["chmod"; "493"; "/test-command"];
1389 ["command"; "/test-command 11"]], "Result11-1\nResult11-2");
1390 InitBasicFS, Always, TestLastFail (
1391 [["upload"; "test-command"; "/test-command"];
1392 ["chmod"; "493"; "/test-command"];
1393 ["command"; "/test-command"]])],
1394 "run a command from the guest filesystem",
1396 Q"This call runs a command from the guest filesystem. The
1397 filesystem must be mounted, and must contain a compatible
1398 operating system (ie. something Linux, with the same
1399 or compatible processor architecture).";
1401 Q"The single parameter is an argv-style list of arguments.
1402 The first element is the name of the program to run.
1403 Subsequent elements are parameters. The list must be
1404 non-empty (ie. must contain a program name).";
1406 P[T"The return value is anything printed to ";C"stdout";T" by
1409 P[T"If the command returns a non-zero exit status, then
1410 this function returns an error message. The error message
1411 string is the content of ";C"stderr";T" from the command."];
1413 P[T"The ";C"PATH";T" environment variable will contain at least ";
1414 C"/usr/bin";T" and ";C"/bin";T". If you require a program from
1415 another location, you should provide the full path in the
1418 Q"Shared libraries and data files required by the program
1419 must be available on filesystems which are mounted in the
1420 correct places. It is the caller's responsibility to ensure
1421 all filesystems that are needed are mounted at the right
1424 ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [ProtocolLimitWarning],
1425 [InitBasicFS, Always, TestOutputList (
1426 [["upload"; "test-command"; "/test-command"];
1427 ["chmod"; "493"; "/test-command"];
1428 ["command_lines"; "/test-command 1"]], ["Result1"]);
1429 InitBasicFS, Always, TestOutputList (
1430 [["upload"; "test-command"; "/test-command"];
1431 ["chmod"; "493"; "/test-command"];
1432 ["command_lines"; "/test-command 2"]], ["Result2"]);
1433 InitBasicFS, Always, TestOutputList (
1434 [["upload"; "test-command"; "/test-command"];
1435 ["chmod"; "493"; "/test-command"];
1436 ["command_lines"; "/test-command 3"]], ["";"Result3"]);
1437 InitBasicFS, Always, TestOutputList (
1438 [["upload"; "test-command"; "/test-command"];
1439 ["chmod"; "493"; "/test-command"];
1440 ["command_lines"; "/test-command 4"]], ["";"Result4"]);
1441 InitBasicFS, Always, TestOutputList (
1442 [["upload"; "test-command"; "/test-command"];
1443 ["chmod"; "493"; "/test-command"];
1444 ["command_lines"; "/test-command 5"]], ["";"Result5";""]);
1445 InitBasicFS, Always, TestOutputList (
1446 [["upload"; "test-command"; "/test-command"];
1447 ["chmod"; "493"; "/test-command"];
1448 ["command_lines"; "/test-command 6"]], ["";"";"Result6";""]);
1449 InitBasicFS, Always, TestOutputList (
1450 [["upload"; "test-command"; "/test-command"];
1451 ["chmod"; "493"; "/test-command"];
1452 ["command_lines"; "/test-command 7"]], []);
1453 InitBasicFS, Always, TestOutputList (
1454 [["upload"; "test-command"; "/test-command"];
1455 ["chmod"; "493"; "/test-command"];
1456 ["command_lines"; "/test-command 8"]], [""]);
1457 InitBasicFS, Always, TestOutputList (
1458 [["upload"; "test-command"; "/test-command"];
1459 ["chmod"; "493"; "/test-command"];
1460 ["command_lines"; "/test-command 9"]], ["";""]);
1461 InitBasicFS, Always, TestOutputList (
1462 [["upload"; "test-command"; "/test-command"];
1463 ["chmod"; "493"; "/test-command"];
1464 ["command_lines"; "/test-command 10"]], ["Result10-1";"Result10-2"]);
1465 InitBasicFS, Always, TestOutputList (
1466 [["upload"; "test-command"; "/test-command"];
1467 ["chmod"; "493"; "/test-command"];
1468 ["command_lines"; "/test-command 11"]], ["Result11-1";"Result11-2"])],
1469 "run a command, returning lines",
1471 P[T"This is the same as ";X"command";T", but splits the
1472 result into a list of lines."]]);
1474 ("stat", (RStat "statbuf", [String "path"]), 52, [],
1475 [InitBasicFS, Always, TestOutputStruct (
1477 ["stat"; "/new"]], [CompareWithInt ("size", 0)])],
1478 "get file information",
1480 P[T"Returns file information for the given ";A"path";T"."];
1482 P[T"This is the same as the ";Man("stat",2);T" system call."]]);
1484 ("lstat", (RStat "statbuf", [String "path"]), 53, [],
1485 [InitBasicFS, Always, TestOutputStruct (
1487 ["lstat"; "/new"]], [CompareWithInt ("size", 0)])],
1488 "get file information for a symbolic link",
1490 P[T"Returns file information for the given ";A"path";T"."];
1492 P[T"This is the same as ";X"stat";T" except that if ";A"path";
1493 T" is a symbolic link, then the link is stat-ed, not the file it
1496 P[T"This is the same as the ";Man("lstat",2);T" system call."]]);
1498 ("statvfs", (RStatVFS "statbuf", [String "path"]), 54, [],
1499 [InitBasicFS, Always, TestOutputStruct (
1500 [["statvfs"; "/"]], [CompareWithInt ("bfree", 487702);
1501 CompareWithInt ("blocks", 490020);
1502 CompareWithInt ("bsize", 1024)])],
1503 "get file system statistics",
1505 P[T"Returns file system statistics for any mounted file system. ";
1506 A"path";T" should be a file or directory in the mounted file system
1507 (typically it is the mount point itself, but it doesn't need to be)."];
1509 P[T"This is the same as the ";Man("statvfs",2);T" system call."]]);
1511 ("tune2fs_l", (RHashtable "superblock", [String "device"]), 55, [],
1513 "get ext2/ext3/ext4 superblock details",
1515 P[T"This returns the contents of the ext2, ext3 or ext4 filesystem
1516 superblock on ";A"device";T"."];
1518 P[T"It is the same as running ";C"tune2fs -l device";T".
1519 See ";Man("tune2fs",8);
1520 T" manpage for more details. The list of fields returned isn't
1521 clearly defined, and depends on both the version of ";C"tune2fs";
1522 T" that libguestfs was built against, and the filesystem itself."]]);
1524 ("blockdev_setro", (RErr, [String "device"]), 56, [],
1525 [InitEmpty, Always, TestOutputTrue (
1526 [["blockdev_setro"; "/dev/sda"];
1527 ["blockdev_getro"; "/dev/sda"]])],
1528 "set block device to read-only",
1530 P[T"Sets the block device named ";A"device";T" to read-only."];
1532 P[T"This uses the ";Man("blockdev",8);T" command."]]);
1534 ("blockdev_setrw", (RErr, [String "device"]), 57, [],
1535 [InitEmpty, Always, TestOutputFalse (
1536 [["blockdev_setrw"; "/dev/sda"];
1537 ["blockdev_getro"; "/dev/sda"]])],
1538 "set block device to read-write",
1540 P[T"Sets the block device named ";A"device";T" to read-write."];
1542 P[T"This uses the ";Man("blockdev",8);T" command."]]);
1544 ("blockdev_getro", (RBool "ro", [String "device"]), 58, [],
1545 [InitEmpty, Always, TestOutputTrue (
1546 [["blockdev_setro"; "/dev/sda"];
1547 ["blockdev_getro"; "/dev/sda"]])],
1548 "is block device set to read-only",
1550 Q"Returns a boolean indicating if the block device is read-only
1551 (true if read-only, false if not).";
1553 P[T"This uses the ";Man("blockdev",8);T" command."]]);
1555 ("blockdev_getss", (RInt "sectorsize", [String "device"]), 59, [],
1556 [InitEmpty, Always, TestOutputInt (
1557 [["blockdev_getss"; "/dev/sda"]], 512)],
1558 "get sectorsize of block device",
1560 Q"This returns the size of sectors on a block device.
1561 Usually 512, but can be larger for modern devices.";
1563 Note[T"This is not the size in sectors, use ";X"blockdev_getsz";
1566 P[T"This uses the ";Man("blockdev",8);T" command."]]);
1568 ("blockdev_getbsz", (RInt "blocksize", [String "device"]), 60, [],
1569 [InitEmpty, Always, TestOutputInt (
1570 [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1571 "get blocksize of block device",
1573 Q"This returns the block size of a device.";
1575 Note[T"This is different from both ";Em"size in blocks";T" and ";
1576 Em"filesystem block size";T")."];
1578 P[T"This uses the ";Man("blockdev",8);T" command."]]);
1580 ("blockdev_setbsz", (RErr, [String "device"; Int "blocksize"]), 61, [],
1582 "set blocksize of block device",
1584 Q"This sets the block size of a device.";
1586 Note[T"This is different from both ";Em"size in blocks";T" and ";
1587 Em"filesystem block size";T")."];
1589 P[T"This uses the ";Man("blockdev",8);T" command."]]);
1591 ("blockdev_getsz", (RInt64 "sizeinsectors", [String "device"]), 62, [],
1592 [InitEmpty, Always, TestOutputInt (
1593 [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1594 "get total size of device in 512-byte sectors",
1596 Q"This returns the size of the device in units of 512-byte sectors
1597 (even if the sectorsize isn't 512 bytes ... weird).";
1599 P[T"See also ";X"blockdev_getss";T" for the real sector size of
1600 the device, and ";X"blockdev_getsize64";T" for the more
1601 useful ";Em"size in bytes";T"."];
1603 P[T"This uses the ";Man("blockdev",8);T" command."]]);
1605 ("blockdev_getsize64", (RInt64 "sizeinbytes", [String "device"]), 63, [],
1606 [InitEmpty, Always, TestOutputInt (
1607 [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1608 "get total size of device in bytes",
1610 Q"This returns the size of the device in bytes.";
1612 SeeAlso ["blockdev_getsz"];
1614 P[T"This uses the ";Man("blockdev",8);T" command."]]);
1616 ("blockdev_flushbufs", (RErr, [String "device"]), 64, [],
1617 [InitEmpty, Always, TestRun
1618 [["blockdev_flushbufs"; "/dev/sda"]]],
1619 "flush device buffers",
1621 P[T"This tells the kernel to flush internal buffers associated
1622 with ";A"device";T"."];
1624 P[T"This uses the ";Man("blockdev",8);T" command."]]);
1626 ("blockdev_rereadpt", (RErr, [String "device"]), 65, [],
1627 [InitEmpty, Always, TestRun
1628 [["blockdev_rereadpt"; "/dev/sda"]]],
1629 "reread partition table",
1631 P[T"Reread the partition table on ";A"device";T"."];
1633 P[T"This uses the ";Man("blockdev",8);T" command."]]);
1635 ("upload", (RErr, [FileIn "filename"; String "remotefilename"]), 66, [],
1636 [InitBasicFS, Always, TestOutput (
1637 (* Pick a file from cwd which isn't likely to change. *)
1638 [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1639 ["checksum"; "md5"; "/COPYING.LIB"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
1640 "upload a file from the local machine",
1642 P[T"Upload local file ";A"filename";T" to ";A"remotefilename";T" on the
1645 P[A"filename";T" can also be a named pipe."];
1647 SeeAlso["download"]]);
1649 ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [],
1650 [InitBasicFS, Always, TestOutput (
1651 (* Pick a file from cwd which isn't likely to change. *)
1652 [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1653 ["download"; "/COPYING.LIB"; "testdownload.tmp"];
1654 ["upload"; "testdownload.tmp"; "/upload"];
1655 ["checksum"; "md5"; "/upload"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
1656 "download a file to the local machine",
1658 P[T"Download file ";A"remotefilename";T" and save it as ";A"filename";
1659 T" on the local machine."];
1661 P[A"filename";T" can also be a named pipe."];
1663 SeeAlso ["upload"; "cat"]]);
1665 ("checksum", (RString "checksum", [String "csumtype"; String "path"]), 68, [],
1666 [InitBasicFS, Always, TestOutput (
1667 [["write_file"; "/new"; "test\n"; "0"];
1668 ["checksum"; "crc"; "/new"]], "935282863");
1669 InitBasicFS, Always, TestLastFail (
1670 [["checksum"; "crc"; "/new"]]);
1671 InitBasicFS, Always, TestOutput (
1672 [["write_file"; "/new"; "test\n"; "0"];
1673 ["checksum"; "md5"; "/new"]], "d8e8fca2dc0f896fd7cb4cb0031ba249");
1674 InitBasicFS, Always, TestOutput (
1675 [["write_file"; "/new"; "test\n"; "0"];
1676 ["checksum"; "sha1"; "/new"]], "4e1243bd22c66e76c2ba9eddc1f91394e57f9f83");
1677 InitBasicFS, Always, TestOutput (
1678 [["write_file"; "/new"; "test\n"; "0"];
1679 ["checksum"; "sha224"; "/new"]], "52f1bf093f4b7588726035c176c0cdb4376cfea53819f1395ac9e6ec");
1680 InitBasicFS, Always, TestOutput (
1681 [["write_file"; "/new"; "test\n"; "0"];
1682 ["checksum"; "sha256"; "/new"]], "f2ca1bb6c7e907d06dafe4687e579fce76b37e4e93b7605022da52e6ccc26fd2");
1683 InitBasicFS, Always, TestOutput (
1684 [["write_file"; "/new"; "test\n"; "0"];
1685 ["checksum"; "sha384"; "/new"]], "109bb6b5b6d5547c1ce03c7a8bd7d8f80c1cb0957f50c4f7fda04692079917e4f9cad52b878f3d8234e1a170b154b72d");
1686 InitBasicFS, Always, TestOutput (
1687 [["write_file"; "/new"; "test\n"; "0"];
1688 ["checksum"; "sha512"; "/new"]], "0e3e75234abc68f4378a86b3f4b32a198ba301845b0cd6e50106e874345700cc6663a86c1ea125dc5e92be17c98f9a0f85ca9d5f595db2012f7cc3571945c123");
1689 InitBasicFS, Always, TestOutput (
1690 [["mount"; "/dev/sdd"; "/"];
1691 ["checksum"; "md5"; "/known-3"]], "46d6ca27ee07cdc6fa99c2e138cc522c")],
1692 "compute MD5, SHAx or CRC checksum of file",
1694 P[T"This call computes the MD5, SHAx or CRC checksum of the
1695 file named ";A"path";T"."];
1697 P[T"The type of checksum to compute is given by the ";A"csumtype";
1698 T" parameter which must have one of the following values:"];
1704 P[T"Compute the cyclic redundancy check (CRC) specified by POSIX
1705 for the ";Man("cksum",1);T" command."];
1709 P[T"Compute the MD5 hash (using the ";Man("md5sum",1);T" program)."];
1713 P[T"Compute the SHA1 hash (using the ";Man("sha1sum",1);T" program)."];
1717 P[T"Compute the SHA224 hash (using the ";Man("sha224sum",1);T" program)."];
1721 P[T"Compute the SHA256 hash (using the ";Man("sha256sum",1);T" program)."];
1725 P[T"Compute the SHA384 hash (using the ";Man("sha384sum",1);T" program)."];
1729 P[T"Compute the SHA512 hash (using the ";Man("sha512sum",1);T" program)."];
1733 Q"The checksum is returned as a printable string."]);
1735 ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [],
1736 [InitBasicFS, Always, TestOutput (
1737 [["tar_in"; "../images/helloworld.tar"; "/"];
1738 ["cat"; "/hello"]], "hello\n")],
1739 "unpack tarfile to directory",
1741 P[T"This command uploads and unpacks local file ";A"tarfile";T" (an ";
1742 Em"uncompressed";T" tar file) into ";A"directory";T"."];
1744 P[T"To upload a compressed tarball, use ";X"tgz_in";T"."]]);
1746 ("tar_out", (RErr, [String "directory"; FileOut "tarfile"]), 70, [],
1748 "pack directory into tarfile",
1750 P[T"This command packs the contents of ";A"directory";T" and downloads
1751 it to local file ";A"tarfile";T"."];
1753 P[T"To download a compressed tarball, use ";X"tgz_out";T"."]]);
1755 ("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [],
1756 [InitBasicFS, Always, TestOutput (
1757 [["tgz_in"; "../images/helloworld.tar.gz"; "/"];
1758 ["cat"; "/hello"]], "hello\n")],
1759 "unpack compressed tarball to directory",
1761 P[T"This command uploads and unpacks local file ";A"tarball";T" (a ";
1762 Em"gzip compressed";T" tar file) into ";A"directory";T"."];
1764 P[T"To upload an uncompressed tarball, use ";X"tar_in";T"."]]);
1766 ("tgz_out", (RErr, [String "directory"; FileOut "tarball"]), 72, [],
1768 "pack directory into compressed tarball",
1770 P[T"This command packs the contents of ";A"directory";T" and downloads
1771 it to local file ";A"tarball";T"."];
1773 P[T"To download an uncompressed tarball, use ";X"tar_out";T"."]]);
1775 ("mount_ro", (RErr, [String "device"; String "mountpoint"]), 73, [],
1776 [InitBasicFS, Always, TestLastFail (
1778 ["mount_ro"; "/dev/sda1"; "/"];
1779 ["touch"; "/new"]]);
1780 InitBasicFS, Always, TestOutput (
1781 [["write_file"; "/new"; "data"; "0"];
1783 ["mount_ro"; "/dev/sda1"; "/"];
1784 ["cat"; "/new"]], "data")],
1785 "mount a guest disk, read-only",
1787 P[T"This is the same as the ";X"mount";T" command, but it
1788 mounts the filesystem with the read-only (";C"-o ro";T") flag."]]);
1790 ("mount_options", (RErr, [String "options"; String "device"; String "mountpoint"]), 74, [],
1792 "mount a guest disk with mount options",
1794 P[T"This is the same as the ";X"mount";T" command, but it
1795 allows you to set the mount options as for the ";
1796 Man("mount",8);T" ";C"-o";T" flag."]]);
1798 ("mount_vfs", (RErr, [String "options"; String "vfstype"; String "device"; String "mountpoint"]), 75, [],
1800 "mount a guest disk with mount options and vfstype",
1802 P[T"This is the same as the ";X"mount";T" command, but it
1803 allows you to set both the mount options and the vfstype
1804 as for the ";Man("mount",8);T" ";C"-o";T" and ";C"-t";T" flags."]]);
1806 ("debug", (RString "result", [String "subcmd"; StringList "extraargs"]), 76, [],
1808 "debugging and internals",
1810 P[T"This command exposes some internals of ";
1811 C"guestfsd";T" (the guestfs daemon) that runs inside the
1814 P[T"There is no comprehensive help for this command. You have
1815 to look at the file ";C"daemon/debug.c";T" in the libguestfs source
1816 to find out what you can do."]]);
1818 ("lvremove", (RErr, [String "device"]), 77, [],
1819 [InitEmpty, Always, TestOutputList (
1820 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1821 ["pvcreate"; "/dev/sda1"];
1822 ["vgcreate"; "VG"; "/dev/sda1"];
1823 ["lvcreate"; "LV1"; "VG"; "50"];
1824 ["lvcreate"; "LV2"; "VG"; "50"];
1825 ["lvremove"; "/dev/VG/LV1"];
1826 ["lvs"]], ["/dev/VG/LV2"]);
1827 InitEmpty, Always, TestOutputList (
1828 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1829 ["pvcreate"; "/dev/sda1"];
1830 ["vgcreate"; "VG"; "/dev/sda1"];
1831 ["lvcreate"; "LV1"; "VG"; "50"];
1832 ["lvcreate"; "LV2"; "VG"; "50"];
1833 ["lvremove"; "/dev/VG"];
1835 InitEmpty, Always, TestOutputList (
1836 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1837 ["pvcreate"; "/dev/sda1"];
1838 ["vgcreate"; "VG"; "/dev/sda1"];
1839 ["lvcreate"; "LV1"; "VG"; "50"];
1840 ["lvcreate"; "LV2"; "VG"; "50"];
1841 ["lvremove"; "/dev/VG"];
1843 "remove an LVM logical volume",
1845 P[T"Remove an LVM logical volume ";A"device";T", where ";A"device";T" is
1846 the path to the LV, such as ";C"/dev/VG/LV";T"."];
1848 P[T"You can also remove all LVs in a volume group by specifying
1849 the VG name, ";C"/dev/VG";T"."]]);
1851 ("vgremove", (RErr, [String "vgname"]), 78, [],
1852 [InitEmpty, Always, TestOutputList (
1853 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1854 ["pvcreate"; "/dev/sda1"];
1855 ["vgcreate"; "VG"; "/dev/sda1"];
1856 ["lvcreate"; "LV1"; "VG"; "50"];
1857 ["lvcreate"; "LV2"; "VG"; "50"];
1860 InitEmpty, Always, TestOutputList (
1861 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1862 ["pvcreate"; "/dev/sda1"];
1863 ["vgcreate"; "VG"; "/dev/sda1"];
1864 ["lvcreate"; "LV1"; "VG"; "50"];
1865 ["lvcreate"; "LV2"; "VG"; "50"];
1868 "remove an LVM volume group",
1870 P[T"Remove an LVM volume group ";A"vgname";T", (for example ";C"VG";T")."];
1872 Q"This also forcibly removes all logical volumes in the volume
1875 ("pvremove", (RErr, [String "device"]), 79, [],
1876 [InitEmpty, Always, TestOutputList (
1877 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1878 ["pvcreate"; "/dev/sda1"];
1879 ["vgcreate"; "VG"; "/dev/sda1"];
1880 ["lvcreate"; "LV1"; "VG"; "50"];
1881 ["lvcreate"; "LV2"; "VG"; "50"];
1883 ["pvremove"; "/dev/sda1"];
1885 InitEmpty, Always, TestOutputList (
1886 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1887 ["pvcreate"; "/dev/sda1"];
1888 ["vgcreate"; "VG"; "/dev/sda1"];
1889 ["lvcreate"; "LV1"; "VG"; "50"];
1890 ["lvcreate"; "LV2"; "VG"; "50"];
1892 ["pvremove"; "/dev/sda1"];
1894 InitEmpty, Always, TestOutputList (
1895 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1896 ["pvcreate"; "/dev/sda1"];
1897 ["vgcreate"; "VG"; "/dev/sda1"];
1898 ["lvcreate"; "LV1"; "VG"; "50"];
1899 ["lvcreate"; "LV2"; "VG"; "50"];
1901 ["pvremove"; "/dev/sda1"];
1903 "remove an LVM physical volume",
1905 P[T"This wipes a physical volume ";A"device";T" so that LVM will no longer
1908 P[T"The implementation uses the ";C"pvremove";T" command which refuses to
1909 wipe physical volumes that contain any volume groups, so you have
1910 to remove those first."]]);
1912 ("set_e2label", (RErr, [String "device"; String "label"]), 80, [],
1913 [InitBasicFS, Always, TestOutput (
1914 [["set_e2label"; "/dev/sda1"; "testlabel"];
1915 ["get_e2label"; "/dev/sda1"]], "testlabel")],
1916 "set the ext2/3/4 filesystem label",
1918 P[T"This sets the ext2/3/4 filesystem label of the filesystem on ";
1919 A"device";T" to ";A"label";T". Filesystem labels are limited to
1922 P[T"You can use either ";X"tune2fs_l";T" or ";X"get_e2label";
1923 T" to return the existing label on a filesystem."]]);
1925 ("get_e2label", (RString "label", [String "device"]), 81, [],
1927 "get the ext2/3/4 filesystem label",
1929 P[T"This returns the ext2/3/4 filesystem label of the filesystem on ";
1932 ("set_e2uuid", (RErr, [String "device"; String "uuid"]), 82, [],
1933 [InitBasicFS, Always, TestOutput (
1934 [["set_e2uuid"; "/dev/sda1"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"];
1935 ["get_e2uuid"; "/dev/sda1"]], "a3a61220-882b-4f61-89f4-cf24dcc7297d");
1936 InitBasicFS, Always, TestOutput (
1937 [["set_e2uuid"; "/dev/sda1"; "clear"];
1938 ["get_e2uuid"; "/dev/sda1"]], "");
1939 (* We can't predict what UUIDs will be, so just check the commands run. *)
1940 InitBasicFS, Always, TestRun (
1941 [["set_e2uuid"; "/dev/sda1"; "random"]]);
1942 InitBasicFS, Always, TestRun (
1943 [["set_e2uuid"; "/dev/sda1"; "time"]])],
1944 "set the ext2/3/4 filesystem UUID",
1946 P[T"This sets the ext2/3/4 filesystem UUID of the filesystem on ";
1947 A"device";T" to ";A"uuid";T". The format of the UUID and alternatives
1948 such as ";C"clear";T", ";C"random";T" and ";C"time";T" are described in the ";
1949 Man("tune2fs",8);T" manpage."];
1951 P[T"You can use either ";X"tune2fs_l";T" or ";X"get_e2uuid";
1952 T" to return the existing UUID of a filesystem."]]);
1954 ("get_e2uuid", (RString "uuid", [String "device"]), 83, [],
1956 "get the ext2/3/4 filesystem UUID",
1958 P[T"This returns the ext2/3/4 filesystem UUID of the filesystem on ";
1961 ("fsck", (RInt "status", [String "fstype"; String "device"]), 84, [],
1962 [InitBasicFS, Always, TestOutputInt (
1963 [["umount"; "/dev/sda1"];
1964 ["fsck"; "ext2"; "/dev/sda1"]], 0);
1965 InitBasicFS, Always, TestOutputInt (
1966 [["umount"; "/dev/sda1"];
1967 ["zero"; "/dev/sda1"];
1968 ["fsck"; "ext2"; "/dev/sda1"]], 8)],
1969 "run the filesystem checker",
1971 P[T"This runs the filesystem checker (fsck) on ";A"device";T" which
1972 should have filesystem type ";A"fstype";T"."];
1974 P[T"The returned integer is the status. See ";Man("fsck",8);T" for the
1975 list of status codes from ";C"fsck";T"."];
1981 Q"Multiple status codes can be summed together.";
1983 Q"A non-zero return code can mean \"success\", for example if
1984 errors have been corrected on the filesystem.";
1986 Q"Checking or repairing NTFS volumes is not supported (by linux-ntfs)."
1990 P[T"This command is entirely equivalent to running ";
1991 C"fsck -a -t fstype device";T"."]]);
1993 ("zero", (RErr, [String "device"]), 85, [],
1994 [InitBasicFS, Always, TestOutput (
1995 [["umount"; "/dev/sda1"];
1996 ["zero"; "/dev/sda1"];
1997 ["file"; "/dev/sda1"]], "data")],
1998 "write zeroes to the device",
2000 P[T"This command writes zeroes over the first few blocks of ";
2003 P[T"How many blocks are zeroed isn't specified (but it's ";Em"not";
2004 T" enough to securely wipe the device). It should be sufficient to remove
2005 any partition tables, filesystem superblocks and so on."]]);
2007 ("grub_install", (RErr, [String "root"; String "device"]), 86, [],
2008 [InitBasicFS, Always, TestOutputTrue (
2009 [["grub_install"; "/"; "/dev/sda1"];
2010 ["is_dir"; "/boot"]])],
2013 P[T"This command installs GRUB (the Grand Unified Bootloader) on ";
2014 A"device";T", with the root directory being ";A"root";T"."]]);
2016 ("cp", (RErr, [String "src"; String "dest"]), 87, [],
2017 [InitBasicFS, Always, TestOutput (
2018 [["write_file"; "/old"; "file content"; "0"];
2019 ["cp"; "/old"; "/new"];
2020 ["cat"; "/new"]], "file content");
2021 InitBasicFS, Always, TestOutputTrue (
2022 [["write_file"; "/old"; "file content"; "0"];
2023 ["cp"; "/old"; "/new"];
2024 ["is_file"; "/old"]]);
2025 InitBasicFS, Always, TestOutput (
2026 [["write_file"; "/old"; "file content"; "0"];
2028 ["cp"; "/old"; "/dir/new"];
2029 ["cat"; "/dir/new"]], "file content")],
2032 P[T"This copies a file from ";A"src";T" to ";A"dest";T" where ";A"dest";
2033 T" is either a destination filename or destination directory."]]);
2035 ("cp_a", (RErr, [String "src"; String "dest"]), 88, [],
2036 [InitBasicFS, Always, TestOutput (
2037 [["mkdir"; "/olddir"];
2038 ["mkdir"; "/newdir"];
2039 ["write_file"; "/olddir/file"; "file content"; "0"];
2040 ["cp_a"; "/olddir"; "/newdir"];
2041 ["cat"; "/newdir/olddir/file"]], "file content")],
2042 "copy a file or directory recursively",
2044 P[T"This copies a file or directory from ";A"src";T" to ";A"dest";
2045 T" recursively using the ";C"cp -a";T" command."]]);
2047 ("mv", (RErr, [String "src"; String "dest"]), 89, [],
2048 [InitBasicFS, Always, TestOutput (
2049 [["write_file"; "/old"; "file content"; "0"];
2050 ["mv"; "/old"; "/new"];
2051 ["cat"; "/new"]], "file content");
2052 InitBasicFS, Always, TestOutputFalse (
2053 [["write_file"; "/old"; "file content"; "0"];
2054 ["mv"; "/old"; "/new"];
2055 ["is_file"; "/old"]])],
2058 P[T"This moves a file from ";A"src";T" to ";A"dest";T" where ";A"dest";
2059 T" is either a destination filename or destination directory."]]);
2061 ("drop_caches", (RErr, [Int "whattodrop"]), 90, [],
2062 [InitEmpty, Always, TestRun (
2063 [["drop_caches"; "3"]])],
2064 "drop kernel page cache, dentries and inodes",
2066 P[T"This instructs the guest kernel to drop its page cache,
2067 and/or dentries and inode caches. The parameter ";A"whattodrop";
2068 T" tells the kernel what precisely to drop, see ";
2069 URL"http://linux-mm.org/Drop_Caches"];
2071 P[T"Setting ";A"whattodrop";T" to 3 should drop everything."];
2073 P[T"This automatically calls ";Man("sync",2);T" before the operation,
2074 so that the maximum guest memory is freed."]]);
2076 ("dmesg", (RString "kmsgs", []), 91, [],
2077 [InitEmpty, Always, TestRun (
2079 "return kernel messages",
2081 P[T"This returns the kernel messages (";C"dmesg";T" output) from
2082 the guest kernel. This is sometimes useful for extended
2083 debugging of problems."];
2085 P[T"Another way to get the same information is to enable
2086 verbose messages with ";X"set_verbose";T" or by setting
2087 the environment variable ";C"LIBGUESTFS_DEBUG=1";T" before
2088 running the program."]]);
2090 ("ping_daemon", (RErr, []), 92, [],
2091 [InitEmpty, Always, TestRun (
2092 [["ping_daemon"]])],
2093 "ping the guest daemon",
2095 Q"This is a test probe into the guestfs daemon running inside
2096 the qemu subprocess. Calling this function checks that the
2097 daemon responds to the ping message, without affecting the daemon
2098 or attached block device(s) in any other way."]);
2100 ("equal", (RBool "equality", [String "file1"; String "file2"]), 93, [],
2101 [InitBasicFS, Always, TestOutputTrue (
2102 [["write_file"; "/file1"; "contents of a file"; "0"];
2103 ["cp"; "/file1"; "/file2"];
2104 ["equal"; "/file1"; "/file2"]]);
2105 InitBasicFS, Always, TestOutputFalse (
2106 [["write_file"; "/file1"; "contents of a file"; "0"];
2107 ["write_file"; "/file2"; "contents of another file"; "0"];
2108 ["equal"; "/file1"; "/file2"]]);
2109 InitBasicFS, Always, TestLastFail (
2110 [["equal"; "/file1"; "/file2"]])],
2111 "test if two files have equal contents",
2113 P[T"This compares the two files ";A"file1";T" and ";A"file2";T" and returns
2114 true if their content is exactly equal, or false otherwise."];
2116 P[T"The external ";Man("cmp",1);T" program is used for the comparison."]]);
2118 ("strings", (RStringList "stringsout", [String "path"]), 94, [ProtocolLimitWarning],
2119 [InitBasicFS, Always, TestOutputList (
2120 [["write_file"; "/new"; "hello\nworld\n"; "0"];
2121 ["strings"; "/new"]], ["hello"; "world"]);
2122 InitBasicFS, Always, TestOutputList (
2124 ["strings"; "/new"]], [])],
2125 "print the printable strings in a file",
2127 P[T"This runs the ";Man("strings",1);T" command on a file and returns
2128 the list of printable strings found."]]);
2130 ("strings_e", (RStringList "stringsout", [String "encoding"; String "path"]), 95, [ProtocolLimitWarning],
2131 [InitBasicFS, Always, TestOutputList (
2132 [["write_file"; "/new"; "hello\nworld\n"; "0"];
2133 ["strings_e"; "b"; "/new"]], []);
2134 InitBasicFS, Disabled, TestOutputList (
2135 [["write_file"; "/new"; "\000h\000e\000l\000l\000o\000\n\000w\000o\000r\000l\000d\000\n"; "24"];
2136 ["strings_e"; "b"; "/new"]], ["hello"; "world"])],
2137 "print the printable strings in a file",
2139 P[T"This is like the ";X"strings";T" command, but allows you to
2140 specify the encoding."];
2142 P[T"See the ";Man("strings",1);T" manpage for the full list of encodings."];
2144 P[T"Commonly useful encodings are ";C"l";T" (lower case L) which will
2145 show strings inside Windows/x86 files."];
2147 Q"The returned strings are transcoded to UTF-8."]);
2149 ("hexdump", (RString "dump", [String "path"]), 96, [ProtocolLimitWarning],
2150 [InitBasicFS, Always, TestOutput (
2151 [["write_file"; "/new"; "hello\nworld\n"; "12"];
2152 ["hexdump"; "/new"]], "00000000 68 65 6c 6c 6f 0a 77 6f 72 6c 64 0a |hello.world.|\n0000000c\n")],
2153 "dump a file in hexadecimal",
2155 P[T"This runs ";C"hexdump -C";T" on the given ";A"path";T". The result is
2156 the human-readable, canonical hex dump of the file."]]);
2158 ("zerofree", (RErr, [String "device"]), 97, [],
2159 [InitNone, Always, TestOutput (
2160 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2161 ["mkfs"; "ext3"; "/dev/sda1"];
2162 ["mount"; "/dev/sda1"; "/"];
2163 ["write_file"; "/new"; "test file"; "0"];
2164 ["umount"; "/dev/sda1"];
2165 ["zerofree"; "/dev/sda1"];
2166 ["mount"; "/dev/sda1"; "/"];
2167 ["cat"; "/new"]], "test file")],
2168 "zero unused inodes and disk blocks on ext2/3 filesystem",
2170 P[T"This runs the ";Man("zerofree",8);T" program on ";A"device";
2171 T". This program claims to zero unused inodes and disk blocks on an ext2/3
2172 filesystem, thus making it possible to compress the filesystem
2173 more effectively."];
2175 P[T"You should ";Em"not";T" run this program if the filesystem is
2178 Q"It is possible that using this program can damage the filesystem
2179 or data on the filesystem."]);
2181 ("pvresize", (RErr, [String "device"]), 98, [],
2183 "resize an LVM physical volume",
2185 Q"This resizes (expands or shrinks) an existing LVM physical
2186 volume to match the new size of the underlying device."]);
2188 ("sfdisk_N", (RErr, [String "device"; Int "n";
2189 Int "cyls"; Int "heads"; Int "sectors";
2190 String "line"]), 99, [DangerWillRobinson],
2192 "modify a single partition on a block device",
2194 P[T"This runs ";Man("sfdisk",8);T" option to modify just the single
2195 partition ";A"n";T" (note: ";A"n";T" counts from 1)."];
2197 P[T"For other parameters, see ";X"sfdisk";T". You should usually
2198 pass ";C"0";T" for the cyls/heads/sectors parameters."]]);
2200 ("sfdisk_l", (RString "partitions", [String "device"]), 100, [],
2202 "display the partition table",
2204 P[T"This displays the partition table on ";A"device";T", in the
2205 human-readable output of the ";Man("sfdisk",8);T" command. It is
2206 not intended to be parsed."]]);
2208 ("sfdisk_kernel_geometry", (RString "partitions", [String "device"]), 101, [],
2210 "display the kernel geometry",
2212 P[T"This displays the kernel's idea of the geometry of ";A"device";T"."];
2214 Q"The result is in human-readable format, and not designed to
2217 ("sfdisk_disk_geometry", (RString "partitions", [String "device"]), 102, [],
2219 "display the disk geometry from the partition table",
2221 P[T"This displays the disk geometry of ";A"device";T" read from the
2222 partition table. Especially in the case where the underlying
2223 block device has been resized, this can be different from the
2224 kernel's idea of the geometry (see ";X"sfdisk_kernel_geometry";T")."];
2226 Q"The result is in human-readable format, and not designed to
2229 ("vg_activate_all", (RErr, [Bool "activate"]), 103, [],
2231 "activate or deactivate all volume groups",
2233 P[T"This command activates or (if ";A"activate";T" is false) deactivates
2234 all logical volumes in all volume groups.
2235 If activated, then they are made known to the
2236 kernel, ie. they appear as ";C"/dev/mapper";T" devices. If deactivated,
2237 then those devices disappear."];
2239 P[T"This command is the same as running ";C"vgchange -a y|n"]]);
2241 ("vg_activate", (RErr, [Bool "activate"; StringList "volgroups"]), 104, [],
2243 "activate or deactivate some volume groups",
2245 P[T"This command activates or (if ";A"activate";T" is false) deactivates
2246 all logical volumes in the listed volume groups ";A"volgroups";T".
2247 If activated, then they are made known to the
2248 kernel, ie. they appear as ";C"/dev/mapper";T" devices. If deactivated,
2249 then those devices disappear."];
2251 P[T"This command is the same as running ";C"vgchange -a y|n volgroups..."];
2253 Note[T"If ";A"volgroups";T" is an empty list then ";
2254 Em"all";T" volume groups are activated or deactivated."]]);
2256 ("lvresize", (RErr, [String "device"; Int "mbytes"]), 105, [],
2257 [InitNone, Always, TestOutput (
2258 [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2259 ["pvcreate"; "/dev/sda1"];
2260 ["vgcreate"; "VG"; "/dev/sda1"];
2261 ["lvcreate"; "LV"; "VG"; "10"];
2262 ["mkfs"; "ext2"; "/dev/VG/LV"];
2263 ["mount"; "/dev/VG/LV"; "/"];
2264 ["write_file"; "/new"; "test content"; "0"];
2266 ["lvresize"; "/dev/VG/LV"; "20"];
2267 ["e2fsck_f"; "/dev/VG/LV"];
2268 ["resize2fs"; "/dev/VG/LV"];
2269 ["mount"; "/dev/VG/LV"; "/"];
2270 ["cat"; "/new"]], "test content")],
2271 "resize an LVM logical volume",
2273 P[T"This resizes (expands or shrinks) an existing LVM logical
2274 volume to ";A"mbytes";T". When reducing, data in the reduced part
2277 ("resize2fs", (RErr, [String "device"]), 106, [],
2278 [], (* lvresize tests this *)
2279 "resize an ext2/ext3 filesystem",
2281 Q"This resizes an ext2 or ext3 filesystem to match the size of
2282 the underlying device.";
2284 Note[T"It is sometimes required that you run ";X"e2fsck_f";
2285 T" on the ";A"device";T" before calling this command. For unknown reasons ";
2286 C"resize2fs";T" sometimes gives an error about this and sometimes not.
2287 In any case, it is always safe to call ";X"e2fsck_f";T" before
2288 calling this function."]]);
2290 ("find", (RStringList "names", [String "directory"]), 107, [],
2291 [InitBasicFS, Always, TestOutputList (
2292 [["find"; "/"]], ["lost+found"]);
2293 InitBasicFS, Always, TestOutputList (
2297 ["find"; "/"]], ["a"; "b"; "b/c"; "lost+found"]);
2298 InitBasicFS, Always, TestOutputList (
2299 [["mkdir_p"; "/a/b/c"];
2300 ["touch"; "/a/b/c/d"];
2301 ["find"; "/a/b/"]], ["c"; "c/d"])],
2302 "find all files and directories",
2304 P[T"This command lists out all files and directories, recursively,
2305 starting at ";A"directory";T". It is essentially equivalent to
2306 running the shell command ";C"find directory -print";T" but some
2307 post-processing happens on the output, described below."];
2309 P[T"This returns a list of strings ";Em"without any prefix";T". Thus
2310 if the directory structure was:"];
2318 P[T"then the returned list from ";XA("find",[C"/tmp"]);T" would be
2328 P[T"If ";A"directory";T" is not a directory, then this command returns
2331 Q"The returned list is sorted."]);
2333 ("e2fsck_f", (RErr, [String "device"]), 108, [],
2334 [], (* lvresize tests this *)
2335 "check an ext2/ext3 filesystem",
2337 P[T"This runs ";C"e2fsck -p -f device";T", ie. runs the ext2/ext3
2338 filesystem checker on ";A"device";T", noninteractively (";C"-p";T"),
2339 even if the filesystem appears to be clean (";C"-f";T")."];
2341 P[T"This command is only needed because of ";X"resize2fs";
2342 T" (q.v.). Normally you should use ";X"fsck";T"."]]);
2346 let all_functions = non_daemon_functions @ daemon_functions
2348 (* In some places we want the functions to be displayed sorted
2349 * alphabetically, so this is useful:
2351 let all_functions_sorted =
2352 List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
2353 compare n1 n2) all_functions
2355 (* Column names and types from LVM PVs/VGs/LVs. *)
2364 "pv_attr", `String (* XXX *);
2365 "pv_pe_count", `Int;
2366 "pv_pe_alloc_count", `Int;
2369 "pv_mda_count", `Int;
2370 "pv_mda_free", `Bytes;
2371 (* Not in Fedora 10:
2372 "pv_mda_size", `Bytes;
2379 "vg_attr", `String (* XXX *);
2382 "vg_sysid", `String;
2383 "vg_extent_size", `Bytes;
2384 "vg_extent_count", `Int;
2385 "vg_free_count", `Int;
2393 "vg_mda_count", `Int;
2394 "vg_mda_free", `Bytes;
2395 (* Not in Fedora 10:
2396 "vg_mda_size", `Bytes;
2402 "lv_attr", `String (* XXX *);
2405 "lv_kernel_major", `Int;
2406 "lv_kernel_minor", `Int;
2410 "snap_percent", `OptPercent;
2411 "copy_percent", `OptPercent;
2414 "mirror_log", `String;
2418 (* Column names and types from stat structures.
2419 * NB. Can't use things like 'st_atime' because glibc header files
2420 * define some of these as macros. Ugh.
2437 let statvfs_cols = [
2451 (* Used for testing language bindings. *)
2453 | CallString of string
2454 | CallOptString of string option
2455 | CallStringList of string list
2459 (* Useful functions.
2460 * Note we don't want to use any external OCaml libraries which
2461 * makes this a bit harder than it should be.
2463 let failwithf fs = ksprintf failwith fs
2465 let replace_char s c1 c2 =
2466 let s2 = String.copy s in
2467 let r = ref false in
2468 for i = 0 to String.length s2 - 1 do
2469 if String.unsafe_get s2 i = c1 then (
2470 String.unsafe_set s2 i c2;
2474 if not !r then s else s2
2478 (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
2480 let triml ?(test = isspace) str =
2482 let n = ref (String.length str) in
2483 while !n > 0 && test str.[!i]; do
2488 else String.sub str !i !n
2490 let trimr ?(test = isspace) str =
2491 let n = ref (String.length str) in
2492 while !n > 0 && test str.[!n-1]; do
2495 if !n = String.length str then str
2496 else String.sub str 0 !n
2498 let trim ?(test = isspace) str =
2499 trimr ~test (triml ~test str)
2501 let rec find s sub =
2502 let len = String.length s in
2503 let sublen = String.length sub in
2505 if i <= len-sublen then (
2507 if j < sublen then (
2508 if s.[i+j] = sub.[j] then loop2 (j+1)
2514 if r = -1 then loop (i+1) else r
2520 let rec replace_str s s1 s2 =
2521 let len = String.length s in
2522 let sublen = String.length s1 in
2523 let i = find s s1 in
2526 let s' = String.sub s 0 i in
2527 let s'' = String.sub s (i+sublen) (len-i-sublen) in
2528 s' ^ s2 ^ replace_str s'' s1 s2
2531 let rec string_split sep str =
2532 let len = String.length str in
2533 let seplen = String.length sep in
2534 let i = find str sep in
2535 if i = -1 then [str]
2537 let s' = String.sub str 0 i in
2538 let s'' = String.sub str (i+seplen) (len-i-seplen) in
2539 s' :: string_split sep s''
2542 let string_map f str =
2543 let strs = ref [] in
2544 let n = String.length str in
2547 let s = f str.[i] in
2553 String.concat "" (List.rev !strs)
2555 let files_equal n1 n2 =
2556 let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
2557 match Sys.command cmd with
2560 | i -> failwithf "%s: failed with error code %d" cmd i
2562 let rec find_map f = function
2563 | [] -> raise Not_found
2567 | None -> find_map f xs
2570 let rec loop i = function
2572 | x :: xs -> f i x; loop (i+1) xs
2577 let rec loop i = function
2579 | x :: xs -> let r = f i x in r :: loop (i+1) xs
2583 let itersep f sep xs =
2584 iteri (fun i x -> if i > 0 then sep (); f x) xs
2586 let name_of_argt = function
2587 | String n | OptString n | StringList n | Bool n | Int n
2588 | FileIn n | FileOut n -> n
2590 let seq_of_test = function
2591 | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
2592 | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s
2593 | TestOutputLength (s, _) | TestOutputStruct (s, _)
2594 | TestLastFail s -> s
2596 (* Check function names etc. for consistency. *)
2597 let check_functions () =
2598 let contains_uppercase str =
2599 let len = String.length str in
2601 if i >= len then false
2604 if c >= 'A' && c <= 'Z' then true
2611 (* Check function names. *)
2613 fun (name, _, _, _, _, _, _) ->
2614 if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
2615 failwithf "function name %s does not need 'guestfs' prefix" name;
2617 failwithf "function name is empty";
2618 if name.[0] < 'a' || name.[0] > 'z' then
2619 failwithf "function name %s must start with lowercase a-z" name;
2620 if String.contains name '-' then
2621 failwithf "function name %s should not contain '-', use '_' instead."
2625 (* Check function parameter/return names. *)
2627 fun (name, style, _, _, _, _, _) ->
2628 let check_arg_ret_name n =
2629 if contains_uppercase n then
2630 failwithf "%s param/ret %s should not contain uppercase chars"
2632 if String.contains n '-' || String.contains n '_' then
2633 failwithf "%s param/ret %s should not contain '-' or '_'"
2636 failwithf "%s has a param/ret called 'value', which causes conflicts in the OCaml bindings, use something like 'val' or a more descriptive name" name;
2637 if n = "int" || n = "char" || n = "short" || n = "long" then
2638 failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;
2640 failwithf "%s has a param/ret called 'i', which will cause some conflicts in the generated code" name;
2641 if n = "argv" || n = "args" then
2642 failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name
2645 (match fst style with
2647 | RInt n | RInt64 n | RBool n | RConstString n | RString n
2648 | RStringList n | RPVList n | RVGList n | RLVList n
2649 | RStat n | RStatVFS n
2651 check_arg_ret_name n
2653 check_arg_ret_name n;
2654 check_arg_ret_name m
2656 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
2659 (* Check short descriptions. *)
2661 fun (name, _, _, _, _, shortdesc, _) ->
2662 if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
2663 failwithf "short description of %s should begin with lowercase." name;
2664 let c = shortdesc.[String.length shortdesc-1] in
2665 if c = '\n' || c = '.' then
2666 failwithf "short description of %s should not end with . or \\n." name
2669 (* Check long descriptions. *)
2671 let cmds = List.map (fun (name, _, _, _, _, _, _) -> name) all_functions in
2674 fun (name, style, _, _, _, _, longdesc) ->
2675 let args = List.map name_of_argt (snd style) in
2677 if longdesc = [] then
2678 failwithf "%s has no long description" name;
2680 let rec check_para = function
2681 | Q str -> check_snippet (T str)
2682 | P snips -> List.iter check_snippet snips
2685 (fun (snips, para) -> check_para (P snips); check_para para)
2687 | BulletList ps -> List.iter check_para ps
2688 | QNote str -> check_snippet (T str)
2689 | Note snips -> List.iter check_snippet snips
2690 | Pre xs -> List.iter (fun str -> check_snippet (T str)) xs
2691 | SeeAlso xs -> List.iter (fun cmd -> check_snippet (X cmd)) xs
2692 and check_snippet = function
2695 failwithf "%s has empty string snippet (eg. T\"\")" name;
2696 check_no_perldoc str
2698 if List.mem code args then
2699 failwithf "%s has C\"%s\", should be A\"%s\"" name code code;
2700 if code = "NULL" || code = "non-NULL" then
2701 failwithf "%s C\"%s\" should be NULL|NONNULL" name code;
2703 if not (List.mem arg args) then
2704 failwithf "%s A\"%s\" refers to non-existent arg" name arg;
2705 | X cmd | XA (cmd, _) ->
2706 if not (List.mem cmd cmds) then
2707 failwithf "%s X\"%s\" refers to non-existent command" name cmd;
2709 if List.mem cmd cmds then
2710 failwithf "%s XU\"%s\" should be X\"%s\"" name cmd cmd;
2712 | Man ("guestfs", 3) -> ()
2713 | Man ("guestfish", 1) -> ()
2714 | Man (man, sect) ->
2715 let prefix = sprintf "/usr/share/man/man%d/%s.%d" sect man sect in
2716 if not (Sys.file_exists prefix) &&
2717 not (Sys.file_exists (prefix ^ ".gz")) then
2718 eprintf "warning: %s: refers to non-existent manpage %s(%d)\n"
2721 | NULL | NONNULL -> ()
2722 and check_no_perldoc str =
2723 if find str "C<" >= 0 || find str "I<" >= 0
2724 || find str "B<" >= 0 || find str "E<" >= 0
2725 || find str "\n=" >= 0 then
2726 failwithf "%s long description contains perldoc markup" name
2728 List.iter check_para longdesc
2731 (* Check proc_nrs. *)
2733 fun (name, _, proc_nr, _, _, _, _) ->
2734 if proc_nr <= 0 then
2735 failwithf "daemon function %s should have proc_nr > 0" name
2739 fun (name, _, proc_nr, _, _, _, _) ->
2740 if proc_nr <> -1 then
2741 failwithf "non-daemon function %s should have proc_nr -1" name
2742 ) non_daemon_functions;
2745 List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
2748 List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
2749 let rec loop = function
2752 | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
2754 | (name1,nr1) :: (name2,nr2) :: _ ->
2755 failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
2763 (* Ignore functions that have no tests. We generate a
2764 * warning when the user does 'make check' instead.
2766 | name, _, _, _, [], _, _ -> ()
2767 | name, _, _, _, tests, _, _ ->
2771 match seq_of_test test with
2773 failwithf "%s has a test containing an empty sequence" name
2774 | cmds -> List.map List.hd cmds
2776 let funcs = List.flatten funcs in
2778 let tested = List.mem name funcs in
2781 failwithf "function %s has tests but does not test itself" name
2784 (* 'pr' prints to the current output file. *)
2785 let chan = ref stdout
2786 let pr fs = ksprintf (output_string !chan) fs
2788 (* Generate a header block in a number of standard styles. *)
2789 type comment_style = CStyle | HashStyle | OCamlStyle | HaskellStyle
2790 type license = GPLv2 | LGPLv2
2792 let generate_header comment license =
2793 let c = match comment with
2794 | CStyle -> pr "/* "; " *"
2795 | HashStyle -> pr "# "; "#"
2796 | OCamlStyle -> pr "(* "; " *"
2797 | HaskellStyle -> pr "{- "; " " in
2798 pr "libguestfs generated file\n";
2799 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
2800 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
2802 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
2806 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
2807 pr "%s it under the terms of the GNU General Public License as published by\n" c;
2808 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
2809 pr "%s (at your option) any later version.\n" c;
2811 pr "%s This program is distributed in the hope that it will be useful,\n" c;
2812 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
2813 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
2814 pr "%s GNU General Public License for more details.\n" c;
2816 pr "%s You should have received a copy of the GNU General Public License along\n" c;
2817 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
2818 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
2821 pr "%s This library is free software; you can redistribute it and/or\n" c;
2822 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
2823 pr "%s License as published by the Free Software Foundation; either\n" c;
2824 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
2826 pr "%s This library is distributed in the hope that it will be useful,\n" c;
2827 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
2828 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
2829 pr "%s Lesser General Public License for more details.\n" c;
2831 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
2832 pr "%s License along with this library; if not, write to the Free Software\n" c;
2833 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
2836 | CStyle -> pr " */\n"
2838 | OCamlStyle -> pr " *)\n"
2839 | HaskellStyle -> pr "-}\n"
2843 (* Start of main code generation functions below this line. *)
2845 (* Generate the pod documentation for the C API. *)
2846 let rec generate_actions_pod () =
2848 fun (shortname, style, _, flags, _, _, longdesc) ->
2849 if not (List.mem NotInDocs flags) then (
2850 let name = "guestfs_" ^ shortname in
2851 pr "=head2 %s\n\n" name;
2853 generate_prototype ~extern:false ~handle:"handle" name style;
2855 generate_pod_of_longdesc ~language:`C longdesc;
2856 (match fst style with
2858 pr "This function returns 0 on success or -1 on error.\n\n"
2860 pr "On error this function returns -1.\n\n"
2862 pr "On error this function returns -1.\n\n"
2864 pr "This function returns a C truth value on success or -1 on error.\n\n"
2866 pr "This function returns a string, or NULL on error.
2867 The string is owned by the guest handle and must I<not> be freed.\n\n"
2869 pr "This function returns a string, or NULL on error.
2870 I<The caller must free the returned string after use>.\n\n"
2872 pr "This function returns a NULL-terminated array of strings
2873 (like L<environ(3)>), or NULL if there was an error.
2874 I<The caller must free the strings and the array after use>.\n\n"
2876 pr "This function returns a C<struct guestfs_int_bool *>,
2877 or NULL if there was an error.
2878 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
2880 pr "This function returns a C<struct guestfs_lvm_pv_list *>
2881 (see E<lt>guestfs-structs.hE<gt>),
2882 or NULL if there was an error.
2883 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
2885 pr "This function returns a C<struct guestfs_lvm_vg_list *>
2886 (see E<lt>guestfs-structs.hE<gt>),
2887 or NULL if there was an error.
2888 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
2890 pr "This function returns a C<struct guestfs_lvm_lv_list *>
2891 (see E<lt>guestfs-structs.hE<gt>),
2892 or NULL if there was an error.
2893 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
2895 pr "This function returns a C<struct guestfs_stat *>
2896 (see L<stat(2)> and E<lt>guestfs-structs.hE<gt>),
2897 or NULL if there was an error.
2898 I<The caller must call C<free> after use>.\n\n"
2900 pr "This function returns a C<struct guestfs_statvfs *>
2901 (see L<statvfs(2)> and E<lt>guestfs-structs.hE<gt>),
2902 or NULL if there was an error.
2903 I<The caller must call C<free> after use>.\n\n"
2905 pr "This function returns a NULL-terminated array of
2906 strings, or NULL if there was an error.
2907 The array of strings will always have length C<2n+1>, where
2908 C<n> keys and values alternate, followed by the trailing NULL entry.
2909 I<The caller must free the strings and the array after use>.\n\n"
2911 if List.mem ProtocolLimitWarning flags then
2912 pr "%s\n\n" protocol_limit_warning;
2913 if List.mem DangerWillRobinson flags then
2914 pr "%s\n\n" danger_will_robinson
2916 ) all_functions_sorted
2918 and generate_structs_pod () =
2919 (* LVM structs documentation. *)
2922 pr "=head2 guestfs_lvm_%s\n" typ;
2924 pr " struct guestfs_lvm_%s {\n" typ;
2927 | name, `String -> pr " char *%s;\n" name
2929 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
2930 pr " char %s[32];\n" name
2931 | name, `Bytes -> pr " uint64_t %s;\n" name
2932 | name, `Int -> pr " int64_t %s;\n" name
2933 | name, `OptPercent ->
2934 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
2935 pr " float %s;\n" name
2938 pr " struct guestfs_lvm_%s_list {\n" typ;
2939 pr " uint32_t len; /* Number of elements in list. */\n";
2940 pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
2943 pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
2946 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2948 (* Generate POD (Perl documentation format, also used for manpages
2949 * and C API documentation) from the longdesc structure.
2951 and generate_pod_of_longdesc ~language paras =
2952 let rec do_para = function
2953 | Q str -> do_para (P [T str])
2954 | P snips -> List.iter do_snippet snips
2958 (fun (snips, para) ->
2960 List.iter do_snippet snips;
2966 | BulletList items ->
2973 | QNote str -> do_para (Note [T str])
2976 List.iter do_snippet snips;
2979 List.iter (pr " %s\n") lines;
2982 pr "I<See also:>\n";
2983 itersep (fun cmd -> do_snippet (X cmd)) (fun () -> pr ", ") cmds;
2985 and do_snippet = function
2986 | T str -> pr "%s" (pod_quote str)
2988 | A str -> pr "C<%s>" (pod_quote str)
2990 (match language with
2991 | `C -> pr "L<guestfs_%s>" cmd
2992 | `Perl -> pr "$h-E<gt>L<%s>" cmd
2995 (match language with
2997 pr "L<guestfs_%s> (g" cmd;
2998 List.iter (fun arg -> pr ", "; do_snippet arg) args;
3001 pr "$h->L<%s> (" cmd;
3002 itersep (fun arg -> do_snippet arg) (fun () -> pr ", ") args;
3004 | XU cmd -> pr "C<%s> I<[unimplemented]>" cmd
3005 | XW cmd -> pr "C<%s>" cmd
3006 | Em str -> pr "I<%s>" (pod_quote str)
3007 | Man (man, sect) -> pr "L<%s(%d)>" man sect
3008 | URL url -> pr "L<%s>" url
3010 (match language with `C -> pr "NULL" | `Perl -> pr "undef")
3012 (match language with `C -> pr "non-NULL" | `Perl -> pr "defined")
3015 (function '<' -> "E<lt>" | '>' -> "E<gt>" | c -> String.make 1 c)
3018 List.iter do_para paras
3020 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
3021 * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
3023 * We have to use an underscore instead of a dash because otherwise
3024 * rpcgen generates incorrect code.
3026 * This header is NOT exported to clients, but see also generate_structs_h.
3028 and generate_xdr () =
3029 generate_header CStyle LGPLv2;
3031 (* This has to be defined to get around a limitation in Sun's rpcgen. *)
3032 pr "typedef string str<>;\n";
3035 (* LVM internal structures. *)
3039 pr "struct guestfs_lvm_int_%s {\n" typ;
3041 | name, `String -> pr " string %s<>;\n" name
3042 | name, `UUID -> pr " opaque %s[32];\n" name
3043 | name, `Bytes -> pr " hyper %s;\n" name
3044 | name, `Int -> pr " hyper %s;\n" name
3045 | name, `OptPercent -> pr " float %s;\n" name
3049 pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
3051 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3053 (* Stat internal structures. *)
3057 pr "struct guestfs_int_%s {\n" typ;
3059 | name, `Int -> pr " hyper %s;\n" name
3063 ) ["stat", stat_cols; "statvfs", statvfs_cols];
3066 fun (shortname, style, _, _, _, _, _) ->
3067 let name = "guestfs_" ^ shortname in
3069 (match snd style with
3072 pr "struct %s_args {\n" name;
3075 | String n -> pr " string %s<>;\n" n
3076 | OptString n -> pr " str *%s;\n" n
3077 | StringList n -> pr " str %s<>;\n" n
3078 | Bool n -> pr " bool %s;\n" n
3079 | Int n -> pr " int %s;\n" n
3080 | FileIn _ | FileOut _ -> ()
3084 (match fst style with
3087 pr "struct %s_ret {\n" name;
3091 pr "struct %s_ret {\n" name;
3092 pr " hyper %s;\n" n;
3095 pr "struct %s_ret {\n" name;
3099 failwithf "RConstString cannot be returned from a daemon function"
3101 pr "struct %s_ret {\n" name;
3102 pr " string %s<>;\n" n;
3105 pr "struct %s_ret {\n" name;
3106 pr " str %s<>;\n" n;
3109 pr "struct %s_ret {\n" name;
3114 pr "struct %s_ret {\n" name;
3115 pr " guestfs_lvm_int_pv_list %s;\n" n;
3118 pr "struct %s_ret {\n" name;
3119 pr " guestfs_lvm_int_vg_list %s;\n" n;
3122 pr "struct %s_ret {\n" name;
3123 pr " guestfs_lvm_int_lv_list %s;\n" n;
3126 pr "struct %s_ret {\n" name;
3127 pr " guestfs_int_stat %s;\n" n;
3130 pr "struct %s_ret {\n" name;
3131 pr " guestfs_int_statvfs %s;\n" n;
3134 pr "struct %s_ret {\n" name;
3135 pr " str %s<>;\n" n;
3140 (* Table of procedure numbers. *)
3141 pr "enum guestfs_procedure {\n";
3143 fun (shortname, _, proc_nr, _, _, _, _) ->
3144 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
3146 pr " GUESTFS_PROC_NR_PROCS\n";
3150 (* Having to choose a maximum message size is annoying for several
3151 * reasons (it limits what we can do in the API), but it (a) makes
3152 * the protocol a lot simpler, and (b) provides a bound on the size
3153 * of the daemon which operates in limited memory space. For large
3154 * file transfers you should use FTP.
3156 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
3159 (* Message header, etc. *)
3161 /* The communication protocol is now documented in the guestfs(3)
3165 const GUESTFS_PROGRAM = 0x2000F5F5;
3166 const GUESTFS_PROTOCOL_VERSION = 1;
3168 /* These constants must be larger than any possible message length. */
3169 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
3170 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
3172 enum guestfs_message_direction {
3173 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
3174 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
3177 enum guestfs_message_status {
3178 GUESTFS_STATUS_OK = 0,
3179 GUESTFS_STATUS_ERROR = 1
3182 const GUESTFS_ERROR_LEN = 256;
3184 struct guestfs_message_error {
3185 string error_message<GUESTFS_ERROR_LEN>;
3188 struct guestfs_message_header {
3189 unsigned prog; /* GUESTFS_PROGRAM */
3190 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
3191 guestfs_procedure proc; /* GUESTFS_PROC_x */
3192 guestfs_message_direction direction;
3193 unsigned serial; /* message serial number */
3194 guestfs_message_status status;
3197 const GUESTFS_MAX_CHUNK_SIZE = 8192;
3199 struct guestfs_chunk {
3200 int cancel; /* if non-zero, transfer is cancelled */
3201 /* data size is 0 bytes if the transfer has finished successfully */
3202 opaque data<GUESTFS_MAX_CHUNK_SIZE>;
3206 (* Generate the guestfs-structs.h file. *)
3207 and generate_structs_h () =
3208 generate_header CStyle LGPLv2;
3210 (* This is a public exported header file containing various
3211 * structures. The structures are carefully written to have
3212 * exactly the same in-memory format as the XDR structures that
3213 * we use on the wire to the daemon. The reason for creating
3214 * copies of these structures here is just so we don't have to
3215 * export the whole of guestfs_protocol.h (which includes much
3216 * unrelated and XDR-dependent stuff that we don't want to be
3217 * public, or required by clients).
3219 * To reiterate, we will pass these structures to and from the
3220 * client with a simple assignment or memcpy, so the format
3221 * must be identical to what rpcgen / the RFC defines.
3224 (* guestfs_int_bool structure. *)
3225 pr "struct guestfs_int_bool {\n";
3231 (* LVM public structures. *)
3235 pr "struct guestfs_lvm_%s {\n" typ;
3238 | name, `String -> pr " char *%s;\n" name
3239 | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
3240 | name, `Bytes -> pr " uint64_t %s;\n" name
3241 | name, `Int -> pr " int64_t %s;\n" name
3242 | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
3246 pr "struct guestfs_lvm_%s_list {\n" typ;
3247 pr " uint32_t len;\n";
3248 pr " struct guestfs_lvm_%s *val;\n" typ;
3251 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3253 (* Stat structures. *)
3257 pr "struct guestfs_%s {\n" typ;
3260 | name, `Int -> pr " int64_t %s;\n" name
3264 ) ["stat", stat_cols; "statvfs", statvfs_cols]
3266 (* Generate the guestfs-actions.h file. *)
3267 and generate_actions_h () =
3268 generate_header CStyle LGPLv2;
3270 fun (shortname, style, _, _, _, _, _) ->
3271 let name = "guestfs_" ^ shortname in
3272 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
3276 (* Generate the client-side dispatch stubs. *)
3277 and generate_client_actions () =
3278 generate_header CStyle LGPLv2;
3284 #include \"guestfs.h\"
3285 #include \"guestfs_protocol.h\"
3287 #define error guestfs_error
3288 #define perrorf guestfs_perrorf
3289 #define safe_malloc guestfs_safe_malloc
3290 #define safe_realloc guestfs_safe_realloc
3291 #define safe_strdup guestfs_safe_strdup
3292 #define safe_memdup guestfs_safe_memdup
3294 /* Check the return message from a call for validity. */
3296 check_reply_header (guestfs_h *g,
3297 const struct guestfs_message_header *hdr,
3298 int proc_nr, int serial)
3300 if (hdr->prog != GUESTFS_PROGRAM) {
3301 error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
3304 if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
3305 error (g, \"wrong protocol version (%%d/%%d)\",
3306 hdr->vers, GUESTFS_PROTOCOL_VERSION);
3309 if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
3310 error (g, \"unexpected message direction (%%d/%%d)\",
3311 hdr->direction, GUESTFS_DIRECTION_REPLY);
3314 if (hdr->proc != proc_nr) {
3315 error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
3318 if (hdr->serial != serial) {
3319 error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
3326 /* Check we are in the right state to run a high-level action. */
3328 check_state (guestfs_h *g, const char *caller)
3330 if (!guestfs_is_ready (g)) {
3331 if (guestfs_is_config (g))
3332 error (g, \"%%s: call launch() before using this function\",
3334 else if (guestfs_is_launching (g))
3335 error (g, \"%%s: call wait_ready() before using this function\",
3338 error (g, \"%%s called from the wrong state, %%d != READY\",
3339 caller, guestfs_get_state (g));
3347 (* Client-side stubs for each function. *)
3349 fun (shortname, style, _, _, _, _, _) ->
3350 let name = "guestfs_" ^ shortname in
3352 (* Generate the context struct which stores the high-level
3353 * state between callback functions.
3355 pr "struct %s_ctx {\n" shortname;
3356 pr " /* This flag is set by the callbacks, so we know we've done\n";
3357 pr " * the callbacks as expected, and in the right sequence.\n";
3358 pr " * 0 = not called, 1 = reply_cb called.\n";
3360 pr " int cb_sequence;\n";
3361 pr " struct guestfs_message_header hdr;\n";
3362 pr " struct guestfs_message_error err;\n";
3363 (match fst style with
3366 failwithf "RConstString cannot be returned from a daemon function"
3368 | RBool _ | RString _ | RStringList _
3370 | RPVList _ | RVGList _ | RLVList _
3371 | RStat _ | RStatVFS _
3373 pr " struct %s_ret ret;\n" name
3378 (* Generate the reply callback function. *)
3379 pr "static void %s_reply_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
3381 pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
3382 pr " struct %s_ctx *ctx = (struct %s_ctx *) data;\n" shortname shortname;
3384 pr " /* This should definitely not happen. */\n";
3385 pr " if (ctx->cb_sequence != 0) {\n";
3386 pr " ctx->cb_sequence = 9999;\n";
3387 pr " error (g, \"%%s: internal error: reply callback called twice\", \"%s\");\n" name;
3391 pr " ml->main_loop_quit (ml, g);\n";
3393 pr " if (!xdr_guestfs_message_header (xdr, &ctx->hdr)) {\n";
3394 pr " error (g, \"%%s: failed to parse reply header\", \"%s\");\n" name;
3397 pr " if (ctx->hdr.status == GUESTFS_STATUS_ERROR) {\n";
3398 pr " if (!xdr_guestfs_message_error (xdr, &ctx->err)) {\n";
3399 pr " error (g, \"%%s: failed to parse reply error\", \"%s\");\n"
3406 (match fst style with
3409 failwithf "RConstString cannot be returned from a daemon function"
3411 | RBool _ | RString _ | RStringList _
3413 | RPVList _ | RVGList _ | RLVList _
3414 | RStat _ | RStatVFS _
3416 pr " if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name;
3417 pr " error (g, \"%%s: failed to parse reply\", \"%s\");\n" name;
3423 pr " ctx->cb_sequence = 1;\n";
3426 (* Generate the action stub. *)
3427 generate_prototype ~extern:false ~semicolon:false ~newline:true
3428 ~handle:"g" name style;
3431 match fst style with
3432 | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
3434 failwithf "RConstString cannot be returned from a daemon function"
3435 | RString _ | RStringList _ | RIntBool _
3436 | RPVList _ | RVGList _ | RLVList _
3437 | RStat _ | RStatVFS _
3443 (match snd style with
3445 | _ -> pr " struct %s_args args;\n" name
3448 pr " struct %s_ctx ctx;\n" shortname;
3449 pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
3450 pr " int serial;\n";
3452 pr " if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
3453 pr " guestfs_set_busy (g);\n";
3455 pr " memset (&ctx, 0, sizeof ctx);\n";
3458 (* Send the main header and arguments. *)
3459 (match snd style with
3461 pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s, NULL, NULL);\n"
3462 (String.uppercase shortname)
3467 pr " args.%s = (char *) %s;\n" n n
3469 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
3471 pr " args.%s.%s_val = (char **) %s;\n" n n n;
3472 pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
3474 pr " args.%s = %s;\n" n n
3476 pr " args.%s = %s;\n" n n
3477 | FileIn _ | FileOut _ -> ()
3479 pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s,\n"
3480 (String.uppercase shortname);
3481 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
3484 pr " if (serial == -1) {\n";
3485 pr " guestfs_end_busy (g);\n";
3486 pr " return %s;\n" error_code;
3490 (* Send any additional files (FileIn) requested. *)
3491 let need_read_reply_label = ref false in
3498 pr " r = guestfs__send_file_sync (g, %s);\n" n;
3499 pr " if (r == -1) {\n";
3500 pr " guestfs_end_busy (g);\n";
3501 pr " return %s;\n" error_code;
3503 pr " if (r == -2) /* daemon cancelled */\n";
3504 pr " goto read_reply;\n";
3505 need_read_reply_label := true;
3511 (* Wait for the reply from the remote end. *)
3512 if !need_read_reply_label then pr " read_reply:\n";
3513 pr " guestfs__switch_to_receiving (g);\n";
3514 pr " ctx.cb_sequence = 0;\n";
3515 pr " guestfs_set_reply_callback (g, %s_reply_cb, &ctx);\n" shortname;
3516 pr " (void) ml->main_loop_run (ml, g);\n";
3517 pr " guestfs_set_reply_callback (g, NULL, NULL);\n";
3518 pr " if (ctx.cb_sequence != 1) {\n";
3519 pr " error (g, \"%%s reply failed, see earlier error messages\", \"%s\");\n" name;
3520 pr " guestfs_end_busy (g);\n";
3521 pr " return %s;\n" error_code;
3525 pr " if (check_reply_header (g, &ctx.hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
3526 (String.uppercase shortname);
3527 pr " guestfs_end_busy (g);\n";
3528 pr " return %s;\n" error_code;
3532 pr " if (ctx.hdr.status == GUESTFS_STATUS_ERROR) {\n";
3533 pr " error (g, \"%%s\", ctx.err.error_message);\n";
3534 pr " free (ctx.err.error_message);\n";
3535 pr " guestfs_end_busy (g);\n";
3536 pr " return %s;\n" error_code;
3540 (* Expecting to receive further files (FileOut)? *)
3544 pr " if (guestfs__receive_file_sync (g, %s) == -1) {\n" n;
3545 pr " guestfs_end_busy (g);\n";
3546 pr " return %s;\n" error_code;
3552 pr " guestfs_end_busy (g);\n";
3554 (match fst style with
3555 | RErr -> pr " return 0;\n"
3556 | RInt n | RInt64 n | RBool n ->
3557 pr " return ctx.ret.%s;\n" n
3559 failwithf "RConstString cannot be returned from a daemon function"
3561 pr " return ctx.ret.%s; /* caller will free */\n" n
3562 | RStringList n | RHashtable n ->
3563 pr " /* caller will free this, but we need to add a NULL entry */\n";
3564 pr " ctx.ret.%s.%s_val =\n" n n;
3565 pr " safe_realloc (g, ctx.ret.%s.%s_val,\n" n n;
3566 pr " sizeof (char *) * (ctx.ret.%s.%s_len + 1));\n"
3568 pr " ctx.ret.%s.%s_val[ctx.ret.%s.%s_len] = NULL;\n" n n n n;
3569 pr " return ctx.ret.%s.%s_val;\n" n n
3571 pr " /* caller with free this */\n";
3572 pr " return safe_memdup (g, &ctx.ret, sizeof (ctx.ret));\n"
3573 | RPVList n | RVGList n | RLVList n
3574 | RStat n | RStatVFS n ->
3575 pr " /* caller will free this */\n";
3576 pr " return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n
3582 (* Generate daemon/actions.h. *)
3583 and generate_daemon_actions_h () =
3584 generate_header CStyle GPLv2;
3586 pr "#include \"../src/guestfs_protocol.h\"\n";
3590 fun (name, style, _, _, _, _, _) ->
3592 ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
3596 (* Generate the server-side stubs. *)
3597 and generate_daemon_actions () =
3598 generate_header CStyle GPLv2;
3600 pr "#include <config.h>\n";
3602 pr "#include <stdio.h>\n";
3603 pr "#include <stdlib.h>\n";
3604 pr "#include <string.h>\n";
3605 pr "#include <inttypes.h>\n";
3606 pr "#include <ctype.h>\n";
3607 pr "#include <rpc/types.h>\n";
3608 pr "#include <rpc/xdr.h>\n";
3610 pr "#include \"daemon.h\"\n";
3611 pr "#include \"../src/guestfs_protocol.h\"\n";
3612 pr "#include \"actions.h\"\n";
3616 fun (name, style, _, _, _, _, _) ->
3617 (* Generate server-side stubs. *)
3618 pr "static void %s_stub (XDR *xdr_in)\n" name;
3621 match fst style with
3622 | RErr | RInt _ -> pr " int r;\n"; "-1"
3623 | RInt64 _ -> pr " int64_t r;\n"; "-1"
3624 | RBool _ -> pr " int r;\n"; "-1"
3626 failwithf "RConstString cannot be returned from a daemon function"
3627 | RString _ -> pr " char *r;\n"; "NULL"
3628 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
3629 | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
3630 | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
3631 | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
3632 | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL"
3633 | RStat _ -> pr " guestfs_int_stat *r;\n"; "NULL"
3634 | RStatVFS _ -> pr " guestfs_int_statvfs *r;\n"; "NULL" in
3636 (match snd style with
3639 pr " struct guestfs_%s_args args;\n" name;
3643 | OptString n -> pr " const char *%s;\n" n
3644 | StringList n -> pr " char **%s;\n" n
3645 | Bool n -> pr " int %s;\n" n
3646 | Int n -> pr " int %s;\n" n
3647 | FileIn _ | FileOut _ -> ()
3652 (match snd style with
3655 pr " memset (&args, 0, sizeof args);\n";
3657 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
3658 pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
3663 | String n -> pr " %s = args.%s;\n" n n
3664 | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
3666 pr " %s = realloc (args.%s.%s_val,\n" n n n;
3667 pr " sizeof (char *) * (args.%s.%s_len+1));\n" n n;
3668 pr " if (%s == NULL) {\n" n;
3669 pr " reply_with_perror (\"realloc\");\n";
3672 pr " %s[args.%s.%s_len] = NULL;\n" n n n;
3673 pr " args.%s.%s_val = %s;\n" n n n;
3674 | Bool n -> pr " %s = args.%s;\n" n n
3675 | Int n -> pr " %s = args.%s;\n" n n
3676 | FileIn _ | FileOut _ -> ()
3681 (* Don't want to call the impl with any FileIn or FileOut
3682 * parameters, since these go "outside" the RPC protocol.
3685 List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
3687 pr " r = do_%s " name;
3688 generate_call_args argsnofile;
3691 pr " if (r == %s)\n" error_code;
3692 pr " /* do_%s has already called reply_with_error */\n" name;
3696 (* If there are any FileOut parameters, then the impl must
3697 * send its own reply.
3700 List.exists (function FileOut _ -> true | _ -> false) (snd style) in
3702 pr " /* do_%s has already sent a reply */\n" name
3704 match fst style with
3705 | RErr -> pr " reply (NULL, NULL);\n"
3706 | RInt n | RInt64 n | RBool n ->
3707 pr " struct guestfs_%s_ret ret;\n" name;
3708 pr " ret.%s = r;\n" n;
3709 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
3712 failwithf "RConstString cannot be returned from a daemon function"
3714 pr " struct guestfs_%s_ret ret;\n" name;
3715 pr " ret.%s = r;\n" n;
3716 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
3719 | RStringList n | RHashtable n ->
3720 pr " struct guestfs_%s_ret ret;\n" name;
3721 pr " ret.%s.%s_len = count_strings (r);\n" n n;
3722 pr " ret.%s.%s_val = r;\n" n n;
3723 pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
3725 pr " free_strings (r);\n"
3727 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n"
3729 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
3730 | RPVList n | RVGList n | RLVList n
3731 | RStat n | RStatVFS n ->
3732 pr " struct guestfs_%s_ret ret;\n" name;
3733 pr " ret.%s = *r;\n" n;
3734 pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
3736 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
3740 (* Free the args. *)
3741 (match snd style with
3746 pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
3753 (* Dispatch function. *)
3754 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
3756 pr " switch (proc_nr) {\n";
3759 fun (name, style, _, _, _, _, _) ->
3760 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
3761 pr " %s_stub (xdr_in);\n" name;
3766 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
3771 (* LVM columns and tokenization functions. *)
3772 (* XXX This generates crap code. We should rethink how we
3778 pr "static const char *lvm_%s_cols = \"%s\";\n"
3779 typ (String.concat "," (List.map fst cols));
3782 pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
3784 pr " char *tok, *p, *next;\n";
3788 pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
3791 pr " if (!str) {\n";
3792 pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
3795 pr " if (!*str || isspace (*str)) {\n";
3796 pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
3801 fun (name, coltype) ->
3802 pr " if (!tok) {\n";
3803 pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
3806 pr " p = strchrnul (tok, ',');\n";
3807 pr " if (*p) next = p+1; else next = NULL;\n";
3808 pr " *p = '\\0';\n";
3811 pr " r->%s = strdup (tok);\n" name;
3812 pr " if (r->%s == NULL) {\n" name;
3813 pr " perror (\"strdup\");\n";
3817 pr " for (i = j = 0; i < 32; ++j) {\n";
3818 pr " if (tok[j] == '\\0') {\n";
3819 pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
3821 pr " } else if (tok[j] != '-')\n";
3822 pr " r->%s[i++] = tok[j];\n" name;
3825 pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
3826 pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
3830 pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
3831 pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
3835 pr " if (tok[0] == '\\0')\n";
3836 pr " r->%s = -1;\n" name;
3837 pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
3838 pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
3842 pr " tok = next;\n";
3845 pr " if (tok != NULL) {\n";
3846 pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
3853 pr "guestfs_lvm_int_%s_list *\n" typ;
3854 pr "parse_command_line_%ss (void)\n" typ;
3856 pr " char *out, *err;\n";
3857 pr " char *p, *pend;\n";
3859 pr " guestfs_lvm_int_%s_list *ret;\n" typ;
3860 pr " void *newp;\n";
3862 pr " ret = malloc (sizeof *ret);\n";
3863 pr " if (!ret) {\n";
3864 pr " reply_with_perror (\"malloc\");\n";
3865 pr " return NULL;\n";
3868 pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
3869 pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
3871 pr " r = command (&out, &err,\n";
3872 pr " \"/sbin/lvm\", \"%ss\",\n" typ;
3873 pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
3874 pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
3875 pr " if (r == -1) {\n";
3876 pr " reply_with_error (\"%%s\", err);\n";
3877 pr " free (out);\n";
3878 pr " free (err);\n";
3879 pr " free (ret);\n";
3880 pr " return NULL;\n";
3883 pr " free (err);\n";
3885 pr " /* Tokenize each line of the output. */\n";
3888 pr " while (p) {\n";
3889 pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
3890 pr " if (pend) {\n";
3891 pr " *pend = '\\0';\n";
3895 pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
3898 pr " if (!*p) { /* Empty line? Skip it. */\n";
3903 pr " /* Allocate some space to store this next entry. */\n";
3904 pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
3905 pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
3906 pr " if (newp == NULL) {\n";
3907 pr " reply_with_perror (\"realloc\");\n";
3908 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
3909 pr " free (ret);\n";
3910 pr " free (out);\n";
3911 pr " return NULL;\n";
3913 pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
3915 pr " /* Tokenize the next entry. */\n";
3916 pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
3917 pr " if (r == -1) {\n";
3918 pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
3919 pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
3920 pr " free (ret);\n";
3921 pr " free (out);\n";
3922 pr " return NULL;\n";
3929 pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
3931 pr " free (out);\n";
3932 pr " return ret;\n";
3935 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
3937 (* Generate the tests. *)
3938 and generate_tests () =
3939 generate_header CStyle GPLv2;
3946 #include <sys/types.h>
3949 #include \"guestfs.h\"
3951 static guestfs_h *g;
3952 static int suppress_error = 0;
3954 /* This will be 's' or 'h' depending on whether the guest kernel
3955 * names IDE devices /dev/sd* or /dev/hd*.
3957 static char devchar = 's';
3959 static void print_error (guestfs_h *g, void *data, const char *msg)
3961 if (!suppress_error)
3962 fprintf (stderr, \"%%s\\n\", msg);
3965 static void print_strings (char * const * const argv)
3969 for (argc = 0; argv[argc] != NULL; ++argc)
3970 printf (\"\\t%%s\\n\", argv[argc]);
3974 static void print_table (char * const * const argv)
3978 for (i = 0; argv[i] != NULL; i += 2)
3979 printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
3983 static void no_test_warnings (void)
3989 | name, _, _, _, [], _, _ ->
3990 pr " fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
3991 | name, _, _, _, tests, _, _ -> ()
3997 (* Generate the actual tests. Note that we generate the tests
3998 * in reverse order, deliberately, so that (in general) the
3999 * newest tests run first. This makes it quicker and easier to
4004 fun (name, _, _, _, tests, _, _) ->
4005 mapi (generate_one_test name) tests
4006 ) (List.rev all_functions) in
4007 let test_names = List.concat test_names in
4008 let nr_tests = List.length test_names in
4011 int main (int argc, char *argv[])
4015 const char *filename;
4017 int nr_tests, test_num = 0;
4020 no_test_warnings ();
4022 g = guestfs_create ();
4024 printf (\"guestfs_create FAILED\\n\");
4028 guestfs_set_error_handler (g, print_error, NULL);
4030 guestfs_set_path (g, \"../appliance\");
4032 filename = \"test1.img\";
4033 fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
4038 if (lseek (fd, %d, SEEK_SET) == -1) {
4044 if (write (fd, &c, 1) == -1) {
4050 if (close (fd) == -1) {
4055 if (guestfs_add_drive (g, filename) == -1) {
4056 printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
4060 filename = \"test2.img\";
4061 fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
4066 if (lseek (fd, %d, SEEK_SET) == -1) {
4072 if (write (fd, &c, 1) == -1) {
4078 if (close (fd) == -1) {
4083 if (guestfs_add_drive (g, filename) == -1) {
4084 printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
4088 filename = \"test3.img\";
4089 fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
4094 if (lseek (fd, %d, SEEK_SET) == -1) {
4100 if (write (fd, &c, 1) == -1) {
4106 if (close (fd) == -1) {
4111 if (guestfs_add_drive (g, filename) == -1) {
4112 printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
4116 if (guestfs_add_drive_ro (g, \"../images/test.sqsh\") == -1) {
4117 printf (\"guestfs_add_drive_ro ../images/test.sqsh FAILED\\n\");
4121 if (guestfs_launch (g) == -1) {
4122 printf (\"guestfs_launch FAILED\\n\");
4125 if (guestfs_wait_ready (g) == -1) {
4126 printf (\"guestfs_wait_ready FAILED\\n\");
4130 /* Detect if the appliance uses /dev/sd* or /dev/hd* in device
4131 * names. This changed between RHEL 5 and RHEL 6 so we have to
4134 devs = guestfs_list_devices (g);
4135 if (devs == NULL || devs[0] == NULL) {
4136 printf (\"guestfs_list_devices FAILED\\n\");
4139 if (strncmp (devs[0], \"/dev/sd\", 7) == 0)
4141 else if (strncmp (devs[0], \"/dev/hd\", 7) == 0)
4144 printf (\"guestfs_list_devices returned unexpected string '%%s'\\n\",
4148 for (i = 0; devs[i] != NULL; ++i)
4154 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
4158 pr " test_num++;\n";
4159 pr " printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
4160 pr " if (%s () == -1) {\n" test_name;
4161 pr " printf (\"%s FAILED\\n\");\n" test_name;
4167 pr " guestfs_close (g);\n";
4168 pr " unlink (\"test1.img\");\n";
4169 pr " unlink (\"test2.img\");\n";
4170 pr " unlink (\"test3.img\");\n";
4173 pr " if (failed > 0) {\n";
4174 pr " printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n";
4182 and generate_one_test name i (init, prereq, test) =
4183 let test_name = sprintf "test_%s_%d" name i in
4186 static int %s_skip (void)
4190 str = getenv (\"SKIP_%s\");
4191 if (str && strcmp (str, \"1\") == 0) return 1;
4192 str = getenv (\"SKIP_TEST_%s\");
4193 if (str && strcmp (str, \"1\") == 0) return 1;
4197 " test_name (String.uppercase test_name) (String.uppercase name);
4200 | Disabled | Always -> ()
4201 | If code | Unless code ->
4202 pr "static int %s_prereq (void)\n" test_name;
4210 static int %s (void)
4213 printf (\"%%s skipped (reason: SKIP_TEST_* variable set)\\n\", \"%s\");
4217 " test_name test_name test_name;
4221 pr " printf (\"%%s skipped (reason: test disabled in generator)\\n\", \"%s\");\n" test_name
4223 pr " if (! %s_prereq ()) {\n" test_name;
4224 pr " printf (\"%%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
4228 generate_one_test_body name i test_name init test;
4230 pr " if (%s_prereq ()) {\n" test_name;
4231 pr " printf (\"%%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
4235 generate_one_test_body name i test_name init test;
4237 generate_one_test_body name i test_name init test
4245 and generate_one_test_body name i test_name init test =
4249 pr " /* InitNone|InitEmpty for %s */\n" test_name;
4250 List.iter (generate_test_command_call test_name)
4251 [["blockdev_setrw"; "/dev/sda"];
4255 pr " /* InitBasicFS for %s: create ext2 on /dev/sda1 */\n" test_name;
4256 List.iter (generate_test_command_call test_name)
4257 [["blockdev_setrw"; "/dev/sda"];
4260 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
4261 ["mkfs"; "ext2"; "/dev/sda1"];
4262 ["mount"; "/dev/sda1"; "/"]]
4263 | InitBasicFSonLVM ->
4264 pr " /* InitBasicFSonLVM for %s: create ext2 on /dev/VG/LV */\n"
4266 List.iter (generate_test_command_call test_name)
4267 [["blockdev_setrw"; "/dev/sda"];
4270 ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
4271 ["pvcreate"; "/dev/sda1"];
4272 ["vgcreate"; "VG"; "/dev/sda1"];
4273 ["lvcreate"; "LV"; "VG"; "8"];
4274 ["mkfs"; "ext2"; "/dev/VG/LV"];
4275 ["mount"; "/dev/VG/LV"; "/"]]
4278 let get_seq_last = function
4280 failwithf "%s: you cannot use [] (empty list) when expecting a command"
4283 let seq = List.rev seq in
4284 List.rev (List.tl seq), List.hd seq
4289 pr " /* TestRun for %s (%d) */\n" name i;
4290 List.iter (generate_test_command_call test_name) seq
4291 | TestOutput (seq, expected) ->
4292 pr " /* TestOutput for %s (%d) */\n" name i;
4293 pr " char expected[] = \"%s\";\n" (c_quote expected);
4294 if String.length expected > 7 &&
4295 String.sub expected 0 7 = "/dev/sd" then
4296 pr " expected[5] = devchar;\n";
4297 let seq, last = get_seq_last seq in
4299 pr " if (strcmp (r, expected) != 0) {\n";
4300 pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
4304 List.iter (generate_test_command_call test_name) seq;
4305 generate_test_command_call ~test test_name last
4306 | TestOutputList (seq, expected) ->
4307 pr " /* TestOutputList for %s (%d) */\n" name i;
4308 let seq, last = get_seq_last seq in
4312 pr " if (!r[%d]) {\n" i;
4313 pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
4314 pr " print_strings (r);\n";
4318 pr " char expected[] = \"%s\";\n" (c_quote str);
4319 if String.length str > 7 && String.sub str 0 7 = "/dev/sd" then
4320 pr " expected[5] = devchar;\n";
4321 pr " if (strcmp (r[%d], expected) != 0) {\n" i;
4322 pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
4327 pr " if (r[%d] != NULL) {\n" (List.length expected);
4328 pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
4330 pr " print_strings (r);\n";
4334 List.iter (generate_test_command_call test_name) seq;
4335 generate_test_command_call ~test test_name last
4336 | TestOutputInt (seq, expected) ->
4337 pr " /* TestOutputInt for %s (%d) */\n" name i;
4338 let seq, last = get_seq_last seq in
4340 pr " if (r != %d) {\n" expected;
4341 pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\","
4347 List.iter (generate_test_command_call test_name) seq;
4348 generate_test_command_call ~test test_name last
4349 | TestOutputTrue seq ->
4350 pr " /* TestOutputTrue for %s (%d) */\n" name i;
4351 let seq, last = get_seq_last seq in
4354 pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n"
4359 List.iter (generate_test_command_call test_name) seq;
4360 generate_test_command_call ~test test_name last
4361 | TestOutputFalse seq ->
4362 pr " /* TestOutputFalse for %s (%d) */\n" name i;
4363 let seq, last = get_seq_last seq in
4366 pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n"
4371 List.iter (generate_test_command_call test_name) seq;
4372 generate_test_command_call ~test test_name last
4373 | TestOutputLength (seq, expected) ->
4374 pr " /* TestOutputLength for %s (%d) */\n" name i;
4375 let seq, last = get_seq_last seq in
4378 pr " for (j = 0; j < %d; ++j)\n" expected;
4379 pr " if (r[j] == NULL) {\n";
4380 pr " fprintf (stderr, \"%s: short list returned\\n\");\n"
4382 pr " print_strings (r);\n";
4385 pr " if (r[j] != NULL) {\n";
4386 pr " fprintf (stderr, \"%s: long list returned\\n\");\n"
4388 pr " print_strings (r);\n";
4392 List.iter (generate_test_command_call test_name) seq;
4393 generate_test_command_call ~test test_name last
4394 | TestOutputStruct (seq, checks) ->
4395 pr " /* TestOutputStruct for %s (%d) */\n" name i;
4396 let seq, last = get_seq_last seq in
4400 | CompareWithInt (field, expected) ->
4401 pr " if (r->%s != %d) {\n" field expected;
4402 pr " fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
4403 test_name field expected;
4404 pr " (int) r->%s);\n" field;
4407 | CompareWithString (field, expected) ->
4408 pr " if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
4409 pr " fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
4410 test_name field expected;
4411 pr " r->%s);\n" field;
4414 | CompareFieldsIntEq (field1, field2) ->
4415 pr " if (r->%s != r->%s) {\n" field1 field2;
4416 pr " fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
4417 test_name field1 field2;
4418 pr " (int) r->%s, (int) r->%s);\n" field1 field2;
4421 | CompareFieldsStrEq (field1, field2) ->
4422 pr " if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
4423 pr " fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
4424 test_name field1 field2;
4425 pr " r->%s, r->%s);\n" field1 field2;
4430 List.iter (generate_test_command_call test_name) seq;
4431 generate_test_command_call ~test test_name last
4432 | TestLastFail seq ->
4433 pr " /* TestLastFail for %s (%d) */\n" name i;
4434 let seq, last = get_seq_last seq in
4435 List.iter (generate_test_command_call test_name) seq;
4436 generate_test_command_call test_name ~expect_error:true last
4438 (* Generate the code to run a command, leaving the result in 'r'.
4439 * If you expect to get an error then you should set expect_error:true.
4441 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
4443 | [] -> assert false
4445 (* Look up the command to find out what args/ret it has. *)
4448 let _, style, _, _, _, _, _ =
4449 List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
4452 failwithf "%s: in test, command %s was not found" test_name name in
4454 if List.length (snd style) <> List.length args then
4455 failwithf "%s: in test, wrong number of args given to %s"
4462 | OptString n, "NULL" -> ()
4464 | OptString n, arg ->
4465 pr " char %s[] = \"%s\";\n" n (c_quote arg);
4466 if String.length arg > 7 && String.sub arg 0 7 = "/dev/sd" then
4467 pr " %s[5] = devchar;\n" n
4470 | FileIn _, _ | FileOut _, _ -> ()
4471 | StringList n, arg ->
4472 let strs = string_split " " arg in
4475 pr " char %s_%d[] = \"%s\";\n" n i (c_quote str);
4476 if String.length str > 7 && String.sub str 0 7 = "/dev/sd" then
4477 pr " %s_%d[5] = devchar;\n" n i
4479 pr " char *%s[] = {\n" n;
4481 fun i _ -> pr " %s_%d,\n" n i
4485 ) (List.combine (snd style) args);
4488 match fst style with
4489 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
4490 | RInt64 _ -> pr " int64_t r;\n"; "-1"
4491 | RConstString _ -> pr " const char *r;\n"; "NULL"
4492 | RString _ -> pr " char *r;\n"; "NULL"
4493 | RStringList _ | RHashtable _ ->
4498 pr " struct guestfs_int_bool *r;\n"; "NULL"
4500 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
4502 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
4504 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
4506 pr " struct guestfs_stat *r;\n"; "NULL"
4508 pr " struct guestfs_statvfs *r;\n"; "NULL" in
4510 pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
4511 pr " r = guestfs_%s (g" name;
4513 (* Generate the parameters. *)
4516 | OptString _, "NULL" -> pr ", NULL"
4520 | FileIn _, arg | FileOut _, arg ->
4521 pr ", \"%s\"" (c_quote arg)
4522 | StringList n, _ ->
4526 try int_of_string arg
4527 with Failure "int_of_string" ->
4528 failwithf "%s: expecting an int, but got '%s'" test_name arg in
4531 let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
4532 ) (List.combine (snd style) args);
4535 if not expect_error then
4536 pr " if (r == %s)\n" error_code
4538 pr " if (r != %s)\n" error_code;
4541 (* Insert the test code. *)
4547 (match fst style with
4548 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ -> ()
4549 | RString _ -> pr " free (r);\n"
4550 | RStringList _ | RHashtable _ ->
4551 pr " for (i = 0; r[i] != NULL; ++i)\n";
4552 pr " free (r[i]);\n";
4555 pr " guestfs_free_int_bool (r);\n"
4557 pr " guestfs_free_lvm_pv_list (r);\n"
4559 pr " guestfs_free_lvm_vg_list (r);\n"
4561 pr " guestfs_free_lvm_lv_list (r);\n"
4562 | RStat _ | RStatVFS _ ->
4569 let str = replace_str str "\r" "\\r" in
4570 let str = replace_str str "\n" "\\n" in
4571 let str = replace_str str "\t" "\\t" in
4572 let str = replace_str str "\000" "\\0" in
4575 (* Generate a lot of different functions for guestfish. *)
4576 and generate_fish_cmds () =
4577 generate_header CStyle GPLv2;
4581 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
4583 let all_functions_sorted =
4585 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
4586 ) all_functions_sorted in
4588 pr "#include <stdio.h>\n";
4589 pr "#include <stdlib.h>\n";
4590 pr "#include <string.h>\n";
4591 pr "#include <inttypes.h>\n";
4593 pr "#include <guestfs.h>\n";
4594 pr "#include \"fish.h\"\n";
4597 (* list_commands function, which implements guestfish -h *)
4598 pr "void list_commands (void)\n";
4600 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
4601 pr " list_builtin_commands ();\n";
4603 fun (name, _, _, flags, _, shortdesc, _) ->
4604 let name = replace_char name '_' '-' in
4605 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
4607 ) all_functions_sorted;
4608 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
4612 (* display_command function, which implements guestfish -h cmd *)
4613 pr "void display_command (const char *cmd)\n";
4616 fun (name, style, _, flags, _, shortdesc, longdesc) ->
4617 let name2 = replace_char name '_' '-' in
4619 try find_map (function FishAlias n -> Some n | _ -> None) flags
4620 with Not_found -> name in
4622 match snd style with
4626 name2 (String.concat "> <" (List.map name_of_argt args)) in
4629 pr "strcasecmp (cmd, \"%s\") == 0" name;
4630 if name <> name2 then
4631 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
4632 if name <> alias then
4633 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
4635 pr " printf (\"%s - %s\\n\\n\");\n" name2 shortdesc;
4636 let lines = text_of_longdesc ~language:`Fish ~width:60 longdesc in
4639 pr " printf (\"%s\\n\");\n" (c_quote line)
4643 if List.mem ProtocolLimitWarning flags then
4644 ("\n\n" ^ protocol_limit_warning)
4647 (* For DangerWillRobinson commands, we should probably have
4648 * guestfish prompt before allowing you to use them (especially
4649 * in interactive mode). XXX
4653 if List.mem DangerWillRobinson flags then
4654 ("\n\n" ^ danger_will_robinson)
4657 let describe_alias =
4658 if name <> alias then
4659 sprintf "\n\nYou can use '%s' as an alias for this command." alias
4665 pr " display_builtin_command (cmd);\n";
4669 (* print_{pv,vg,lv}_list functions *)
4673 pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
4680 pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
4682 pr " printf (\"%s: \");\n" name;
4683 pr " for (i = 0; i < 32; ++i)\n";
4684 pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
4685 pr " printf (\"\\n\");\n"
4687 pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
4689 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
4690 | name, `OptPercent ->
4691 pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
4692 typ name name typ name;
4693 pr " else printf (\"%s: \\n\");\n" name
4697 pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
4702 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
4703 pr " print_%s (&%ss->val[i]);\n" typ typ;
4706 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
4708 (* print_{stat,statvfs} functions *)
4712 pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
4717 pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
4721 ) ["stat", stat_cols; "statvfs", statvfs_cols];
4723 (* run_<action> actions *)
4725 fun (name, style, _, flags, _, _, _) ->
4726 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
4728 (match fst style with
4731 | RBool _ -> pr " int r;\n"
4732 | RInt64 _ -> pr " int64_t r;\n"
4733 | RConstString _ -> pr " const char *r;\n"
4734 | RString _ -> pr " char *r;\n"
4735 | RStringList _ | RHashtable _ -> pr " char **r;\n"
4736 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
4737 | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
4738 | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
4739 | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
4740 | RStat _ -> pr " struct guestfs_stat *r;\n"
4741 | RStatVFS _ -> pr " struct guestfs_statvfs *r;\n"
4748 | FileOut n -> pr " const char *%s;\n" n
4749 | StringList n -> pr " char **%s;\n" n
4750 | Bool n -> pr " int %s;\n" n
4751 | Int n -> pr " int %s;\n" n
4754 (* Check and convert parameters. *)
4755 let argc_expected = List.length (snd style) in
4756 pr " if (argc != %d) {\n" argc_expected;
4757 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
4759 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
4765 | String name -> pr " %s = argv[%d];\n" name i
4767 pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
4770 pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdin\";\n"
4773 pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n"
4775 | StringList name ->
4776 pr " %s = parse_string_list (argv[%d]);\n" name i
4778 pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
4780 pr " %s = atoi (argv[%d]);\n" name i
4783 (* Call C API function. *)
4785 try find_map (function FishAction n -> Some n | _ -> None) flags
4786 with Not_found -> sprintf "guestfs_%s" name in
4788 generate_call_args ~handle:"g" (snd style);
4791 (* Check return value for errors and display command results. *)
4792 (match fst style with
4793 | RErr -> pr " return r;\n"
4795 pr " if (r == -1) return -1;\n";
4796 pr " printf (\"%%d\\n\", r);\n";
4799 pr " if (r == -1) return -1;\n";
4800 pr " printf (\"%%\" PRIi64 \"\\n\", r);\n";
4803 pr " if (r == -1) return -1;\n";
4804 pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
4807 pr " if (r == NULL) return -1;\n";
4808 pr " printf (\"%%s\\n\", r);\n";
4811 pr " if (r == NULL) return -1;\n";
4812 pr " printf (\"%%s\\n\", r);\n";
4816 pr " if (r == NULL) return -1;\n";
4817 pr " print_strings (r);\n";
4818 pr " free_strings (r);\n";
4821 pr " if (r == NULL) return -1;\n";
4822 pr " printf (\"%%d, %%s\\n\", r->i,\n";
4823 pr " r->b ? \"true\" : \"false\");\n";
4824 pr " guestfs_free_int_bool (r);\n";
4827 pr " if (r == NULL) return -1;\n";
4828 pr " print_pv_list (r);\n";
4829 pr " guestfs_free_lvm_pv_list (r);\n";
4832 pr " if (r == NULL) return -1;\n";
4833 pr " print_vg_list (r);\n";
4834 pr " guestfs_free_lvm_vg_list (r);\n";
4837 pr " if (r == NULL) return -1;\n";
4838 pr " print_lv_list (r);\n";
4839 pr " guestfs_free_lvm_lv_list (r);\n";
4842 pr " if (r == NULL) return -1;\n";
4843 pr " print_stat (r);\n";
4847 pr " if (r == NULL) return -1;\n";
4848 pr " print_statvfs (r);\n";
4852 pr " if (r == NULL) return -1;\n";
4853 pr " print_table (r);\n";
4854 pr " free_strings (r);\n";
4861 (* run_action function *)
4862 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
4865 fun (name, _, _, flags, _, _, _) ->
4866 let name2 = replace_char name '_' '-' in
4868 try find_map (function FishAlias n -> Some n | _ -> None) flags
4869 with Not_found -> name in
4871 pr "strcasecmp (cmd, \"%s\") == 0" name;
4872 if name <> name2 then
4873 pr " || strcasecmp (cmd, \"%s\") == 0" name2;
4874 if name <> alias then
4875 pr " || strcasecmp (cmd, \"%s\") == 0" alias;
4877 pr " return run_%s (cmd, argc, argv);\n" name;
4881 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
4888 (* Readline completion for guestfish. *)
4889 and generate_fish_completion () =
4890 generate_header CStyle GPLv2;
4894 fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
4904 #ifdef HAVE_LIBREADLINE
4905 #include <readline/readline.h>
4910 #ifdef HAVE_LIBREADLINE
4912 static const char *const commands[] = {
4913 BUILTIN_COMMANDS_FOR_COMPLETION,
4916 (* Get the commands, including the aliases. They don't need to be
4917 * sorted - the generator() function just does a dumb linear search.
4921 fun (name, _, _, flags, _, _, _) ->
4922 let name2 = replace_char name '_' '-' in
4924 try find_map (function FishAlias n -> Some n | _ -> None) flags
4925 with Not_found -> name in
4927 if name <> alias then [name2; alias] else [name2]
4929 let commands = List.flatten commands in
4931 List.iter (pr " \"%s\",\n") commands;
4937 generator (const char *text, int state)
4939 static int index, len;
4944 len = strlen (text);
4947 while ((name = commands[index]) != NULL) {
4949 if (strncasecmp (name, text, len) == 0)
4950 return strdup (name);
4956 #endif /* HAVE_LIBREADLINE */
4958 char **do_completion (const char *text, int start, int end)
4960 char **matches = NULL;
4962 #ifdef HAVE_LIBREADLINE
4964 matches = rl_completion_matches (text, generator);
4971 (* Generate the POD documentation for guestfish. *)
4972 and generate_fish_actions_pod () =
4973 let all_functions_sorted =
4975 fun (_, _, _, flags, _, _, _) ->
4976 not (List.mem NotInFish flags || List.mem NotInDocs flags)
4977 ) all_functions_sorted in
4979 let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
4982 fun (name, style, _, flags, _, _, longdesc) ->
4984 Str.global_substitute rex (
4987 try Str.matched_group 1 s
4989 failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
4990 "C<" ^ replace_char sub '_' '-' ^ ">"
4992 let name = replace_char name '_' '-' in
4994 try find_map (function FishAlias n -> Some n | _ -> None) flags
4995 with Not_found -> name in
4997 pr "=head2 %s" name;
4998 if name <> alias then
5005 | String n -> pr " %s" n
5006 | OptString n -> pr " %s" n
5007 | StringList n -> pr " '%s ...'" n
5008 | Bool _ -> pr " true|false"
5009 | Int n -> pr " %s" n
5010 | FileIn n | FileOut n -> pr " (%s|-)" n
5014 pr "%s\n\n" longdesc;
5016 if List.exists (function FileIn _ | FileOut _ -> true
5017 | _ -> false) (snd style) then
5018 pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
5020 if List.mem ProtocolLimitWarning flags then
5021 pr "%s\n\n" protocol_limit_warning;
5023 if List.mem DangerWillRobinson flags then
5024 pr "%s\n\n" danger_will_robinson
5025 ) all_functions_sorted
5027 (* Generate a C function prototype. *)
5028 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
5029 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
5031 ?handle name style =
5032 if extern then pr "extern ";
5033 if static then pr "static ";
5034 (match fst style with
5036 | RInt _ -> pr "int "
5037 | RInt64 _ -> pr "int64_t "
5038 | RBool _ -> pr "int "
5039 | RConstString _ -> pr "const char *"
5040 | RString _ -> pr "char *"
5041 | RStringList _ | RHashtable _ -> pr "char **"
5043 if not in_daemon then pr "struct guestfs_int_bool *"
5044 else pr "guestfs_%s_ret *" name
5046 if not in_daemon then pr "struct guestfs_lvm_pv_list *"
5047 else pr "guestfs_lvm_int_pv_list *"
5049 if not in_daemon then pr "struct guestfs_lvm_vg_list *"
5050 else pr "guestfs_lvm_int_vg_list *"
5052 if not in_daemon then pr "struct guestfs_lvm_lv_list *"
5053 else pr "guestfs_lvm_int_lv_list *"
5055 if not in_daemon then pr "struct guestfs_stat *"
5056 else pr "guestfs_int_stat *"
5058 if not in_daemon then pr "struct guestfs_statvfs *"
5059 else pr "guestfs_int_statvfs *"
5061 pr "%s%s (" prefix name;
5062 if handle = None && List.length (snd style) = 0 then
5065 let comma = ref false in
5068 | Some handle -> pr "guestfs_h *%s" handle; comma := true
5072 if single_line then pr ", " else pr ",\n\t\t"
5079 | OptString n -> next (); pr "const char *%s" n
5080 | StringList n -> next (); pr "char * const* const %s" n
5081 | Bool n -> next (); pr "int %s" n
5082 | Int n -> next (); pr "int %s" n
5085 if not in_daemon then (next (); pr "const char *%s" n)
5089 if semicolon then pr ";";
5090 if newline then pr "\n"
5092 (* Generate C call arguments, eg "(handle, foo, bar)" *)
5093 and generate_call_args ?handle args =
5095 let comma = ref false in
5098 | Some handle -> pr "%s" handle; comma := true
5102 if !comma then pr ", ";
5104 pr "%s" (name_of_argt arg)
5108 (* Generate the OCaml bindings interface. *)
5109 and generate_ocaml_mli () =
5110 generate_header OCamlStyle LGPLv2;
5113 (** For API documentation you should refer to the C API
5114 in the guestfs(3) manual page. The OCaml API uses almost
5115 exactly the same calls. *)
5118 (** A [guestfs_h] handle. *)
5120 exception Error of string
5121 (** This exception is raised when there is an error. *)
5123 val create : unit -> t
5125 val close : t -> unit
5126 (** Handles are closed by the garbage collector when they become
5127 unreferenced, but callers can also call this in order to
5128 provide predictable cleanup. *)
5131 generate_ocaml_lvm_structure_decls ();
5133 generate_ocaml_stat_structure_decls ();
5137 fun (name, style, _, _, _, shortdesc, _) ->
5138 generate_ocaml_prototype name style;
5139 pr "(** %s *)\n" shortdesc;
5143 (* Generate the OCaml bindings implementation. *)
5144 and generate_ocaml_ml () =
5145 generate_header OCamlStyle LGPLv2;
5149 exception Error of string
5150 external create : unit -> t = \"ocaml_guestfs_create\"
5151 external close : t -> unit = \"ocaml_guestfs_close\"
5154 Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
5158 generate_ocaml_lvm_structure_decls ();
5160 generate_ocaml_stat_structure_decls ();
5164 fun (name, style, _, _, _, shortdesc, _) ->
5165 generate_ocaml_prototype ~is_external:true name style;
5168 (* Generate the OCaml bindings C implementation. *)
5169 and generate_ocaml_c () =
5170 generate_header CStyle LGPLv2;
5177 #include <caml/config.h>
5178 #include <caml/alloc.h>
5179 #include <caml/callback.h>
5180 #include <caml/fail.h>
5181 #include <caml/memory.h>
5182 #include <caml/mlvalues.h>
5183 #include <caml/signals.h>
5185 #include <guestfs.h>
5187 #include \"guestfs_c.h\"
5189 /* Copy a hashtable of string pairs into an assoc-list. We return
5190 * the list in reverse order, but hashtables aren't supposed to be
5193 static CAMLprim value
5194 copy_table (char * const * argv)
5197 CAMLlocal5 (rv, pairv, kv, vv, cons);
5201 for (i = 0; argv[i] != NULL; i += 2) {
5202 kv = caml_copy_string (argv[i]);
5203 vv = caml_copy_string (argv[i+1]);
5204 pairv = caml_alloc (2, 0);
5205 Store_field (pairv, 0, kv);
5206 Store_field (pairv, 1, vv);
5207 cons = caml_alloc (2, 0);
5208 Store_field (cons, 1, rv);
5210 Store_field (cons, 0, pairv);
5218 (* LVM struct copy functions. *)
5221 let has_optpercent_col =
5222 List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
5224 pr "static CAMLprim value\n";
5225 pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
5227 pr " CAMLparam0 ();\n";
5228 if has_optpercent_col then
5229 pr " CAMLlocal3 (rv, v, v2);\n"
5231 pr " CAMLlocal2 (rv, v);\n";
5233 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
5238 pr " v = caml_copy_string (%s->%s);\n" typ name
5240 pr " v = caml_alloc_string (32);\n";
5241 pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
5244 pr " v = caml_copy_int64 (%s->%s);\n" typ name
5245 | name, `OptPercent ->
5246 pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
5247 pr " v2 = caml_copy_double (%s->%s);\n" typ name;
5248 pr " v = caml_alloc (1, 0);\n";
5249 pr " Store_field (v, 0, v2);\n";
5250 pr " } else /* None */\n";
5251 pr " v = Val_int (0);\n";
5253 pr " Store_field (rv, %d, v);\n" i
5255 pr " CAMLreturn (rv);\n";
5259 pr "static CAMLprim value\n";
5260 pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
5263 pr " CAMLparam0 ();\n";
5264 pr " CAMLlocal2 (rv, v);\n";
5267 pr " if (%ss->len == 0)\n" typ;
5268 pr " CAMLreturn (Atom (0));\n";
5270 pr " rv = caml_alloc (%ss->len, 0);\n" typ;
5271 pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
5272 pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
5273 pr " caml_modify (&Field (rv, i), v);\n";
5275 pr " CAMLreturn (rv);\n";
5279 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
5281 (* Stat copy functions. *)
5284 pr "static CAMLprim value\n";
5285 pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
5287 pr " CAMLparam0 ();\n";
5288 pr " CAMLlocal2 (rv, v);\n";
5290 pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
5295 pr " v = caml_copy_int64 (%s->%s);\n" typ name
5297 pr " Store_field (rv, %d, v);\n" i
5299 pr " CAMLreturn (rv);\n";
5302 ) ["stat", stat_cols; "statvfs", statvfs_cols];
5306 fun (name, style, _, _, _, _, _) ->
5308 "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
5310 pr "CAMLprim value\n";
5311 pr "ocaml_guestfs_%s (value %s" name (List.hd params);
5312 List.iter (pr ", value %s") (List.tl params);
5317 | [p1; p2; p3; p4; p5] ->
5318 pr " CAMLparam5 (%s);\n" (String.concat ", " params)
5319 | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
5320 pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
5321 pr " CAMLxparam%d (%s);\n"
5322 (List.length rest) (String.concat ", " rest)
5324 pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
5326 pr " CAMLlocal1 (rv);\n";
5329 pr " guestfs_h *g = Guestfs_val (gv);\n";
5330 pr " if (g == NULL)\n";
5331 pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
5339 pr " const char *%s = String_val (%sv);\n" n n
5341 pr " const char *%s =\n" n;
5342 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
5345 pr " char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
5347 pr " int %s = Bool_val (%sv);\n" n n
5349 pr " int %s = Int_val (%sv);\n" n n
5352 match fst style with
5353 | RErr -> pr " int r;\n"; "-1"
5354 | RInt _ -> pr " int r;\n"; "-1"
5355 | RInt64 _ -> pr " int64_t r;\n"; "-1"
5356 | RBool _ -> pr " int r;\n"; "-1"
5357 | RConstString _ -> pr " const char *r;\n"; "NULL"
5358 | RString _ -> pr " char *r;\n"; "NULL"
5364 pr " struct guestfs_int_bool *r;\n"; "NULL"
5366 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
5368 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
5370 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
5372 pr " struct guestfs_stat *r;\n"; "NULL"
5374 pr " struct guestfs_statvfs *r;\n"; "NULL"
5381 pr " caml_enter_blocking_section ();\n";
5382 pr " r = guestfs_%s " name;
5383 generate_call_args ~handle:"g" (snd style);
5385 pr " caml_leave_blocking_section ();\n";
5390 pr " ocaml_guestfs_free_strings (%s);\n" n;
5391 | String _ | OptString _ | Bool _ | Int _ | FileIn _ | FileOut _ -> ()
5394 pr " if (r == %s)\n" error_code;
5395 pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
5398 (match fst style with
5399 | RErr -> pr " rv = Val_unit;\n"
5400 | RInt _ -> pr " rv = Val_int (r);\n"
5402 pr " rv = caml_copy_int64 (r);\n"
5403 | RBool _ -> pr " rv = Val_bool (r);\n"
5404 | RConstString _ -> pr " rv = caml_copy_string (r);\n"
5406 pr " rv = caml_copy_string (r);\n";
5409 pr " rv = caml_copy_string_array ((const char **) r);\n";
5410 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
5413 pr " rv = caml_alloc (2, 0);\n";
5414 pr " Store_field (rv, 0, Val_int (r->i));\n";
5415 pr " Store_field (rv, 1, Val_bool (r->b));\n";
5416 pr " guestfs_free_int_bool (r);\n";
5418 pr " rv = copy_lvm_pv_list (r);\n";
5419 pr " guestfs_free_lvm_pv_list (r);\n";
5421 pr " rv = copy_lvm_vg_list (r);\n";
5422 pr " guestfs_free_lvm_vg_list (r);\n";
5424 pr " rv = copy_lvm_lv_list (r);\n";
5425 pr " guestfs_free_lvm_lv_list (r);\n";
5427 pr " rv = copy_stat (r);\n";
5430 pr " rv = copy_statvfs (r);\n";
5433 pr " rv = copy_table (r);\n";
5434 pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
5438 pr " CAMLreturn (rv);\n";
5442 if List.length params > 5 then (
5443 pr "CAMLprim value\n";
5444 pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
5446 pr " return ocaml_guestfs_%s (argv[0]" name;
5447 iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
5454 and generate_ocaml_lvm_structure_decls () =
5457 pr "type lvm_%s = {\n" typ;
5460 | name, `String -> pr " %s : string;\n" name
5461 | name, `UUID -> pr " %s : string;\n" name
5462 | name, `Bytes -> pr " %s : int64;\n" name
5463 | name, `Int -> pr " %s : int64;\n" name
5464 | name, `OptPercent -> pr " %s : float option;\n" name
5468 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
5470 and generate_ocaml_stat_structure_decls () =
5473 pr "type %s = {\n" typ;
5476 | name, `Int -> pr " %s : int64;\n" name
5480 ) ["stat", stat_cols; "statvfs", statvfs_cols]
5482 and generate_ocaml_prototype ?(is_external = false) name style =
5483 if is_external then pr "external " else pr "val ";
5484 pr "%s : t -> " name;
5487 | String _ | FileIn _ | FileOut _ -> pr "string -> "
5488 | OptString _ -> pr "string option -> "
5489 | StringList _ -> pr "string array -> "
5490 | Bool _ -> pr "bool -> "
5491 | Int _ -> pr "int -> "
5493 (match fst style with
5494 | RErr -> pr "unit" (* all errors are turned into exceptions *)
5495 | RInt _ -> pr "int"
5496 | RInt64 _ -> pr "int64"
5497 | RBool _ -> pr "bool"
5498 | RConstString _ -> pr "string"
5499 | RString _ -> pr "string"
5500 | RStringList _ -> pr "string array"
5501 | RIntBool _ -> pr "int * bool"
5502 | RPVList _ -> pr "lvm_pv array"
5503 | RVGList _ -> pr "lvm_vg array"
5504 | RLVList _ -> pr "lvm_lv array"
5505 | RStat _ -> pr "stat"
5506 | RStatVFS _ -> pr "statvfs"
5507 | RHashtable _ -> pr "(string * string) list"
5509 if is_external then (
5511 if List.length (snd style) + 1 > 5 then
5512 pr "\"ocaml_guestfs_%s_byte\" " name;
5513 pr "\"ocaml_guestfs_%s\"" name
5517 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
5518 and generate_perl_xs () =
5519 generate_header CStyle LGPLv2;
5522 #include \"EXTERN.h\"
5526 #include <guestfs.h>
5529 #define PRId64 \"lld\"
5533 my_newSVll(long long val) {
5534 #ifdef USE_64_BIT_ALL
5535 return newSViv(val);
5539 len = snprintf(buf, 100, \"%%\" PRId64, val);
5540 return newSVpv(buf, len);
5545 #define PRIu64 \"llu\"
5549 my_newSVull(unsigned long long val) {
5550 #ifdef USE_64_BIT_ALL
5551 return newSVuv(val);
5555 len = snprintf(buf, 100, \"%%\" PRIu64, val);
5556 return newSVpv(buf, len);
5560 /* http://www.perlmonks.org/?node_id=680842 */
5562 XS_unpack_charPtrPtr (SV *arg) {
5567 if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
5568 croak (\"array reference expected\");
5570 av = (AV *)SvRV (arg);
5571 ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
5573 croak (\"malloc failed\");
5575 for (i = 0; i <= av_len (av); i++) {
5576 SV **elem = av_fetch (av, i, 0);
5578 if (!elem || !*elem)
5579 croak (\"missing element in list\");
5581 ret[i] = SvPV_nolen (*elem);
5589 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
5596 RETVAL = guestfs_create ();
5598 croak (\"could not create guestfs handle\");
5599 guestfs_set_error_handler (RETVAL, NULL, NULL);
5612 fun (name, style, _, _, _, _, _) ->
5613 (match fst style with
5614 | RErr -> pr "void\n"
5615 | RInt _ -> pr "SV *\n"
5616 | RInt64 _ -> pr "SV *\n"
5617 | RBool _ -> pr "SV *\n"
5618 | RConstString _ -> pr "SV *\n"
5619 | RString _ -> pr "SV *\n"
5622 | RPVList _ | RVGList _ | RLVList _
5623 | RStat _ | RStatVFS _
5625 pr "void\n" (* all lists returned implictly on the stack *)
5627 (* Call and arguments. *)
5629 generate_call_args ~handle:"g" (snd style);
5631 pr " guestfs_h *g;\n";
5635 | String n | FileIn n | FileOut n -> pr " char *%s;\n" n
5637 (* http://www.perlmonks.org/?node_id=554277
5638 * Note that the implicit handle argument means we have
5639 * to add 1 to the ST(x) operator.
5641 pr " char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
5642 | StringList n -> pr " char **%s;\n" n
5643 | Bool n -> pr " int %s;\n" n
5644 | Int n -> pr " int %s;\n" n
5647 let do_cleanups () =
5650 | String _ | OptString _ | Bool _ | Int _
5651 | FileIn _ | FileOut _ -> ()
5652 | StringList n -> pr " free (%s);\n" n
5657 (match fst style with
5662 pr " r = guestfs_%s " name;
5663 generate_call_args ~handle:"g" (snd style);
5666 pr " if (r == -1)\n";
5667 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5673 pr " %s = guestfs_%s " n name;
5674 generate_call_args ~handle:"g" (snd style);
5677 pr " if (%s == -1)\n" n;
5678 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5679 pr " RETVAL = newSViv (%s);\n" n;
5684 pr " int64_t %s;\n" n;
5686 pr " %s = guestfs_%s " n name;
5687 generate_call_args ~handle:"g" (snd style);
5690 pr " if (%s == -1)\n" n;
5691 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5692 pr " RETVAL = my_newSVll (%s);\n" n;
5697 pr " const char *%s;\n" n;
5699 pr " %s = guestfs_%s " n name;
5700 generate_call_args ~handle:"g" (snd style);
5703 pr " if (%s == NULL)\n" n;
5704 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5705 pr " RETVAL = newSVpv (%s, 0);\n" n;
5710 pr " char *%s;\n" n;
5712 pr " %s = guestfs_%s " n name;
5713 generate_call_args ~handle:"g" (snd style);
5716 pr " if (%s == NULL)\n" n;
5717 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5718 pr " RETVAL = newSVpv (%s, 0);\n" n;
5719 pr " free (%s);\n" n;
5722 | RStringList n | RHashtable n ->
5724 pr " char **%s;\n" n;
5727 pr " %s = guestfs_%s " n name;
5728 generate_call_args ~handle:"g" (snd style);
5731 pr " if (%s == NULL)\n" n;
5732 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5733 pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
5734 pr " EXTEND (SP, n);\n";
5735 pr " for (i = 0; i < n; ++i) {\n";
5736 pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
5737 pr " free (%s[i]);\n" n;
5739 pr " free (%s);\n" n;
5742 pr " struct guestfs_int_bool *r;\n";
5744 pr " r = guestfs_%s " name;
5745 generate_call_args ~handle:"g" (snd style);
5748 pr " if (r == NULL)\n";
5749 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5750 pr " EXTEND (SP, 2);\n";
5751 pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
5752 pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
5753 pr " guestfs_free_int_bool (r);\n";
5755 generate_perl_lvm_code "pv" pv_cols name style n do_cleanups
5757 generate_perl_lvm_code "vg" vg_cols name style n do_cleanups
5759 generate_perl_lvm_code "lv" lv_cols name style n do_cleanups
5761 generate_perl_stat_code "stat" stat_cols name style n do_cleanups
5763 generate_perl_stat_code
5764 "statvfs" statvfs_cols name style n do_cleanups
5770 and generate_perl_lvm_code typ cols name style n do_cleanups =
5772 pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
5776 pr " %s = guestfs_%s " n name;
5777 generate_call_args ~handle:"g" (snd style);
5780 pr " if (%s == NULL)\n" n;
5781 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5782 pr " EXTEND (SP, %s->len);\n" n;
5783 pr " for (i = 0; i < %s->len; ++i) {\n" n;
5784 pr " hv = newHV ();\n";
5788 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
5789 name (String.length name) n name
5791 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
5792 name (String.length name) n name
5794 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
5795 name (String.length name) n name
5797 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
5798 name (String.length name) n name
5799 | name, `OptPercent ->
5800 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
5801 name (String.length name) n name
5803 pr " PUSHs (sv_2mortal ((SV *) hv));\n";
5805 pr " guestfs_free_lvm_%s_list (%s);\n" typ n
5807 and generate_perl_stat_code typ cols name style n do_cleanups =
5809 pr " struct guestfs_%s *%s;\n" typ n;
5811 pr " %s = guestfs_%s " n name;
5812 generate_call_args ~handle:"g" (snd style);
5815 pr " if (%s == NULL)\n" n;
5816 pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5817 pr " EXTEND (SP, %d);\n" (List.length cols);
5821 pr " PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n" n name
5823 pr " free (%s);\n" n
5825 (* Generate Sys/Guestfs.pm. *)
5826 and generate_perl_pm () =
5827 generate_header HashStyle LGPLv2;
5834 Sys::Guestfs - Perl bindings for libguestfs
5840 my $h = Sys::Guestfs->new ();
5841 $h->add_drive ('guest.img');
5844 $h->mount ('/dev/sda1', '/');
5845 $h->touch ('/hello');
5850 The C<Sys::Guestfs> module provides a Perl XS binding to the
5851 libguestfs API for examining and modifying virtual machine
5854 Amongst the things this is good for: making batch configuration
5855 changes to guests, getting disk used/free statistics (see also:
5856 virt-df), migrating between virtualization systems (see also:
5857 virt-p2v), performing partial backups, performing partial guest
5858 clones, cloning guests and changing registry/UUID/hostname info, and
5861 Libguestfs uses Linux kernel and qemu code, and can access any type of
5862 guest filesystem that Linux and qemu can, including but not limited
5863 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
5864 schemes, qcow, qcow2, vmdk.
5866 Libguestfs provides ways to enumerate guest storage (eg. partitions,
5867 LVs, what filesystem is in each LV, etc.). It can also run commands
5868 in the context of the guest. Also you can access filesystems over FTP.
5872 All errors turn into calls to C<croak> (see L<Carp(3)>).
5880 package Sys::Guestfs;
5886 XSLoader::load ('Sys::Guestfs');
5888 =item $h = Sys::Guestfs->new ();
5890 Create a new guestfs handle.
5896 my $class = ref ($proto) || $proto;
5898 my $self = Sys::Guestfs::_create ();
5899 bless $self, $class;
5905 (* Actions. We only need to print documentation for these as
5906 * they are pulled in from the XS code automatically.
5909 fun (name, style, _, flags, _, _, longdesc) ->
5910 if not (List.mem NotInDocs flags) then (
5911 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
5913 generate_perl_prototype name style;
5915 pr "%s\n\n" longdesc;
5916 if List.mem ProtocolLimitWarning flags then
5917 pr "%s\n\n" protocol_limit_warning;
5918 if List.mem DangerWillRobinson flags then
5919 pr "%s\n\n" danger_will_robinson
5921 ) all_functions_sorted;
5933 Copyright (C) 2009 Red Hat Inc.
5937 Please see the file COPYING.LIB for the full license.
5941 L<guestfs(3)>, L<guestfish(1)>.
5946 and generate_perl_prototype name style =
5947 (match fst style with
5953 | RString n -> pr "$%s = " n
5954 | RIntBool (n, m) -> pr "($%s, $%s) = " n m
5958 | RLVList n -> pr "@%s = " n
5961 | RHashtable n -> pr "%%%s = " n
5967 | String n | OptString n | Bool n | Int n | FileIn n | FileOut n ->
5971 ) (fun () -> pr ", ") (snd style);
5974 (* Generate Python C module. *)
5975 and generate_python_c () =
5976 generate_header CStyle LGPLv2;
5985 #include \"guestfs.h\"
5993 get_handle (PyObject *obj)
5996 assert (obj != Py_None);
5997 return ((Pyguestfs_Object *) obj)->g;
6001 put_handle (guestfs_h *g)
6005 PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
6008 /* This list should be freed (but not the strings) after use. */
6009 static const char **
6010 get_string_list (PyObject *obj)
6017 if (!PyList_Check (obj)) {
6018 PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
6022 len = PyList_Size (obj);
6023 r = malloc (sizeof (char *) * (len+1));
6025 PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
6029 for (i = 0; i < len; ++i)
6030 r[i] = PyString_AsString (PyList_GetItem (obj, i));
6037 put_string_list (char * const * const argv)
6042 for (argc = 0; argv[argc] != NULL; ++argc)
6045 list = PyList_New (argc);
6046 for (i = 0; i < argc; ++i)
6047 PyList_SetItem (list, i, PyString_FromString (argv[i]));
6053 put_table (char * const * const argv)
6055 PyObject *list, *item;
6058 for (argc = 0; argv[argc] != NULL; ++argc)
6061 list = PyList_New (argc >> 1);
6062 for (i = 0; i < argc; i += 2) {
6063 item = PyTuple_New (2);
6064 PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
6065 PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
6066 PyList_SetItem (list, i >> 1, item);
6073 free_strings (char **argv)
6077 for (argc = 0; argv[argc] != NULL; ++argc)
6083 py_guestfs_create (PyObject *self, PyObject *args)
6087 g = guestfs_create ();
6089 PyErr_SetString (PyExc_RuntimeError,
6090 \"guestfs.create: failed to allocate handle\");
6093 guestfs_set_error_handler (g, NULL, NULL);
6094 return put_handle (g);
6098 py_guestfs_close (PyObject *self, PyObject *args)
6103 if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
6105 g = get_handle (py_g);
6109 Py_INCREF (Py_None);
6115 (* LVM structures, turned into Python dictionaries. *)
6118 pr "static PyObject *\n";
6119 pr "put_lvm_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
6121 pr " PyObject *dict;\n";
6123 pr " dict = PyDict_New ();\n";
6127 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
6128 pr " PyString_FromString (%s->%s));\n"
6131 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
6132 pr " PyString_FromStringAndSize (%s->%s, 32));\n"
6135 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
6136 pr " PyLong_FromUnsignedLongLong (%s->%s));\n"
6139 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
6140 pr " PyLong_FromLongLong (%s->%s));\n"
6142 | name, `OptPercent ->
6143 pr " if (%s->%s >= 0)\n" typ name;
6144 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
6145 pr " PyFloat_FromDouble ((double) %s->%s));\n"
6148 pr " Py_INCREF (Py_None);\n";
6149 pr " PyDict_SetItemString (dict, \"%s\", Py_None);" name;
6152 pr " return dict;\n";
6156 pr "static PyObject *\n";
6157 pr "put_lvm_%s_list (struct guestfs_lvm_%s_list *%ss)\n" typ typ typ;
6159 pr " PyObject *list;\n";
6162 pr " list = PyList_New (%ss->len);\n" typ;
6163 pr " for (i = 0; i < %ss->len; ++i)\n" typ;
6164 pr " PyList_SetItem (list, i, put_lvm_%s (&%ss->val[i]));\n" typ typ;
6165 pr " return list;\n";
6168 ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
6170 (* Stat structures, turned into Python dictionaries. *)
6173 pr "static PyObject *\n";
6174 pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
6176 pr " PyObject *dict;\n";
6178 pr " dict = PyDict_New ();\n";
6182 pr " PyDict_SetItemString (dict, \"%s\",\n" name;
6183 pr " PyLong_FromLongLong (%s->%s));\n"
6186 pr " return dict;\n";
6189 ) ["stat", stat_cols; "statvfs", statvfs_cols];
6191 (* Python wrapper functions. *)
6193 fun (name, style, _, _, _, _, _) ->
6194 pr "static PyObject *\n";
6195 pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
6198 pr " PyObject *py_g;\n";
6199 pr " guestfs_h *g;\n";
6200 pr " PyObject *py_r;\n";
6203 match fst style with
6204 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
6205 | RInt64 _ -> pr " int64_t r;\n"; "-1"
6206 | RConstString _ -> pr " const char *r;\n"; "NULL"
6207 | RString _ -> pr " char *r;\n"; "NULL"
6208 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
6209 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
6210 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
6211 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
6212 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
6213 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
6214 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
6218 | String n | FileIn n | FileOut n -> pr " const char *%s;\n" n
6219 | OptString n -> pr " const char *%s;\n" n
6221 pr " PyObject *py_%s;\n" n;
6222 pr " const char **%s;\n" n
6223 | Bool n -> pr " int %s;\n" n
6224 | Int n -> pr " int %s;\n" n
6229 (* Convert the parameters. *)
6230 pr " if (!PyArg_ParseTuple (args, (char *) \"O";
6233 | String _ | FileIn _ | FileOut _ -> pr "s"
6234 | OptString _ -> pr "z"
6235 | StringList _ -> pr "O"
6236 | Bool _ -> pr "i" (* XXX Python has booleans? *)
6239 pr ":guestfs_%s\",\n" name;
6243 | String n | FileIn n | FileOut n -> pr ", &%s" n
6244 | OptString n -> pr ", &%s" n
6245 | StringList n -> pr ", &py_%s" n
6246 | Bool n -> pr ", &%s" n
6247 | Int n -> pr ", &%s" n
6251 pr " return NULL;\n";
6253 pr " g = get_handle (py_g);\n";
6256 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
6258 pr " %s = get_string_list (py_%s);\n" n n;
6259 pr " if (!%s) return NULL;\n" n
6264 pr " r = guestfs_%s " name;
6265 generate_call_args ~handle:"g" (snd style);
6270 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
6272 pr " free (%s);\n" n
6275 pr " if (r == %s) {\n" error_code;
6276 pr " PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
6277 pr " return NULL;\n";
6281 (match fst style with
6283 pr " Py_INCREF (Py_None);\n";
6284 pr " py_r = Py_None;\n"
6286 | RBool _ -> pr " py_r = PyInt_FromLong ((long) r);\n"
6287 | RInt64 _ -> pr " py_r = PyLong_FromLongLong (r);\n"
6288 | RConstString _ -> pr " py_r = PyString_FromString (r);\n"
6290 pr " py_r = PyString_FromString (r);\n";
6293 pr " py_r = put_string_list (r);\n";
6294 pr " free_strings (r);\n"
6296 pr " py_r = PyTuple_New (2);\n";
6297 pr " PyTuple_SetItem (py_r, 0, PyInt_FromLong ((long) r->i));\n";
6298 pr " PyTuple_SetItem (py_r, 1, PyInt_FromLong ((long) r->b));\n";
6299 pr " guestfs_free_int_bool (r);\n"
6301 pr " py_r = put_lvm_pv_list (r);\n";
6302 pr " guestfs_free_lvm_pv_list (r);\n"
6304 pr " py_r = put_lvm_vg_list (r);\n";
6305 pr " guestfs_free_lvm_vg_list (r);\n"
6307 pr " py_r = put_lvm_lv_list (r);\n";
6308 pr " guestfs_free_lvm_lv_list (r);\n"
6310 pr " py_r = put_stat (r);\n";
6313 pr " py_r = put_statvfs (r);\n";
6316 pr " py_r = put_table (r);\n";
6317 pr " free_strings (r);\n"
6320 pr " return py_r;\n";
6325 (* Table of functions. *)
6326 pr "static PyMethodDef methods[] = {\n";
6327 pr " { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
6328 pr " { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
6330 fun (name, _, _, _, _, _, _) ->
6331 pr " { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
6334 pr " { NULL, NULL, 0, NULL }\n";
6338 (* Init function. *)
6341 initlibguestfsmod (void)
6343 static int initialized = 0;
6345 if (initialized) return;
6346 Py_InitModule ((char *) \"libguestfsmod\", methods);
6351 (* Generate Python module. *)
6352 and generate_python_py () =
6353 generate_header HashStyle LGPLv2;
6356 u\"\"\"Python bindings for libguestfs
6359 g = guestfs.GuestFS ()
6360 g.add_drive (\"guest.img\")
6363 parts = g.list_partitions ()
6365 The guestfs module provides a Python binding to the libguestfs API
6366 for examining and modifying virtual machine disk images.
6368 Amongst the things this is good for: making batch configuration
6369 changes to guests, getting disk used/free statistics (see also:
6370 virt-df), migrating between virtualization systems (see also:
6371 virt-p2v), performing partial backups, performing partial guest
6372 clones, cloning guests and changing registry/UUID/hostname info, and
6375 Libguestfs uses Linux kernel and qemu code, and can access any type of
6376 guest filesystem that Linux and qemu can, including but not limited
6377 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
6378 schemes, qcow, qcow2, vmdk.
6380 Libguestfs provides ways to enumerate guest storage (eg. partitions,
6381 LVs, what filesystem is in each LV, etc.). It can also run commands
6382 in the context of the guest. Also you can access filesystems over FTP.
6384 Errors which happen while using the API are turned into Python
6385 RuntimeError exceptions.
6387 To create a guestfs handle you usually have to perform the following
6390 # Create the handle, call add_drive at least once, and possibly
6391 # several times if the guest has multiple block devices:
6392 g = guestfs.GuestFS ()
6393 g.add_drive (\"guest.img\")
6395 # Launch the qemu subprocess and wait for it to become ready:
6399 # Now you can issue commands, for example:
6404 import libguestfsmod
6407 \"\"\"Instances of this class are libguestfs API handles.\"\"\"
6409 def __init__ (self):
6410 \"\"\"Create a new libguestfs handle.\"\"\"
6411 self._o = libguestfsmod.create ()
6414 libguestfsmod.close (self._o)
6419 fun (name, style, _, flags, _, _, longdesc) ->
6421 generate_call_args ~handle:"self" (snd style);
6424 if not (List.mem NotInDocs flags) then (
6425 let doc = replace_str longdesc "C<guestfs_" "C<g." in
6427 match fst style with
6428 | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _
6431 doc ^ "\n\nThis function returns a list of strings."
6433 doc ^ "\n\nThis function returns a tuple (int, bool).\n"
6435 doc ^ "\n\nThis function returns a list of PVs. Each PV is represented as a dictionary."
6437 doc ^ "\n\nThis function returns a list of VGs. Each VG is represented as a dictionary."
6439 doc ^ "\n\nThis function returns a list of LVs. Each LV is represented as a dictionary."
6441 doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the stat structure."
6443 doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the statvfs structure."
6445 doc ^ "\n\nThis function returns a dictionary." in
6447 if List.mem ProtocolLimitWarning flags then
6448 doc ^ "\n\n" ^ protocol_limit_warning
6451 if List.mem DangerWillRobinson flags then
6452 doc ^ "\n\n" ^ danger_will_robinson
6454 let doc = pod2text ~width:60 name doc in
6455 let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
6456 let doc = String.concat "\n " doc in
6457 pr " u\"\"\"%s\"\"\"\n" doc;
6459 pr " return libguestfsmod.%s " name;
6460 generate_call_args ~handle:"self._o" (snd style);
6465 (* Useful if you need the longdesc POD text as plain text. Returns a
6468 * This is the slowest thing about autogeneration.
6470 and pod2text ~width name longdesc =
6471 let filename, chan = Filename.open_temp_file "gen" ".tmp" in
6472 fprintf chan "=head1 %s\n\n%s\n" name longdesc;
6474 let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
6475 let chan = Unix.open_process_in cmd in
6476 let lines = ref [] in
6478 let line = input_line chan in
6479 if i = 1 then (* discard the first line of output *)
6482 let line = triml line in
6483 lines := line :: !lines;
6486 let lines = try loop 1 with End_of_file -> List.rev !lines in
6487 Unix.unlink filename;
6488 match Unix.close_process_in chan with
6489 | Unix.WEXITED 0 -> lines
6491 failwithf "pod2text: process exited with non-zero status (%d)" i
6492 | Unix.WSIGNALED i | Unix.WSTOPPED i ->
6493 failwithf "pod2text: process signalled or stopped by signal %d" i
6495 (* Generate ruby bindings. *)
6496 and generate_ruby_c () =
6497 generate_header CStyle LGPLv2;
6505 #include \"guestfs.h\"
6507 #include \"extconf.h\"
6509 /* For Ruby < 1.9 */
6511 #define RARRAY_LEN(r) (RARRAY((r))->len)
6514 static VALUE m_guestfs; /* guestfs module */
6515 static VALUE c_guestfs; /* guestfs_h handle */
6516 static VALUE e_Error; /* used for all errors */
6518 static void ruby_guestfs_free (void *p)
6521 guestfs_close ((guestfs_h *) p);
6524 static VALUE ruby_guestfs_create (VALUE m)
6528 g = guestfs_create ();
6530 rb_raise (e_Error, \"failed to create guestfs handle\");
6532 /* Don't print error messages to stderr by default. */
6533 guestfs_set_error_handler (g, NULL, NULL);
6535 /* Wrap it, and make sure the close function is called when the
6538 return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
6541 static VALUE ruby_guestfs_close (VALUE gv)
6544 Data_Get_Struct (gv, guestfs_h, g);
6546 ruby_guestfs_free (g);
6547 DATA_PTR (gv) = NULL;
6555 fun (name, style, _, _, _, _, _) ->
6556 pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
6557 List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
6560 pr " guestfs_h *g;\n";
6561 pr " Data_Get_Struct (gv, guestfs_h, g);\n";
6563 pr " rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
6569 | String n | FileIn n | FileOut n ->
6570 pr " const char *%s = StringValueCStr (%sv);\n" n n;
6572 pr " rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
6573 pr " \"%s\", \"%s\");\n" n name
6575 pr " const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
6579 pr " int i, len;\n";
6580 pr " len = RARRAY_LEN (%sv);\n" n;
6581 pr " %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
6583 pr " for (i = 0; i < len; ++i) {\n";
6584 pr " VALUE v = rb_ary_entry (%sv, i);\n" n;
6585 pr " %s[i] = StringValueCStr (v);\n" n;
6587 pr " %s[len] = NULL;\n" n;
6590 pr " int %s = RTEST (%sv);\n" n n
6592 pr " int %s = NUM2INT (%sv);\n" n n
6597 match fst style with
6598 | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
6599 | RInt64 _ -> pr " int64_t r;\n"; "-1"
6600 | RConstString _ -> pr " const char *r;\n"; "NULL"
6601 | RString _ -> pr " char *r;\n"; "NULL"
6602 | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
6603 | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
6604 | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
6605 | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
6606 | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
6607 | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
6608 | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
6611 pr " r = guestfs_%s " name;
6612 generate_call_args ~handle:"g" (snd style);
6617 | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
6619 pr " free (%s);\n" n
6622 pr " if (r == %s)\n" error_code;
6623 pr " rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
6626 (match fst style with
6628 pr " return Qnil;\n"
6629 | RInt _ | RBool _ ->
6630 pr " return INT2NUM (r);\n"
6632 pr " return ULL2NUM (r);\n"
6634 pr " return rb_str_new2 (r);\n";
6636 pr " VALUE rv = rb_str_new2 (r);\n";
6640 pr " int i, len = 0;\n";
6641 pr " for (i = 0; r[i] != NULL; ++i) len++;\n";
6642 pr " VALUE rv = rb_ary_new2 (len);\n";
6643 pr " for (i = 0; r[i] != NULL; ++i) {\n";
6644 pr " rb_ary_push (rv, rb_str_new2 (r[i]));\n";
6645 pr " free (r[i]);\n";
6650 pr " VALUE rv = rb_ary_new2 (2);\n";
6651 pr " rb_ary_push (rv, INT2NUM (r->i));\n";
6652 pr " rb_ary_push (rv, INT2NUM (r->b));\n";
6653 pr " guestfs_free_int_bool (r);\n";
6656 generate_ruby_lvm_code "pv" pv_cols
6658 generate_ruby_lvm_code "vg" vg_cols
6660 generate_ruby_lvm_code "lv" lv_cols
6662 pr " VALUE rv = rb_hash_new ();\n";
6666 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
6671 pr " VALUE rv = rb_hash_new ();\n";
6675 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
6680 pr " VALUE rv = rb_hash_new ();\n";
6682 pr " for (i = 0; r[i] != NULL; i+=2) {\n";
6683 pr " rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
6684 pr " free (r[i]);\n";
6685 pr " free (r[i+1]);\n";
6696 /* Initialize the module. */
6697 void Init__guestfs ()
6699 m_guestfs = rb_define_module (\"Guestfs\");
6700 c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
6701 e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
6703 rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
6704 rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
6707 (* Define the rest of the methods. *)
6709 fun (name, style, _, _, _, _, _) ->
6710 pr " rb_define_method (c_guestfs, \"%s\",\n" name;
6711 pr " ruby_guestfs_%s, %d);\n" name (List.length (snd style))
6716 (* Ruby code to return an LVM struct list. *)
6717 and generate_ruby_lvm_code typ cols =
6718 pr " VALUE rv = rb_ary_new2 (r->len);\n";
6720 pr " for (i = 0; i < r->len; ++i) {\n";
6721 pr " VALUE hv = rb_hash_new ();\n";
6725 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
6727 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
6730 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
6731 | name, `OptPercent ->
6732 pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
6734 pr " rb_ary_push (rv, hv);\n";
6736 pr " guestfs_free_lvm_%s_list (r);\n" typ;
6739 (* Generate Java bindings GuestFS.java file. *)
6740 and generate_java_java () =
6741 generate_header CStyle LGPLv2;
6744 package com.redhat.et.libguestfs;
6746 import java.util.HashMap;
6747 import com.redhat.et.libguestfs.LibGuestFSException;
6748 import com.redhat.et.libguestfs.PV;
6749 import com.redhat.et.libguestfs.VG;
6750 import com.redhat.et.libguestfs.LV;
6751 import com.redhat.et.libguestfs.Stat;
6752 import com.redhat.et.libguestfs.StatVFS;
6753 import com.redhat.et.libguestfs.IntBool;
6756 * The GuestFS object is a libguestfs handle.
6760 public class GuestFS {
6761 // Load the native code.
6763 System.loadLibrary (\"guestfs_jni\");
6767 * The native guestfs_h pointer.
6772 * Create a libguestfs handle.
6774 * @throws LibGuestFSException
6776 public GuestFS () throws LibGuestFSException
6780 private native long _create () throws LibGuestFSException;
6783 * Close a libguestfs handle.
6785 * You can also leave handles to be collected by the garbage
6786 * collector, but this method ensures that the resources used
6787 * by the handle are freed up immediately. If you call any
6788 * other methods after closing the handle, you will get an
6791 * @throws LibGuestFSException
6793 public void close () throws LibGuestFSException
6799 private native void _close (long g) throws LibGuestFSException;
6801 public void finalize () throws LibGuestFSException
6809 fun (name, style, _, flags, _, shortdesc, longdesc) ->
6810 if not (List.mem NotInDocs flags); then (
6811 let doc = replace_str longdesc "C<guestfs_" "C<g." in
6813 if List.mem ProtocolLimitWarning flags then
6814 doc ^ "\n\n" ^ protocol_limit_warning
6817 if List.mem DangerWillRobinson flags then
6818 doc ^ "\n\n" ^ danger_will_robinson
6820 let doc = pod2text ~width:60 name doc in
6821 let doc = List.map ( (* RHBZ#501883 *)
6824 | nonempty -> nonempty
6826 let doc = String.concat "\n * " doc in
6829 pr " * %s\n" shortdesc;
6832 pr " * @throws LibGuestFSException\n";
6836 generate_java_prototype ~public:true ~semicolon:false name style;
6839 pr " if (g == 0)\n";
6840 pr " throw new LibGuestFSException (\"%s: handle is closed\");\n"
6843 if fst style <> RErr then pr "return ";
6845 generate_call_args ~handle:"g" (snd style);
6849 generate_java_prototype ~privat:true ~native:true name style;
6856 and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
6857 ?(semicolon=true) name style =
6858 if privat then pr "private ";
6859 if public then pr "public ";
6860 if native then pr "native ";
6863 (match fst style with
6864 | RErr -> pr "void ";
6865 | RInt _ -> pr "int ";
6866 | RInt64 _ -> pr "long ";
6867 | RBool _ -> pr "boolean ";
6868 | RConstString _ | RString _ -> pr "String ";
6869 | RStringList _ -> pr "String[] ";
6870 | RIntBool _ -> pr "IntBool ";
6871 | RPVList _ -> pr "PV[] ";
6872 | RVGList _ -> pr "VG[] ";
6873 | RLVList _ -> pr "LV[] ";
6874 | RStat _ -> pr "Stat ";
6875 | RStatVFS _ -> pr "StatVFS ";
6876 | RHashtable _ -> pr "HashMap<String,String> ";
6879 if native then pr "_%s " name else pr "%s " name;
6881 let needs_comma = ref false in
6890 if !needs_comma then pr ", ";
6891 needs_comma := true;
6908 pr " throws LibGuestFSException";
6909 if semicolon then pr ";"
6911 and generate_java_struct typ cols =
6912 generate_header CStyle LGPLv2;
6915 package com.redhat.et.libguestfs;
6918 * Libguestfs %s structure.
6929 | name, `UUID -> pr " public String %s;\n" name
6931 | name, `Int -> pr " public long %s;\n" name
6932 | name, `OptPercent ->
6933 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
6934 pr " public float %s;\n" name
6939 and generate_java_c () =
6940 generate_header CStyle LGPLv2;
6947 #include \"com_redhat_et_libguestfs_GuestFS.h\"
6948 #include \"guestfs.h\"
6950 /* Note that this function returns. The exception is not thrown
6951 * until after the wrapper function returns.
6954 throw_exception (JNIEnv *env, const char *msg)
6957 cl = (*env)->FindClass (env,
6958 \"com/redhat/et/libguestfs/LibGuestFSException\");
6959 (*env)->ThrowNew (env, cl, msg);
6962 JNIEXPORT jlong JNICALL
6963 Java_com_redhat_et_libguestfs_GuestFS__1create
6964 (JNIEnv *env, jobject obj)
6968 g = guestfs_create ();
6970 throw_exception (env, \"GuestFS.create: failed to allocate handle\");
6973 guestfs_set_error_handler (g, NULL, NULL);
6974 return (jlong) (long) g;
6977 JNIEXPORT void JNICALL
6978 Java_com_redhat_et_libguestfs_GuestFS__1close
6979 (JNIEnv *env, jobject obj, jlong jg)
6981 guestfs_h *g = (guestfs_h *) (long) jg;
6988 fun (name, style, _, _, _, _, _) ->
6990 (match fst style with
6991 | RErr -> pr "void ";
6992 | RInt _ -> pr "jint ";
6993 | RInt64 _ -> pr "jlong ";
6994 | RBool _ -> pr "jboolean ";
6995 | RConstString _ | RString _ -> pr "jstring ";
6996 | RIntBool _ | RStat _ | RStatVFS _ | RHashtable _ ->
6998 | RStringList _ | RPVList _ | RVGList _ | RLVList _ ->
7002 pr "Java_com_redhat_et_libguestfs_GuestFS_";
7003 pr "%s" (replace_str ("_" ^ name) "_" "_1");
7005 pr " (JNIEnv *env, jobject obj, jlong jg";
7012 pr ", jstring j%s" n
7014 pr ", jobjectArray j%s" n
7016 pr ", jboolean j%s" n
7022 pr " guestfs_h *g = (guestfs_h *) (long) jg;\n";
7023 let error_code, no_ret =
7024 match fst style with
7025 | RErr -> pr " int r;\n"; "-1", ""
7027 | RInt _ -> pr " int r;\n"; "-1", "0"
7028 | RInt64 _ -> pr " int64_t r;\n"; "-1", "0"
7029 | RConstString _ -> pr " const char *r;\n"; "NULL", "NULL"
7031 pr " jstring jr;\n";
7032 pr " char *r;\n"; "NULL", "NULL"
7034 pr " jobjectArray jr;\n";
7037 pr " jstring jstr;\n";
7038 pr " char **r;\n"; "NULL", "NULL"
7040 pr " jobject jr;\n";
7042 pr " jfieldID fl;\n";
7043 pr " struct guestfs_int_bool *r;\n"; "NULL", "NULL"
7045 pr " jobject jr;\n";
7047 pr " jfieldID fl;\n";
7048 pr " struct guestfs_stat *r;\n"; "NULL", "NULL"
7050 pr " jobject jr;\n";
7052 pr " jfieldID fl;\n";
7053 pr " struct guestfs_statvfs *r;\n"; "NULL", "NULL"
7055 pr " jobjectArray jr;\n";
7057 pr " jfieldID fl;\n";
7058 pr " jobject jfl;\n";
7059 pr " struct guestfs_lvm_pv_list *r;\n"; "NULL", "NULL"
7061 pr " jobjectArray jr;\n";
7063 pr " jfieldID fl;\n";
7064 pr " jobject jfl;\n";
7065 pr " struct guestfs_lvm_vg_list *r;\n"; "NULL", "NULL"
7067 pr " jobjectArray jr;\n";
7069 pr " jfieldID fl;\n";
7070 pr " jobject jfl;\n";
7071 pr " struct guestfs_lvm_lv_list *r;\n"; "NULL", "NULL"
7072 | RHashtable _ -> pr " char **r;\n"; "NULL", "NULL" in
7079 pr " const char *%s;\n" n
7081 pr " int %s_len;\n" n;
7082 pr " const char **%s;\n" n
7089 (match fst style with
7090 | RStringList _ | RPVList _ | RVGList _ | RLVList _ -> true
7091 | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
7092 | RString _ | RIntBool _ | RStat _ | RStatVFS _
7093 | RHashtable _ -> false) ||
7094 List.exists (function StringList _ -> true | _ -> false) (snd style) in
7100 (* Get the parameters. *)
7106 pr " %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
7108 (* This is completely undocumented, but Java null becomes
7111 pr " %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
7113 pr " %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
7114 pr " %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
7115 pr " for (i = 0; i < %s_len; ++i) {\n" n;
7116 pr " jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
7118 pr " %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
7120 pr " %s[%s_len] = NULL;\n" n n;
7123 pr " %s = j%s;\n" n n
7126 (* Make the call. *)
7127 pr " r = guestfs_%s " name;
7128 generate_call_args ~handle:"g" (snd style);
7131 (* Release the parameters. *)
7137 pr " (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
7140 pr " (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
7142 pr " for (i = 0; i < %s_len; ++i) {\n" n;
7143 pr " jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
7145 pr " (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
7147 pr " free (%s);\n" n
7152 (* Check for errors. *)
7153 pr " if (r == %s) {\n" error_code;
7154 pr " throw_exception (env, guestfs_last_error (g));\n";
7155 pr " return %s;\n" no_ret;
7159 (match fst style with
7161 | RInt _ -> pr " return (jint) r;\n"
7162 | RBool _ -> pr " return (jboolean) r;\n"
7163 | RInt64 _ -> pr " return (jlong) r;\n"
7164 | RConstString _ -> pr " return (*env)->NewStringUTF (env, r);\n"
7166 pr " jr = (*env)->NewStringUTF (env, r);\n";
7170 pr " for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
7171 pr " cl = (*env)->FindClass (env, \"java/lang/String\");\n";
7172 pr " jstr = (*env)->NewStringUTF (env, \"\");\n";
7173 pr " jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n";
7174 pr " for (i = 0; i < r_len; ++i) {\n";
7175 pr " jstr = (*env)->NewStringUTF (env, r[i]);\n";
7176 pr " (*env)->SetObjectArrayElement (env, jr, i, jstr);\n";
7177 pr " free (r[i]);\n";
7182 pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/IntBool\");\n";
7183 pr " jr = (*env)->AllocObject (env, cl);\n";
7184 pr " fl = (*env)->GetFieldID (env, cl, \"i\", \"I\");\n";
7185 pr " (*env)->SetIntField (env, jr, fl, r->i);\n";
7186 pr " fl = (*env)->GetFieldID (env, cl, \"i\", \"Z\");\n";
7187 pr " (*env)->SetBooleanField (env, jr, fl, r->b);\n";
7188 pr " guestfs_free_int_bool (r);\n";
7191 pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/Stat\");\n";
7192 pr " jr = (*env)->AllocObject (env, cl);\n";
7196 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n"
7198 pr " (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
7203 pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/StatVFS\");\n";
7204 pr " jr = (*env)->AllocObject (env, cl);\n";
7208 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n"
7210 pr " (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
7215 generate_java_lvm_return "pv" "PV" pv_cols
7217 generate_java_lvm_return "vg" "VG" vg_cols
7219 generate_java_lvm_return "lv" "LV" lv_cols
7222 pr " throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
7223 pr " return NULL;\n"
7230 and generate_java_lvm_return typ jtyp cols =
7231 pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
7232 pr " jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n";
7233 pr " for (i = 0; i < r->len; ++i) {\n";
7234 pr " jfl = (*env)->AllocObject (env, cl);\n";
7238 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
7239 pr " (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name;
7242 pr " char s[33];\n";
7243 pr " memcpy (s, r->val[i].%s, 32);\n" name;
7245 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
7246 pr " (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
7248 | name, (`Bytes|`Int) ->
7249 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
7250 pr " (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
7251 | name, `OptPercent ->
7252 pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
7253 pr " (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\n" name;
7255 pr " (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n";
7257 pr " guestfs_free_lvm_%s_list (r);\n" typ;
7260 and generate_haskell_hs () =
7261 generate_header HaskellStyle LGPLv2;
7263 (* XXX We only know how to generate partial FFI for Haskell
7264 * at the moment. Please help out!
7266 let can_generate style =
7267 let check_no_bad_args =
7268 List.for_all (function Bool _ | Int _ -> false | _ -> true)
7271 | RErr, args -> check_no_bad_args args
7284 | RHashtable _, _ -> false in
7287 {-# INCLUDE <guestfs.h> #-}
7288 {-# LANGUAGE ForeignFunctionInterface #-}
7293 (* List out the names of the actions we want to export. *)
7295 fun (name, style, _, _, _, _, _) ->
7296 if can_generate style then pr ",\n %s" name
7304 import Control.Exception
7305 import Data.Typeable
7307 data GuestfsS = GuestfsS -- represents the opaque C struct
7308 type GuestfsP = Ptr GuestfsS -- guestfs_h *
7309 type GuestfsH = ForeignPtr GuestfsS -- guestfs_h * with attached finalizer
7311 -- XXX define properly later XXX
7315 data IntBool = IntBool
7317 data StatVFS = StatVFS
7318 data Hashtable = Hashtable
7320 foreign import ccall unsafe \"guestfs_create\" c_create
7322 foreign import ccall unsafe \"&guestfs_close\" c_close
7323 :: FunPtr (GuestfsP -> IO ())
7324 foreign import ccall unsafe \"guestfs_set_error_handler\" c_set_error_handler
7325 :: GuestfsP -> Ptr CInt -> Ptr CInt -> IO ()
7327 create :: IO GuestfsH
7330 c_set_error_handler p nullPtr nullPtr
7331 h <- newForeignPtr c_close p
7334 foreign import ccall unsafe \"guestfs_last_error\" c_last_error
7335 :: GuestfsP -> IO CString
7337 -- last_error :: GuestfsH -> IO (Maybe String)
7338 -- last_error h = do
7339 -- str <- withForeignPtr h (\\p -> c_last_error p)
7340 -- maybePeek peekCString str
7342 last_error :: GuestfsH -> IO (String)
7344 str <- withForeignPtr h (\\p -> c_last_error p)
7346 then return \"no error\"
7347 else peekCString str
7351 (* Generate wrappers for each foreign function. *)
7353 fun (name, style, _, _, _, _, _) ->
7354 if can_generate style then (
7355 pr "foreign import ccall unsafe \"guestfs_%s\" c_%s\n" name name;
7357 generate_haskell_prototype ~handle:"GuestfsP" style;
7361 generate_haskell_prototype ~handle:"GuestfsH" ~hs:true style;
7363 pr "%s %s = do\n" name
7364 (String.concat " " ("h" :: List.map name_of_argt (snd style)));
7370 | String n -> pr "withCString %s $ \\%s -> " n n
7371 | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
7372 | StringList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
7374 (* XXX this doesn't work *)
7376 pr " %s = case %s of\n" n n;
7379 pr " in fromIntegral %s $ \\%s ->\n" n n
7380 | Int n -> pr "fromIntegral %s $ \\%s -> " n n
7382 pr "withForeignPtr h (\\p -> c_%s %s)\n" name
7383 (String.concat " " ("p" :: List.map name_of_argt (snd style)));
7384 (match fst style with
7385 | RErr | RInt _ | RInt64 _ | RBool _ ->
7386 pr " if (r == -1)\n";
7388 pr " err <- last_error h\n";
7390 | RConstString _ | RString _ | RStringList _ | RIntBool _
7391 | RPVList _ | RVGList _ | RLVList _ | RStat _ | RStatVFS _
7393 pr " if (r == nullPtr)\n";
7395 pr " err <- last_error h\n";
7398 (match fst style with
7400 pr " else return ()\n"
7402 pr " else return (fromIntegral r)\n"
7404 pr " else return (fromIntegral r)\n"
7406 pr " else return (toBool r)\n"
7417 pr " else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *)
7423 and generate_haskell_prototype ~handle ?(hs = false) style =
7425 let string = if hs then "String" else "CString" in
7426 let int = if hs then "Int" else "CInt" in
7427 let bool = if hs then "Bool" else "CInt" in
7428 let int64 = if hs then "Integer" else "Int64" in
7432 | String _ -> pr "%s" string
7433 | OptString _ -> if hs then pr "Maybe String" else pr "CString"
7434 | StringList _ -> if hs then pr "[String]" else pr "Ptr CString"
7435 | Bool _ -> pr "%s" bool
7436 | Int _ -> pr "%s" int
7437 | FileIn _ -> pr "%s" string
7438 | FileOut _ -> pr "%s" string
7443 (match fst style with
7444 | RErr -> if not hs then pr "CInt"
7445 | RInt _ -> pr "%s" int
7446 | RInt64 _ -> pr "%s" int64
7447 | RBool _ -> pr "%s" bool
7448 | RConstString _ -> pr "%s" string
7449 | RString _ -> pr "%s" string
7450 | RStringList _ -> pr "[%s]" string
7451 | RIntBool _ -> pr "IntBool"
7452 | RPVList _ -> pr "[PV]"
7453 | RVGList _ -> pr "[VG]"
7454 | RLVList _ -> pr "[LV]"
7455 | RStat _ -> pr "Stat"
7456 | RStatVFS _ -> pr "StatVFS"
7457 | RHashtable _ -> pr "Hashtable"
7461 and generate_bindtests () =
7462 generate_header CStyle LGPLv2;
7467 #include <inttypes.h>
7470 #include \"guestfs.h\"
7471 #include \"guestfs_protocol.h\"
7473 #define error guestfs_error
7476 print_strings (char * const* const argv)
7481 for (argc = 0; argv[argc] != NULL; ++argc) {
7482 if (argc > 0) printf (\", \");
7483 printf (\"\\\"%%s\\\"\", argv[argc]);
7488 /* The test0 function prints its parameters to stdout. */
7492 match test_functions with
7493 | [] -> assert false
7494 | test0 :: tests -> test0, tests in
7497 let (name, style, _, _, _, _, _) = test0 in
7498 generate_prototype ~extern:false ~semicolon:false ~newline:true
7499 ~handle:"g" ~prefix:"guestfs_" name style;
7505 | FileOut n -> pr " printf (\"%%s\\n\", %s);\n" n
7506 | OptString n -> pr " printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
7507 | StringList n -> pr " print_strings (%s);\n" n
7508 | Bool n -> pr " printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
7509 | Int n -> pr " printf (\"%%d\\n\", %s);\n" n
7511 pr " /* Java changes stdout line buffering so we need this: */\n";
7512 pr " fflush (stdout);\n";
7518 fun (name, style, _, _, _, _, _) ->
7519 if String.sub name (String.length name - 3) 3 <> "err" then (
7520 pr "/* Test normal return. */\n";
7521 generate_prototype ~extern:false ~semicolon:false ~newline:true
7522 ~handle:"g" ~prefix:"guestfs_" name style;
7524 (match fst style with
7529 pr " sscanf (val, \"%%d\", &r);\n";
7533 pr " sscanf (val, \"%%\" SCNi64, &r);\n";
7536 pr " return strcmp (val, \"true\") == 0;\n"
7538 (* Can't return the input string here. Return a static
7539 * string so we ensure we get a segfault if the caller
7542 pr " return \"static string\";\n"
7544 pr " return strdup (val);\n"
7546 pr " char **strs;\n";
7548 pr " sscanf (val, \"%%d\", &n);\n";
7549 pr " strs = malloc ((n+1) * sizeof (char *));\n";
7550 pr " for (i = 0; i < n; ++i) {\n";
7551 pr " strs[i] = malloc (16);\n";
7552 pr " snprintf (strs[i], 16, \"%%d\", i);\n";
7554 pr " strs[n] = NULL;\n";
7555 pr " return strs;\n"
7557 pr " struct guestfs_int_bool *r;\n";
7558 pr " r = malloc (sizeof (struct guestfs_int_bool));\n";
7559 pr " sscanf (val, \"%%\" SCNi32, &r->i);\n";
7563 pr " struct guestfs_lvm_pv_list *r;\n";
7565 pr " r = malloc (sizeof (struct guestfs_lvm_pv_list));\n";
7566 pr " sscanf (val, \"%%d\", &r->len);\n";
7567 pr " r->val = calloc (r->len, sizeof (struct guestfs_lvm_pv));\n";
7568 pr " for (i = 0; i < r->len; ++i) {\n";
7569 pr " r->val[i].pv_name = malloc (16);\n";
7570 pr " snprintf (r->val[i].pv_name, 16, \"%%d\", i);\n";
7574 pr " struct guestfs_lvm_vg_list *r;\n";
7576 pr " r = malloc (sizeof (struct guestfs_lvm_vg_list));\n";
7577 pr " sscanf (val, \"%%d\", &r->len);\n";
7578 pr " r->val = calloc (r->len, sizeof (struct guestfs_lvm_vg));\n";
7579 pr " for (i = 0; i < r->len; ++i) {\n";
7580 pr " r->val[i].vg_name = malloc (16);\n";
7581 pr " snprintf (r->val[i].vg_name, 16, \"%%d\", i);\n";
7585 pr " struct guestfs_lvm_lv_list *r;\n";
7587 pr " r = malloc (sizeof (struct guestfs_lvm_lv_list));\n";
7588 pr " sscanf (val, \"%%d\", &r->len);\n";
7589 pr " r->val = calloc (r->len, sizeof (struct guestfs_lvm_lv));\n";
7590 pr " for (i = 0; i < r->len; ++i) {\n";
7591 pr " r->val[i].lv_name = malloc (16);\n";
7592 pr " snprintf (r->val[i].lv_name, 16, \"%%d\", i);\n";
7596 pr " struct guestfs_stat *r;\n";
7597 pr " r = calloc (1, sizeof (*r));\n";
7598 pr " sscanf (val, \"%%\" SCNi64, &r->dev);\n";
7601 pr " struct guestfs_statvfs *r;\n";
7602 pr " r = calloc (1, sizeof (*r));\n";
7603 pr " sscanf (val, \"%%\" SCNi64, &r->bsize);\n";
7606 pr " char **strs;\n";
7608 pr " sscanf (val, \"%%d\", &n);\n";
7609 pr " strs = malloc ((n*2+1) * sizeof (char *));\n";
7610 pr " for (i = 0; i < n; ++i) {\n";
7611 pr " strs[i*2] = malloc (16);\n";
7612 pr " strs[i*2+1] = malloc (16);\n";
7613 pr " snprintf (strs[i*2], 16, \"%%d\", i);\n";
7614 pr " snprintf (strs[i*2+1], 16, \"%%d\", i);\n";
7616 pr " strs[n*2] = NULL;\n";
7617 pr " return strs;\n"
7622 pr "/* Test error return. */\n";
7623 generate_prototype ~extern:false ~semicolon:false ~newline:true
7624 ~handle:"g" ~prefix:"guestfs_" name style;
7626 pr " error (g, \"error\");\n";
7627 (match fst style with
7628 | RErr | RInt _ | RInt64 _ | RBool _ ->
7631 | RString _ | RStringList _ | RIntBool _
7632 | RPVList _ | RVGList _ | RLVList _ | RStat _ | RStatVFS _
7634 pr " return NULL;\n"
7641 and generate_ocaml_bindtests () =
7642 generate_header OCamlStyle GPLv2;
7646 let g = Guestfs.create () in
7653 | CallString s -> "\"" ^ s ^ "\""
7654 | CallOptString None -> "None"
7655 | CallOptString (Some s) -> sprintf "(Some \"%s\")" s
7656 | CallStringList xs ->
7657 "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
7658 | CallInt i when i >= 0 -> string_of_int i
7659 | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
7660 | CallBool b -> string_of_bool b
7665 generate_lang_bindtests (
7666 fun f args -> pr " Guestfs.%s g %s;\n" f (mkargs args)
7669 pr "print_endline \"EOF\"\n"
7671 and generate_perl_bindtests () =
7672 pr "#!/usr/bin/perl -w\n";
7673 generate_header HashStyle GPLv2;
7680 my $g = Sys::Guestfs->new ();
7684 String.concat ", " (
7687 | CallString s -> "\"" ^ s ^ "\""
7688 | CallOptString None -> "undef"
7689 | CallOptString (Some s) -> sprintf "\"%s\"" s
7690 | CallStringList xs ->
7691 "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
7692 | CallInt i -> string_of_int i
7693 | CallBool b -> if b then "1" else "0"
7698 generate_lang_bindtests (
7699 fun f args -> pr "$g->%s (%s);\n" f (mkargs args)
7702 pr "print \"EOF\\n\"\n"
7704 and generate_python_bindtests () =
7705 generate_header HashStyle GPLv2;
7710 g = guestfs.GuestFS ()
7714 String.concat ", " (
7717 | CallString s -> "\"" ^ s ^ "\""
7718 | CallOptString None -> "None"
7719 | CallOptString (Some s) -> sprintf "\"%s\"" s
7720 | CallStringList xs ->
7721 "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
7722 | CallInt i -> string_of_int i
7723 | CallBool b -> if b then "1" else "0"
7728 generate_lang_bindtests (
7729 fun f args -> pr "g.%s (%s)\n" f (mkargs args)
7732 pr "print \"EOF\"\n"
7734 and generate_ruby_bindtests () =
7735 generate_header HashStyle GPLv2;
7740 g = Guestfs::create()
7744 String.concat ", " (
7747 | CallString s -> "\"" ^ s ^ "\""
7748 | CallOptString None -> "nil"
7749 | CallOptString (Some s) -> sprintf "\"%s\"" s
7750 | CallStringList xs ->
7751 "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
7752 | CallInt i -> string_of_int i
7753 | CallBool b -> string_of_bool b
7758 generate_lang_bindtests (
7759 fun f args -> pr "g.%s(%s)\n" f (mkargs args)
7762 pr "print \"EOF\\n\"\n"
7764 and generate_java_bindtests () =
7765 generate_header CStyle GPLv2;
7768 import com.redhat.et.libguestfs.*;
7770 public class Bindtests {
7771 public static void main (String[] argv)
7774 GuestFS g = new GuestFS ();
7778 String.concat ", " (
7781 | CallString s -> "\"" ^ s ^ "\""
7782 | CallOptString None -> "null"
7783 | CallOptString (Some s) -> sprintf "\"%s\"" s
7784 | CallStringList xs ->
7786 String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
7787 | CallInt i -> string_of_int i
7788 | CallBool b -> string_of_bool b
7793 generate_lang_bindtests (
7794 fun f args -> pr " g.%s (%s);\n" f (mkargs args)
7798 System.out.println (\"EOF\");
7800 catch (Exception exn) {
7801 System.err.println (exn);
7808 and generate_haskell_bindtests () =
7809 () (* XXX Haskell bindings need to be fleshed out. *)
7811 (* Language-independent bindings tests - we do it this way to
7812 * ensure there is parity in testing bindings across all languages.
7814 and generate_lang_bindtests call =
7815 call "test0" [CallString "abc"; CallOptString (Some "def");
7816 CallStringList []; CallBool false;
7817 CallInt 0; CallString "123"; CallString "456"];
7818 call "test0" [CallString "abc"; CallOptString None;
7819 CallStringList []; CallBool false;
7820 CallInt 0; CallString "123"; CallString "456"];
7821 call "test0" [CallString ""; CallOptString (Some "def");
7822 CallStringList []; CallBool false;
7823 CallInt 0; CallString "123"; CallString "456"];
7824 call "test0" [CallString ""; CallOptString (Some "");
7825 CallStringList []; CallBool false;
7826 CallInt 0; CallString "123"; CallString "456"];
7827 call "test0" [CallString "abc"; CallOptString (Some "def");
7828 CallStringList ["1"]; CallBool false;
7829 CallInt 0; CallString "123"; CallString "456"];
7830 call "test0" [CallString "abc"; CallOptString (Some "def");
7831 CallStringList ["1"; "2"]; CallBool false;
7832 CallInt 0; CallString "123"; CallString "456"];
7833 call "test0" [CallString "abc"; CallOptString (Some "def");
7834 CallStringList ["1"]; CallBool true;
7835 CallInt 0; CallString "123"; CallString "456"];
7836 call "test0" [CallString "abc"; CallOptString (Some "def");
7837 CallStringList ["1"]; CallBool false;
7838 CallInt (-1); CallString "123"; CallString "456"];
7839 call "test0" [CallString "abc"; CallOptString (Some "def");
7840 CallStringList ["1"]; CallBool false;
7841 CallInt (-2); CallString "123"; CallString "456"];
7842 call "test0" [CallString "abc"; CallOptString (Some "def");
7843 CallStringList ["1"]; CallBool false;
7844 CallInt 1; CallString "123"; CallString "456"];
7845 call "test0" [CallString "abc"; CallOptString (Some "def");
7846 CallStringList ["1"]; CallBool false;
7847 CallInt 2; CallString "123"; CallString "456"];
7848 call "test0" [CallString "abc"; CallOptString (Some "def");
7849 CallStringList ["1"]; CallBool false;
7850 CallInt 4095; CallString "123"; CallString "456"];
7851 call "test0" [CallString "abc"; CallOptString (Some "def");
7852 CallStringList ["1"]; CallBool false;
7853 CallInt 0; CallString ""; CallString ""]
7855 (* XXX Add here tests of the return and error functions. *)
7857 let output_to filename =
7858 let filename_new = filename ^ ".new" in
7859 chan := open_out filename_new;
7864 (* Is the new file different from the current file? *)
7865 if Sys.file_exists filename && files_equal filename filename_new then
7866 Unix.unlink filename_new (* same, so skip it *)
7868 (* different, overwrite old one *)
7869 (try Unix.chmod filename 0o644 with Unix.Unix_error _ -> ());
7870 Unix.rename filename_new filename;
7871 Unix.chmod filename 0o444;
7872 printf "written %s\n%!" filename;
7881 if not (Sys.file_exists "configure.ac") then (
7883 You are probably running this from the wrong directory.
7884 Run it from the top source directory using the command
7890 let close = output_to "src/guestfs_protocol.x" in
7894 let close = output_to "src/guestfs-structs.h" in
7895 generate_structs_h ();
7898 let close = output_to "src/guestfs-actions.h" in
7899 generate_actions_h ();
7902 let close = output_to "src/guestfs-actions.c" in
7903 generate_client_actions ();
7906 let close = output_to "daemon/actions.h" in
7907 generate_daemon_actions_h ();
7910 let close = output_to "daemon/stubs.c" in
7911 generate_daemon_actions ();
7914 let close = output_to "capitests/tests.c" in
7918 let close = output_to "src/guestfs-bindtests.c" in
7919 generate_bindtests ();
7922 let close = output_to "fish/cmds.c" in
7923 generate_fish_cmds ();
7926 let close = output_to "fish/completion.c" in
7927 generate_fish_completion ();
7930 let close = output_to "guestfs-structs.pod" in
7931 generate_structs_pod ();
7934 let close = output_to "guestfs-actions.pod" in
7935 generate_actions_pod ();
7938 let close = output_to "guestfish-actions.pod" in
7939 generate_fish_actions_pod ();
7942 let close = output_to "ocaml/guestfs.mli" in
7943 generate_ocaml_mli ();
7946 let close = output_to "ocaml/guestfs.ml" in
7947 generate_ocaml_ml ();
7950 let close = output_to "ocaml/guestfs_c_actions.c" in
7951 generate_ocaml_c ();
7954 let close = output_to "ocaml/bindtests.ml" in
7955 generate_ocaml_bindtests ();
7958 let close = output_to "perl/Guestfs.xs" in
7959 generate_perl_xs ();
7962 let close = output_to "perl/lib/Sys/Guestfs.pm" in
7963 generate_perl_pm ();
7966 let close = output_to "perl/bindtests.pl" in
7967 generate_perl_bindtests ();
7970 let close = output_to "python/guestfs-py.c" in
7971 generate_python_c ();
7974 let close = output_to "python/guestfs.py" in
7975 generate_python_py ();
7978 let close = output_to "python/bindtests.py" in
7979 generate_python_bindtests ();
7982 let close = output_to "ruby/ext/guestfs/_guestfs.c" in
7986 let close = output_to "ruby/bindtests.rb" in
7987 generate_ruby_bindtests ();
7990 let close = output_to "java/com/redhat/et/libguestfs/GuestFS.java" in
7991 generate_java_java ();
7994 let close = output_to "java/com/redhat/et/libguestfs/PV.java" in
7995 generate_java_struct "PV" pv_cols;
7998 let close = output_to "java/com/redhat/et/libguestfs/VG.java" in
7999 generate_java_struct "VG" vg_cols;
8002 let close = output_to "java/com/redhat/et/libguestfs/LV.java" in
8003 generate_java_struct "LV" lv_cols;
8006 let close = output_to "java/com/redhat/et/libguestfs/Stat.java" in
8007 generate_java_struct "Stat" stat_cols;
8010 let close = output_to "java/com/redhat/et/libguestfs/StatVFS.java" in
8011 generate_java_struct "StatVFS" statvfs_cols;
8014 let close = output_to "java/com_redhat_et_libguestfs_GuestFS.c" in
8018 let close = output_to "java/Bindtests.java" in
8019 generate_java_bindtests ();
8022 let close = output_to "haskell/Guestfs.hs" in
8023 generate_haskell_hs ();
8026 let close = output_to "haskell/bindtests.hs" in
8027 generate_haskell_bindtests ();