X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=src%2Fgenerator.ml;h=c4f285119308fdb4ecd6911e77ac85086474f173;hp=d680d42459671bf5d18cc9be18a58348206e9865;hb=1e97e406c36031617a86a4fa6bb78a112848ee87;hpb=abb447c32abdea467374edc30704818dd2883da7 diff --git a/src/generator.ml b/src/generator.ml index d680d42..c4f2851 100755 --- a/src/generator.ml +++ b/src/generator.ml @@ -116,6 +116,7 @@ type flags = | FishAlias of string (* provide an alias for this cmd in guestfish *) | FishAction of string (* call this function in guestfish *) | NotInFish (* do not export via guestfish *) + | NotInDocs (* do not add this function to documentation *) let protocol_limit_warning = "Because of the message protocol, there is a transfer limit @@ -129,19 +130,41 @@ can easily destroy all your data>." (* You can supply zero or as many tests as you want per API call. * * Note that the test environment has 3 block devices, of size 500MB, - * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc). + * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc), and + * a fourth squashfs block device with some known files on it (/dev/sdd). + * * Note for partitioning purposes, the 500MB device has 63 cylinders. * + * The squashfs block device (/dev/sdd) comes from images/test.sqsh. + * * To be able to run the tests in a reasonable amount of time, * the virtual machine and block devices are reused between tests. * So don't try testing kill_subprocess :-x * - * Between each test we umount-all and lvm-remove-all (except InitNone). + * Between each test we blockdev-setrw, umount-all, lvm-remove-all. + * + * If the appliance is running an older Linux kernel (eg. RHEL 5) then + * devices are named /dev/hda etc. To cope with this, the test suite + * adds some hairly logic to detect this case, and then automagically + * replaces all strings which match "/dev/sd.*" with "/dev/hd.*". + * When writing test cases you shouldn't have to worry about this + * difference. * * Don't assume anything about the previous contents of the block * devices. Use 'Init*' to create some initial scenarios. + * + * You can add a prerequisite clause to any individual test. This + * is a run-time check, which, if it fails, causes the test to be + * skipped. Useful if testing a command which might not work on + * all variations of libguestfs builds. A test that has prerequisite + * of 'Always' is run unconditionally. + * + * In addition, packagers can skip individual tests by setting the + * environment variables: eg: + * SKIP_TEST__=1 SKIP_TEST_COMMAND_3=1 (skips test #3 of command) + * SKIP_TEST_=1 SKIP_TEST_ZEROFREE=1 (skips all zerofree tests) *) -type tests = (test_init * test) list +type tests = (test_init * test_prereq * test) list and test = (* Run the command sequence and just expect nothing to fail. *) | TestRun of seq @@ -154,6 +177,12 @@ and test = *) | TestOutputList of seq * string list (* Run the command sequence and expect the output of the final + * command to be the list of block devices (could be either + * "/dev/sd.." or "/dev/hd.." form - we don't check the 5th + * character of each string). + *) + | TestOutputListOfDevices of seq * string list + (* Run the command sequence and expect the output of the final * command to be the integer. *) | TestOutputInt of seq * int @@ -185,6 +214,21 @@ and test_field_compare = | CompareFieldsIntEq of string * string | CompareFieldsStrEq of string * string +(* Test prerequisites. *) +and test_prereq = + (* Test always runs. *) + | Always + (* Test is currently disabled - eg. it fails, or it tests some + * unimplemented feature. + *) + | Disabled + (* 'string' is some C code (a function body) that should return + * true or false. The test will run if the code returns true. + *) + | If of string + (* As for 'If' but the test runs _unless_ the code returns true. *) + | Unless of string + (* Some initial scenarios for testing. *) and test_init = (* Do nothing, block devices could contain random stuff including @@ -220,7 +264,81 @@ and cmd = string list * Apart from that, long descriptions are just perldoc paragraphs. *) -let non_daemon_functions = [ +(* These test functions are used in the language binding tests. *) + +let test_all_args = [ + String "str"; + OptString "optstr"; + StringList "strlist"; + Bool "b"; + Int "integer"; + FileIn "filein"; + FileOut "fileout"; +] + +let test_all_rets = [ + (* except for RErr, which is tested thoroughly elsewhere *) + "test0rint", RInt "valout"; + "test0rint64", RInt64 "valout"; + "test0rbool", RBool "valout"; + "test0rconststring", RConstString "valout"; + "test0rstring", RString "valout"; + "test0rstringlist", RStringList "valout"; + "test0rintbool", RIntBool ("valout", "valout"); + "test0rpvlist", RPVList "valout"; + "test0rvglist", RVGList "valout"; + "test0rlvlist", RLVList "valout"; + "test0rstat", RStat "valout"; + "test0rstatvfs", RStatVFS "valout"; + "test0rhashtable", RHashtable "valout"; +] + +let test_functions = [ + ("test0", (RErr, test_all_args), -1, [NotInFish; NotInDocs], + [], + "internal test function - do not use", + "\ +This is an internal test function which is used to test whether +the automatically generated bindings can handle every possible +parameter type correctly. + +It echos the contents of each parameter to stdout. + +You probably don't want to call this function."); +] @ List.flatten ( + List.map ( + fun (name, ret) -> + [(name, (ret, [String "val"]), -1, [NotInFish; NotInDocs], + [], + "internal test function - do not use", + "\ +This is an internal test function which is used to test whether +the automatically generated bindings can handle every possible +return type correctly. + +It converts string C to the return type. + +You probably don't want to call this function."); + (name ^ "err", (ret, []), -1, [NotInFish; NotInDocs], + [], + "internal test function - do not use", + "\ +This is an internal test function which is used to test whether +the automatically generated bindings can handle every possible +return type correctly. + +This function always returns an error. + +You probably don't want to call this function.")] + ) test_all_rets +) + +(* non_daemon_functions are any functions which don't get processed + * in the daemon, eg. functions for setting and getting local + * configuration values. + *) + +let non_daemon_functions = test_functions @ [ ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"], [], "launch the qemu subprocess", @@ -262,7 +380,12 @@ for whatever operations you want to perform (ie. read access if you just want to read the image or write access if you want to modify the image). -This is equivalent to the qemu parameter C<-drive file=filename>."); +This is equivalent to the qemu parameter C<-drive file=filename>. + +Note that this call checks for the existence of C. This +stops you from specifying other types of drive which are supported +by qemu such as C and C URLs. To specify those, use +the general C call instead."); ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"], [], @@ -270,7 +393,33 @@ This is equivalent to the qemu parameter C<-drive file=filename>."); "\ This function adds a virtual CD-ROM disk image to the guest. -This is equivalent to the qemu parameter C<-cdrom filename>."); +This is equivalent to the qemu parameter C<-cdrom filename>. + +Note that this call checks for the existence of C. This +stops you from specifying other types of drive which are supported +by qemu such as C and C URLs. To specify those, use +the general C call instead."); + + ("add_drive_ro", (RErr, [String "filename"]), -1, [FishAlias "add-ro"], + [], + "add a drive in snapshot mode (read-only)", + "\ +This adds a drive in snapshot mode, making it effectively +read-only. + +Note that writes to the device are allowed, and will be seen for +the duration of the guestfs handle, but they are written +to a temporary file which is discarded as soon as the guestfs +handle is closed. We don't currently have any method to enable +changes to be committed, although qemu can support this. + +This is equivalent to the qemu parameter +C<-drive file=filename,snapshot=on>. + +Note that this call checks for the existence of C. This +stops you from specifying other types of drive which are supported +by qemu such as C and C URLs. To specify those, use +the general C call instead."); ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [], [], @@ -297,9 +446,6 @@ configure script. You can also override this by setting the C environment variable. -The string C is stashed in the libguestfs handle, so the caller -must make sure it remains valid for the lifetime of the handle. - Setting C to C restores the default qemu binary."); ("get_qemu", (RConstString "qemu", []), -1, [], @@ -320,9 +466,6 @@ Set the path that libguestfs searches for kernel and initrd.img. The default is C<$libdir/guestfs> unless overridden by setting C environment variable. -The string C is stashed in the libguestfs handle, so the caller -must make sure it remains valid for the lifetime of the handle. - Setting C to C restores the default path."); ("get_path", (RConstString "path", []), -1, [], @@ -334,13 +477,39 @@ Return the current search path. This is always non-NULL. If it wasn't set already, then this will return the default path."); + ("set_append", (RErr, [String "append"]), -1, [FishAlias "append"], + [], + "add options to kernel command line", + "\ +This function is used to add additional options to the +guest kernel command line. + +The default is C unless overridden by setting +C environment variable. + +Setting C to C means I additional options +are passed (libguestfs always adds a few of its own)."); + + ("get_append", (RConstString "append", []), -1, [], + [], + "get the additional kernel options", + "\ +Return the additional kernel options which are added to the +guest kernel command line. + +If C then no options are added."); + ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"], [], "set autosync mode", "\ If C is true, this enables autosync. Libguestfs will make a -best effort attempt to run C when the handle is closed -(also if the program exits without closing handles)."); +best effort attempt to run C followed by +C when the handle is closed +(also if the program exits without closing handles). + +This is disabled by default (except in guestfish where it is +enabled by default)."); ("get_autosync", (RBool "autosync", []), -1, [], [], @@ -426,11 +595,25 @@ actions using the low-level API. For more information on states, see L."); + ("end_busy", (RErr, []), -1, [NotInFish], + [], + "leave the busy state", + "\ +This sets the state to C, or if in C then it leaves the +state as is. This is only used when implementing +actions using the low-level API. + +For more information on states, see L."); + ] +(* daemon_functions are any functions which cause some action + * to take place in the daemon. + *) + let daemon_functions = [ ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [], - [InitEmpty, TestOutput ( + [InitEmpty, Always, TestOutput ( [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; ["mkfs"; "ext2"; "/dev/sda1"]; ["mount"; "/dev/sda1"; "/"]; @@ -456,7 +639,7 @@ The filesystem options C and C are set with this call, in order to improve reliability."); ("sync", (RErr, []), 2, [], - [ InitEmpty, TestRun [["sync"]]], + [ InitEmpty, Always, TestRun [["sync"]]], "sync disks, writes are flushed through to the disk image", "\ This syncs the disk, so that any writes are flushed through to the @@ -466,7 +649,7 @@ You should always call this if you have modified a disk image, before closing the handle."); ("touch", (RErr, [String "path"]), 3, [], - [InitBasicFS, TestOutputTrue ( + [InitBasicFS, Always, TestOutputTrue ( [["touch"; "/new"]; ["exists"; "/new"]])], "update file timestamps or create a new file", @@ -476,7 +659,7 @@ update the timestamps on a file, or, if the file does not exist, to create a new zero-length file."); ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning], - [InitBasicFS, TestOutput ( + [InitBasicFS, Always, TestOutput ( [["write_file"; "/new"; "new file contents"; "0"]; ["cat"; "/new"]], "new file contents")], "list the contents of a file", @@ -501,7 +684,7 @@ This command is mostly useful for interactive sessions. It is I intended that you try to parse the output string."); ("ls", (RStringList "listing", [String "directory"]), 6, [], - [InitBasicFS, TestOutputList ( + [InitBasicFS, Always, TestOutputList ( [["touch"; "/new"]; ["touch"; "/newer"]; ["touch"; "/newest"]; @@ -516,8 +699,8 @@ This command is mostly useful for interactive sessions. Programs should probably use C instead."); ("list_devices", (RStringList "devices", []), 7, [], - [InitEmpty, TestOutputList ( - [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"])], + [InitEmpty, Always, TestOutputListOfDevices ( + [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"; "/dev/sdd"])], "list the block devices", "\ List all the block devices. @@ -525,9 +708,9 @@ List all the block devices. The full block device names are returned, eg. C"); ("list_partitions", (RStringList "partitions", []), 8, [], - [InitBasicFS, TestOutputList ( + [InitBasicFS, Always, TestOutputListOfDevices ( [["list_partitions"]], ["/dev/sda1"]); - InitEmpty, TestOutputList ( + InitEmpty, Always, TestOutputListOfDevices ( [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])], "list the partitions", @@ -540,9 +723,9 @@ This does not return logical volumes. For that you will need to call C."); ("pvs", (RStringList "physvols", []), 9, [], - [InitBasicFSonLVM, TestOutputList ( + [InitBasicFSonLVM, Always, TestOutputListOfDevices ( [["pvs"]], ["/dev/sda1"]); - InitEmpty, TestOutputList ( + InitEmpty, Always, TestOutputListOfDevices ( [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; ["pvcreate"; "/dev/sda1"]; ["pvcreate"; "/dev/sda2"]; @@ -559,9 +742,9 @@ PVs (eg. C). See also C."); ("vgs", (RStringList "volgroups", []), 10, [], - [InitBasicFSonLVM, TestOutputList ( + [InitBasicFSonLVM, Always, TestOutputList ( [["vgs"]], ["VG"]); - InitEmpty, TestOutputList ( + InitEmpty, Always, TestOutputList ( [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; ["pvcreate"; "/dev/sda1"]; ["pvcreate"; "/dev/sda2"]; @@ -580,9 +763,9 @@ detected (eg. C). See also C."); ("lvs", (RStringList "logvols", []), 11, [], - [InitBasicFSonLVM, TestOutputList ( + [InitBasicFSonLVM, Always, TestOutputList ( [["lvs"]], ["/dev/VG/LV"]); - InitEmpty, TestOutputList ( + InitEmpty, Always, TestOutputList ( [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; ["pvcreate"; "/dev/sda1"]; ["pvcreate"; "/dev/sda2"]; @@ -625,10 +808,10 @@ List all the logical volumes detected. This is the equivalent of the L command. The \"full\" version includes all fields."); ("read_lines", (RStringList "lines", [String "path"]), 15, [], - [InitBasicFS, TestOutputList ( + [InitBasicFS, Always, TestOutputList ( [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"]; ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]); - InitBasicFS, TestOutputList ( + InitBasicFS, Always, TestOutputList ( [["write_file"; "/new"; ""; "0"]; ["read_lines"; "/new"]], [])], "read file as lines", @@ -803,12 +986,12 @@ This is just a shortcut for listing C C and sorting the resulting nodes into alphabetical order."); ("rm", (RErr, [String "path"]), 29, [], - [InitBasicFS, TestRun + [InitBasicFS, Always, TestRun [["touch"; "/new"]; ["rm"; "/new"]]; - InitBasicFS, TestLastFail + InitBasicFS, Always, TestLastFail [["rm"; "/new"]]; - InitBasicFS, TestLastFail + InitBasicFS, Always, TestLastFail [["mkdir"; "/new"]; ["rm"; "/new"]]], "remove a file", @@ -816,12 +999,12 @@ C and sorting the resulting nodes into alphabetical order."); Remove the single file C."); ("rmdir", (RErr, [String "path"]), 30, [], - [InitBasicFS, TestRun + [InitBasicFS, Always, TestRun [["mkdir"; "/new"]; ["rmdir"; "/new"]]; - InitBasicFS, TestLastFail + InitBasicFS, Always, TestLastFail [["rmdir"; "/new"]]; - InitBasicFS, TestLastFail + InitBasicFS, Always, TestLastFail [["touch"; "/new"]; ["rmdir"; "/new"]]], "remove a directory", @@ -829,7 +1012,7 @@ Remove the single file C."); Remove the single directory C."); ("rm_rf", (RErr, [String "path"]), 31, [], - [InitBasicFS, TestOutputFalse + [InitBasicFS, Always, TestOutputFalse [["mkdir"; "/new"]; ["mkdir"; "/new/foo"]; ["touch"; "/new/foo/bar"]; @@ -842,25 +1025,32 @@ contents if its a directory. This is like the C shell command."); ("mkdir", (RErr, [String "path"]), 32, [], - [InitBasicFS, TestOutputTrue + [InitBasicFS, Always, TestOutputTrue [["mkdir"; "/new"]; ["is_dir"; "/new"]]; - InitBasicFS, TestLastFail + InitBasicFS, Always, TestLastFail [["mkdir"; "/new/foo/bar"]]], "create a directory", "\ Create a directory named C."); ("mkdir_p", (RErr, [String "path"]), 33, [], - [InitBasicFS, TestOutputTrue + [InitBasicFS, Always, TestOutputTrue [["mkdir_p"; "/new/foo/bar"]; ["is_dir"; "/new/foo/bar"]]; - InitBasicFS, TestOutputTrue + InitBasicFS, Always, TestOutputTrue [["mkdir_p"; "/new/foo/bar"]; ["is_dir"; "/new/foo"]]; - InitBasicFS, TestOutputTrue + InitBasicFS, Always, TestOutputTrue [["mkdir_p"; "/new/foo/bar"]; - ["is_dir"; "/new"]]], + ["is_dir"; "/new"]]; + (* Regression tests for RHBZ#503133: *) + InitBasicFS, Always, TestRun + [["mkdir"; "/new"]; + ["mkdir_p"; "/new"]]; + InitBasicFS, Always, TestLastFail + [["touch"; "/new"]; + ["mkdir_p"; "/new"]]], "create a directory and parents", "\ Create a directory named C, creating any parent directories @@ -884,10 +1074,10 @@ names, you will need to locate and parse the password file yourself (Augeas support makes this relatively easy)."); ("exists", (RBool "existsflag", [String "path"]), 36, [], - [InitBasicFS, TestOutputTrue ( + [InitBasicFS, Always, TestOutputTrue ( [["touch"; "/new"]; ["exists"; "/new"]]); - InitBasicFS, TestOutputTrue ( + InitBasicFS, Always, TestOutputTrue ( [["mkdir"; "/new"]; ["exists"; "/new"]])], "test if file or directory exists", @@ -898,10 +1088,10 @@ This returns C if and only if there is a file, directory See also C, C, C."); ("is_file", (RBool "fileflag", [String "path"]), 37, [], - [InitBasicFS, TestOutputTrue ( + [InitBasicFS, Always, TestOutputTrue ( [["touch"; "/new"]; ["is_file"; "/new"]]); - InitBasicFS, TestOutputFalse ( + InitBasicFS, Always, TestOutputFalse ( [["mkdir"; "/new"]; ["is_file"; "/new"]])], "test if file exists", @@ -913,10 +1103,10 @@ other objects like directories. See also C."); ("is_dir", (RBool "dirflag", [String "path"]), 38, [], - [InitBasicFS, TestOutputFalse ( + [InitBasicFS, Always, TestOutputFalse ( [["touch"; "/new"]; ["is_dir"; "/new"]]); - InitBasicFS, TestOutputTrue ( + InitBasicFS, Always, TestOutputTrue ( [["mkdir"; "/new"]; ["is_dir"; "/new"]])], "test if file exists", @@ -928,7 +1118,7 @@ other objects like files. See also C."); ("pvcreate", (RErr, [String "device"]), 39, [], - [InitEmpty, TestOutputList ( + [InitEmpty, Always, TestOutputListOfDevices ( [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; ["pvcreate"; "/dev/sda1"]; ["pvcreate"; "/dev/sda2"]; @@ -941,7 +1131,7 @@ where C should usually be a partition name such as C."); ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [], - [InitEmpty, TestOutputList ( + [InitEmpty, Always, TestOutputList ( [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; ["pvcreate"; "/dev/sda1"]; ["pvcreate"; "/dev/sda2"]; @@ -955,7 +1145,7 @@ This creates an LVM volume group called C from the non-empty list of physical volumes C."); ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [], - [InitEmpty, TestOutputList ( + [InitEmpty, Always, TestOutputList ( [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; ["pvcreate"; "/dev/sda1"]; ["pvcreate"; "/dev/sda2"]; @@ -976,7 +1166,7 @@ This creates an LVM volume group called C on the volume group C, with C megabytes."); ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [], - [InitEmpty, TestOutput ( + [InitEmpty, Always, TestOutput ( [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; ["mkfs"; "ext2"; "/dev/sda1"]; ["mount"; "/dev/sda1"; "/"]; @@ -985,7 +1175,7 @@ on the volume group C, with C megabytes."); "make a filesystem", "\ This creates a filesystem on C (usually a partition -of LVM logical volume). The filesystem type is C, for +or LVM logical volume). The filesystem type is C, for example C."); ("sfdisk", (RErr, [String "device"; @@ -1012,25 +1202,27 @@ information refer to the L manpage. To create a single partition occupying the whole disk, you would pass C as a single element list, when the single element being -the string C<,> (comma)."); +the string C<,> (comma). + +See also: C, C"); ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning], - [InitBasicFS, TestOutput ( + [InitBasicFS, Always, TestOutput ( [["write_file"; "/new"; "new file contents"; "0"]; ["cat"; "/new"]], "new file contents"); - InitBasicFS, TestOutput ( + InitBasicFS, Always, TestOutput ( [["write_file"; "/new"; "\nnew file contents\n"; "0"]; ["cat"; "/new"]], "\nnew file contents\n"); - InitBasicFS, TestOutput ( + InitBasicFS, Always, TestOutput ( [["write_file"; "/new"; "\n\n"; "0"]; ["cat"; "/new"]], "\n\n"); - InitBasicFS, TestOutput ( + InitBasicFS, Always, TestOutput ( [["write_file"; "/new"; ""; "0"]; ["cat"; "/new"]], ""); - InitBasicFS, TestOutput ( + InitBasicFS, Always, TestOutput ( [["write_file"; "/new"; "\n\n\n"; "0"]; ["cat"; "/new"]], "\n\n\n"); - InitBasicFS, TestOutput ( + InitBasicFS, Always, TestOutput ( [["write_file"; "/new"; "\n"; "0"]; ["cat"; "/new"]], "\n")], "create a file", @@ -1041,15 +1233,20 @@ with length C. As a special case, if C is C<0> then the length is calculated using C (so in this case -the content cannot contain embedded ASCII NULs)."); +the content cannot contain embedded ASCII NULs). + +I Owing to a bug, writing content containing ASCII NUL +characters does I work, even if the length is specified. +We hope to resolve this bug in a future version. In the meantime +use C."); ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"], - [InitEmpty, TestOutputList ( + [InitEmpty, Always, TestOutputListOfDevices ( [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; ["mkfs"; "ext2"; "/dev/sda1"]; ["mount"; "/dev/sda1"; "/"]; ["mounts"]], ["/dev/sda1"]); - InitEmpty, TestOutputList ( + InitEmpty, Always, TestOutputList ( [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; ["mkfs"; "ext2"; "/dev/sda1"]; ["mount"; "/dev/sda1"; "/"]; @@ -1062,7 +1259,7 @@ specified either by its mountpoint (path) or the device which contains the filesystem."); ("mounts", (RStringList "devices", []), 46, [], - [InitBasicFS, TestOutputList ( + [InitBasicFS, Always, TestOutputListOfDevices ( [["mounts"]], ["/dev/sda1"])], "show mounted filesystems", "\ @@ -1072,8 +1269,22 @@ the list of devices (eg. C, C). Some internal mounts are not shown."); ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"], - [InitBasicFS, TestOutputList ( + [InitBasicFS, Always, TestOutputList ( [["umount_all"]; + ["mounts"]], []); + (* check that umount_all can unmount nested mounts correctly: *) + InitEmpty, Always, TestOutputList ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; + ["mkfs"; "ext2"; "/dev/sda1"]; + ["mkfs"; "ext2"; "/dev/sda2"]; + ["mkfs"; "ext2"; "/dev/sda3"]; + ["mount"; "/dev/sda1"; "/"]; + ["mkdir"; "/mp1"]; + ["mount"; "/dev/sda2"; "/mp1"]; + ["mkdir"; "/mp1/mp2"]; + ["mount"; "/dev/sda3"; "/mp1/mp2"]; + ["mkdir"; "/mp1/mp2/mp3"]; + ["umount_all"]; ["mounts"]], [])], "unmount all filesystems", "\ @@ -1089,13 +1300,13 @@ This command removes all LVM logical volumes, volume groups and physical volumes."); ("file", (RString "description", [String "path"]), 49, [], - [InitBasicFS, TestOutput ( + [InitBasicFS, Always, TestOutput ( [["touch"; "/new"]; ["file"; "/new"]], "empty"); - InitBasicFS, TestOutput ( + InitBasicFS, Always, TestOutput ( [["write_file"; "/new"; "some content\n"; "0"]; ["file"; "/new"]], "ASCII text"); - InitBasicFS, TestLastFail ( + InitBasicFS, Always, TestLastFail ( [["file"; "/nofile"]])], "determine file type", "\ @@ -1107,8 +1318,55 @@ The exact command which runs is C. Note in particular that the filename is not prepended to the output (the C<-b> option)."); - ("command", (RString "output", [StringList "arguments"]), 50, [], - [], (* XXX how to test? *) + ("command", (RString "output", [StringList "arguments"]), 50, [ProtocolLimitWarning], + [InitBasicFS, Always, TestOutput ( + [["upload"; "test-command"; "/test-command"]; + ["chmod"; "493"; "/test-command"]; + ["command"; "/test-command 1"]], "Result1"); + InitBasicFS, Always, TestOutput ( + [["upload"; "test-command"; "/test-command"]; + ["chmod"; "493"; "/test-command"]; + ["command"; "/test-command 2"]], "Result2\n"); + InitBasicFS, Always, TestOutput ( + [["upload"; "test-command"; "/test-command"]; + ["chmod"; "493"; "/test-command"]; + ["command"; "/test-command 3"]], "\nResult3"); + InitBasicFS, Always, TestOutput ( + [["upload"; "test-command"; "/test-command"]; + ["chmod"; "493"; "/test-command"]; + ["command"; "/test-command 4"]], "\nResult4\n"); + InitBasicFS, Always, TestOutput ( + [["upload"; "test-command"; "/test-command"]; + ["chmod"; "493"; "/test-command"]; + ["command"; "/test-command 5"]], "\nResult5\n\n"); + InitBasicFS, Always, TestOutput ( + [["upload"; "test-command"; "/test-command"]; + ["chmod"; "493"; "/test-command"]; + ["command"; "/test-command 6"]], "\n\nResult6\n\n"); + InitBasicFS, Always, TestOutput ( + [["upload"; "test-command"; "/test-command"]; + ["chmod"; "493"; "/test-command"]; + ["command"; "/test-command 7"]], ""); + InitBasicFS, Always, TestOutput ( + [["upload"; "test-command"; "/test-command"]; + ["chmod"; "493"; "/test-command"]; + ["command"; "/test-command 8"]], "\n"); + InitBasicFS, Always, TestOutput ( + [["upload"; "test-command"; "/test-command"]; + ["chmod"; "493"; "/test-command"]; + ["command"; "/test-command 9"]], "\n\n"); + InitBasicFS, Always, TestOutput ( + [["upload"; "test-command"; "/test-command"]; + ["chmod"; "493"; "/test-command"]; + ["command"; "/test-command 10"]], "Result10-1\nResult10-2\n"); + InitBasicFS, Always, TestOutput ( + [["upload"; "test-command"; "/test-command"]; + ["chmod"; "493"; "/test-command"]; + ["command"; "/test-command 11"]], "Result11-1\nResult11-2"); + InitBasicFS, Always, TestLastFail ( + [["upload"; "test-command"; "/test-command"]; + ["chmod"; "493"; "/test-command"]; + ["command"; "/test-command"]])], "run a command from the guest filesystem", "\ This call runs a command from the guest filesystem. The @@ -1121,6 +1379,13 @@ The first element is the name of the program to run. Subsequent elements are parameters. The list must be non-empty (ie. must contain a program name). +The return value is anything printed to I by +the command. + +If the command returns a non-zero exit status, then +this function returns an error message. The error message +string is the content of I from the command. + The C<$PATH> environment variable will contain at least C and C. If you require a program from another location, you should provide the full path in the @@ -1132,15 +1397,58 @@ correct places. It is the caller's responsibility to ensure all filesystems that are needed are mounted at the right locations."); - ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [], - [], (* XXX how to test? *) + ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [ProtocolLimitWarning], + [InitBasicFS, Always, TestOutputList ( + [["upload"; "test-command"; "/test-command"]; + ["chmod"; "493"; "/test-command"]; + ["command_lines"; "/test-command 1"]], ["Result1"]); + InitBasicFS, Always, TestOutputList ( + [["upload"; "test-command"; "/test-command"]; + ["chmod"; "493"; "/test-command"]; + ["command_lines"; "/test-command 2"]], ["Result2"]); + InitBasicFS, Always, TestOutputList ( + [["upload"; "test-command"; "/test-command"]; + ["chmod"; "493"; "/test-command"]; + ["command_lines"; "/test-command 3"]], ["";"Result3"]); + InitBasicFS, Always, TestOutputList ( + [["upload"; "test-command"; "/test-command"]; + ["chmod"; "493"; "/test-command"]; + ["command_lines"; "/test-command 4"]], ["";"Result4"]); + InitBasicFS, Always, TestOutputList ( + [["upload"; "test-command"; "/test-command"]; + ["chmod"; "493"; "/test-command"]; + ["command_lines"; "/test-command 5"]], ["";"Result5";""]); + InitBasicFS, Always, TestOutputList ( + [["upload"; "test-command"; "/test-command"]; + ["chmod"; "493"; "/test-command"]; + ["command_lines"; "/test-command 6"]], ["";"";"Result6";""]); + InitBasicFS, Always, TestOutputList ( + [["upload"; "test-command"; "/test-command"]; + ["chmod"; "493"; "/test-command"]; + ["command_lines"; "/test-command 7"]], []); + InitBasicFS, Always, TestOutputList ( + [["upload"; "test-command"; "/test-command"]; + ["chmod"; "493"; "/test-command"]; + ["command_lines"; "/test-command 8"]], [""]); + InitBasicFS, Always, TestOutputList ( + [["upload"; "test-command"; "/test-command"]; + ["chmod"; "493"; "/test-command"]; + ["command_lines"; "/test-command 9"]], ["";""]); + InitBasicFS, Always, TestOutputList ( + [["upload"; "test-command"; "/test-command"]; + ["chmod"; "493"; "/test-command"]; + ["command_lines"; "/test-command 10"]], ["Result10-1";"Result10-2"]); + InitBasicFS, Always, TestOutputList ( + [["upload"; "test-command"; "/test-command"]; + ["chmod"; "493"; "/test-command"]; + ["command_lines"; "/test-command 11"]], ["Result11-1";"Result11-2"])], "run a command, returning lines", "\ This is the same as C, but splits the result into a list of lines."); ("stat", (RStat "statbuf", [String "path"]), 52, [], - [InitBasicFS, TestOutputStruct ( + [InitBasicFS, Always, TestOutputStruct ( [["touch"; "/new"]; ["stat"; "/new"]], [CompareWithInt ("size", 0)])], "get file information", @@ -1150,7 +1458,7 @@ Returns file information for the given C. This is the same as the C system call."); ("lstat", (RStat "statbuf", [String "path"]), 53, [], - [InitBasicFS, TestOutputStruct ( + [InitBasicFS, Always, TestOutputStruct ( [["touch"; "/new"]; ["lstat"; "/new"]], [CompareWithInt ("size", 0)])], "get file information for a symbolic link", @@ -1164,7 +1472,7 @@ refers to. This is the same as the C system call."); ("statvfs", (RStatVFS "statbuf", [String "path"]), 54, [], - [InitBasicFS, TestOutputStruct ( + [InitBasicFS, Always, TestOutputStruct ( [["statvfs"; "/"]], [CompareWithInt ("bfree", 487702); CompareWithInt ("blocks", 490020); CompareWithInt ("bsize", 1024)])], @@ -1189,7 +1497,7 @@ clearly defined, and depends on both the version of C that libguestfs was built against, and the filesystem itself."); ("blockdev_setro", (RErr, [String "device"]), 56, [], - [InitEmpty, TestOutputTrue ( + [InitEmpty, Always, TestOutputTrue ( [["blockdev_setro"; "/dev/sda"]; ["blockdev_getro"; "/dev/sda"]])], "set block device to read-only", @@ -1199,7 +1507,7 @@ Sets the block device named C to read-only. This uses the L command."); ("blockdev_setrw", (RErr, [String "device"]), 57, [], - [InitEmpty, TestOutputFalse ( + [InitEmpty, Always, TestOutputFalse ( [["blockdev_setrw"; "/dev/sda"]; ["blockdev_getro"; "/dev/sda"]])], "set block device to read-write", @@ -1209,7 +1517,7 @@ Sets the block device named C to read-write. This uses the L command."); ("blockdev_getro", (RBool "ro", [String "device"]), 58, [], - [InitEmpty, TestOutputTrue ( + [InitEmpty, Always, TestOutputTrue ( [["blockdev_setro"; "/dev/sda"]; ["blockdev_getro"; "/dev/sda"]])], "is block device set to read-only", @@ -1220,7 +1528,7 @@ Returns a boolean indicating if the block device is read-only This uses the L command."); ("blockdev_getss", (RInt "sectorsize", [String "device"]), 59, [], - [InitEmpty, TestOutputInt ( + [InitEmpty, Always, TestOutputInt ( [["blockdev_getss"; "/dev/sda"]], 512)], "get sectorsize of block device", "\ @@ -1233,7 +1541,7 @@ for that). This uses the L command."); ("blockdev_getbsz", (RInt "blocksize", [String "device"]), 60, [], - [InitEmpty, TestOutputInt ( + [InitEmpty, Always, TestOutputInt ( [["blockdev_getbsz"; "/dev/sda"]], 4096)], "get blocksize of block device", "\ @@ -1256,7 +1564,7 @@ I). This uses the L command."); ("blockdev_getsz", (RInt64 "sizeinsectors", [String "device"]), 62, [], - [InitEmpty, TestOutputInt ( + [InitEmpty, Always, TestOutputInt ( [["blockdev_getsz"; "/dev/sda"]], 1024000)], "get total size of device in 512-byte sectors", "\ @@ -1270,7 +1578,7 @@ useful I. This uses the L command."); ("blockdev_getsize64", (RInt64 "sizeinbytes", [String "device"]), 63, [], - [InitEmpty, TestOutputInt ( + [InitEmpty, Always, TestOutputInt ( [["blockdev_getsize64"; "/dev/sda"]], 524288000)], "get total size of device in bytes", "\ @@ -1281,7 +1589,7 @@ See also C. This uses the L command."); ("blockdev_flushbufs", (RErr, [String "device"]), 64, [], - [InitEmpty, TestRun + [InitEmpty, Always, TestRun [["blockdev_flushbufs"; "/dev/sda"]]], "flush device buffers", "\ @@ -1291,7 +1599,7 @@ with C. This uses the L command."); ("blockdev_rereadpt", (RErr, [String "device"]), 65, [], - [InitEmpty, TestRun + [InitEmpty, Always, TestRun [["blockdev_rereadpt"; "/dev/sda"]]], "reread partition table", "\ @@ -1300,9 +1608,9 @@ Reread the partition table on C. This uses the L command."); ("upload", (RErr, [FileIn "filename"; String "remotefilename"]), 66, [], - [InitBasicFS, TestOutput ( + [InitBasicFS, Always, TestOutput ( (* Pick a file from cwd which isn't likely to change. *) - [["upload"; "COPYING.LIB"; "/COPYING.LIB"]; + [["upload"; "../COPYING.LIB"; "/COPYING.LIB"]; ["checksum"; "md5"; "/COPYING.LIB"]], "e3eda01d9815f8d24aae2dbd89b68b06")], "upload a file from the local machine", "\ @@ -1314,9 +1622,9 @@ C can also be a named pipe. See also C."); ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [], - [InitBasicFS, TestOutput ( + [InitBasicFS, Always, TestOutput ( (* Pick a file from cwd which isn't likely to change. *) - [["upload"; "COPYING.LIB"; "/COPYING.LIB"]; + [["upload"; "../COPYING.LIB"; "/COPYING.LIB"]; ["download"; "/COPYING.LIB"; "testdownload.tmp"]; ["upload"; "testdownload.tmp"; "/upload"]; ["checksum"; "md5"; "/upload"]], "e3eda01d9815f8d24aae2dbd89b68b06")], @@ -1330,29 +1638,32 @@ C can also be a named pipe. See also C, C."); ("checksum", (RString "checksum", [String "csumtype"; String "path"]), 68, [], - [InitBasicFS, TestOutput ( + [InitBasicFS, Always, TestOutput ( [["write_file"; "/new"; "test\n"; "0"]; ["checksum"; "crc"; "/new"]], "935282863"); - InitBasicFS, TestLastFail ( + InitBasicFS, Always, TestLastFail ( [["checksum"; "crc"; "/new"]]); - InitBasicFS, TestOutput ( + InitBasicFS, Always, TestOutput ( [["write_file"; "/new"; "test\n"; "0"]; ["checksum"; "md5"; "/new"]], "d8e8fca2dc0f896fd7cb4cb0031ba249"); - InitBasicFS, TestOutput ( + InitBasicFS, Always, TestOutput ( [["write_file"; "/new"; "test\n"; "0"]; ["checksum"; "sha1"; "/new"]], "4e1243bd22c66e76c2ba9eddc1f91394e57f9f83"); - InitBasicFS, TestOutput ( + InitBasicFS, Always, TestOutput ( [["write_file"; "/new"; "test\n"; "0"]; ["checksum"; "sha224"; "/new"]], "52f1bf093f4b7588726035c176c0cdb4376cfea53819f1395ac9e6ec"); - InitBasicFS, TestOutput ( + InitBasicFS, Always, TestOutput ( [["write_file"; "/new"; "test\n"; "0"]; ["checksum"; "sha256"; "/new"]], "f2ca1bb6c7e907d06dafe4687e579fce76b37e4e93b7605022da52e6ccc26fd2"); - InitBasicFS, TestOutput ( + InitBasicFS, Always, TestOutput ( [["write_file"; "/new"; "test\n"; "0"]; ["checksum"; "sha384"; "/new"]], "109bb6b5b6d5547c1ce03c7a8bd7d8f80c1cb0957f50c4f7fda04692079917e4f9cad52b878f3d8234e1a170b154b72d"); - InitBasicFS, TestOutput ( + InitBasicFS, Always, TestOutput ( [["write_file"; "/new"; "test\n"; "0"]; - ["checksum"; "sha512"; "/new"]], "0e3e75234abc68f4378a86b3f4b32a198ba301845b0cd6e50106e874345700cc6663a86c1ea125dc5e92be17c98f9a0f85ca9d5f595db2012f7cc3571945c123")], + ["checksum"; "sha512"; "/new"]], "0e3e75234abc68f4378a86b3f4b32a198ba301845b0cd6e50106e874345700cc6663a86c1ea125dc5e92be17c98f9a0f85ca9d5f595db2012f7cc3571945c123"); + InitBasicFS, Always, TestOutput ( + [["mount"; "/dev/sdd"; "/"]; + ["checksum"; "md5"; "/known-3"]], "46d6ca27ee07cdc6fa99c2e138cc522c")], "compute MD5, SHAx or CRC checksum of file", "\ This call computes the MD5, SHAx or CRC checksum of the @@ -1397,8 +1708,8 @@ Compute the SHA512 hash (using the C program). The checksum is returned as a printable string."); ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [], - [InitBasicFS, TestOutput ( - [["tar_in"; "images/helloworld.tar"; "/"]; + [InitBasicFS, Always, TestOutput ( + [["tar_in"; "../images/helloworld.tar"; "/"]; ["cat"; "/hello"]], "hello\n")], "unpack tarfile to directory", "\ @@ -1417,8 +1728,8 @@ it to local file C. To download a compressed tarball, use C."); ("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [], - [InitBasicFS, TestOutput ( - [["tgz_in"; "images/helloworld.tar.gz"; "/"]; + [InitBasicFS, Always, TestOutput ( + [["tgz_in"; "../images/helloworld.tar.gz"; "/"]; ["cat"; "/hello"]], "hello\n")], "unpack compressed tarball to directory", "\ @@ -1437,11 +1748,11 @@ it to local file C. To download an uncompressed tarball, use C."); ("mount_ro", (RErr, [String "device"; String "mountpoint"]), 73, [], - [InitBasicFS, TestLastFail ( + [InitBasicFS, Always, TestLastFail ( [["umount"; "/"]; ["mount_ro"; "/dev/sda1"; "/"]; ["touch"; "/new"]]); - InitBasicFS, TestOutput ( + InitBasicFS, Always, TestOutput ( [["write_file"; "/new"; "data"; "0"]; ["umount"; "/"]; ["mount_ro"; "/dev/sda1"; "/"]; @@ -1480,23 +1791,26 @@ to look at the file C in the libguestfs source to find out what you can do."); ("lvremove", (RErr, [String "device"]), 77, [], - [InitEmpty, TestOutputList ( - [["pvcreate"; "/dev/sda"]; - ["vgcreate"; "VG"; "/dev/sda"]; + [InitEmpty, Always, TestOutputList ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; + ["pvcreate"; "/dev/sda1"]; + ["vgcreate"; "VG"; "/dev/sda1"]; ["lvcreate"; "LV1"; "VG"; "50"]; ["lvcreate"; "LV2"; "VG"; "50"]; ["lvremove"; "/dev/VG/LV1"]; ["lvs"]], ["/dev/VG/LV2"]); - InitEmpty, TestOutputList ( - [["pvcreate"; "/dev/sda"]; - ["vgcreate"; "VG"; "/dev/sda"]; + InitEmpty, Always, TestOutputList ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; + ["pvcreate"; "/dev/sda1"]; + ["vgcreate"; "VG"; "/dev/sda1"]; ["lvcreate"; "LV1"; "VG"; "50"]; ["lvcreate"; "LV2"; "VG"; "50"]; ["lvremove"; "/dev/VG"]; ["lvs"]], []); - InitEmpty, TestOutputList ( - [["pvcreate"; "/dev/sda"]; - ["vgcreate"; "VG"; "/dev/sda"]; + InitEmpty, Always, TestOutputList ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; + ["pvcreate"; "/dev/sda1"]; + ["vgcreate"; "VG"; "/dev/sda1"]; ["lvcreate"; "LV1"; "VG"; "50"]; ["lvcreate"; "LV2"; "VG"; "50"]; ["lvremove"; "/dev/VG"]; @@ -1510,16 +1824,18 @@ You can also remove all LVs in a volume group by specifying the VG name, C."); ("vgremove", (RErr, [String "vgname"]), 78, [], - [InitEmpty, TestOutputList ( - [["pvcreate"; "/dev/sda"]; - ["vgcreate"; "VG"; "/dev/sda"]; + [InitEmpty, Always, TestOutputList ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; + ["pvcreate"; "/dev/sda1"]; + ["vgcreate"; "VG"; "/dev/sda1"]; ["lvcreate"; "LV1"; "VG"; "50"]; ["lvcreate"; "LV2"; "VG"; "50"]; ["vgremove"; "VG"]; ["lvs"]], []); - InitEmpty, TestOutputList ( - [["pvcreate"; "/dev/sda"]; - ["vgcreate"; "VG"; "/dev/sda"]; + InitEmpty, Always, TestOutputList ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; + ["pvcreate"; "/dev/sda1"]; + ["vgcreate"; "VG"; "/dev/sda1"]; ["lvcreate"; "LV1"; "VG"; "50"]; ["lvcreate"; "LV2"; "VG"; "50"]; ["vgremove"; "VG"]; @@ -1532,29 +1848,32 @@ This also forcibly removes all logical volumes in the volume group (if any)."); ("pvremove", (RErr, [String "device"]), 79, [], - [InitEmpty, TestOutputList ( - [["pvcreate"; "/dev/sda"]; - ["vgcreate"; "VG"; "/dev/sda"]; + [InitEmpty, Always, TestOutputListOfDevices ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; + ["pvcreate"; "/dev/sda1"]; + ["vgcreate"; "VG"; "/dev/sda1"]; ["lvcreate"; "LV1"; "VG"; "50"]; ["lvcreate"; "LV2"; "VG"; "50"]; ["vgremove"; "VG"]; - ["pvremove"; "/dev/sda"]; + ["pvremove"; "/dev/sda1"]; ["lvs"]], []); - InitEmpty, TestOutputList ( - [["pvcreate"; "/dev/sda"]; - ["vgcreate"; "VG"; "/dev/sda"]; + InitEmpty, Always, TestOutputListOfDevices ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; + ["pvcreate"; "/dev/sda1"]; + ["vgcreate"; "VG"; "/dev/sda1"]; ["lvcreate"; "LV1"; "VG"; "50"]; ["lvcreate"; "LV2"; "VG"; "50"]; ["vgremove"; "VG"]; - ["pvremove"; "/dev/sda"]; + ["pvremove"; "/dev/sda1"]; ["vgs"]], []); - InitEmpty, TestOutputList ( - [["pvcreate"; "/dev/sda"]; - ["vgcreate"; "VG"; "/dev/sda"]; + InitEmpty, Always, TestOutputListOfDevices ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; + ["pvcreate"; "/dev/sda1"]; + ["vgcreate"; "VG"; "/dev/sda1"]; ["lvcreate"; "LV1"; "VG"; "50"]; ["lvcreate"; "LV2"; "VG"; "50"]; ["vgremove"; "VG"]; - ["pvremove"; "/dev/sda"]; + ["pvremove"; "/dev/sda1"]; ["pvs"]], [])], "remove an LVM physical volume", "\ @@ -1566,7 +1885,7 @@ wipe physical volumes that contain any volume groups, so you have to remove those first."); ("set_e2label", (RErr, [String "device"; String "label"]), 80, [], - [InitBasicFS, TestOutput ( + [InitBasicFS, Always, TestOutput ( [["set_e2label"; "/dev/sda1"; "testlabel"]; ["get_e2label"; "/dev/sda1"]], "testlabel")], "set the ext2/3/4 filesystem label", @@ -1586,16 +1905,16 @@ This returns the ext2/3/4 filesystem label of the filesystem on C."); ("set_e2uuid", (RErr, [String "device"; String "uuid"]), 82, [], - [InitBasicFS, TestOutput ( + [InitBasicFS, Always, TestOutput ( [["set_e2uuid"; "/dev/sda1"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"]; ["get_e2uuid"; "/dev/sda1"]], "a3a61220-882b-4f61-89f4-cf24dcc7297d"); - InitBasicFS, TestOutput ( + InitBasicFS, Always, TestOutput ( [["set_e2uuid"; "/dev/sda1"; "clear"]; ["get_e2uuid"; "/dev/sda1"]], ""); (* We can't predict what UUIDs will be, so just check the commands run. *) - InitBasicFS, TestRun ( + InitBasicFS, Always, TestRun ( [["set_e2uuid"; "/dev/sda1"; "random"]]); - InitBasicFS, TestRun ( + InitBasicFS, Always, TestRun ( [["set_e2uuid"; "/dev/sda1"; "time"]])], "set the ext2/3/4 filesystem UUID", "\ @@ -1614,6 +1933,420 @@ to return the existing UUID of a filesystem."); This returns the ext2/3/4 filesystem UUID of the filesystem on C."); + ("fsck", (RInt "status", [String "fstype"; String "device"]), 84, [], + [InitBasicFS, Always, TestOutputInt ( + [["umount"; "/dev/sda1"]; + ["fsck"; "ext2"; "/dev/sda1"]], 0); + InitBasicFS, Always, TestOutputInt ( + [["umount"; "/dev/sda1"]; + ["zero"; "/dev/sda1"]; + ["fsck"; "ext2"; "/dev/sda1"]], 8)], + "run the filesystem checker", + "\ +This runs the filesystem checker (fsck) on C which +should have filesystem type C. + +The returned integer is the status. See L for the +list of status codes from C. + +Notes: + +=over 4 + +=item * + +Multiple status codes can be summed together. + +=item * + +A non-zero return code can mean \"success\", for example if +errors have been corrected on the filesystem. + +=item * + +Checking or repairing NTFS volumes is not supported +(by linux-ntfs). + +=back + +This command is entirely equivalent to running C."); + + ("zero", (RErr, [String "device"]), 85, [], + [InitBasicFS, Always, TestOutput ( + [["umount"; "/dev/sda1"]; + ["zero"; "/dev/sda1"]; + ["file"; "/dev/sda1"]], "data")], + "write zeroes to the device", + "\ +This command writes zeroes over the first few blocks of C. + +How many blocks are zeroed isn't specified (but it's I enough +to securely wipe the device). It should be sufficient to remove +any partition tables, filesystem superblocks and so on."); + + ("grub_install", (RErr, [String "root"; String "device"]), 86, [], + [InitBasicFS, Always, TestOutputTrue ( + [["grub_install"; "/"; "/dev/sda1"]; + ["is_dir"; "/boot"]])], + "install GRUB", + "\ +This command installs GRUB (the Grand Unified Bootloader) on +C, with the root directory being C."); + + ("cp", (RErr, [String "src"; String "dest"]), 87, [], + [InitBasicFS, Always, TestOutput ( + [["write_file"; "/old"; "file content"; "0"]; + ["cp"; "/old"; "/new"]; + ["cat"; "/new"]], "file content"); + InitBasicFS, Always, TestOutputTrue ( + [["write_file"; "/old"; "file content"; "0"]; + ["cp"; "/old"; "/new"]; + ["is_file"; "/old"]]); + InitBasicFS, Always, TestOutput ( + [["write_file"; "/old"; "file content"; "0"]; + ["mkdir"; "/dir"]; + ["cp"; "/old"; "/dir/new"]; + ["cat"; "/dir/new"]], "file content")], + "copy a file", + "\ +This copies a file from C to C where C is +either a destination filename or destination directory."); + + ("cp_a", (RErr, [String "src"; String "dest"]), 88, [], + [InitBasicFS, Always, TestOutput ( + [["mkdir"; "/olddir"]; + ["mkdir"; "/newdir"]; + ["write_file"; "/olddir/file"; "file content"; "0"]; + ["cp_a"; "/olddir"; "/newdir"]; + ["cat"; "/newdir/olddir/file"]], "file content")], + "copy a file or directory recursively", + "\ +This copies a file or directory from C to C +recursively using the C command."); + + ("mv", (RErr, [String "src"; String "dest"]), 89, [], + [InitBasicFS, Always, TestOutput ( + [["write_file"; "/old"; "file content"; "0"]; + ["mv"; "/old"; "/new"]; + ["cat"; "/new"]], "file content"); + InitBasicFS, Always, TestOutputFalse ( + [["write_file"; "/old"; "file content"; "0"]; + ["mv"; "/old"; "/new"]; + ["is_file"; "/old"]])], + "move a file", + "\ +This moves a file from C to C where C is +either a destination filename or destination directory."); + + ("drop_caches", (RErr, [Int "whattodrop"]), 90, [], + [InitEmpty, Always, TestRun ( + [["drop_caches"; "3"]])], + "drop kernel page cache, dentries and inodes", + "\ +This instructs the guest kernel to drop its page cache, +and/or dentries and inode caches. The parameter C +tells the kernel what precisely to drop, see +L + +Setting C to 3 should drop everything. + +This automatically calls L before the operation, +so that the maximum guest memory is freed."); + + ("dmesg", (RString "kmsgs", []), 91, [], + [InitEmpty, Always, TestRun ( + [["dmesg"]])], + "return kernel messages", + "\ +This returns the kernel messages (C output) from +the guest kernel. This is sometimes useful for extended +debugging of problems. + +Another way to get the same information is to enable +verbose messages with C or by setting +the environment variable C before +running the program."); + + ("ping_daemon", (RErr, []), 92, [], + [InitEmpty, Always, TestRun ( + [["ping_daemon"]])], + "ping the guest daemon", + "\ +This is a test probe into the guestfs daemon running inside +the qemu subprocess. Calling this function checks that the +daemon responds to the ping message, without affecting the daemon +or attached block device(s) in any other way."); + + ("equal", (RBool "equality", [String "file1"; String "file2"]), 93, [], + [InitBasicFS, Always, TestOutputTrue ( + [["write_file"; "/file1"; "contents of a file"; "0"]; + ["cp"; "/file1"; "/file2"]; + ["equal"; "/file1"; "/file2"]]); + InitBasicFS, Always, TestOutputFalse ( + [["write_file"; "/file1"; "contents of a file"; "0"]; + ["write_file"; "/file2"; "contents of another file"; "0"]; + ["equal"; "/file1"; "/file2"]]); + InitBasicFS, Always, TestLastFail ( + [["equal"; "/file1"; "/file2"]])], + "test if two files have equal contents", + "\ +This compares the two files C and C and returns +true if their content is exactly equal, or false otherwise. + +The external L program is used for the comparison."); + + ("strings", (RStringList "stringsout", [String "path"]), 94, [ProtocolLimitWarning], + [InitBasicFS, Always, TestOutputList ( + [["write_file"; "/new"; "hello\nworld\n"; "0"]; + ["strings"; "/new"]], ["hello"; "world"]); + InitBasicFS, Always, TestOutputList ( + [["touch"; "/new"]; + ["strings"; "/new"]], [])], + "print the printable strings in a file", + "\ +This runs the L command on a file and returns +the list of printable strings found."); + + ("strings_e", (RStringList "stringsout", [String "encoding"; String "path"]), 95, [ProtocolLimitWarning], + [InitBasicFS, Always, TestOutputList ( + [["write_file"; "/new"; "hello\nworld\n"; "0"]; + ["strings_e"; "b"; "/new"]], []); + InitBasicFS, Disabled, TestOutputList ( + [["write_file"; "/new"; "\000h\000e\000l\000l\000o\000\n\000w\000o\000r\000l\000d\000\n"; "24"]; + ["strings_e"; "b"; "/new"]], ["hello"; "world"])], + "print the printable strings in a file", + "\ +This is like the C command, but allows you to +specify the encoding. + +See the L manpage for the full list of encodings. + +Commonly useful encodings are C (lower case L) which will +show strings inside Windows/x86 files. + +The returned strings are transcoded to UTF-8."); + + ("hexdump", (RString "dump", [String "path"]), 96, [ProtocolLimitWarning], + [InitBasicFS, Always, TestOutput ( + [["write_file"; "/new"; "hello\nworld\n"; "12"]; + ["hexdump"; "/new"]], "00000000 68 65 6c 6c 6f 0a 77 6f 72 6c 64 0a |hello.world.|\n0000000c\n")], + "dump a file in hexadecimal", + "\ +This runs C on the given C. The result is +the human-readable, canonical hex dump of the file."); + + ("zerofree", (RErr, [String "device"]), 97, [], + [InitNone, Always, TestOutput ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; + ["mkfs"; "ext3"; "/dev/sda1"]; + ["mount"; "/dev/sda1"; "/"]; + ["write_file"; "/new"; "test file"; "0"]; + ["umount"; "/dev/sda1"]; + ["zerofree"; "/dev/sda1"]; + ["mount"; "/dev/sda1"; "/"]; + ["cat"; "/new"]], "test file")], + "zero unused inodes and disk blocks on ext2/3 filesystem", + "\ +This runs the I program on C. This program +claims to zero unused inodes and disk blocks on an ext2/3 +filesystem, thus making it possible to compress the filesystem +more effectively. + +You should B run this program if the filesystem is +mounted. + +It is possible that using this program can damage the filesystem +or data on the filesystem."); + + ("pvresize", (RErr, [String "device"]), 98, [], + [], + "resize an LVM physical volume", + "\ +This resizes (expands or shrinks) an existing LVM physical +volume to match the new size of the underlying device."); + + ("sfdisk_N", (RErr, [String "device"; Int "n"; + Int "cyls"; Int "heads"; Int "sectors"; + String "line"]), 99, [DangerWillRobinson], + [], + "modify a single partition on a block device", + "\ +This runs L option to modify just the single +partition C (note: C counts from 1). + +For other parameters, see C. You should usually +pass C<0> for the cyls/heads/sectors parameters."); + + ("sfdisk_l", (RString "partitions", [String "device"]), 100, [], + [], + "display the partition table", + "\ +This displays the partition table on C, in the +human-readable output of the L command. It is +not intended to be parsed."); + + ("sfdisk_kernel_geometry", (RString "partitions", [String "device"]), 101, [], + [], + "display the kernel geometry", + "\ +This displays the kernel's idea of the geometry of C. + +The result is in human-readable format, and not designed to +be parsed."); + + ("sfdisk_disk_geometry", (RString "partitions", [String "device"]), 102, [], + [], + "display the disk geometry from the partition table", + "\ +This displays the disk geometry of C read from the +partition table. Especially in the case where the underlying +block device has been resized, this can be different from the +kernel's idea of the geometry (see C). + +The result is in human-readable format, and not designed to +be parsed."); + + ("vg_activate_all", (RErr, [Bool "activate"]), 103, [], + [], + "activate or deactivate all volume groups", + "\ +This command activates or (if C is false) deactivates +all logical volumes in all volume groups. +If activated, then they are made known to the +kernel, ie. they appear as C devices. If deactivated, +then those devices disappear. + +This command is the same as running C"); + + ("vg_activate", (RErr, [Bool "activate"; StringList "volgroups"]), 104, [], + [], + "activate or deactivate some volume groups", + "\ +This command activates or (if C is false) deactivates +all logical volumes in the listed volume groups C. +If activated, then they are made known to the +kernel, ie. they appear as C devices. If deactivated, +then those devices disappear. + +This command is the same as running C + +Note that if C is an empty list then B volume groups +are activated or deactivated."); + + ("lvresize", (RErr, [String "device"; Int "mbytes"]), 105, [], + [InitNone, Always, TestOutput ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; + ["pvcreate"; "/dev/sda1"]; + ["vgcreate"; "VG"; "/dev/sda1"]; + ["lvcreate"; "LV"; "VG"; "10"]; + ["mkfs"; "ext2"; "/dev/VG/LV"]; + ["mount"; "/dev/VG/LV"; "/"]; + ["write_file"; "/new"; "test content"; "0"]; + ["umount"; "/"]; + ["lvresize"; "/dev/VG/LV"; "20"]; + ["e2fsck_f"; "/dev/VG/LV"]; + ["resize2fs"; "/dev/VG/LV"]; + ["mount"; "/dev/VG/LV"; "/"]; + ["cat"; "/new"]], "test content")], + "resize an LVM logical volume", + "\ +This resizes (expands or shrinks) an existing LVM logical +volume to C. When reducing, data in the reduced part +is lost."); + + ("resize2fs", (RErr, [String "device"]), 106, [], + [], (* lvresize tests this *) + "resize an ext2/ext3 filesystem", + "\ +This resizes an ext2 or ext3 filesystem to match the size of +the underlying device. + +I It is sometimes required that you run C +on the C before calling this command. For unknown reasons +C sometimes gives an error about this and sometimes not. +In any case, it is always safe to call C before +calling this function."); + + ("find", (RStringList "names", [String "directory"]), 107, [], + [InitBasicFS, Always, TestOutputList ( + [["find"; "/"]], ["lost+found"]); + InitBasicFS, Always, TestOutputList ( + [["touch"; "/a"]; + ["mkdir"; "/b"]; + ["touch"; "/b/c"]; + ["find"; "/"]], ["a"; "b"; "b/c"; "lost+found"]); + InitBasicFS, Always, TestOutputList ( + [["mkdir_p"; "/a/b/c"]; + ["touch"; "/a/b/c/d"]; + ["find"; "/a/b/"]], ["c"; "c/d"])], + "find all files and directories", + "\ +This command lists out all files and directories, recursively, +starting at C. It is essentially equivalent to +running the shell command C but some +post-processing happens on the output, described below. + +This returns a list of strings I. Thus +if the directory structure was: + + /tmp/a + /tmp/b + /tmp/c/d + +then the returned list from C C would be +4 elements: + + a + b + c + c/d + +If C is not a directory, then this command returns +an error. + +The returned list is sorted."); + + ("e2fsck_f", (RErr, [String "device"]), 108, [], + [], (* lvresize tests this *) + "check an ext2/ext3 filesystem", + "\ +This runs C, ie. runs the ext2/ext3 +filesystem checker on C, noninteractively (C<-p>), +even if the filesystem appears to be clean (C<-f>). + +This command is only needed because of C +(q.v.). Normally you should use C."); + + ("sleep", (RErr, [Int "secs"]), 109, [], + [InitNone, Always, TestRun ( + [["sleep"; "1"]])], + "sleep for some seconds", + "\ +Sleep for C seconds."); + + ("ntfs_3g_probe", (RInt "status", [Bool "rw"; String "device"]), 110, [], + [InitNone, Always, TestOutputInt ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; + ["mkfs"; "ntfs"; "/dev/sda1"]; + ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 0); + InitNone, Always, TestOutputInt ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; + ["mkfs"; "ext2"; "/dev/sda1"]; + ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 12)], + "probe NTFS volume", + "\ +This command runs the L command which probes +an NTFS C for mountability. (Not all NTFS volumes can +be mounted read-write, and some cannot be mounted at all). + +C is a boolean flag. Set it to true if you want to test +if the volume can be mounted read-write. Set it to false if +you want to test if the volume can be mounted read-only. + +The return value is an integer which C<0> if the operation +would succeed, or some non-zero value documented in the +L manual page."); + ] let all_functions = non_daemon_functions @ daemon_functions @@ -1721,6 +2454,14 @@ let statvfs_cols = [ "namemax", `Int; ] +(* Used for testing language bindings. *) +type callt = + | CallString of string + | CallOptString of string option + | CallStringList of string list + | CallInt of int + | CallBool of bool + (* Useful functions. * Note we don't want to use any external OCaml libraries which * makes this a bit harder than it should be. @@ -1804,6 +2545,13 @@ let rec string_split sep str = s' :: string_split sep s'' ) +let files_equal n1 n2 = + let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in + match Sys.command cmd with + | 0 -> true + | 1 -> false + | i -> failwithf "%s: failed with error code %d" cmd i + let rec find_map f = function | [] -> raise Not_found | x :: xs -> @@ -1831,6 +2579,7 @@ let name_of_argt = function let seq_of_test = function | TestRun s | TestOutput (s, _) | TestOutputList (s, _) + | TestOutputListOfDevices (s, _) | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s | TestOutputLength (s, _) | TestOutputStruct (s, _) | TestLastFail s -> s @@ -1855,8 +2604,10 @@ let check_functions () = fun (name, _, _, _, _, _, _) -> if String.length name >= 7 && String.sub name 0 7 = "guestfs" then failwithf "function name %s does not need 'guestfs' prefix" name; - if contains_uppercase name then - failwithf "function name %s should not contain uppercase chars" name; + if name = "" then + failwithf "function name is empty"; + if name.[0] < 'a' || name.[0] > 'z' then + failwithf "function name %s must start with lowercase a-z" name; if String.contains name '-' then failwithf "function name %s should not contain '-', use '_' instead." name @@ -1873,9 +2624,13 @@ let check_functions () = failwithf "%s param/ret %s should not contain '-' or '_'" name n; if n = "value" then - failwithf "%s has a param/ret called 'value', which causes conflicts in the OCaml bindings, use something like 'val' or a more descriptive name" n; + 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; + if n = "int" || n = "char" || n = "short" || n = "long" then + failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name; + if n = "i" then + failwithf "%s has a param/ret called 'i', which will cause some conflicts in the generated code" name; if n = "argv" || n = "args" then - failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" n + failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name in (match fst style with @@ -1948,7 +2703,7 @@ let check_functions () = | name, _, _, _, tests, _, _ -> let funcs = List.map ( - fun (_, test) -> + fun (_, _, test) -> match seq_of_test test with | [] -> failwithf "%s has a test containing an empty sequence" name @@ -1967,14 +2722,15 @@ let chan = ref stdout let pr fs = ksprintf (output_string !chan) fs (* Generate a header block in a number of standard styles. *) -type comment_style = CStyle | HashStyle | OCamlStyle +type comment_style = CStyle | HashStyle | OCamlStyle | HaskellStyle type license = GPLv2 | LGPLv2 let generate_header comment license = let c = match comment with | CStyle -> pr "/* "; " *" | HashStyle -> pr "# "; "#" - | OCamlStyle -> pr "(* "; " *" in + | OCamlStyle -> pr "(* "; " *" + | HaskellStyle -> pr "{- "; " " in pr "libguestfs generated file\n"; pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c; pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c; @@ -2016,6 +2772,7 @@ let generate_header comment license = | CStyle -> pr " */\n" | HashStyle -> () | OCamlStyle -> pr " *)\n" + | HaskellStyle -> pr "-}\n" ); pr "\n" @@ -2025,71 +2782,73 @@ let generate_header comment license = let rec generate_actions_pod () = List.iter ( fun (shortname, style, _, flags, _, _, longdesc) -> - let name = "guestfs_" ^ shortname in - pr "=head2 %s\n\n" name; - pr " "; - generate_prototype ~extern:false ~handle:"handle" name style; - pr "\n\n"; - pr "%s\n\n" longdesc; - (match fst style with - | RErr -> - pr "This function returns 0 on success or -1 on error.\n\n" - | RInt _ -> - pr "On error this function returns -1.\n\n" - | RInt64 _ -> - pr "On error this function returns -1.\n\n" - | RBool _ -> - pr "This function returns a C truth value on success or -1 on error.\n\n" - | RConstString _ -> - pr "This function returns a string, or NULL on error. + if not (List.mem NotInDocs flags) then ( + let name = "guestfs_" ^ shortname in + pr "=head2 %s\n\n" name; + pr " "; + generate_prototype ~extern:false ~handle:"handle" name style; + pr "\n\n"; + pr "%s\n\n" longdesc; + (match fst style with + | RErr -> + pr "This function returns 0 on success or -1 on error.\n\n" + | RInt _ -> + pr "On error this function returns -1.\n\n" + | RInt64 _ -> + pr "On error this function returns -1.\n\n" + | RBool _ -> + pr "This function returns a C truth value on success or -1 on error.\n\n" + | RConstString _ -> + pr "This function returns a string, or NULL on error. The string is owned by the guest handle and must I be freed.\n\n" - | RString _ -> - pr "This function returns a string, or NULL on error. + | RString _ -> + pr "This function returns a string, or NULL on error. I.\n\n" - | RStringList _ -> - pr "This function returns a NULL-terminated array of strings + | RStringList _ -> + pr "This function returns a NULL-terminated array of strings (like L), or NULL if there was an error. I.\n\n" - | RIntBool _ -> - pr "This function returns a C, + | RIntBool _ -> + pr "This function returns a C, or NULL if there was an error. I after use>.\n\n" - | RPVList _ -> - pr "This function returns a C + | RPVList _ -> + pr "This function returns a C (see Eguestfs-structs.hE), or NULL if there was an error. I after use>.\n\n" - | RVGList _ -> - pr "This function returns a C + | RVGList _ -> + pr "This function returns a C (see Eguestfs-structs.hE), or NULL if there was an error. I after use>.\n\n" - | RLVList _ -> - pr "This function returns a C + | RLVList _ -> + pr "This function returns a C (see Eguestfs-structs.hE), or NULL if there was an error. I after use>.\n\n" - | RStat _ -> - pr "This function returns a C + | RStat _ -> + pr "This function returns a C (see L and Eguestfs-structs.hE), or NULL if there was an error. I after use>.\n\n" - | RStatVFS _ -> - pr "This function returns a C + | RStatVFS _ -> + pr "This function returns a C (see L and Eguestfs-structs.hE), or NULL if there was an error. I after use>.\n\n" - | RHashtable _ -> - pr "This function returns a NULL-terminated array of + | RHashtable _ -> + pr "This function returns a NULL-terminated array of strings, or NULL if there was an error. The array of strings will always have length C<2n+1>, where C keys and values alternate, followed by the trailing NULL entry. I.\n\n" - ); - if List.mem ProtocolLimitWarning flags then - pr "%s\n\n" protocol_limit_warning; - if List.mem DangerWillRobinson flags then - pr "%s\n\n" danger_will_robinson; + ); + if List.mem ProtocolLimitWarning flags then + pr "%s\n\n" protocol_limit_warning; + if List.mem DangerWillRobinson flags then + pr "%s\n\n" danger_will_robinson + ) ) all_functions_sorted and generate_structs_pod () = @@ -2587,7 +3346,7 @@ check_state (guestfs_h *g, const char *caller) name; ); pr " if (serial == -1) {\n"; - pr " guestfs_set_ready (g);\n"; + pr " guestfs_end_busy (g);\n"; pr " return %s;\n" error_code; pr " }\n"; pr "\n"; @@ -2602,7 +3361,7 @@ check_state (guestfs_h *g, const char *caller) pr "\n"; pr " r = guestfs__send_file_sync (g, %s);\n" n; pr " if (r == -1) {\n"; - pr " guestfs_set_ready (g);\n"; + pr " guestfs_end_busy (g);\n"; pr " return %s;\n" error_code; pr " }\n"; pr " if (r == -2) /* daemon cancelled */\n"; @@ -2622,21 +3381,22 @@ check_state (guestfs_h *g, const char *caller) pr " guestfs_set_reply_callback (g, NULL, NULL);\n"; pr " if (ctx.cb_sequence != 1) {\n"; pr " error (g, \"%%s reply failed, see earlier error messages\", \"%s\");\n" name; - pr " guestfs_set_ready (g);\n"; + pr " guestfs_end_busy (g);\n"; pr " return %s;\n" error_code; pr " }\n"; pr "\n"; pr " if (check_reply_header (g, &ctx.hdr, GUESTFS_PROC_%s, serial) == -1) {\n" (String.uppercase shortname); - pr " guestfs_set_ready (g);\n"; + pr " guestfs_end_busy (g);\n"; pr " return %s;\n" error_code; pr " }\n"; pr "\n"; pr " if (ctx.hdr.status == GUESTFS_STATUS_ERROR) {\n"; pr " error (g, \"%%s\", ctx.err.error_message);\n"; - pr " guestfs_set_ready (g);\n"; + pr " free (ctx.err.error_message);\n"; + pr " guestfs_end_busy (g);\n"; pr " return %s;\n" error_code; pr " }\n"; pr "\n"; @@ -2646,14 +3406,14 @@ check_state (guestfs_h *g, const char *caller) function | FileOut n -> pr " if (guestfs__receive_file_sync (g, %s) == -1) {\n" n; - pr " guestfs_set_ready (g);\n"; + pr " guestfs_end_busy (g);\n"; pr " return %s;\n" error_code; pr " }\n"; pr "\n"; | _ -> () ) (snd style); - pr " guestfs_set_ready (g);\n"; + pr " guestfs_end_busy (g);\n"; (match fst style with | RErr -> pr " return 0;\n" @@ -2743,8 +3503,12 @@ and generate_daemon_actions () = pr " struct guestfs_%s_args args;\n" name; List.iter ( function + (* Note we allow the string to be writable, in order to + * allow device name translation. This is safe because + * we can modify the string (passed from RPC). + *) | String n - | OptString n -> pr " const char *%s;\n" n + | OptString n -> pr " char *%s;\n" n | StringList n -> pr " char **%s;\n" n | Bool n -> pr " int %s;\n" n | Int n -> pr " int %s;\n" n @@ -3111,7 +3875,6 @@ int main (int argc, char *argv[]) { char c = 0; int failed = 0; - const char *srcdir; const char *filename; int fd; int nr_tests, test_num = 0; @@ -3126,10 +3889,7 @@ int main (int argc, char *argv[]) guestfs_set_error_handler (g, print_error, NULL); - srcdir = getenv (\"srcdir\"); - if (!srcdir) srcdir = \".\"; - chdir (srcdir); - guestfs_set_path (g, \".\"); + guestfs_set_path (g, \"../appliance\"); filename = \"test1.img\"; fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666); @@ -3215,6 +3975,11 @@ int main (int argc, char *argv[]) exit (1); } + if (guestfs_add_drive_ro (g, \"../images/test.sqsh\") == -1) { + printf (\"guestfs_add_drive_ro ../images/test.sqsh FAILED\\n\"); + exit (1); + } + if (guestfs_launch (g) == -1) { printf (\"guestfs_launch FAILED\\n\"); exit (1); @@ -3254,32 +4019,93 @@ int main (int argc, char *argv[]) pr " exit (0);\n"; pr "}\n" -and generate_one_test name i (init, test) = +and generate_one_test name i (init, prereq, test) = let test_name = sprintf "test_%s_%d" name i in - pr "static int %s (void)\n" test_name; - pr "{\n"; + pr "\ +static int %s_skip (void) +{ + const char *str; + + str = getenv (\"SKIP_%s\"); + if (str && strcmp (str, \"1\") == 0) return 1; + str = getenv (\"SKIP_TEST_%s\"); + if (str && strcmp (str, \"1\") == 0) return 1; + return 0; +} + +" test_name (String.uppercase test_name) (String.uppercase name); + + (match prereq with + | Disabled | Always -> () + | If code | Unless code -> + pr "static int %s_prereq (void)\n" test_name; + pr "{\n"; + pr " %s\n" code; + pr "}\n"; + pr "\n"; + ); + + pr "\ +static int %s (void) +{ + if (%s_skip ()) { + printf (\"%%s skipped (reason: SKIP_TEST_* variable set)\\n\", \"%s\"); + return 0; + } + +" test_name test_name test_name; + + (match prereq with + | Disabled -> + pr " printf (\"%%s skipped (reason: test disabled in generator)\\n\", \"%s\");\n" test_name + | If _ -> + pr " if (! %s_prereq ()) {\n" test_name; + pr " printf (\"%%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name; + pr " return 0;\n"; + pr " }\n"; + pr "\n"; + generate_one_test_body name i test_name init test; + | Unless _ -> + pr " if (%s_prereq ()) {\n" test_name; + pr " printf (\"%%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name; + pr " return 0;\n"; + pr " }\n"; + pr "\n"; + generate_one_test_body name i test_name init test; + | Always -> + generate_one_test_body name i test_name init test + ); + + pr " return 0;\n"; + pr "}\n"; + pr "\n"; + test_name +and generate_one_test_body name i test_name init test = (match init with - | InitNone -> () + | InitNone | InitEmpty -> - pr " /* InitEmpty for %s (%d) */\n" name i; + pr " /* InitNone|InitEmpty for %s */\n" test_name; List.iter (generate_test_command_call test_name) - [["umount_all"]; + [["blockdev_setrw"; "/dev/sda"]; + ["umount_all"]; ["lvm_remove_all"]] | InitBasicFS -> - pr " /* InitBasicFS for %s (%d): create ext2 on /dev/sda1 */\n" name i; + pr " /* InitBasicFS for %s: create ext2 on /dev/sda1 */\n" test_name; List.iter (generate_test_command_call test_name) - [["umount_all"]; + [["blockdev_setrw"; "/dev/sda"]; + ["umount_all"]; ["lvm_remove_all"]; ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; ["mkfs"; "ext2"; "/dev/sda1"]; ["mount"; "/dev/sda1"; "/"]] | InitBasicFSonLVM -> - pr " /* InitBasicFSonLVM for %s (%d): create ext2 on /dev/VG/LV */\n" - name i; + pr " /* InitBasicFSonLVM for %s: create ext2 on /dev/VG/LV */\n" + test_name; List.iter (generate_test_command_call test_name) - [["umount_all"]; + [["blockdev_setrw"; "/dev/sda"]; + ["umount_all"]; ["lvm_remove_all"]; ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; ["pvcreate"; "/dev/sda1"]; @@ -3298,153 +4124,180 @@ and generate_one_test name i (init, test) = List.rev (List.tl seq), List.hd seq in - (match test with - | TestRun seq -> - pr " /* TestRun for %s (%d) */\n" name i; - List.iter (generate_test_command_call test_name) seq - | TestOutput (seq, expected) -> - pr " /* TestOutput for %s (%d) */\n" name i; - let seq, last = get_seq_last seq in - let test () = - pr " if (strcmp (r, \"%s\") != 0) {\n" (c_quote expected); - pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r);\n" test_name (c_quote expected); - pr " return -1;\n"; - pr " }\n" - in - List.iter (generate_test_command_call test_name) seq; - generate_test_command_call ~test test_name last - | TestOutputList (seq, expected) -> - pr " /* TestOutputList for %s (%d) */\n" name i; - let seq, last = get_seq_last seq in - let test () = - iteri ( - fun i str -> - pr " if (!r[%d]) {\n" i; - pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name; - pr " print_strings (r);\n"; - pr " return -1;\n"; - pr " }\n"; - pr " if (strcmp (r[%d], \"%s\") != 0) {\n" i (c_quote str); - pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r[%d]);\n" test_name (c_quote str) i; - pr " return -1;\n"; - pr " }\n" - ) expected; - pr " if (r[%d] != NULL) {\n" (List.length expected); - pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n" - test_name; - pr " print_strings (r);\n"; - pr " return -1;\n"; - pr " }\n" - in - List.iter (generate_test_command_call test_name) seq; - generate_test_command_call ~test test_name last - | TestOutputInt (seq, expected) -> - pr " /* TestOutputInt for %s (%d) */\n" name i; - let seq, last = get_seq_last seq in - let test () = - pr " if (r != %d) {\n" expected; - pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\"," - test_name expected; - pr " (int) r);\n"; - pr " return -1;\n"; - pr " }\n" - in - List.iter (generate_test_command_call test_name) seq; - generate_test_command_call ~test test_name last - | TestOutputTrue seq -> - pr " /* TestOutputTrue for %s (%d) */\n" name i; - let seq, last = get_seq_last seq in - let test () = - pr " if (!r) {\n"; - pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n" - test_name; - pr " return -1;\n"; - pr " }\n" - in - List.iter (generate_test_command_call test_name) seq; - generate_test_command_call ~test test_name last - | TestOutputFalse seq -> - pr " /* TestOutputFalse for %s (%d) */\n" name i; - let seq, last = get_seq_last seq in - let test () = - pr " if (r) {\n"; - pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n" - test_name; - pr " return -1;\n"; - pr " }\n" - in - List.iter (generate_test_command_call test_name) seq; - generate_test_command_call ~test test_name last - | TestOutputLength (seq, expected) -> - pr " /* TestOutputLength for %s (%d) */\n" name i; - let seq, last = get_seq_last seq in - let test () = - pr " int j;\n"; - pr " for (j = 0; j < %d; ++j)\n" expected; - pr " if (r[j] == NULL) {\n"; - pr " fprintf (stderr, \"%s: short list returned\\n\");\n" - test_name; - pr " print_strings (r);\n"; - pr " return -1;\n"; - pr " }\n"; - pr " if (r[j] != NULL) {\n"; - pr " fprintf (stderr, \"%s: long list returned\\n\");\n" - test_name; - pr " print_strings (r);\n"; - pr " return -1;\n"; - pr " }\n" - in - List.iter (generate_test_command_call test_name) seq; - generate_test_command_call ~test test_name last - | TestOutputStruct (seq, checks) -> - pr " /* TestOutputStruct for %s (%d) */\n" name i; - let seq, last = get_seq_last seq in - let test () = - List.iter ( - function - | CompareWithInt (field, expected) -> - pr " if (r->%s != %d) {\n" field expected; - pr " fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n" - test_name field expected; - pr " (int) r->%s);\n" field; - pr " return -1;\n"; - pr " }\n" - | CompareWithString (field, expected) -> - pr " if (strcmp (r->%s, \"%s\") != 0) {\n" field expected; - pr " fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n" - test_name field expected; - pr " r->%s);\n" field; - pr " return -1;\n"; - pr " }\n" - | CompareFieldsIntEq (field1, field2) -> - pr " if (r->%s != r->%s) {\n" field1 field2; - pr " fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n" - test_name field1 field2; - pr " (int) r->%s, (int) r->%s);\n" field1 field2; - pr " return -1;\n"; - pr " }\n" - | CompareFieldsStrEq (field1, field2) -> - pr " if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2; - pr " fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n" - test_name field1 field2; - pr " r->%s, r->%s);\n" field1 field2; - pr " return -1;\n"; - pr " }\n" - ) checks - in - List.iter (generate_test_command_call test_name) seq; - generate_test_command_call ~test test_name last - | TestLastFail seq -> - pr " /* TestLastFail for %s (%d) */\n" name i; - let seq, last = get_seq_last seq in - List.iter (generate_test_command_call test_name) seq; - generate_test_command_call test_name ~expect_error:true last - ); - - pr " return 0;\n"; - pr "}\n"; - pr "\n"; - test_name + match test with + | TestRun seq -> + pr " /* TestRun for %s (%d) */\n" name i; + List.iter (generate_test_command_call test_name) seq + | TestOutput (seq, expected) -> + pr " /* TestOutput for %s (%d) */\n" name i; + pr " char expected[] = \"%s\";\n" (c_quote expected); + let seq, last = get_seq_last seq in + let test () = + pr " if (strcmp (r, expected) != 0) {\n"; + pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name; + pr " return -1;\n"; + pr " }\n" + in + List.iter (generate_test_command_call test_name) seq; + generate_test_command_call ~test test_name last + | TestOutputList (seq, expected) -> + pr " /* TestOutputList for %s (%d) */\n" name i; + let seq, last = get_seq_last seq in + let test () = + iteri ( + fun i str -> + pr " if (!r[%d]) {\n" i; + pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name; + pr " print_strings (r);\n"; + pr " return -1;\n"; + pr " }\n"; + pr " {\n"; + pr " char expected[] = \"%s\";\n" (c_quote str); + pr " if (strcmp (r[%d], expected) != 0) {\n" i; + pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i; + pr " return -1;\n"; + pr " }\n"; + pr " }\n" + ) expected; + pr " if (r[%d] != NULL) {\n" (List.length expected); + pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n" + test_name; + pr " print_strings (r);\n"; + pr " return -1;\n"; + pr " }\n" + in + List.iter (generate_test_command_call test_name) seq; + generate_test_command_call ~test test_name last + | TestOutputListOfDevices (seq, expected) -> + pr " /* TestOutputListOfDevices for %s (%d) */\n" name i; + let seq, last = get_seq_last seq in + let test () = + iteri ( + fun i str -> + pr " if (!r[%d]) {\n" i; + pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name; + pr " print_strings (r);\n"; + pr " return -1;\n"; + pr " }\n"; + pr " {\n"; + pr " char expected[] = \"%s\";\n" (c_quote str); + pr " r[%d][5] = 's';\n" i; + pr " if (strcmp (r[%d], expected) != 0) {\n" i; + pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i; + pr " return -1;\n"; + pr " }\n"; + pr " }\n" + ) expected; + pr " if (r[%d] != NULL) {\n" (List.length expected); + pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n" + test_name; + pr " print_strings (r);\n"; + pr " return -1;\n"; + pr " }\n" + in + List.iter (generate_test_command_call test_name) seq; + generate_test_command_call ~test test_name last + | TestOutputInt (seq, expected) -> + pr " /* TestOutputInt for %s (%d) */\n" name i; + let seq, last = get_seq_last seq in + let test () = + pr " if (r != %d) {\n" expected; + pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\"," + test_name expected; + pr " (int) r);\n"; + pr " return -1;\n"; + pr " }\n" + in + List.iter (generate_test_command_call test_name) seq; + generate_test_command_call ~test test_name last + | TestOutputTrue seq -> + pr " /* TestOutputTrue for %s (%d) */\n" name i; + let seq, last = get_seq_last seq in + let test () = + pr " if (!r) {\n"; + pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n" + test_name; + pr " return -1;\n"; + pr " }\n" + in + List.iter (generate_test_command_call test_name) seq; + generate_test_command_call ~test test_name last + | TestOutputFalse seq -> + pr " /* TestOutputFalse for %s (%d) */\n" name i; + let seq, last = get_seq_last seq in + let test () = + pr " if (r) {\n"; + pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n" + test_name; + pr " return -1;\n"; + pr " }\n" + in + List.iter (generate_test_command_call test_name) seq; + generate_test_command_call ~test test_name last + | TestOutputLength (seq, expected) -> + pr " /* TestOutputLength for %s (%d) */\n" name i; + let seq, last = get_seq_last seq in + let test () = + pr " int j;\n"; + pr " for (j = 0; j < %d; ++j)\n" expected; + pr " if (r[j] == NULL) {\n"; + pr " fprintf (stderr, \"%s: short list returned\\n\");\n" + test_name; + pr " print_strings (r);\n"; + pr " return -1;\n"; + pr " }\n"; + pr " if (r[j] != NULL) {\n"; + pr " fprintf (stderr, \"%s: long list returned\\n\");\n" + test_name; + pr " print_strings (r);\n"; + pr " return -1;\n"; + pr " }\n" + in + List.iter (generate_test_command_call test_name) seq; + generate_test_command_call ~test test_name last + | TestOutputStruct (seq, checks) -> + pr " /* TestOutputStruct for %s (%d) */\n" name i; + let seq, last = get_seq_last seq in + let test () = + List.iter ( + function + | CompareWithInt (field, expected) -> + pr " if (r->%s != %d) {\n" field expected; + pr " fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n" + test_name field expected; + pr " (int) r->%s);\n" field; + pr " return -1;\n"; + pr " }\n" + | CompareWithString (field, expected) -> + pr " if (strcmp (r->%s, \"%s\") != 0) {\n" field expected; + pr " fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n" + test_name field expected; + pr " r->%s);\n" field; + pr " return -1;\n"; + pr " }\n" + | CompareFieldsIntEq (field1, field2) -> + pr " if (r->%s != r->%s) {\n" field1 field2; + pr " fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n" + test_name field1 field2; + pr " (int) r->%s, (int) r->%s);\n" field1 field2; + pr " return -1;\n"; + pr " }\n" + | CompareFieldsStrEq (field1, field2) -> + pr " if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2; + pr " fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n" + test_name field1 field2; + pr " r->%s, r->%s);\n" field1 field2; + pr " return -1;\n"; + pr " }\n" + ) checks + in + List.iter (generate_test_command_call test_name) seq; + generate_test_command_call ~test test_name last + | TestLastFail seq -> + pr " /* TestLastFail for %s (%d) */\n" name i; + let seq, last = get_seq_last seq in + List.iter (generate_test_command_call test_name) seq; + generate_test_command_call test_name ~expect_error:true last (* Generate the code to run a command, leaving the result in 'r'. * If you expect to get an error then you should set expect_error:true. @@ -3470,16 +4323,22 @@ and generate_test_command_call ?(expect_error = false) ?test test_name cmd = List.iter ( function - | String _, _ - | OptString _, _ + | OptString n, "NULL" -> () + | String n, arg + | OptString n, arg -> + pr " char %s[] = \"%s\";\n" n (c_quote arg); | Int _, _ - | Bool _, _ -> () + | Bool _, _ | FileIn _, _ | FileOut _, _ -> () | StringList n, arg -> - pr " char *%s[] = {\n" n; let strs = string_split " " arg in - List.iter ( - fun str -> pr " \"%s\",\n" (c_quote str) + iteri ( + fun i str -> + pr " char %s_%d[] = \"%s\";\n" n i (c_quote str); + ) strs; + pr " char *%s[] = {\n" n; + iteri ( + fun i _ -> pr " %s_%d,\n" n i ) strs; pr " NULL\n"; pr " };\n"; @@ -3514,11 +4373,12 @@ and generate_test_command_call ?(expect_error = false) ?test test_name cmd = (* Generate the parameters. *) List.iter ( function - | String _, arg + | OptString _, "NULL" -> pr ", NULL" + | String n, _ + | OptString n, _ -> + pr ", %s" n | FileIn _, arg | FileOut _, arg -> pr ", \"%s\"" (c_quote arg) - | OptString _, arg -> - if arg = "NULL" then pr ", NULL" else pr ", \"%s\"" (c_quote arg) | StringList n, _ -> pr ", %s" n | Int _, arg -> @@ -3569,6 +4429,7 @@ and c_quote str = let str = replace_str str "\r" "\\r" in let str = replace_str str "\n" "\\n" in let str = replace_str str "\t" "\\t" in + let str = replace_str str "\000" "\\0" in str (* Generate a lot of different functions for guestfish. *) @@ -3905,9 +4766,12 @@ and generate_fish_completion () = #ifdef HAVE_LIBREADLINE static const char *const commands[] = { + BUILTIN_COMMANDS_FOR_COMPLETION, "; - (* Get the commands and sort them, including the aliases. *) + (* Get the commands, including the aliases. They don't need to be + * sorted - the generator() function just does a dumb linear search. + *) let commands = List.map ( fun (name, _, _, flags, _, _, _) -> @@ -3919,7 +4783,6 @@ static const char *const commands[] = { if name <> alias then [name2; alias] else [name2] ) all_functions in let commands = List.flatten commands in - let commands = List.sort compare commands in List.iter (pr " \"%s\",\n") commands; @@ -3965,7 +4828,8 @@ char **do_completion (const char *text, int start, int end) and generate_fish_actions_pod () = let all_functions_sorted = List.filter ( - fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags) + fun (_, _, _, flags, _, _, _) -> + not (List.mem NotInFish flags || List.mem NotInDocs flags) ) all_functions_sorted in let rex = Str.regexp "C]+\\)>" in @@ -4068,8 +4932,14 @@ and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true) List.iter ( function | String n - | OptString n -> next (); pr "const char *%s" n - | StringList n -> next (); pr "char * const* const %s" n + | OptString n -> + next (); + if not in_daemon then pr "const char *%s" n + else pr "char *%s" n + | StringList n -> + next (); + if not in_daemon then pr "char * const* const %s" n + else pr "char **%s" n | Bool n -> next (); pr "int %s" n | Int n -> next (); pr "int %s" n | FileIn n @@ -4560,7 +5430,7 @@ XS_unpack_charPtrPtr (SV *arg) { croak (\"array reference expected\"); av = (AV *)SvRV (arg); - ret = malloc (av_len (av) + 1 + 1); + ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *)); if (!ret) croak (\"malloc failed\"); @@ -4580,6 +5450,8 @@ XS_unpack_charPtrPtr (SV *arg) { MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs +PROTOTYPES: ENABLE + guestfs_h * _create () CODE: @@ -4619,13 +5491,19 @@ DESTROY (g) generate_call_args ~handle:"g" (snd style); pr "\n"; pr " guestfs_h *g;\n"; - List.iter ( - function - | String n | FileIn n | FileOut n -> pr " char *%s;\n" n - | OptString n -> pr " char *%s;\n" n - | StringList n -> pr " char **%s;\n" n - | Bool n -> pr " int %s;\n" n - | Int n -> pr " int %s;\n" n + iteri ( + fun i -> + function + | String n | FileIn n | FileOut n -> pr " char *%s;\n" n + | OptString n -> + (* http://www.perlmonks.org/?node_id=554277 + * Note that the implicit handle argument means we have + * to add 1 to the ST(x) operator. + *) + pr " char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1) + | StringList n -> pr " char **%s;\n" n + | Bool n -> pr " int %s;\n" n + | Int n -> pr " int %s;\n" n ) (snd style); let do_cleanups () = @@ -4891,15 +5769,17 @@ sub new { *) List.iter ( fun (name, style, _, flags, _, _, longdesc) -> - let longdesc = replace_str longdesc "C" in - pr "=item "; - generate_perl_prototype name style; - pr "\n\n"; - pr "%s\n\n" longdesc; - if List.mem ProtocolLimitWarning flags then - pr "%s\n\n" protocol_limit_warning; - if List.mem DangerWillRobinson flags then - pr "%s\n\n" danger_will_robinson + if not (List.mem NotInDocs flags) then ( + let longdesc = replace_str longdesc "C" in + pr "=item "; + generate_perl_prototype name style; + pr "\n\n"; + pr "%s\n\n" longdesc; + if List.mem ProtocolLimitWarning flags then + pr "%s\n\n" protocol_limit_warning; + if List.mem DangerWillRobinson flags then + pr "%s\n\n" danger_will_robinson + ) ) all_functions_sorted; (* End of file. *) @@ -5402,43 +6282,45 @@ class GuestFS: List.iter ( fun (name, style, _, flags, _, _, longdesc) -> - let doc = replace_str longdesc "C doc - | RStringList _ -> - doc ^ "\n\nThis function returns a list of strings." - | RIntBool _ -> - doc ^ "\n\nThis function returns a tuple (int, bool).\n" - | RPVList _ -> - doc ^ "\n\nThis function returns a list of PVs. Each PV is represented as a dictionary." - | RVGList _ -> - doc ^ "\n\nThis function returns a list of VGs. Each VG is represented as a dictionary." - | RLVList _ -> - doc ^ "\n\nThis function returns a list of LVs. Each LV is represented as a dictionary." - | RStat _ -> - doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the stat structure." - | RStatVFS _ -> - doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the statvfs structure." - | RHashtable _ -> - doc ^ "\n\nThis function returns a dictionary." in - let doc = - if List.mem ProtocolLimitWarning flags then - doc ^ "\n\n" ^ protocol_limit_warning - else doc in - let doc = - if List.mem DangerWillRobinson flags then - doc ^ "\n\n" ^ danger_will_robinson - else doc in - let doc = pod2text ~width:60 name doc in - let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in - let doc = String.concat "\n " doc in - pr " def %s " name; generate_call_args ~handle:"self" (snd style); pr ":\n"; - pr " u\"\"\"%s\"\"\"\n" doc; + + if not (List.mem NotInDocs flags) then ( + let doc = replace_str longdesc "C doc + | RStringList _ -> + doc ^ "\n\nThis function returns a list of strings." + | RIntBool _ -> + doc ^ "\n\nThis function returns a tuple (int, bool).\n" + | RPVList _ -> + doc ^ "\n\nThis function returns a list of PVs. Each PV is represented as a dictionary." + | RVGList _ -> + doc ^ "\n\nThis function returns a list of VGs. Each VG is represented as a dictionary." + | RLVList _ -> + doc ^ "\n\nThis function returns a list of LVs. Each LV is represented as a dictionary." + | RStat _ -> + doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the stat structure." + | RStatVFS _ -> + doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the statvfs structure." + | RHashtable _ -> + doc ^ "\n\nThis function returns a dictionary." in + let doc = + if List.mem ProtocolLimitWarning flags then + doc ^ "\n\n" ^ protocol_limit_warning + else doc in + let doc = + if List.mem DangerWillRobinson flags then + doc ^ "\n\n" ^ danger_will_robinson + else doc in + let doc = pod2text ~width:60 name doc in + let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in + let doc = String.concat "\n " doc in + pr " u\"\"\"%s\"\"\"\n" doc; + ); pr " return libguestfsmod.%s " name; generate_call_args ~handle:"self._o" (snd style); pr "\n"; @@ -5489,6 +6371,11 @@ and generate_ruby_c () = #include \"extconf.h\" +/* For Ruby < 1.9 */ +#ifndef RARRAY_LEN +#define RARRAY_LEN(r) (RARRAY((r))->len) +#endif + static VALUE m_guestfs; /* guestfs module */ static VALUE c_guestfs; /* guestfs_h handle */ static VALUE e_Error; /* used for all errors */ @@ -5550,7 +6437,7 @@ static VALUE ruby_guestfs_close (VALUE gv) pr " rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n"; pr " \"%s\", \"%s\");\n" n name | OptString n -> - pr " const char *%s = StringValueCStr (%sv);\n" n n + pr " const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n | StringList n -> pr " char **%s;" n; pr " {\n"; @@ -5564,7 +6451,8 @@ static VALUE ruby_guestfs_close (VALUE gv) pr " }\n"; pr " %s[len] = NULL;\n" n; pr " }\n"; - | Bool n + | Bool n -> + pr " int %s = RTEST (%sv);\n" n n | Int n -> pr " int %s = NUM2INT (%sv);\n" n n ) (snd style); @@ -5784,25 +6672,32 @@ public class GuestFS { List.iter ( fun (name, style, _, flags, _, shortdesc, longdesc) -> - let doc = replace_str longdesc "C "

" + | nonempty -> nonempty + ) doc in + let doc = String.concat "\n * " doc in + + pr " /**\n"; + pr " * %s\n" shortdesc; + pr " *

\n"; + pr " * %s\n" doc; + pr " * @throws LibGuestFSException\n"; + pr " */\n"; + pr " "; + ); generate_java_prototype ~public:true ~semicolon:false name style; pr "\n"; pr " {\n"; @@ -6058,7 +6953,7 @@ Java_com_redhat_et_libguestfs_GuestFS__1close let needs_i = (match fst style with | RStringList _ | RPVList _ | RVGList _ | RLVList _ -> true - | RErr _ | RBool _ | RInt _ | RInt64 _ | RConstString _ + | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _ | RString _ | RIntBool _ | RStat _ | RStatVFS _ | RHashtable _ -> false) || List.exists (function StringList _ -> true | _ -> false) (snd style) in @@ -6071,10 +6966,14 @@ Java_com_redhat_et_libguestfs_GuestFS__1close List.iter ( function | String n - | OptString n | FileIn n | FileOut n -> pr " %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n + | OptString n -> + (* This is completely undocumented, but Java null becomes + * a NULL parameter. + *) + pr " %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n | StringList n -> pr " %s_len = (*env)->GetArrayLength (env, j%s);\n" n n; pr " %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n; @@ -6098,10 +6997,12 @@ Java_com_redhat_et_libguestfs_GuestFS__1close List.iter ( function | String n - | OptString n | FileIn n | FileOut n -> pr " (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n + | OptString n -> + pr " if (j%s)\n" n; + pr " (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n | StringList n -> pr " for (i = 0; i < %s_len; ++i) {\n" n; pr " jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n" @@ -6221,14 +7122,620 @@ and generate_java_lvm_return typ jtyp cols = pr " guestfs_free_lvm_%s_list (r);\n" typ; pr " return jr;\n" +and generate_haskell_hs () = + generate_header HaskellStyle LGPLv2; + + (* XXX We only know how to generate partial FFI for Haskell + * at the moment. Please help out! + *) + let can_generate style = + let check_no_bad_args = + List.for_all (function Bool _ | Int _ -> false | _ -> true) + in + match style with + | RErr, args -> check_no_bad_args args + | RBool _, _ + | RInt _, _ + | RInt64 _, _ + | RConstString _, _ + | RString _, _ + | RStringList _, _ + | RIntBool _, _ + | RPVList _, _ + | RVGList _, _ + | RLVList _, _ + | RStat _, _ + | RStatVFS _, _ + | RHashtable _, _ -> false in + + pr "\ +{-# INCLUDE #-} +{-# LANGUAGE ForeignFunctionInterface #-} + +module Guestfs ( + create"; + + (* List out the names of the actions we want to export. *) + List.iter ( + fun (name, style, _, _, _, _, _) -> + if can_generate style then pr ",\n %s" name + ) all_functions; + + pr " + ) where +import Foreign +import Foreign.C +import IO +import Control.Exception +import Data.Typeable + +data GuestfsS = GuestfsS -- represents the opaque C struct +type GuestfsP = Ptr GuestfsS -- guestfs_h * +type GuestfsH = ForeignPtr GuestfsS -- guestfs_h * with attached finalizer + +-- XXX define properly later XXX +data PV = PV +data VG = VG +data LV = LV +data IntBool = IntBool +data Stat = Stat +data StatVFS = StatVFS +data Hashtable = Hashtable + +foreign import ccall unsafe \"guestfs_create\" c_create + :: IO GuestfsP +foreign import ccall unsafe \"&guestfs_close\" c_close + :: FunPtr (GuestfsP -> IO ()) +foreign import ccall unsafe \"guestfs_set_error_handler\" c_set_error_handler + :: GuestfsP -> Ptr CInt -> Ptr CInt -> IO () + +create :: IO GuestfsH +create = do + p <- c_create + c_set_error_handler p nullPtr nullPtr + h <- newForeignPtr c_close p + return h + +foreign import ccall unsafe \"guestfs_last_error\" c_last_error + :: GuestfsP -> IO CString + +-- last_error :: GuestfsH -> IO (Maybe String) +-- last_error h = do +-- str <- withForeignPtr h (\\p -> c_last_error p) +-- maybePeek peekCString str + +last_error :: GuestfsH -> IO (String) +last_error h = do + str <- withForeignPtr h (\\p -> c_last_error p) + if (str == nullPtr) + then return \"no error\" + else peekCString str + +"; + + (* Generate wrappers for each foreign function. *) + List.iter ( + fun (name, style, _, _, _, _, _) -> + if can_generate style then ( + pr "foreign import ccall unsafe \"guestfs_%s\" c_%s\n" name name; + pr " :: "; + generate_haskell_prototype ~handle:"GuestfsP" style; + pr "\n"; + pr "\n"; + pr "%s :: " name; + generate_haskell_prototype ~handle:"GuestfsH" ~hs:true style; + pr "\n"; + pr "%s %s = do\n" name + (String.concat " " ("h" :: List.map name_of_argt (snd style))); + pr " r <- "; + List.iter ( + function + | FileIn n + | FileOut n + | String n -> pr "withCString %s $ \\%s -> " n n + | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n + | StringList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n + | Bool n -> + (* XXX this doesn't work *) + pr " let\n"; + pr " %s = case %s of\n" n n; + pr " False -> 0\n"; + pr " True -> 1\n"; + pr " in fromIntegral %s $ \\%s ->\n" n n + | Int n -> pr "fromIntegral %s $ \\%s -> " n n + ) (snd style); + pr "withForeignPtr h (\\p -> c_%s %s)\n" name + (String.concat " " ("p" :: List.map name_of_argt (snd style))); + (match fst style with + | RErr | RInt _ | RInt64 _ | RBool _ -> + pr " if (r == -1)\n"; + pr " then do\n"; + pr " err <- last_error h\n"; + pr " fail err\n"; + | RConstString _ | RString _ | RStringList _ | RIntBool _ + | RPVList _ | RVGList _ | RLVList _ | RStat _ | RStatVFS _ + | RHashtable _ -> + pr " if (r == nullPtr)\n"; + pr " then do\n"; + pr " err <- last_error h\n"; + pr " fail err\n"; + ); + (match fst style with + | RErr -> + pr " else return ()\n" + | RInt _ -> + pr " else return (fromIntegral r)\n" + | RInt64 _ -> + pr " else return (fromIntegral r)\n" + | RBool _ -> + pr " else return (toBool r)\n" + | RConstString _ + | RString _ + | RStringList _ + | RIntBool _ + | RPVList _ + | RVGList _ + | RLVList _ + | RStat _ + | RStatVFS _ + | RHashtable _ -> + pr " else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *) + ); + pr "\n"; + ) + ) all_functions + +and generate_haskell_prototype ~handle ?(hs = false) style = + pr "%s -> " handle; + let string = if hs then "String" else "CString" in + let int = if hs then "Int" else "CInt" in + let bool = if hs then "Bool" else "CInt" in + let int64 = if hs then "Integer" else "Int64" in + List.iter ( + fun arg -> + (match arg with + | String _ -> pr "%s" string + | OptString _ -> if hs then pr "Maybe String" else pr "CString" + | StringList _ -> if hs then pr "[String]" else pr "Ptr CString" + | Bool _ -> pr "%s" bool + | Int _ -> pr "%s" int + | FileIn _ -> pr "%s" string + | FileOut _ -> pr "%s" string + ); + pr " -> "; + ) (snd style); + pr "IO ("; + (match fst style with + | RErr -> if not hs then pr "CInt" + | RInt _ -> pr "%s" int + | RInt64 _ -> pr "%s" int64 + | RBool _ -> pr "%s" bool + | RConstString _ -> pr "%s" string + | RString _ -> pr "%s" string + | RStringList _ -> pr "[%s]" string + | RIntBool _ -> pr "IntBool" + | RPVList _ -> pr "[PV]" + | RVGList _ -> pr "[VG]" + | RLVList _ -> pr "[LV]" + | RStat _ -> pr "Stat" + | RStatVFS _ -> pr "StatVFS" + | RHashtable _ -> pr "Hashtable" + ); + pr ")" + +and generate_bindtests () = + generate_header CStyle LGPLv2; + + pr "\ +#include +#include +#include +#include + +#include \"guestfs.h\" +#include \"guestfs_protocol.h\" + +#define error guestfs_error + +static void +print_strings (char * const* const argv) +{ + int argc; + + printf (\"[\"); + for (argc = 0; argv[argc] != NULL; ++argc) { + if (argc > 0) printf (\", \"); + printf (\"\\\"%%s\\\"\", argv[argc]); + } + printf (\"]\\n\"); +} + +/* The test0 function prints its parameters to stdout. */ +"; + + let test0, tests = + match test_functions with + | [] -> assert false + | test0 :: tests -> test0, tests in + + let () = + let (name, style, _, _, _, _, _) = test0 in + generate_prototype ~extern:false ~semicolon:false ~newline:true + ~handle:"g" ~prefix:"guestfs_" name style; + pr "{\n"; + List.iter ( + function + | String n + | FileIn n + | FileOut n -> pr " printf (\"%%s\\n\", %s);\n" n + | OptString n -> pr " printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n + | StringList n -> pr " print_strings (%s);\n" n + | Bool n -> pr " printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n + | Int n -> pr " printf (\"%%d\\n\", %s);\n" n + ) (snd style); + pr " /* Java changes stdout line buffering so we need this: */\n"; + pr " fflush (stdout);\n"; + pr " return 0;\n"; + pr "}\n"; + pr "\n" in + + List.iter ( + fun (name, style, _, _, _, _, _) -> + if String.sub name (String.length name - 3) 3 <> "err" then ( + pr "/* Test normal return. */\n"; + generate_prototype ~extern:false ~semicolon:false ~newline:true + ~handle:"g" ~prefix:"guestfs_" name style; + pr "{\n"; + (match fst style with + | RErr -> + pr " return 0;\n" + | RInt _ -> + pr " int r;\n"; + pr " sscanf (val, \"%%d\", &r);\n"; + pr " return r;\n" + | RInt64 _ -> + pr " int64_t r;\n"; + pr " sscanf (val, \"%%\" SCNi64, &r);\n"; + pr " return r;\n" + | RBool _ -> + pr " return strcmp (val, \"true\") == 0;\n" + | RConstString _ -> + (* Can't return the input string here. Return a static + * string so we ensure we get a segfault if the caller + * tries to free it. + *) + pr " return \"static string\";\n" + | RString _ -> + pr " return strdup (val);\n" + | RStringList _ -> + pr " char **strs;\n"; + pr " int n, i;\n"; + pr " sscanf (val, \"%%d\", &n);\n"; + pr " strs = malloc ((n+1) * sizeof (char *));\n"; + pr " for (i = 0; i < n; ++i) {\n"; + pr " strs[i] = malloc (16);\n"; + pr " snprintf (strs[i], 16, \"%%d\", i);\n"; + pr " }\n"; + pr " strs[n] = NULL;\n"; + pr " return strs;\n" + | RIntBool _ -> + pr " struct guestfs_int_bool *r;\n"; + pr " r = malloc (sizeof (struct guestfs_int_bool));\n"; + pr " sscanf (val, \"%%\" SCNi32, &r->i);\n"; + pr " r->b = 0;\n"; + pr " return r;\n" + | RPVList _ -> + pr " struct guestfs_lvm_pv_list *r;\n"; + pr " int i;\n"; + pr " r = malloc (sizeof (struct guestfs_lvm_pv_list));\n"; + pr " sscanf (val, \"%%d\", &r->len);\n"; + pr " r->val = calloc (r->len, sizeof (struct guestfs_lvm_pv));\n"; + pr " for (i = 0; i < r->len; ++i) {\n"; + pr " r->val[i].pv_name = malloc (16);\n"; + pr " snprintf (r->val[i].pv_name, 16, \"%%d\", i);\n"; + pr " }\n"; + pr " return r;\n" + | RVGList _ -> + pr " struct guestfs_lvm_vg_list *r;\n"; + pr " int i;\n"; + pr " r = malloc (sizeof (struct guestfs_lvm_vg_list));\n"; + pr " sscanf (val, \"%%d\", &r->len);\n"; + pr " r->val = calloc (r->len, sizeof (struct guestfs_lvm_vg));\n"; + pr " for (i = 0; i < r->len; ++i) {\n"; + pr " r->val[i].vg_name = malloc (16);\n"; + pr " snprintf (r->val[i].vg_name, 16, \"%%d\", i);\n"; + pr " }\n"; + pr " return r;\n" + | RLVList _ -> + pr " struct guestfs_lvm_lv_list *r;\n"; + pr " int i;\n"; + pr " r = malloc (sizeof (struct guestfs_lvm_lv_list));\n"; + pr " sscanf (val, \"%%d\", &r->len);\n"; + pr " r->val = calloc (r->len, sizeof (struct guestfs_lvm_lv));\n"; + pr " for (i = 0; i < r->len; ++i) {\n"; + pr " r->val[i].lv_name = malloc (16);\n"; + pr " snprintf (r->val[i].lv_name, 16, \"%%d\", i);\n"; + pr " }\n"; + pr " return r;\n" + | RStat _ -> + pr " struct guestfs_stat *r;\n"; + pr " r = calloc (1, sizeof (*r));\n"; + pr " sscanf (val, \"%%\" SCNi64, &r->dev);\n"; + pr " return r;\n" + | RStatVFS _ -> + pr " struct guestfs_statvfs *r;\n"; + pr " r = calloc (1, sizeof (*r));\n"; + pr " sscanf (val, \"%%\" SCNi64, &r->bsize);\n"; + pr " return r;\n" + | RHashtable _ -> + pr " char **strs;\n"; + pr " int n, i;\n"; + pr " sscanf (val, \"%%d\", &n);\n"; + pr " strs = malloc ((n*2+1) * sizeof (char *));\n"; + pr " for (i = 0; i < n; ++i) {\n"; + pr " strs[i*2] = malloc (16);\n"; + pr " strs[i*2+1] = malloc (16);\n"; + pr " snprintf (strs[i*2], 16, \"%%d\", i);\n"; + pr " snprintf (strs[i*2+1], 16, \"%%d\", i);\n"; + pr " }\n"; + pr " strs[n*2] = NULL;\n"; + pr " return strs;\n" + ); + pr "}\n"; + pr "\n" + ) else ( + pr "/* Test error return. */\n"; + generate_prototype ~extern:false ~semicolon:false ~newline:true + ~handle:"g" ~prefix:"guestfs_" name style; + pr "{\n"; + pr " error (g, \"error\");\n"; + (match fst style with + | RErr | RInt _ | RInt64 _ | RBool _ -> + pr " return -1;\n" + | RConstString _ + | RString _ | RStringList _ | RIntBool _ + | RPVList _ | RVGList _ | RLVList _ | RStat _ | RStatVFS _ + | RHashtable _ -> + pr " return NULL;\n" + ); + pr "}\n"; + pr "\n" + ) + ) tests + +and generate_ocaml_bindtests () = + generate_header OCamlStyle GPLv2; + + pr "\ +let () = + let g = Guestfs.create () in +"; + + let mkargs args = + String.concat " " ( + List.map ( + function + | CallString s -> "\"" ^ s ^ "\"" + | CallOptString None -> "None" + | CallOptString (Some s) -> sprintf "(Some \"%s\")" s + | CallStringList xs -> + "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]" + | CallInt i when i >= 0 -> string_of_int i + | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")" + | CallBool b -> string_of_bool b + ) args + ) + in + + generate_lang_bindtests ( + fun f args -> pr " Guestfs.%s g %s;\n" f (mkargs args) + ); + + pr "print_endline \"EOF\"\n" + +and generate_perl_bindtests () = + pr "#!/usr/bin/perl -w\n"; + generate_header HashStyle GPLv2; + + pr "\ +use strict; + +use Sys::Guestfs; + +my $g = Sys::Guestfs->new (); +"; + + let mkargs args = + String.concat ", " ( + List.map ( + function + | CallString s -> "\"" ^ s ^ "\"" + | CallOptString None -> "undef" + | CallOptString (Some s) -> sprintf "\"%s\"" s + | CallStringList xs -> + "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]" + | CallInt i -> string_of_int i + | CallBool b -> if b then "1" else "0" + ) args + ) + in + + generate_lang_bindtests ( + fun f args -> pr "$g->%s (%s);\n" f (mkargs args) + ); + + pr "print \"EOF\\n\"\n" + +and generate_python_bindtests () = + generate_header HashStyle GPLv2; + + pr "\ +import guestfs + +g = guestfs.GuestFS () +"; + + let mkargs args = + String.concat ", " ( + List.map ( + function + | CallString s -> "\"" ^ s ^ "\"" + | CallOptString None -> "None" + | CallOptString (Some s) -> sprintf "\"%s\"" s + | CallStringList xs -> + "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]" + | CallInt i -> string_of_int i + | CallBool b -> if b then "1" else "0" + ) args + ) + in + + generate_lang_bindtests ( + fun f args -> pr "g.%s (%s)\n" f (mkargs args) + ); + + pr "print \"EOF\"\n" + +and generate_ruby_bindtests () = + generate_header HashStyle GPLv2; + + pr "\ +require 'guestfs' + +g = Guestfs::create() +"; + + let mkargs args = + String.concat ", " ( + List.map ( + function + | CallString s -> "\"" ^ s ^ "\"" + | CallOptString None -> "nil" + | CallOptString (Some s) -> sprintf "\"%s\"" s + | CallStringList xs -> + "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]" + | CallInt i -> string_of_int i + | CallBool b -> string_of_bool b + ) args + ) + in + + generate_lang_bindtests ( + fun f args -> pr "g.%s(%s)\n" f (mkargs args) + ); + + pr "print \"EOF\\n\"\n" + +and generate_java_bindtests () = + generate_header CStyle GPLv2; + + pr "\ +import com.redhat.et.libguestfs.*; + +public class Bindtests { + public static void main (String[] argv) + { + try { + GuestFS g = new GuestFS (); +"; + + let mkargs args = + String.concat ", " ( + List.map ( + function + | CallString s -> "\"" ^ s ^ "\"" + | CallOptString None -> "null" + | CallOptString (Some s) -> sprintf "\"%s\"" s + | CallStringList xs -> + "new String[]{" ^ + String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}" + | CallInt i -> string_of_int i + | CallBool b -> string_of_bool b + ) args + ) + in + + generate_lang_bindtests ( + fun f args -> pr " g.%s (%s);\n" f (mkargs args) + ); + + pr " + System.out.println (\"EOF\"); + } + catch (Exception exn) { + System.err.println (exn); + System.exit (1); + } + } +} +" + +and generate_haskell_bindtests () = + () (* XXX Haskell bindings need to be fleshed out. *) + +(* Language-independent bindings tests - we do it this way to + * ensure there is parity in testing bindings across all languages. + *) +and generate_lang_bindtests call = + call "test0" [CallString "abc"; CallOptString (Some "def"); + CallStringList []; CallBool false; + CallInt 0; CallString "123"; CallString "456"]; + call "test0" [CallString "abc"; CallOptString None; + CallStringList []; CallBool false; + CallInt 0; CallString "123"; CallString "456"]; + call "test0" [CallString ""; CallOptString (Some "def"); + CallStringList []; CallBool false; + CallInt 0; CallString "123"; CallString "456"]; + call "test0" [CallString ""; CallOptString (Some ""); + CallStringList []; CallBool false; + CallInt 0; CallString "123"; CallString "456"]; + call "test0" [CallString "abc"; CallOptString (Some "def"); + CallStringList ["1"]; CallBool false; + CallInt 0; CallString "123"; CallString "456"]; + call "test0" [CallString "abc"; CallOptString (Some "def"); + CallStringList ["1"; "2"]; CallBool false; + CallInt 0; CallString "123"; CallString "456"]; + call "test0" [CallString "abc"; CallOptString (Some "def"); + CallStringList ["1"]; CallBool true; + CallInt 0; CallString "123"; CallString "456"]; + call "test0" [CallString "abc"; CallOptString (Some "def"); + CallStringList ["1"]; CallBool false; + CallInt (-1); CallString "123"; CallString "456"]; + call "test0" [CallString "abc"; CallOptString (Some "def"); + CallStringList ["1"]; CallBool false; + CallInt (-2); CallString "123"; CallString "456"]; + call "test0" [CallString "abc"; CallOptString (Some "def"); + CallStringList ["1"]; CallBool false; + CallInt 1; CallString "123"; CallString "456"]; + call "test0" [CallString "abc"; CallOptString (Some "def"); + CallStringList ["1"]; CallBool false; + CallInt 2; CallString "123"; CallString "456"]; + call "test0" [CallString "abc"; CallOptString (Some "def"); + CallStringList ["1"]; CallBool false; + CallInt 4095; CallString "123"; CallString "456"]; + call "test0" [CallString "abc"; CallOptString (Some "def"); + CallStringList ["1"]; CallBool false; + CallInt 0; CallString ""; CallString ""] + + (* XXX Add here tests of the return and error functions. *) + let output_to filename = let filename_new = filename ^ ".new" in chan := open_out filename_new; let close () = close_out !chan; chan := stdout; - Unix.rename filename_new filename; - printf "written %s\n%!" filename; + + (* Is the new file different from the current file? *) + if Sys.file_exists filename && files_equal filename filename_new then + Unix.unlink filename_new (* same, so skip it *) + else ( + (* different, overwrite old one *) + (try Unix.chmod filename 0o644 with Unix.Unix_error _ -> ()); + Unix.rename filename_new filename; + Unix.chmod filename 0o444; + printf "written %s\n%!" filename; + ) in close @@ -6269,10 +7776,14 @@ Run it from the top source directory using the command generate_daemon_actions (); close (); - let close = output_to "tests.c" in + let close = output_to "capitests/tests.c" in generate_tests (); close (); + let close = output_to "src/guestfs-bindtests.c" in + generate_bindtests (); + close (); + let close = output_to "fish/cmds.c" in generate_fish_cmds (); close (); @@ -6305,6 +7816,10 @@ Run it from the top source directory using the command generate_ocaml_c (); close (); + let close = output_to "ocaml/bindtests.ml" in + generate_ocaml_bindtests (); + close (); + let close = output_to "perl/Guestfs.xs" in generate_perl_xs (); close (); @@ -6313,6 +7828,10 @@ Run it from the top source directory using the command generate_perl_pm (); close (); + let close = output_to "perl/bindtests.pl" in + generate_perl_bindtests (); + close (); + let close = output_to "python/guestfs-py.c" in generate_python_c (); close (); @@ -6321,10 +7840,18 @@ Run it from the top source directory using the command generate_python_py (); close (); + let close = output_to "python/bindtests.py" in + generate_python_bindtests (); + close (); + let close = output_to "ruby/ext/guestfs/_guestfs.c" in generate_ruby_c (); close (); + let close = output_to "ruby/bindtests.rb" in + generate_ruby_bindtests (); + close (); + let close = output_to "java/com/redhat/et/libguestfs/GuestFS.java" in generate_java_java (); close (); @@ -6352,3 +7879,15 @@ Run it from the top source directory using the command let close = output_to "java/com_redhat_et_libguestfs_GuestFS.c" in generate_java_c (); close (); + + let close = output_to "java/Bindtests.java" in + generate_java_bindtests (); + close (); + + let close = output_to "haskell/Guestfs.hs" in + generate_haskell_hs (); + close (); + + let close = output_to "haskell/bindtests.hs" in + generate_haskell_bindtests (); + close ();