X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=src%2Fgenerator.ml;h=c4f285119308fdb4ecd6911e77ac85086474f173;hp=19dc20d53a986756d473c899ebd193134915bc1c;hb=1e97e406c36031617a86a4fa6bb78a112848ee87;hpb=5cd39c83e23eb300d1bdfa806902a31b409ff420 diff --git a/src/generator.ml b/src/generator.ml index 19dc20d..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,15 +130,18 @@ 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 blockdev-setrw, umount-all, 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 @@ -154,6 +158,11 @@ can easily destroy all your data>." * 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_prereq * test) list and test = @@ -168,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 @@ -241,11 +256,6 @@ and test_init = and seq = cmd list and cmd = string list -(* Canned test prerequisites. *) -let env_is_true env = - sprintf "const char *str = getenv (\"%s\"); - return str && strcmp (str, \"1\") == 0;" env - (* Note about long descriptions: When referring to another * action, use the format C (ie. the full name of * the C function). This will be replaced as appropriate in other @@ -254,7 +264,81 @@ let env_is_true env = * 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", @@ -296,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"], [], @@ -304,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, [], [], @@ -492,6 +607,10 @@ 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, Always, TestOutput ( @@ -580,8 +699,8 @@ This command is mostly useful for interactive sessions. Programs should probably use C instead."); ("list_devices", (RStringList "devices", []), 7, [], - [InitEmpty, Always, 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. @@ -589,9 +708,9 @@ List all the block devices. The full block device names are returned, eg. C"); ("list_partitions", (RStringList "partitions", []), 8, [], - [InitBasicFS, Always, TestOutputList ( + [InitBasicFS, Always, TestOutputListOfDevices ( [["list_partitions"]], ["/dev/sda1"]); - InitEmpty, Always, TestOutputList ( + InitEmpty, Always, TestOutputListOfDevices ( [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])], "list the partitions", @@ -604,9 +723,9 @@ This does not return logical volumes. For that you will need to call C."); ("pvs", (RStringList "physvols", []), 9, [], - [InitBasicFSonLVM, Always, TestOutputList ( + [InitBasicFSonLVM, Always, TestOutputListOfDevices ( [["pvs"]], ["/dev/sda1"]); - InitEmpty, Always, TestOutputList ( + InitEmpty, Always, TestOutputListOfDevices ( [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; ["pvcreate"; "/dev/sda1"]; ["pvcreate"; "/dev/sda2"]; @@ -924,7 +1043,14 @@ Create a directory named C."); ["is_dir"; "/new/foo"]]; 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 @@ -992,7 +1118,7 @@ other objects like files. See also C."); ("pvcreate", (RErr, [String "device"]), 39, [], - [InitEmpty, Always, TestOutputList ( + [InitEmpty, Always, TestOutputListOfDevices ( [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; ["pvcreate"; "/dev/sda1"]; ["pvcreate"; "/dev/sda2"]; @@ -1115,7 +1241,7 @@ We hope to resolve this bug in a future version. In the meantime use C."); ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"], - [InitEmpty, Always, TestOutputList ( + [InitEmpty, Always, TestOutputListOfDevices ( [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; ["mkfs"; "ext2"; "/dev/sda1"]; ["mount"; "/dev/sda1"; "/"]; @@ -1133,7 +1259,7 @@ specified either by its mountpoint (path) or the device which contains the filesystem."); ("mounts", (RStringList "devices", []), 46, [], - [InitBasicFS, Always, TestOutputList ( + [InitBasicFS, Always, TestOutputListOfDevices ( [["mounts"]], ["/dev/sda1"])], "show mounted filesystems", "\ @@ -1193,51 +1319,51 @@ particular that the filename is not prepended to the output (the C<-b> option)."); ("command", (RString "output", [StringList "arguments"]), 50, [ProtocolLimitWarning], - [InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutput ( + [InitBasicFS, Always, TestOutput ( [["upload"; "test-command"; "/test-command"]; ["chmod"; "493"; "/test-command"]; ["command"; "/test-command 1"]], "Result1"); - InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutput ( + InitBasicFS, Always, TestOutput ( [["upload"; "test-command"; "/test-command"]; ["chmod"; "493"; "/test-command"]; ["command"; "/test-command 2"]], "Result2\n"); - InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutput ( + InitBasicFS, Always, TestOutput ( [["upload"; "test-command"; "/test-command"]; ["chmod"; "493"; "/test-command"]; ["command"; "/test-command 3"]], "\nResult3"); - InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutput ( + InitBasicFS, Always, TestOutput ( [["upload"; "test-command"; "/test-command"]; ["chmod"; "493"; "/test-command"]; ["command"; "/test-command 4"]], "\nResult4\n"); - InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutput ( + InitBasicFS, Always, TestOutput ( [["upload"; "test-command"; "/test-command"]; ["chmod"; "493"; "/test-command"]; ["command"; "/test-command 5"]], "\nResult5\n\n"); - InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutput ( + InitBasicFS, Always, TestOutput ( [["upload"; "test-command"; "/test-command"]; ["chmod"; "493"; "/test-command"]; ["command"; "/test-command 6"]], "\n\nResult6\n\n"); - InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutput ( + InitBasicFS, Always, TestOutput ( [["upload"; "test-command"; "/test-command"]; ["chmod"; "493"; "/test-command"]; ["command"; "/test-command 7"]], ""); - InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutput ( + InitBasicFS, Always, TestOutput ( [["upload"; "test-command"; "/test-command"]; ["chmod"; "493"; "/test-command"]; ["command"; "/test-command 8"]], "\n"); - InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutput ( + InitBasicFS, Always, TestOutput ( [["upload"; "test-command"; "/test-command"]; ["chmod"; "493"; "/test-command"]; ["command"; "/test-command 9"]], "\n\n"); - InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutput ( + InitBasicFS, Always, TestOutput ( [["upload"; "test-command"; "/test-command"]; ["chmod"; "493"; "/test-command"]; ["command"; "/test-command 10"]], "Result10-1\nResult10-2\n"); - InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutput ( + InitBasicFS, Always, TestOutput ( [["upload"; "test-command"; "/test-command"]; ["chmod"; "493"; "/test-command"]; ["command"; "/test-command 11"]], "Result11-1\nResult11-2"); - InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestLastFail ( + InitBasicFS, Always, TestLastFail ( [["upload"; "test-command"; "/test-command"]; ["chmod"; "493"; "/test-command"]; ["command"; "/test-command"]])], @@ -1272,47 +1398,47 @@ all filesystems that are needed are mounted at the right locations."); ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [ProtocolLimitWarning], - [InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutputList ( + [InitBasicFS, Always, TestOutputList ( [["upload"; "test-command"; "/test-command"]; ["chmod"; "493"; "/test-command"]; ["command_lines"; "/test-command 1"]], ["Result1"]); - InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutputList ( + InitBasicFS, Always, TestOutputList ( [["upload"; "test-command"; "/test-command"]; ["chmod"; "493"; "/test-command"]; ["command_lines"; "/test-command 2"]], ["Result2"]); - InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutputList ( + InitBasicFS, Always, TestOutputList ( [["upload"; "test-command"; "/test-command"]; ["chmod"; "493"; "/test-command"]; ["command_lines"; "/test-command 3"]], ["";"Result3"]); - InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutputList ( + InitBasicFS, Always, TestOutputList ( [["upload"; "test-command"; "/test-command"]; ["chmod"; "493"; "/test-command"]; ["command_lines"; "/test-command 4"]], ["";"Result4"]); - InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutputList ( + InitBasicFS, Always, TestOutputList ( [["upload"; "test-command"; "/test-command"]; ["chmod"; "493"; "/test-command"]; ["command_lines"; "/test-command 5"]], ["";"Result5";""]); - InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutputList ( + InitBasicFS, Always, TestOutputList ( [["upload"; "test-command"; "/test-command"]; ["chmod"; "493"; "/test-command"]; ["command_lines"; "/test-command 6"]], ["";"";"Result6";""]); - InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutputList ( + InitBasicFS, Always, TestOutputList ( [["upload"; "test-command"; "/test-command"]; ["chmod"; "493"; "/test-command"]; ["command_lines"; "/test-command 7"]], []); - InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutputList ( + InitBasicFS, Always, TestOutputList ( [["upload"; "test-command"; "/test-command"]; ["chmod"; "493"; "/test-command"]; ["command_lines"; "/test-command 8"]], [""]); - InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutputList ( + InitBasicFS, Always, TestOutputList ( [["upload"; "test-command"; "/test-command"]; ["chmod"; "493"; "/test-command"]; ["command_lines"; "/test-command 9"]], ["";""]); - InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutputList ( + InitBasicFS, Always, TestOutputList ( [["upload"; "test-command"; "/test-command"]; ["chmod"; "493"; "/test-command"]; ["command_lines"; "/test-command 10"]], ["Result10-1";"Result10-2"]); - InitBasicFS, Unless (env_is_true "SKIP_TEST_COMMAND"), TestOutputList ( + InitBasicFS, Always, TestOutputList ( [["upload"; "test-command"; "/test-command"]; ["chmod"; "493"; "/test-command"]; ["command_lines"; "/test-command 11"]], ["Result11-1";"Result11-2"])], @@ -1484,7 +1610,7 @@ This uses the L command."); ("upload", (RErr, [FileIn "filename"; String "remotefilename"]), 66, [], [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", "\ @@ -1498,7 +1624,7 @@ See also C."); ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [], [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")], @@ -1534,7 +1660,10 @@ See also C, C."); ["checksum"; "sha384"; "/new"]], "109bb6b5b6d5547c1ce03c7a8bd7d8f80c1cb0957f50c4f7fda04692079917e4f9cad52b878f3d8234e1a170b154b72d"); 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 @@ -1580,7 +1709,7 @@ The checksum is returned as a printable string."); ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [], [InitBasicFS, Always, TestOutput ( - [["tar_in"; "images/helloworld.tar"; "/"]; + [["tar_in"; "../images/helloworld.tar"; "/"]; ["cat"; "/hello"]], "hello\n")], "unpack tarfile to directory", "\ @@ -1600,7 +1729,7 @@ To download a compressed tarball, use C."); ("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [], [InitBasicFS, Always, TestOutput ( - [["tgz_in"; "images/helloworld.tar.gz"; "/"]; + [["tgz_in"; "../images/helloworld.tar.gz"; "/"]; ["cat"; "/hello"]], "hello\n")], "unpack compressed tarball to directory", "\ @@ -1663,22 +1792,25 @@ to find out what you can do."); ("lvremove", (RErr, [String "device"]), 77, [], [InitEmpty, Always, TestOutputList ( - [["pvcreate"; "/dev/sda"]; - ["vgcreate"; "VG"; "/dev/sda"]; + [["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, Always, TestOutputList ( - [["pvcreate"; "/dev/sda"]; - ["vgcreate"; "VG"; "/dev/sda"]; + [["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, Always, TestOutputList ( - [["pvcreate"; "/dev/sda"]; - ["vgcreate"; "VG"; "/dev/sda"]; + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; + ["pvcreate"; "/dev/sda1"]; + ["vgcreate"; "VG"; "/dev/sda1"]; ["lvcreate"; "LV1"; "VG"; "50"]; ["lvcreate"; "LV2"; "VG"; "50"]; ["lvremove"; "/dev/VG"]; @@ -1693,15 +1825,17 @@ the VG name, C."); ("vgremove", (RErr, [String "vgname"]), 78, [], [InitEmpty, Always, TestOutputList ( - [["pvcreate"; "/dev/sda"]; - ["vgcreate"; "VG"; "/dev/sda"]; + [["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, Always, TestOutputList ( - [["pvcreate"; "/dev/sda"]; - ["vgcreate"; "VG"; "/dev/sda"]; + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; + ["pvcreate"; "/dev/sda1"]; + ["vgcreate"; "VG"; "/dev/sda1"]; ["lvcreate"; "LV1"; "VG"; "50"]; ["lvcreate"; "LV2"; "VG"; "50"]; ["vgremove"; "VG"]; @@ -1714,29 +1848,32 @@ This also forcibly removes all logical volumes in the volume group (if any)."); ("pvremove", (RErr, [String "device"]), 79, [], - [InitEmpty, Always, 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, Always, 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, Always, 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", "\ @@ -2069,6 +2206,147 @@ 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 @@ -2176,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. @@ -2293,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 @@ -2337,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 @@ -2491,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 () = @@ -3210,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 @@ -3522,11 +3819,6 @@ and generate_tests () = static guestfs_h *g; static int suppress_error = 0; -/* This will be 's' or 'h' depending on whether the guest kernel - * names IDE devices /dev/sd* or /dev/hd*. - */ -static char devchar = 's'; - static void print_error (guestfs_h *g, void *data, const char *msg) { if (!suppress_error) @@ -3583,11 +3875,9 @@ int main (int argc, char *argv[]) { char c = 0; int failed = 0; - const char *srcdir; const char *filename; - int fd, i; + int fd; int nr_tests, test_num = 0; - char **devs; no_test_warnings (); @@ -3599,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); @@ -3688,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); @@ -3697,28 +3989,6 @@ int main (int argc, char *argv[]) exit (1); } - /* Detect if the appliance uses /dev/sd* or /dev/hd* in device - * names. This changed between RHEL 5 and RHEL 6 so we have to - * support both. - */ - devs = guestfs_list_devices (g); - if (devs == NULL || devs[0] == NULL) { - printf (\"guestfs_list_devices FAILED\\n\"); - exit (1); - } - if (strncmp (devs[0], \"/dev/sd\", 7) == 0) - devchar = 's'; - else if (strncmp (devs[0], \"/dev/hd\", 7) == 0) - devchar = 'h'; - else { - printf (\"guestfs_list_devices returned unexpected string '%%s'\\n\", - devs[0]); - exit (1); - } - for (i = 0; devs[i] != NULL; ++i) - free (devs[i]); - free (devs); - nr_tests = %d; " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests; @@ -3752,6 +4022,20 @@ int main (int argc, char *argv[]) and generate_one_test name i (init, prereq, test) = let test_name = sprintf "test_%s_%d" name i in + 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 -> @@ -3762,22 +4046,33 @@ and generate_one_test name i (init, prereq, test) = pr "\n"; ); - pr "static int %s (void)\n" test_name; - 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 " 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; - pr " } else\n"; - pr " printf (\"%%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name | Unless _ -> - pr " if (! %s_prereq ()) {\n" test_name; + 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; - pr " } else\n"; - pr " printf (\"%%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name | Always -> generate_one_test_body name i test_name init test ); @@ -3789,15 +4084,15 @@ and generate_one_test name i (init, prereq, test) = 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) [["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) [["blockdev_setrw"; "/dev/sda"]; ["umount_all"]; @@ -3806,8 +4101,8 @@ and generate_one_test_body name i test_name init test = ["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) [["blockdev_setrw"; "/dev/sda"]; ["umount_all"]; @@ -3836,9 +4131,6 @@ and generate_one_test_body name i test_name init test = | TestOutput (seq, expected) -> pr " /* TestOutput for %s (%d) */\n" name i; pr " char expected[] = \"%s\";\n" (c_quote expected); - if String.length expected > 7 && - String.sub expected 0 7 = "/dev/sd" then - pr " expected[5] = devchar;\n"; let seq, last = get_seq_last seq in let test () = pr " if (strcmp (r, expected) != 0) {\n"; @@ -3861,8 +4153,35 @@ and generate_one_test_body name i test_name init test = pr " }\n"; pr " {\n"; pr " char expected[] = \"%s\";\n" (c_quote str); - if String.length str > 7 && String.sub str 0 7 = "/dev/sd" then - pr " expected[5] = devchar;\n"; + 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"; @@ -4008,8 +4327,6 @@ and generate_test_command_call ?(expect_error = false) ?test test_name cmd = | String n, arg | OptString n, arg -> pr " char %s[] = \"%s\";\n" n (c_quote arg); - if String.length arg > 7 && String.sub arg 0 7 = "/dev/sd" then - pr " %s[5] = devchar;\n" n | Int _, _ | Bool _, _ | FileIn _, _ | FileOut _, _ -> () @@ -4018,8 +4335,6 @@ and generate_test_command_call ?(expect_error = false) ?test test_name cmd = iteri ( fun i str -> pr " char %s_%d[] = \"%s\";\n" n i (c_quote str); - if String.length str > 7 && String.sub str 0 7 = "/dev/sd" then - pr " %s_%d[5] = devchar;\n" n i ) strs; pr " char *%s[] = {\n" n; iteri ( @@ -4451,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, _, _, _) -> @@ -4465,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; @@ -4511,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 @@ -4614,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 @@ -5167,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 () = @@ -5439,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. *) @@ -5950,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"; @@ -6103,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"; @@ -6117,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); @@ -6337,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"; @@ -6624,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; @@ -6651,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" @@ -6975,6 +7323,402 @@ and generate_haskell_prototype ~handle ?(hs = false) style = ); 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; @@ -7032,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 (); @@ -7068,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 (); @@ -7076,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 (); @@ -7084,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 (); @@ -7116,6 +7880,14 @@ Run it from the top source directory using the command 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 ();