X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=src%2Fgenerator.ml;h=c0a47404b687217117f833a8083b7093075e4f6f;hp=06a638e62e8bd45654b720257e39844dae66f342;hb=92804dec7c4982d2039f81586bc4a5cacb46217b;hpb=99f68f259f92eee884c6c7396f61b9c16e2bf354 diff --git a/src/generator.ml b/src/generator.ml index 06a638e..c0a4740 100755 --- a/src/generator.ml +++ b/src/generator.ml @@ -43,9 +43,15 @@ and ret = *) | RErr (* "RInt" as a return value means an int which is -1 for error - * or any value >= 0 on success. + * or any value >= 0 on success. Only use this for smallish + * positive ints (0 <= i < 2^30). *) | RInt of string + (* "RInt64" is the same as RInt, but is guaranteed to be able + * to return a full 64 bit value, _except_ that -1 means error + * (so -1 cannot be a valid, non-error return value). + *) + | RInt64 of string (* "RBool" is a bool return value which can be true/false or * -1 for error. *) @@ -65,6 +71,18 @@ and ret = | RPVList of string | RVGList of string | RLVList of string + (* Stat buffers. *) + | RStat of string + | RStatVFS of string + (* Key-value pairs of untyped strings. Turns into a hashtable or + * dictionary in languages which support it. DON'T use this as a + * general "bucket" for results. Prefer a stronger typed return + * value if one is available, or write a custom struct. Don't use + * this if the list could potentially be very long, since it is + * inefficient. Keys should be unique. NULLs are not permitted. + *) + | RHashtable of string + and args = argt list (* Function parameters, guestfs handle is implicit. *) (* Note in future we should allow a "variable args" parameter as @@ -77,77 +95,107 @@ and args = argt list (* Function parameters, guestfs handle is implicit. *) and argt = | String of string (* const char *name, cannot be NULL *) | OptString of string (* const char *name, may be NULL *) + | StringList of string(* list of strings (each string cannot be NULL) *) | Bool of string (* boolean *) | Int of string (* int (smallish ints, signed, <= 31 bits) *) type flags = | ProtocolLimitWarning (* display warning about protocol size limits *) + | DangerWillRobinson (* flags particularly dangerous commands *) | 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 *) +let protocol_limit_warning = + "Because of the message protocol, there is a transfer limit +of somewhere between 2MB and 4MB. To transfer large files you should use +FTP." + +let danger_will_robinson = + "B." + (* 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 10M, 20M - * and 30M (respectively /dev/sda, /dev/sdb, /dev/sdc). 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 + * Note that the test environment has 3 block devices, of size 500MB, + * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc). + * Note for partitioning purposes, the 500MB device has 63 cylinders. + * + * 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). * * Don't assume anything about the previous contents of the block * devices. Use 'Init*' to create some initial scenarios. *) -type tests = test list +type tests = (test_init * test) list and test = (* Run the command sequence and just expect nothing to fail. *) - | TestRun of test_init * seq + | TestRun of seq (* Run the command sequence and expect the output of the final * command to be the string. *) - | TestOutput of test_init * seq * string + | TestOutput of seq * string (* Run the command sequence and expect the output of the final * command to be the list of strings. *) - | TestOutputList of test_init * seq * string list + | TestOutputList of seq * string list (* Run the command sequence and expect the output of the final * command to be the integer. *) - | TestOutputInt of test_init * seq * int + | TestOutputInt of seq * int (* Run the command sequence and expect the output of the final * command to be a true value (!= 0 or != NULL). *) - | TestOutputTrue of test_init * seq + | TestOutputTrue of seq (* Run the command sequence and expect the output of the final * command to be a false value (== 0 or == NULL, but not an error). *) - | TestOutputFalse of test_init * seq + | TestOutputFalse of seq (* Run the command sequence and expect the output of the final * command to be a list of the given length (but don't care about * content). *) - | TestOutputLength of test_init * seq * int + | TestOutputLength of seq * int + (* Run the command sequence and expect the output of the final + * command to be a structure. + *) + | TestOutputStruct of seq * test_field_compare list (* Run the command sequence and expect the final command (only) * to fail. *) - | TestLastFail of test_init * seq + | TestLastFail of seq + +and test_field_compare = + | CompareWithInt of string * int + | CompareWithString of string * string + | CompareFieldsIntEq of string * string + | CompareFieldsStrEq of string * string (* Some initial scenarios for testing. *) and test_init = - (* Do nothing, block devices could contain random stuff. *) + (* Do nothing, block devices could contain random stuff including + * LVM PVs, and some filesystems might be mounted. This is usually + * a bad idea. + *) | InitNone + (* Block devices are empty and no filesystems are mounted. *) + | InitEmpty (* /dev/sda contains a single partition /dev/sda1, which is formatted * as ext2, empty [except for lost+found] and mounted on /. * /dev/sdb and /dev/sdc may have random content. * No LVM. *) - | InitEmpty + | InitBasicFS (* /dev/sda: * /dev/sda1 (is a PV): - * /dev/VG/LV: + * /dev/VG/LV (size 8MB): * formatted as ext2, empty [except for lost+found], mounted on / * /dev/sdb and /dev/sdc may have random content. *) - | InitEmptyLVM + | InitBasicFSonLVM (* Sequence of commands for testing. *) and seq = cmd list @@ -281,9 +329,8 @@ This returns the verbose messages flag.") let daemon_functions = [ ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [], - [TestOutput ( - InitNone, - [["sfdisk"]; + [InitEmpty, TestOutput ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; ["mkfs"; "ext2"; "/dev/sda1"]; ["mount"; "/dev/sda1"; "/"]; ["write_file"; "/new"; "new file contents"; "0"]; @@ -308,7 +355,7 @@ The filesystem options C and C are set with this call, in order to improve reliability."); ("sync", (RErr, []), 2, [], - [ TestRun (InitNone, [["sync"]])], + [ InitEmpty, 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 @@ -318,8 +365,7 @@ You should always call this if you have modified a disk image, before closing the handle."); ("touch", (RErr, [String "path"]), 3, [], - [TestOutputTrue ( - InitEmpty, + [InitBasicFS, TestOutputTrue ( [["touch"; "/new"]; ["exists"; "/new"]])], "update file timestamps or create a new file", @@ -329,8 +375,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], - [TestOutput ( - InitEmpty, + [InitBasicFS, TestOutput ( [["write_file"; "/new"; "new file contents"; "0"]; ["cat"; "/new"]], "new file contents")], "list the contents of a file", @@ -355,8 +400,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, [], - [TestOutputList ( - InitEmpty, + [InitBasicFS, TestOutputList ( [["touch"; "/new"]; ["touch"; "/newer"]; ["touch"; "/newest"]; @@ -371,8 +415,7 @@ This command is mostly useful for interactive sessions. Programs should probably use C instead."); ("list_devices", (RStringList "devices", []), 7, [], - [TestOutputList ( - InitNone, + [InitEmpty, TestOutputList ( [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"])], "list the block devices", "\ @@ -381,12 +424,10 @@ List all the block devices. The full block device names are returned, eg. C"); ("list_partitions", (RStringList "partitions", []), 8, [], - [TestOutputList ( - InitEmpty, + [InitBasicFS, TestOutputList ( [["list_partitions"]], ["/dev/sda1"]); - TestOutputList ( - InitEmpty, - [["sfdisk"]; + InitEmpty, TestOutputList ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])], "list the partitions", "\ @@ -398,12 +439,10 @@ This does not return logical volumes. For that you will need to call C."); ("pvs", (RStringList "physvols", []), 9, [], - [TestOutputList ( - InitEmptyLVM, + [InitBasicFSonLVM, TestOutputList ( [["pvs"]], ["/dev/sda1"]); - TestOutputList ( - InitNone, - [["sfdisk"]; + InitEmpty, TestOutputList ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; ["pvcreate"; "/dev/sda1"]; ["pvcreate"; "/dev/sda2"]; ["pvcreate"; "/dev/sda3"]; @@ -419,12 +458,10 @@ PVs (eg. C). See also C."); ("vgs", (RStringList "volgroups", []), 10, [], - [TestOutputList ( - InitEmptyLVM, + [InitBasicFSonLVM, TestOutputList ( [["vgs"]], ["VG"]); - TestOutputList ( - InitNone, - [["sfdisk"]; + InitEmpty, TestOutputList ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; ["pvcreate"; "/dev/sda1"]; ["pvcreate"; "/dev/sda2"]; ["pvcreate"; "/dev/sda3"]; @@ -442,21 +479,19 @@ detected (eg. C). See also C."); ("lvs", (RStringList "logvols", []), 11, [], - [TestOutputList ( - InitEmptyLVM, + [InitBasicFSonLVM, TestOutputList ( [["lvs"]], ["/dev/VG/LV"]); - TestOutputList ( - InitNone, - [["sfdisk"]; + InitEmpty, TestOutputList ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; ["pvcreate"; "/dev/sda1"]; ["pvcreate"; "/dev/sda2"]; ["pvcreate"; "/dev/sda3"]; ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"]; ["vgcreate"; "VG2"; "/dev/sda3"]; - ["lvcreate"; "LV1"; "VG1"; "5000"]; - ["lvcreate"; "LV2"; "VG1"; "5000"]; - ["lvcreate"; "LV3"; "VG2"; "5000"]; - ["lvs"]], ["LV1"; "LV2"; "LV3"])], + ["lvcreate"; "LV1"; "VG1"; "50"]; + ["lvcreate"; "LV2"; "VG1"; "50"]; + ["lvcreate"; "LV3"; "VG2"; "50"]; + ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])], "list the LVM logical volumes (LVs)", "\ List all the logical volumes detected. This is the equivalent @@ -468,39 +503,31 @@ This returns a list of the logical volume device names See also C."); ("pvs_full", (RPVList "physvols", []), 12, [], - [TestOutputLength ( - InitEmptyLVM, - [["pvs"]], 1)], + [], (* XXX how to test? *) "list the LVM physical volumes (PVs)", "\ List all the physical volumes detected. This is the equivalent of the L command. The \"full\" version includes all fields."); ("vgs_full", (RVGList "volgroups", []), 13, [], - [TestOutputLength ( - InitEmptyLVM, - [["pvs"]], 1)], + [], (* XXX how to test? *) "list the LVM volume groups (VGs)", "\ List all the volumes groups detected. This is the equivalent of the L command. The \"full\" version includes all fields."); ("lvs_full", (RLVList "logvols", []), 14, [], - [TestOutputLength ( - InitEmptyLVM, - [["pvs"]], 1)], + [], (* XXX how to test? *) "list the LVM logical volumes (LVs)", "\ 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, [], - [TestOutputList ( - InitEmpty, + [InitBasicFS, TestOutputList ( [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"]; ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]); - TestOutputList ( - InitEmpty, + InitBasicFS, TestOutputList ( [["write_file"; "/new"; ""; "0"]; ["read_lines"; "/new"]], [])], "read file as lines", @@ -675,45 +702,38 @@ This is just a shortcut for listing C C and sorting the resulting nodes into alphabetical order."); ("rm", (RErr, [String "path"]), 29, [], - [TestRun ( - InitEmpty, + [InitBasicFS, TestRun [["touch"; "/new"]; - ["rm"; "/new"]]); - TestLastFail ( - InitEmpty, - [["rm"; "/new"]]); - TestLastFail ( - InitEmpty, + ["rm"; "/new"]]; + InitBasicFS, TestLastFail + [["rm"; "/new"]]; + InitBasicFS, TestLastFail [["mkdir"; "/new"]; - ["rm"; "/new"]])], + ["rm"; "/new"]]], "remove a file", "\ Remove the single file C."); ("rmdir", (RErr, [String "path"]), 30, [], - [TestRun ( - InitEmpty, + [InitBasicFS, TestRun [["mkdir"; "/new"]; - ["rmdir"; "/new"]]); - TestLastFail ( - InitEmpty, - [["rmdir"; "/new"]]); - TestLastFail ( - InitEmpty, + ["rmdir"; "/new"]]; + InitBasicFS, TestLastFail + [["rmdir"; "/new"]]; + InitBasicFS, TestLastFail [["touch"; "/new"]; - ["rmdir"; "/new"]])], + ["rmdir"; "/new"]]], "remove a directory", "\ Remove the single directory C."); ("rm_rf", (RErr, [String "path"]), 31, [], - [TestOutputFalse ( - InitEmpty, + [InitBasicFS, TestOutputFalse [["mkdir"; "/new"]; ["mkdir"; "/new/foo"]; ["touch"; "/new/foo/bar"]; ["rm_rf"; "/new"]; - ["exists"; "/new"]])], + ["exists"; "/new"]]], "remove a file or directory recursively", "\ Remove the file or directory C, recursively removing the @@ -721,27 +741,25 @@ contents if its a directory. This is like the C shell command."); ("mkdir", (RErr, [String "path"]), 32, [], - [TestOutputTrue ( - InitEmpty, + [InitBasicFS, TestOutputTrue [["mkdir"; "/new"]; - ["is_dir"; "/new"]])], + ["is_dir"; "/new"]]; + InitBasicFS, TestLastFail + [["mkdir"; "/new/foo/bar"]]], "create a directory", "\ Create a directory named C."); ("mkdir_p", (RErr, [String "path"]), 33, [], - [TestOutputTrue ( - InitEmpty, + [InitBasicFS, TestOutputTrue [["mkdir_p"; "/new/foo/bar"]; - ["is_dir"; "/new/foo/bar"]]); - TestOutputTrue ( - InitEmpty, + ["is_dir"; "/new/foo/bar"]]; + InitBasicFS, TestOutputTrue [["mkdir_p"; "/new/foo/bar"]; - ["is_dir"; "/new/foo"]]); - TestOutputTrue ( - InitEmpty, + ["is_dir"; "/new/foo"]]; + InitBasicFS, TestOutputTrue [["mkdir_p"; "/new/foo/bar"]; - ["is_dir"; "/new"]])], + ["is_dir"; "/new"]]], "create a directory and parents", "\ Create a directory named C, creating any parent directories @@ -763,6 +781,423 @@ Change the file owner to C and group to C. Only numeric uid and gid are supported. If you want to use 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 ( + [["touch"; "/new"]; + ["exists"; "/new"]]); + InitBasicFS, TestOutputTrue ( + [["mkdir"; "/new"]; + ["exists"; "/new"]])], + "test if file or directory exists", + "\ +This returns C if and only if there is a file, directory +(or anything) with the given C name. + +See also C, C, C."); + + ("is_file", (RBool "fileflag", [String "path"]), 37, [], + [InitBasicFS, TestOutputTrue ( + [["touch"; "/new"]; + ["is_file"; "/new"]]); + InitBasicFS, TestOutputFalse ( + [["mkdir"; "/new"]; + ["is_file"; "/new"]])], + "test if file exists", + "\ +This returns C if and only if there is a file +with the given C name. Note that it returns false for +other objects like directories. + +See also C."); + + ("is_dir", (RBool "dirflag", [String "path"]), 38, [], + [InitBasicFS, TestOutputFalse ( + [["touch"; "/new"]; + ["is_dir"; "/new"]]); + InitBasicFS, TestOutputTrue ( + [["mkdir"; "/new"]; + ["is_dir"; "/new"]])], + "test if file exists", + "\ +This returns C if and only if there is a directory +with the given C name. Note that it returns false for +other objects like files. + +See also C."); + + ("pvcreate", (RErr, [String "device"]), 39, [], + [InitEmpty, TestOutputList ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; + ["pvcreate"; "/dev/sda1"]; + ["pvcreate"; "/dev/sda2"]; + ["pvcreate"; "/dev/sda3"]; + ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])], + "create an LVM physical volume", + "\ +This creates an LVM physical volume on the named C, +where C should usually be a partition name such +as C."); + + ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [], + [InitEmpty, TestOutputList ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; + ["pvcreate"; "/dev/sda1"]; + ["pvcreate"; "/dev/sda2"]; + ["pvcreate"; "/dev/sda3"]; + ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"]; + ["vgcreate"; "VG2"; "/dev/sda3"]; + ["vgs"]], ["VG1"; "VG2"])], + "create an LVM volume group", + "\ +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 ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; + ["pvcreate"; "/dev/sda1"]; + ["pvcreate"; "/dev/sda2"]; + ["pvcreate"; "/dev/sda3"]; + ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"]; + ["vgcreate"; "VG2"; "/dev/sda3"]; + ["lvcreate"; "LV1"; "VG1"; "50"]; + ["lvcreate"; "LV2"; "VG1"; "50"]; + ["lvcreate"; "LV3"; "VG2"; "50"]; + ["lvcreate"; "LV4"; "VG2"; "50"]; + ["lvcreate"; "LV5"; "VG2"; "50"]; + ["lvs"]], + ["/dev/VG1/LV1"; "/dev/VG1/LV2"; + "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])], + "create an LVM volume group", + "\ +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 ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; + ["mkfs"; "ext2"; "/dev/sda1"]; + ["mount"; "/dev/sda1"; "/"]; + ["write_file"; "/new"; "new file contents"; "0"]; + ["cat"; "/new"]], "new file contents")], + "make a filesystem", + "\ +This creates a filesystem on C (usually a partition +of LVM logical volume). The filesystem type is C, for +example C."); + + ("sfdisk", (RErr, [String "device"; + Int "cyls"; Int "heads"; Int "sectors"; + StringList "lines"]), 43, [DangerWillRobinson], + [], + "create partitions on a block device", + "\ +This is a direct interface to the L program for creating +partitions on block devices. + +C should be a block device, for example C. + +C, C and C are the number of cylinders, heads +and sectors on the device, which are passed directly to sfdisk as +the I<-C>, I<-H> and I<-S> parameters. If you pass C<0> for any +of these, then the corresponding parameter is omitted. Usually for +'large' disks, you can just pass C<0> for these, but for small +(floppy-sized) disks, sfdisk (or rather, the kernel) cannot work +out the right geometry and you will need to tell it. + +C is a list of lines that we feed to C. For more +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)."); + + ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning], + [InitBasicFS, TestOutput ( + [["write_file"; "/new"; "new file contents"; "0"]; + ["cat"; "/new"]], "new file contents"); + InitBasicFS, TestOutput ( + [["write_file"; "/new"; "\nnew file contents\n"; "0"]; + ["cat"; "/new"]], "\nnew file contents\n"); + InitBasicFS, TestOutput ( + [["write_file"; "/new"; "\n\n"; "0"]; + ["cat"; "/new"]], "\n\n"); + InitBasicFS, TestOutput ( + [["write_file"; "/new"; ""; "0"]; + ["cat"; "/new"]], ""); + InitBasicFS, TestOutput ( + [["write_file"; "/new"; "\n\n\n"; "0"]; + ["cat"; "/new"]], "\n\n\n"); + InitBasicFS, TestOutput ( + [["write_file"; "/new"; "\n"; "0"]; + ["cat"; "/new"]], "\n")], + "create a file", + "\ +This call creates a file called C. The contents of the +file is the string C (which can contain any 8 bit data), +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)."); + + ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"], + [InitEmpty, TestOutputList ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; + ["mkfs"; "ext2"; "/dev/sda1"]; + ["mount"; "/dev/sda1"; "/"]; + ["mounts"]], ["/dev/sda1"]); + InitEmpty, TestOutputList ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; + ["mkfs"; "ext2"; "/dev/sda1"]; + ["mount"; "/dev/sda1"; "/"]; + ["umount"; "/"]; + ["mounts"]], [])], + "unmount a filesystem", + "\ +This unmounts the given filesystem. The filesystem may be +specified either by its mountpoint (path) or the device which +contains the filesystem."); + + ("mounts", (RStringList "devices", []), 46, [], + [InitBasicFS, TestOutputList ( + [["mounts"]], ["/dev/sda1"])], + "show mounted filesystems", + "\ +This returns the list of currently mounted filesystems. It returns +the list of devices (eg. C, C). + +Some internal mounts are not shown."); + + ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"], + [InitBasicFS, TestOutputList ( + [["umount_all"]; + ["mounts"]], [])], + "unmount all filesystems", + "\ +This unmounts all mounted filesystems. + +Some internal mounts are not unmounted by this call."); + + ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson], + [], + "remove all LVM LVs, VGs and PVs", + "\ +This command removes all LVM logical volumes, volume groups +and physical volumes."); + + ("file", (RString "description", [String "path"]), 49, [], + [InitBasicFS, TestOutput ( + [["touch"; "/new"]; + ["file"; "/new"]], "empty"); + InitBasicFS, TestOutput ( + [["write_file"; "/new"; "some content\n"; "0"]; + ["file"; "/new"]], "ASCII text"); + InitBasicFS, TestLastFail ( + [["file"; "/nofile"]])], + "determine file type", + "\ +This call uses the standard L command to determine +the type or contents of the file. This also works on devices, +for example to find out whether a partition contains a filesystem. + +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? *) + "run a command from the guest filesystem", + "\ +This call runs a command from the guest filesystem. The +filesystem must be mounted, and must contain a compatible +operating system (ie. something Linux, with the same +or compatible processor architecture). + +The single parameter is an argv-style list of arguments. +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 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 +first parameter. + +Shared libraries and data files required by the program +must be available on filesystems which are mounted in the +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? *) + "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 ( + [["touch"; "/new"]; + ["stat"; "/new"]], [CompareWithInt ("size", 0)])], + "get file information", + "\ +Returns file information for the given C. + +This is the same as the C system call."); + + ("lstat", (RStat "statbuf", [String "path"]), 53, [], + [InitBasicFS, TestOutputStruct ( + [["touch"; "/new"]; + ["lstat"; "/new"]], [CompareWithInt ("size", 0)])], + "get file information for a symbolic link", + "\ +Returns file information for the given C. + +This is the same as C except that if C +is a symbolic link, then the link is stat-ed, not the file it +refers to. + +This is the same as the C system call."); + + ("statvfs", (RStatVFS "statbuf", [String "path"]), 54, [], + [InitBasicFS, TestOutputStruct ( + [["statvfs"; "/"]], [CompareWithInt ("bfree", 487702); + CompareWithInt ("blocks", 490020); + CompareWithInt ("bsize", 1024)])], + "get file system statistics", + "\ +Returns file system statistics for any mounted file system. +C should be a file or directory in the mounted file system +(typically it is the mount point itself, but it doesn't need to be). + +This is the same as the C system call."); + + ("tune2fs_l", (RHashtable "superblock", [String "device"]), 55, [], + [], (* XXX test *) + "get ext2/ext3 superblock details", + "\ +This returns the contents of the ext2 or ext3 filesystem superblock +on C. + +It is the same as running C. See L +manpage for more details. The list of fields returned isn't +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 ( + [["blockdev_setro"; "/dev/sda"]; + ["blockdev_getro"; "/dev/sda"]])], + "set block device to read-only", + "\ +Sets the block device named C to read-only. + +This uses the L command."); + + ("blockdev_setrw", (RErr, [String "device"]), 57, [], + [InitEmpty, TestOutputFalse ( + [["blockdev_setrw"; "/dev/sda"]; + ["blockdev_getro"; "/dev/sda"]])], + "set block device to read-write", + "\ +Sets the block device named C to read-write. + +This uses the L command."); + + ("blockdev_getro", (RBool "ro", [String "device"]), 58, [], + [InitEmpty, TestOutputTrue ( + [["blockdev_setro"; "/dev/sda"]; + ["blockdev_getro"; "/dev/sda"]])], + "is block device set to read-only", + "\ +Returns a boolean indicating if the block device is read-only +(true if read-only, false if not). + +This uses the L command."); + + ("blockdev_getss", (RInt "sectorsize", [String "device"]), 59, [], + [InitEmpty, TestOutputInt ( + [["blockdev_getss"; "/dev/sda"]], 512)], + "get sectorsize of block device", + "\ +This returns the size of sectors on a block device. +Usually 512, but can be larger for modern devices. + +(Note, this is not the size in sectors, use C +for that). + +This uses the L command."); + + ("blockdev_getbsz", (RInt "blocksize", [String "device"]), 60, [], + [InitEmpty, TestOutputInt ( + [["blockdev_getbsz"; "/dev/sda"]], 4096)], + "get blocksize of block device", + "\ +This returns the block size of a device. + +(Note this is different from both I and +I). + +This uses the L command."); + + ("blockdev_setbsz", (RErr, [String "device"; Int "blocksize"]), 61, [], + [], (* XXX test *) + "set blocksize of block device", + "\ +This sets the block size of a device. + +(Note this is different from both I and +I). + +This uses the L command."); + + ("blockdev_getsz", (RInt64 "sizeinsectors", [String "device"]), 62, [], + [InitEmpty, TestOutputInt ( + [["blockdev_getsz"; "/dev/sda"]], 1024000)], + "get total size of device in 512-byte sectors", + "\ +This returns the size of the device in units of 512-byte sectors +(even if the sectorsize isn't 512 bytes ... weird). + +See also C for the real sector size of +the device, and C for the more +useful I. + +This uses the L command."); + + ("blockdev_getsize64", (RInt64 "sizeinbytes", [String "device"]), 63, [], + [InitEmpty, TestOutputInt ( + [["blockdev_getsize64"; "/dev/sda"]], 524288000)], + "get total size of device in bytes", + "\ +This returns the size of the device in bytes. + +See also C. + +This uses the L command."); + + ("blockdev_flushbufs", (RErr, [String "device"]), 64, [], + [InitEmpty, TestRun + [["blockdev_flushbufs"; "/dev/sda"]]], + "flush device buffers", + "\ +This tells the kernel to flush internal buffers associated +with C. + +This uses the L command."); + + ("blockdev_rereadpt", (RErr, [String "device"]), 65, [], + [InitEmpty, TestRun + [["blockdev_rereadpt"; "/dev/sda"]]], + "reread partition table", + "\ +Reread the partition table on C. + +This uses the L command."); + ] let all_functions = non_daemon_functions @ daemon_functions @@ -837,6 +1272,39 @@ let lv_cols = [ "modules", `String; ] +(* Column names and types from stat structures. + * NB. Can't use things like 'st_atime' because glibc header files + * define some of these as macros. Ugh. + *) +let stat_cols = [ + "dev", `Int; + "ino", `Int; + "mode", `Int; + "nlink", `Int; + "uid", `Int; + "gid", `Int; + "rdev", `Int; + "size", `Int; + "blksize", `Int; + "blocks", `Int; + "atime", `Int; + "mtime", `Int; + "ctime", `Int; +] +let statvfs_cols = [ + "bsize", `Int; + "frsize", `Int; + "blocks", `Int; + "bfree", `Int; + "bavail", `Int; + "files", `Int; + "ffree", `Int; + "favail", `Int; + "fsid", `Int; + "flag", `Int; + "namemax", `Int; +] + (* Useful functions. * Note we don't want to use any external OCaml libraries which * makes this a bit harder than it should be. @@ -854,6 +1322,31 @@ let replace_char s c1 c2 = done; if not !r then s else s2 +let isspace c = + c = ' ' + (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *) + +let triml ?(test = isspace) str = + let i = ref 0 in + let n = ref (String.length str) in + while !n > 0 && test str.[!i]; do + decr n; + incr i + done; + if !i = 0 then str + else String.sub str !i !n + +let trimr ?(test = isspace) str = + let n = ref (String.length str) in + while !n > 0 && test str.[!n-1]; do + decr n + done; + if !n = String.length str then str + else String.sub str 0 !n + +let trim ?(test = isspace) str = + trimr ~test (triml ~test str) + let rec find s sub = let len = String.length s in let sublen = String.length sub in @@ -884,6 +1377,17 @@ let rec replace_str s s1 s2 = s' ^ s2 ^ replace_str s'' s1 s2 ) +let rec string_split sep str = + let len = String.length str in + let seplen = String.length sep in + let i = find str sep in + if i = -1 then [str] + else ( + let s' = String.sub str 0 i in + let s'' = String.sub str (i+seplen) (len-i-seplen) in + s' :: string_split sep s'' + ) + let rec find_map f = function | [] -> raise Not_found | x :: xs -> @@ -898,7 +1402,21 @@ let iteri f xs = in loop 0 xs -let name_of_argt = function String n | OptString n | Bool n | Int n -> n +let mapi f xs = + let rec loop i = function + | [] -> [] + | x :: xs -> let r = f i x in r :: loop (i+1) xs + in + loop 0 xs + +let name_of_argt = function + | String n | OptString n | StringList n | Bool n | Int n -> n + +let seq_of_test = function + | TestRun s | TestOutput (s, _) | TestOutputList (s, _) + | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s + | TestOutputLength (s, _) | TestOutputStruct (s, _) + | TestLastFail s -> s (* Check function names etc. for consistency. *) let check_functions () = @@ -938,13 +1456,17 @@ 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" n; + 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 in (match fst style with | RErr -> () - | RInt n | RBool n | RConstString n | RString n - | RStringList n | RPVList n | RVGList n | RLVList n -> + | RInt n | RInt64 n | RBool n | RConstString n | RString n + | RStringList n | RPVList n | RVGList n | RLVList n + | RStat n | RStatVFS n + | RHashtable n -> check_arg_ret_name n | RIntBool (n,m) -> check_arg_ret_name n; @@ -953,6 +1475,16 @@ let check_functions () = List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style) ) all_functions; + (* Check short descriptions. *) + List.iter ( + fun (name, _, _, _, _, shortdesc, _) -> + if shortdesc.[0] <> Char.lowercase shortdesc.[0] then + failwithf "short description of %s should begin with lowercase." name; + let c = shortdesc.[String.length shortdesc-1] in + if c = '\n' || c = '.' then + failwithf "short description of %s should not end with . or \\n." name + ) all_functions; + (* Check long dscriptions. *) List.iter ( fun (name, _, _, _, _, _, longdesc) -> @@ -987,7 +1519,31 @@ let check_functions () = failwithf "%s and %s have conflicting procedure numbers (%d, %d)" name1 name2 nr1 nr2 in - loop proc_nrs + loop proc_nrs; + + (* Check tests. *) + List.iter ( + function + (* Ignore functions that have no tests. We generate a + * warning when the user does 'make check' instead. + *) + | name, _, _, _, [], _, _ -> () + | name, _, _, _, tests, _, _ -> + let funcs = + List.map ( + fun (_, test) -> + match seq_of_test test with + | [] -> + failwithf "%s has a test containing an empty sequence" name + | cmds -> List.map List.hd cmds + ) tests in + let funcs = List.flatten funcs in + + let tested = List.mem name funcs in + + if not tested then + failwithf "function %s has tests but does not test itself" name + ) all_functions (* 'pr' prints to the current output file. *) let chan = ref stdout @@ -1063,35 +1619,60 @@ let rec generate_actions_pod () = 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. + 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. + pr "This function returns a string, or NULL on error. I.\n\n" | 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. + 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. + 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. + 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. + 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 +(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 +(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 +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 "Because of the message protocol, there is a transfer limit -of somewhere between 2MB and 4MB. To transfer large files you should use -FTP.\n\n"; + 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 () = @@ -1157,6 +1738,18 @@ and generate_xdr () = pr "\n"; ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]; + (* Stat internal structures. *) + List.iter ( + function + | typ, cols -> + pr "struct guestfs_int_%s {\n" typ; + List.iter (function + | name, `Int -> pr " hyper %s;\n" name + ) cols; + pr "};\n"; + pr "\n"; + ) ["stat", stat_cols; "statvfs", statvfs_cols]; + List.iter ( fun (shortname, style, _, _, _, _, _) -> let name = "guestfs_" ^ shortname in @@ -1169,6 +1762,7 @@ and generate_xdr () = function | String n -> pr " string %s<>;\n" n | OptString n -> pr " str *%s;\n" n + | StringList n -> pr " str %s<>;\n" n | Bool n -> pr " bool %s;\n" n | Int n -> pr " int %s;\n" n ) args; @@ -1180,6 +1774,10 @@ and generate_xdr () = pr "struct %s_ret {\n" name; pr " int %s;\n" n; pr "};\n\n" + | RInt64 n -> + pr "struct %s_ret {\n" name; + pr " hyper %s;\n" n; + pr "};\n\n" | RBool n -> pr "struct %s_ret {\n" name; pr " bool %s;\n" n; @@ -1211,6 +1809,18 @@ and generate_xdr () = pr "struct %s_ret {\n" name; pr " guestfs_lvm_int_lv_list %s;\n" n; pr "};\n\n" + | RStat n -> + pr "struct %s_ret {\n" name; + pr " guestfs_int_stat %s;\n" n; + pr "};\n\n" + | RStatVFS n -> + pr "struct %s_ret {\n" name; + pr " guestfs_int_statvfs %s;\n" n; + pr "};\n\n" + | RHashtable n -> + pr "struct %s_ret {\n" name; + pr " str %s<>;\n" n; + pr "};\n\n" ); ) daemon_functions; @@ -1309,7 +1919,20 @@ and generate_structs_h () = pr " struct guestfs_lvm_%s *val;\n" typ; pr "};\n"; pr "\n" - ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols] + ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]; + + (* Stat structures. *) + List.iter ( + function + | typ, cols -> + pr "struct guestfs_%s {\n" typ; + List.iter ( + function + | name, `Int -> pr " int64_t %s;\n" name + ) cols; + pr "};\n"; + pr "\n" + ) ["stat", stat_cols; "statvfs", statvfs_cols] (* Generate the guestfs-actions.h file. *) and generate_actions_h () = @@ -1339,10 +1962,12 @@ and generate_client_actions () = | RErr -> () | RConstString _ -> failwithf "RConstString cannot be returned from a daemon function" - | RInt _ + | RInt _ | RInt64 _ | RBool _ | RString _ | RStringList _ | RIntBool _ - | RPVList _ | RVGList _ | RLVList _ -> + | RPVList _ | RVGList _ | RLVList _ + | RStat _ | RStatVFS _ + | RHashtable _ -> pr " struct %s_ret ret;\n" name ); pr "};\n\n"; @@ -1368,10 +1993,12 @@ and generate_client_actions () = | RErr -> () | RConstString _ -> failwithf "RConstString cannot be returned from a daemon function" - | RInt _ + | RInt _ | RInt64 _ | RBool _ | RString _ | RStringList _ | RIntBool _ - | RPVList _ | RVGList _ | RLVList _ -> + | RPVList _ | RVGList _ | RLVList _ + | RStat _ | RStatVFS _ + | RHashtable _ -> pr " if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name; pr " error (g, \"%s: failed to parse reply\");\n" name; pr " return;\n"; @@ -1389,11 +2016,13 @@ and generate_client_actions () = let error_code = match fst style with - | RErr | RInt _ | RBool _ -> "-1" + | RErr | RInt _ | RInt64 _ | RBool _ -> "-1" | RConstString _ -> failwithf "RConstString cannot be returned from a daemon function" | RString _ | RStringList _ | RIntBool _ - | RPVList _ | RVGList _ | RLVList _ -> + | RPVList _ | RVGList _ | RLVList _ + | RStat _ | RStatVFS _ + | RHashtable _ -> "NULL" in pr "{\n"; @@ -1427,6 +2056,9 @@ and generate_client_actions () = pr " args.%s = (char *) %s;\n" n n | OptString n -> pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n + | StringList n -> + pr " args.%s.%s_val = (char **) %s;\n" n n n; + pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n; | Bool n -> pr " args.%s = %s;\n" n n | Int n -> @@ -1466,13 +2098,13 @@ and generate_client_actions () = (match fst style with | RErr -> pr " return 0;\n" - | RInt n - | RBool n -> pr " return rv.ret.%s;\n" n + | RInt n | RInt64 n | RBool n -> + pr " return rv.ret.%s;\n" n | RConstString _ -> failwithf "RConstString cannot be returned from a daemon function" | RString n -> pr " return rv.ret.%s; /* caller will free */\n" n - | RStringList n -> + | RStringList n | RHashtable n -> pr " /* caller will free this, but we need to add a NULL entry */\n"; pr " rv.ret.%s.%s_val =" n n; pr " safe_realloc (g, rv.ret.%s.%s_val,\n" n n; @@ -1483,13 +2115,8 @@ and generate_client_actions () = | RIntBool _ -> pr " /* caller with free this */\n"; pr " return safe_memdup (g, &rv.ret, sizeof (rv.ret));\n" - | RPVList n -> - pr " /* caller will free this */\n"; - pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n - | RVGList n -> - pr " /* caller will free this */\n"; - pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n - | RLVList n -> + | RPVList n | RVGList n | RLVList n + | RStat n | RStatVFS n -> pr " /* caller will free this */\n"; pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n ); @@ -1538,15 +2165,18 @@ and generate_daemon_actions () = let error_code = match fst style with | RErr | RInt _ -> pr " int r;\n"; "-1" + | RInt64 _ -> pr " int64_t r;\n"; "-1" | RBool _ -> pr " int r;\n"; "-1" | RConstString _ -> failwithf "RConstString cannot be returned from a daemon function" | RString _ -> pr " char *r;\n"; "NULL" - | RStringList _ -> pr " char **r;\n"; "NULL" + | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL" | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL" | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL" | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL" - | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL" in + | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL" + | RStat _ -> pr " guestfs_int_stat *r;\n"; "NULL" + | RStatVFS _ -> pr " guestfs_int_statvfs *r;\n"; "NULL" in (match snd style with | [] -> () @@ -1556,6 +2186,7 @@ and generate_daemon_actions () = function | String n | OptString n -> pr " const 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 ) args @@ -1575,6 +2206,10 @@ and generate_daemon_actions () = function | String n -> pr " %s = args.%s;\n" n n | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n + | StringList n -> + pr " args.%s.%s_val = realloc (args.%s.%s_val, sizeof (char *) * (args.%s.%s_len+1));\n" n n n n n n; + pr " args.%s.%s_val[args.%s.%s_len] = NULL;\n" n n n n; + pr " %s = args.%s.%s_val;\n" n n n | Bool n -> pr " %s = args.%s;\n" n n | Int n -> pr " %s = args.%s;\n" n n ) args; @@ -1586,17 +2221,13 @@ and generate_daemon_actions () = pr ";\n"; pr " if (r == %s)\n" error_code; - pr " /* do_%s has already called reply_with_error, so just return */\n" name; - pr " return;\n"; + pr " /* do_%s has already called reply_with_error */\n" name; + pr " goto done;\n"; pr "\n"; (match fst style with | RErr -> pr " reply (NULL, NULL);\n" - | RInt n -> - pr " struct guestfs_%s_ret ret;\n" name; - pr " ret.%s = r;\n" n; - pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name - | RBool n -> + | RInt n | RInt64 n | RBool n -> pr " struct guestfs_%s_ret ret;\n" name; pr " ret.%s = r;\n" n; pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name @@ -1607,7 +2238,7 @@ and generate_daemon_actions () = pr " ret.%s = r;\n" n; pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name; pr " free (r);\n" - | RStringList n -> + | RStringList n | RHashtable n -> pr " struct guestfs_%s_ret ret;\n" name; pr " ret.%s.%s_len = count_strings (r);\n" n n; pr " ret.%s.%s_val = r;\n" n n; @@ -1616,23 +2247,24 @@ and generate_daemon_actions () = | RIntBool _ -> pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name; pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name - | RPVList n -> - pr " struct guestfs_%s_ret ret;\n" name; - pr " ret.%s = *r;\n" n; - pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name; - pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name - | RVGList n -> - pr " struct guestfs_%s_ret ret;\n" name; - pr " ret.%s = *r;\n" n; - pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name; - pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name - | RLVList n -> + | RPVList n | RVGList n | RLVList n + | RStat n | RStatVFS n -> pr " struct guestfs_%s_ret ret;\n" name; pr " ret.%s = *r;\n" n; pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name; pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name ); + (* Free the args. *) + (match snd style with + | [] -> + pr "done: ;\n"; + | _ -> + pr "done:\n"; + pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n" + name + ); + pr "}\n\n"; ) daemon_functions; @@ -1762,6 +2394,7 @@ and generate_daemon_actions () = pr " reply_with_error (\"%%s\", err);\n"; pr " free (out);\n"; pr " free (err);\n"; + pr " free (ret);\n"; pr " return NULL;\n"; pr " }\n"; pr "\n"; @@ -1823,29 +2456,543 @@ and generate_daemon_actions () = and generate_tests () = generate_header CStyle GPLv2; - pr "#include \n"; - pr "#include \n"; - pr "#include \n"; - pr "\n"; - pr "#include \"guestfs.h\"\n"; - pr "\n"; + pr "\ +#include +#include +#include +#include +#include +#include +#include \"guestfs.h\" +static guestfs_h *g; +static int suppress_error = 0; - pr "int main (int argc, char *argv[])\n"; - pr "{\n"; - pr " exit (0);\n"; - pr "}\n" +static void print_error (guestfs_h *g, void *data, const char *msg) +{ + if (!suppress_error) + fprintf (stderr, \"%%s\\n\", msg); +} -(* Generate a lot of different functions for guestfish. *) -and generate_fish_cmds () = - generate_header CStyle GPLv2; +static void print_strings (char * const * const argv) +{ + int argc; - let all_functions = - List.filter ( - fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags) - ) all_functions in - let all_functions_sorted = + for (argc = 0; argv[argc] != NULL; ++argc) + printf (\"\\t%%s\\n\", argv[argc]); +} + +/* +static void print_table (char * const * const argv) +{ + int i; + + for (i = 0; argv[i] != NULL; i += 2) + printf (\"%%s: %%s\\n\", argv[i], argv[i+1]); +} +*/ + +static void no_test_warnings (void) +{ +"; + + List.iter ( + function + | name, _, _, _, [], _, _ -> + pr " fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name + | name, _, _, _, tests, _, _ -> () + ) all_functions; + + pr "}\n"; + pr "\n"; + + (* Generate the actual tests. Note that we generate the tests + * in reverse order, deliberately, so that (in general) the + * newest tests run first. This makes it quicker and easier to + * debug them. + *) + let test_names = + List.map ( + fun (name, _, _, _, tests, _, _) -> + mapi (generate_one_test name) tests + ) (List.rev all_functions) in + let test_names = List.concat test_names in + let nr_tests = List.length test_names in + + pr "\ +int main (int argc, char *argv[]) +{ + char c = 0; + int failed = 0; + const char *srcdir; + int fd; + char buf[256]; + int nr_tests, test_num = 0; + + no_test_warnings (); + + g = guestfs_create (); + if (g == NULL) { + printf (\"guestfs_create FAILED\\n\"); + exit (1); + } + + guestfs_set_error_handler (g, print_error, NULL); + + srcdir = getenv (\"srcdir\"); + if (!srcdir) srcdir = \".\"; + guestfs_set_path (g, srcdir); + + snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir); + fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666); + if (fd == -1) { + perror (buf); + exit (1); + } + if (lseek (fd, %d, SEEK_SET) == -1) { + perror (\"lseek\"); + close (fd); + unlink (buf); + exit (1); + } + if (write (fd, &c, 1) == -1) { + perror (\"write\"); + close (fd); + unlink (buf); + exit (1); + } + if (close (fd) == -1) { + perror (buf); + unlink (buf); + exit (1); + } + if (guestfs_add_drive (g, buf) == -1) { + printf (\"guestfs_add_drive %%s FAILED\\n\", buf); + exit (1); + } + + snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir); + fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666); + if (fd == -1) { + perror (buf); + exit (1); + } + if (lseek (fd, %d, SEEK_SET) == -1) { + perror (\"lseek\"); + close (fd); + unlink (buf); + exit (1); + } + if (write (fd, &c, 1) == -1) { + perror (\"write\"); + close (fd); + unlink (buf); + exit (1); + } + if (close (fd) == -1) { + perror (buf); + unlink (buf); + exit (1); + } + if (guestfs_add_drive (g, buf) == -1) { + printf (\"guestfs_add_drive %%s FAILED\\n\", buf); + exit (1); + } + + snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir); + fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666); + if (fd == -1) { + perror (buf); + exit (1); + } + if (lseek (fd, %d, SEEK_SET) == -1) { + perror (\"lseek\"); + close (fd); + unlink (buf); + exit (1); + } + if (write (fd, &c, 1) == -1) { + perror (\"write\"); + close (fd); + unlink (buf); + exit (1); + } + if (close (fd) == -1) { + perror (buf); + unlink (buf); + exit (1); + } + if (guestfs_add_drive (g, buf) == -1) { + printf (\"guestfs_add_drive %%s FAILED\\n\", buf); + exit (1); + } + + if (guestfs_launch (g) == -1) { + printf (\"guestfs_launch FAILED\\n\"); + exit (1); + } + if (guestfs_wait_ready (g) == -1) { + printf (\"guestfs_wait_ready FAILED\\n\"); + exit (1); + } + + nr_tests = %d; + +" (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests; + + iteri ( + fun i test_name -> + pr " test_num++;\n"; + pr " printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name; + pr " if (%s () == -1) {\n" test_name; + pr " printf (\"%s FAILED\\n\");\n" test_name; + pr " failed++;\n"; + pr " }\n"; + ) test_names; + pr "\n"; + + pr " guestfs_close (g);\n"; + pr " snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);\n"; + pr " unlink (buf);\n"; + pr " snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);\n"; + pr " unlink (buf);\n"; + pr " snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);\n"; + pr " unlink (buf);\n"; + pr "\n"; + + pr " if (failed > 0) {\n"; + pr " printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n"; + pr " exit (1);\n"; + pr " }\n"; + pr "\n"; + + pr " exit (0);\n"; + pr "}\n" + +and generate_one_test name i (init, test) = + let test_name = sprintf "test_%s_%d" name i in + + pr "static int %s (void)\n" test_name; + pr "{\n"; + + (match init with + | InitNone -> () + | InitEmpty -> + pr " /* InitEmpty for %s (%d) */\n" name i; + List.iter (generate_test_command_call test_name) + [["umount_all"]; + ["lvm_remove_all"]] + | InitBasicFS -> + pr " /* InitBasicFS for %s (%d): create ext2 on /dev/sda1 */\n" name i; + List.iter (generate_test_command_call test_name) + [["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; + List.iter (generate_test_command_call test_name) + [["umount_all"]; + ["lvm_remove_all"]; + ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","]; + ["pvcreate"; "/dev/sda1"]; + ["vgcreate"; "VG"; "/dev/sda1"]; + ["lvcreate"; "LV"; "VG"; "8"]; + ["mkfs"; "ext2"; "/dev/VG/LV"]; + ["mount"; "/dev/VG/LV"; "/"]] + ); + + let get_seq_last = function + | [] -> + failwithf "%s: you cannot use [] (empty list) when expecting a command" + test_name + | seq -> + let seq = List.rev seq in + 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 + +(* 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. + *) +and generate_test_command_call ?(expect_error = false) ?test test_name cmd = + match cmd with + | [] -> assert false + | name :: args -> + (* Look up the command to find out what args/ret it has. *) + let style = + try + let _, style, _, _, _, _, _ = + List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in + style + with Not_found -> + failwithf "%s: in test, command %s was not found" test_name name in + + if List.length (snd style) <> List.length args then + failwithf "%s: in test, wrong number of args given to %s" + test_name name; + + pr " {\n"; + + List.iter ( + function + | String _, _ + | OptString _, _ + | Int _, _ + | Bool _, _ -> () + | StringList n, arg -> + pr " char *%s[] = {\n" n; + let strs = string_split " " arg in + List.iter ( + fun str -> pr " \"%s\",\n" (c_quote str) + ) strs; + pr " NULL\n"; + pr " };\n"; + ) (List.combine (snd style) args); + + let error_code = + match fst style with + | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1" + | RInt64 _ -> pr " int64_t r;\n"; "-1" + | RConstString _ -> pr " const char *r;\n"; "NULL" + | RString _ -> pr " char *r;\n"; "NULL" + | RStringList _ | RHashtable _ -> + pr " char **r;\n"; + pr " int i;\n"; + "NULL" + | RIntBool _ -> + pr " struct guestfs_int_bool *r;\n"; "NULL" + | RPVList _ -> + pr " struct guestfs_lvm_pv_list *r;\n"; "NULL" + | RVGList _ -> + pr " struct guestfs_lvm_vg_list *r;\n"; "NULL" + | RLVList _ -> + pr " struct guestfs_lvm_lv_list *r;\n"; "NULL" + | RStat _ -> + pr " struct guestfs_stat *r;\n"; "NULL" + | RStatVFS _ -> + pr " struct guestfs_statvfs *r;\n"; "NULL" in + + pr " suppress_error = %d;\n" (if expect_error then 1 else 0); + pr " r = guestfs_%s (g" name; + + (* Generate the parameters. *) + List.iter ( + function + | String _, 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 -> + let i = + try int_of_string arg + with Failure "int_of_string" -> + failwithf "%s: expecting an int, but got '%s'" test_name arg in + pr ", %d" i + | Bool _, arg -> + let b = bool_of_string arg in pr ", %d" (if b then 1 else 0) + ) (List.combine (snd style) args); + + pr ");\n"; + if not expect_error then + pr " if (r == %s)\n" error_code + else + pr " if (r != %s)\n" error_code; + pr " return -1;\n"; + + (* Insert the test code. *) + (match test with + | None -> () + | Some f -> f () + ); + + (match fst style with + | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ -> () + | RString _ -> pr " free (r);\n" + | RStringList _ | RHashtable _ -> + pr " for (i = 0; r[i] != NULL; ++i)\n"; + pr " free (r[i]);\n"; + pr " free (r);\n" + | RIntBool _ -> + pr " guestfs_free_int_bool (r);\n" + | RPVList _ -> + pr " guestfs_free_lvm_pv_list (r);\n" + | RVGList _ -> + pr " guestfs_free_lvm_vg_list (r);\n" + | RLVList _ -> + pr " guestfs_free_lvm_lv_list (r);\n" + | RStat _ | RStatVFS _ -> + pr " free (r);\n" + ); + + pr " }\n" + +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 + str + +(* Generate a lot of different functions for guestfish. *) +and generate_fish_cmds () = + generate_header CStyle GPLv2; + + let all_functions = + List.filter ( + fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags) + ) all_functions in + let all_functions_sorted = List.filter ( fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags) ) all_functions_sorted in @@ -1893,11 +3040,19 @@ and generate_fish_cmds () = let warnings = if List.mem ProtocolLimitWarning flags then - "\n\nBecause of the message protocol, there is a transfer limit -of somewhere between 2MB and 4MB. To transfer large files you should use -FTP." + ("\n\n" ^ protocol_limit_warning) else "" in + (* For DangerWillRobinson commands, we should probably have + * guestfish prompt before allowing you to use them (especially + * in interactive mode). XXX + *) + let warnings = + warnings ^ + if List.mem DangerWillRobinson flags then + ("\n\n" ^ danger_will_robinson) + else "" in + let describe_alias = if name <> alias then sprintf "\n\nYou can use '%s' as an alias for this command." alias @@ -1958,6 +3113,21 @@ FTP." pr "\n"; ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]; + (* print_{stat,statvfs} functions *) + List.iter ( + function + | typ, cols -> + pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ; + pr "{\n"; + List.iter ( + function + | name, `Int -> + pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name + ) cols; + pr "}\n"; + pr "\n"; + ) ["stat", stat_cols; "statvfs", statvfs_cols]; + (* run_ actions *) List.iter ( fun (name, style, _, flags, _, _, _) -> @@ -1967,18 +3137,22 @@ FTP." | RErr | RInt _ | RBool _ -> pr " int r;\n" + | RInt64 _ -> pr " int64_t r;\n" | RConstString _ -> pr " const char *r;\n" | RString _ -> pr " char *r;\n" - | RStringList _ -> pr " char **r;\n" + | RStringList _ | RHashtable _ -> pr " char **r;\n" | RIntBool _ -> pr " struct guestfs_int_bool *r;\n" | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n" | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n" | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n" + | RStat _ -> pr " struct guestfs_stat *r;\n" + | RStatVFS _ -> pr " struct guestfs_statvfs *r;\n" ); List.iter ( function - | String n -> pr " const char *%s;\n" n + | String n | OptString n -> pr " const 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 ) (snd style); @@ -1998,6 +3172,8 @@ FTP." | OptString name -> pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n" name i i + | StringList name -> + pr " %s = parse_string_list (argv[%d]);\n" name i | Bool name -> pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i | Int name -> @@ -2017,7 +3193,11 @@ FTP." | RErr -> pr " return r;\n" | RInt _ -> pr " if (r == -1) return -1;\n"; - pr " if (r) printf (\"%%d\\n\", r);\n"; + pr " printf (\"%%d\\n\", r);\n"; + pr " return 0;\n" + | RInt64 _ -> + pr " if (r == -1) return -1;\n"; + pr " printf (\"%%\" PRIi64 \"\\n\", r);\n"; pr " return 0;\n" | RBool _ -> pr " if (r == -1) return -1;\n"; @@ -2058,6 +3238,21 @@ FTP." pr " print_lv_list (r);\n"; pr " guestfs_free_lvm_lv_list (r);\n"; pr " return 0;\n" + | RStat _ -> + pr " if (r == NULL) return -1;\n"; + pr " print_stat (r);\n"; + pr " free (r);\n"; + pr " return 0;\n" + | RStatVFS _ -> + pr " if (r == NULL) return -1;\n"; + pr " print_statvfs (r);\n"; + pr " free (r);\n"; + pr " return 0;\n" + | RHashtable _ -> + pr " if (r == NULL) return -1;\n"; + pr " print_table (r);\n"; + pr " free_strings (r);\n"; + pr " return 0;\n" ); pr "}\n"; pr "\n" @@ -2090,6 +3285,87 @@ FTP." pr "}\n"; pr "\n" +(* Readline completion for guestfish. *) +and generate_fish_completion () = + generate_header CStyle GPLv2; + + let all_functions = + List.filter ( + fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags) + ) all_functions in + + pr "\ +#include + +#include +#include +#include + +#ifdef HAVE_LIBREADLINE +#include +#endif + +#include \"fish.h\" + +#ifdef HAVE_LIBREADLINE + +static const char *commands[] = { +"; + + (* Get the commands and sort them, including the aliases. *) + let commands = + List.map ( + fun (name, _, _, flags, _, _, _) -> + let name2 = replace_char name '_' '-' in + let alias = + try find_map (function FishAlias n -> Some n | _ -> None) flags + with Not_found -> name in + + 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; + + pr " NULL +}; + +static char * +generator (const char *text, int state) +{ + static int index, len; + const char *name; + + if (!state) { + index = 0; + len = strlen (text); + } + + while ((name = commands[index]) != NULL) { + index++; + if (strncasecmp (name, text, len) == 0) + return strdup (name); + } + + return NULL; +} + +#endif /* HAVE_LIBREADLINE */ + +char **do_completion (const char *text, int start, int end) +{ + char **matches = NULL; + +#ifdef HAVE_LIBREADLINE + if (start == 0) + matches = rl_completion_matches (text, generator); +#endif + + return matches; +} +"; + (* Generate the POD documentation for guestfish. *) and generate_fish_actions_pod () = let all_functions_sorted = @@ -2115,12 +3391,19 @@ and generate_fish_actions_pod () = function | String n -> pr " %s" n | OptString n -> pr " %s" n + | StringList n -> pr " %s,..." n | Bool _ -> pr " true|false" | Int n -> pr " %s" n ) (snd style); pr "\n"; pr "\n"; - pr "%s\n\n" longdesc + 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 (* Generate a C function prototype. *) @@ -2133,10 +3416,11 @@ and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true) (match fst style with | RErr -> pr "int " | RInt _ -> pr "int " + | RInt64 _ -> pr "int64_t " | RBool _ -> pr "int " | RConstString _ -> pr "const char *" | RString _ -> pr "char *" - | RStringList _ -> pr "char **" + | RStringList _ | RHashtable _ -> pr "char **" | RIntBool _ -> if not in_daemon then pr "struct guestfs_int_bool *" else pr "guestfs_%s_ret *" name @@ -2149,6 +3433,12 @@ and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true) | RLVList _ -> if not in_daemon then pr "struct guestfs_lvm_lv_list *" else pr "guestfs_lvm_int_lv_list *" + | RStat _ -> + if not in_daemon then pr "struct guestfs_stat *" + else pr "guestfs_int_stat *" + | RStatVFS _ -> + if not in_daemon then pr "struct guestfs_statvfs *" + else pr "guestfs_int_statvfs *" ); pr "%s%s (" prefix name; if handle = None && List.length (snd style) = 0 then @@ -2169,6 +3459,7 @@ and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true) function | String n -> next (); pr "const char *%s" n | OptString n -> next (); pr "const char *%s" n + | StringList n -> next (); pr "char * const* const %s" n | Bool n -> next (); pr "int %s" n | Int n -> next (); pr "int %s" n ) (snd style); @@ -2190,9 +3481,10 @@ and generate_call_args ?handle style = if !comma then pr ", "; comma := true; match arg with - | String n -> pr "%s" n - | OptString n -> pr "%s" n - | Bool n -> pr "%s" n + | String n + | OptString n + | StringList n + | Bool n | Int n -> pr "%s" n ) (snd style); pr ")" @@ -2222,6 +3514,8 @@ val close : t -> unit "; generate_ocaml_lvm_structure_decls (); + generate_ocaml_stat_structure_decls (); + (* The actions. *) List.iter ( fun (name, style, _, _, _, shortdesc, _) -> @@ -2247,6 +3541,8 @@ let () = generate_ocaml_lvm_structure_decls (); + generate_ocaml_stat_structure_decls (); + (* The actions. *) List.iter ( fun (name, style, _, _, _, shortdesc, _) -> @@ -2257,22 +3553,51 @@ let () = and generate_ocaml_c () = generate_header CStyle LGPLv2; - pr "#include \n"; - pr "#include \n"; - pr "#include \n"; - pr "\n"; - pr "#include \n"; - pr "#include \n"; - pr "#include \n"; - pr "#include \n"; - pr "#include \n"; - pr "#include \n"; - pr "#include \n"; - pr "\n"; - pr "#include \n"; - pr "\n"; - pr "#include \"guestfs_c.h\"\n"; - pr "\n"; + pr "\ +#include +#include +#include + +#include +#include +#include +#include +#include +#include +#include + +#include + +#include \"guestfs_c.h\" + +/* Copy a hashtable of string pairs into an assoc-list. We return + * the list in reverse order, but hashtables aren't supposed to be + * ordered anyway. + */ +static CAMLprim value +copy_table (char * const * argv) +{ + CAMLparam0 (); + CAMLlocal5 (rv, pairv, kv, vv, cons); + int i; + + rv = Val_int (0); + for (i = 0; argv[i] != NULL; i += 2) { + kv = caml_copy_string (argv[i]); + vv = caml_copy_string (argv[i+1]); + pairv = caml_alloc (2, 0); + Store_field (pairv, 0, kv); + Store_field (pairv, 1, vv); + cons = caml_alloc (2, 0); + Store_field (cons, 1, rv); + rv = cons; + Store_field (cons, 0, pairv); + } + + CAMLreturn (rv); +} + +"; (* LVM struct copy functions. *) List.iter ( @@ -2337,20 +3662,49 @@ and generate_ocaml_c () = pr "\n"; ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]; + (* Stat copy functions. *) + List.iter ( + fun (typ, cols) -> + pr "static CAMLprim value\n"; + pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ; + pr "{\n"; + pr " CAMLparam0 ();\n"; + pr " CAMLlocal2 (rv, v);\n"; + pr "\n"; + pr " rv = caml_alloc (%d, 0);\n" (List.length cols); + iteri ( + fun i col -> + (match col with + | name, `Int -> + pr " v = caml_copy_int64 (%s->%s);\n" typ name + ); + pr " Store_field (rv, %d, v);\n" i + ) cols; + pr " CAMLreturn (rv);\n"; + pr "}\n"; + pr "\n"; + ) ["stat", stat_cols; "statvfs", statvfs_cols]; + + (* The wrappers. *) List.iter ( fun (name, style, _, _, _, _, _) -> + let params = + "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in + pr "CAMLprim value\n"; - pr "ocaml_guestfs_%s (value gv" name; - List.iter ( - fun arg -> pr ", value %sv" (name_of_argt arg) - ) (snd style); + pr "ocaml_guestfs_%s (value %s" name (List.hd params); + List.iter (pr ", value %s") (List.tl params); pr ")\n"; pr "{\n"; - pr " CAMLparam%d (gv" (1 + (List.length (snd style))); - List.iter ( - fun arg -> pr ", %sv" (name_of_argt arg) - ) (snd style); - pr ");\n"; + + (match params with + | p1 :: p2 :: p3 :: p4 :: p5 :: rest -> + pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]); + pr " CAMLxparam%d (%s);\n" + (List.length rest) (String.concat ", " rest) + | ps -> + pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps) + ); pr " CAMLlocal1 (rv);\n"; pr "\n"; @@ -2367,6 +3721,8 @@ and generate_ocaml_c () = pr " const char *%s =\n" n; pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n" n n + | StringList n -> + pr " char **%s = ocaml_guestfs_strings_val (%sv);\n" n n | Bool n -> pr " int %s = Bool_val (%sv);\n" n n | Int n -> @@ -2376,6 +3732,7 @@ and generate_ocaml_c () = match fst style with | RErr -> pr " int r;\n"; "-1" | RInt _ -> pr " int r;\n"; "-1" + | RInt64 _ -> pr " int64_t r;\n"; "-1" | RBool _ -> pr " int r;\n"; "-1" | RConstString _ -> pr " const char *r;\n"; "NULL" | RString _ -> pr " char *r;\n"; "NULL" @@ -2384,16 +3741,20 @@ and generate_ocaml_c () = pr " char **r;\n"; "NULL" | RIntBool _ -> - pr " struct guestfs_int_bool *r;\n"; - "NULL" + pr " struct guestfs_int_bool *r;\n"; "NULL" | RPVList _ -> - pr " struct guestfs_lvm_pv_list *r;\n"; - "NULL" + pr " struct guestfs_lvm_pv_list *r;\n"; "NULL" | RVGList _ -> - pr " struct guestfs_lvm_vg_list *r;\n"; - "NULL" + pr " struct guestfs_lvm_vg_list *r;\n"; "NULL" | RLVList _ -> - pr " struct guestfs_lvm_lv_list *r;\n"; + pr " struct guestfs_lvm_lv_list *r;\n"; "NULL" + | RStat _ -> + pr " struct guestfs_stat *r;\n"; "NULL" + | RStatVFS _ -> + pr " struct guestfs_statvfs *r;\n"; "NULL" + | RHashtable _ -> + pr " int i;\n"; + pr " char **r;\n"; "NULL" in pr "\n"; @@ -2402,6 +3763,14 @@ and generate_ocaml_c () = generate_call_args ~handle:"g" style; pr ";\n"; pr " caml_leave_blocking_section ();\n"; + + List.iter ( + function + | StringList n -> + pr " ocaml_guestfs_free_strings (%s);\n" n; + | String _ | OptString _ | Bool _ | Int _ -> () + ) (snd style); + pr " if (r == %s)\n" error_code; pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name; pr "\n"; @@ -2409,6 +3778,8 @@ and generate_ocaml_c () = (match fst style with | RErr -> pr " rv = Val_unit;\n" | RInt _ -> pr " rv = Val_int (r);\n" + | RInt64 _ -> + pr " rv = caml_copy_int64 (r);\n" | RBool _ -> pr " rv = Val_bool (r);\n" | RConstString _ -> pr " rv = caml_copy_string (r);\n" | RString _ -> @@ -2432,11 +3803,32 @@ and generate_ocaml_c () = | RLVList _ -> pr " rv = copy_lvm_lv_list (r);\n"; pr " guestfs_free_lvm_lv_list (r);\n"; + | RStat _ -> + pr " rv = copy_stat (r);\n"; + pr " free (r);\n"; + | RStatVFS _ -> + pr " rv = copy_statvfs (r);\n"; + pr " free (r);\n"; + | RHashtable _ -> + pr " rv = copy_table (r);\n"; + pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n"; + pr " free (r);\n"; ); pr " CAMLreturn (rv);\n"; pr "}\n"; - pr "\n" + pr "\n"; + + if List.length params > 5 then ( + pr "CAMLprim value\n"; + pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name; + pr "{\n"; + pr " return ocaml_guestfs_%s (argv[0]" name; + iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params); + pr ");\n"; + pr "}\n"; + pr "\n" + ) ) all_functions and generate_ocaml_lvm_structure_decls () = @@ -2455,6 +3847,18 @@ and generate_ocaml_lvm_structure_decls () = pr "\n" ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols] +and generate_ocaml_stat_structure_decls () = + List.iter ( + fun (typ, cols) -> + pr "type %s = {\n" typ; + List.iter ( + function + | name, `Int -> pr " %s : int64;\n" name + ) cols; + pr "}\n"; + pr "\n" + ) ["stat", stat_cols; "statvfs", statvfs_cols] + and generate_ocaml_prototype ?(is_external = false) name style = if is_external then pr "external " else pr "val "; pr "%s : t -> " name; @@ -2462,12 +3866,14 @@ and generate_ocaml_prototype ?(is_external = false) name style = function | String _ -> pr "string -> " | OptString _ -> pr "string option -> " + | StringList _ -> pr "string array -> " | Bool _ -> pr "bool -> " | Int _ -> pr "int -> " ) (snd style); (match fst style with | RErr -> pr "unit" (* all errors are turned into exceptions *) | RInt _ -> pr "int" + | RInt64 _ -> pr "int64" | RBool _ -> pr "bool" | RConstString _ -> pr "string" | RString _ -> pr "string" @@ -2476,8 +3882,16 @@ and generate_ocaml_prototype ?(is_external = false) name style = | RPVList _ -> pr "lvm_pv array" | RVGList _ -> pr "lvm_vg array" | RLVList _ -> pr "lvm_lv array" + | RStat _ -> pr "stat" + | RStatVFS _ -> pr "statvfs" + | RHashtable _ -> pr "(string * string) list" + ); + if is_external then ( + pr " = "; + if List.length (snd style) + 1 > 5 then + pr "\"ocaml_guestfs_%s_byte\" " name; + pr "\"ocaml_guestfs_%s\"" name ); - if is_external then pr " = \"ocaml_guestfs_%s\"" name; pr "\n" (* Generate Perl xs code, a sort of crazy variation of C with macros. *) @@ -2523,20 +3937,32 @@ my_newSVull(unsigned long long val) { #endif } -/* XXX Not thread-safe, and in general not safe if the caller is - * issuing multiple requests in parallel (on different guestfs - * handles). We should use the guestfs_h handle passed to the - * error handle to distinguish these cases. - */ -static char *last_error = NULL; +/* http://www.perlmonks.org/?node_id=680842 */ +static char ** +XS_unpack_charPtrPtr (SV *arg) { + char **ret; + AV *av; + I32 i; -static void -error_handler (guestfs_h *g, - void *data, - const char *msg) -{ - if (last_error != NULL) free (last_error); - last_error = strdup (msg); + if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV) { + croak (\"array reference expected\"); + } + + av = (AV *)SvRV (arg); + ret = (char **)malloc (av_len (av) + 1 + 1); + + for (i = 0; i <= av_len (av); i++) { + SV **elem = av_fetch (av, i, 0); + + if (!elem || !*elem) + croak (\"missing element in list\"); + + ret[i] = SvPV_nolen (*elem); + } + + ret[i] = NULL; + + return ret; } MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs @@ -2547,7 +3973,7 @@ _create () RETVAL = guestfs_create (); if (!RETVAL) croak (\"could not create guestfs handle\"); - guestfs_set_error_handler (RETVAL, error_handler, NULL); + guestfs_set_error_handler (RETVAL, NULL, NULL); OUTPUT: RETVAL @@ -2564,12 +3990,15 @@ DESTROY (g) (match fst style with | RErr -> pr "void\n" | RInt _ -> pr "SV *\n" + | RInt64 _ -> pr "SV *\n" | RBool _ -> pr "SV *\n" | RConstString _ -> pr "SV *\n" | RString _ -> pr "SV *\n" | RStringList _ | RIntBool _ - | RPVList _ | RVGList _ | RLVList _ -> + | RPVList _ | RVGList _ | RLVList _ + | RStat _ | RStatVFS _ + | RHashtable _ -> pr "void\n" (* all lists returned implictly on the stack *) ); (* Call and arguments. *) @@ -2581,17 +4010,34 @@ DESTROY (g) function | String 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 ) (snd style); + + let do_cleanups () = + List.iter ( + function + | String _ + | OptString _ + | Bool _ + | Int _ -> () + | StringList n -> pr " free (%s);\n" n + ) (snd style) + in + (* Code. *) (match fst style with | RErr -> + pr "PREINIT:\n"; + pr " int r;\n"; pr " PPCODE:\n"; - pr " if (guestfs_%s " name; + pr " r = guestfs_%s " name; generate_call_args ~handle:"g" style; - pr " == -1)\n"; - pr " croak (\"%s: %%s\", last_error);\n" name + pr ";\n"; + do_cleanups (); + pr " if (r == -1)\n"; + pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name; | RInt n | RBool n -> pr "PREINIT:\n"; @@ -2600,11 +4046,25 @@ DESTROY (g) pr " %s = guestfs_%s " n name; generate_call_args ~handle:"g" style; pr ";\n"; + do_cleanups (); pr " if (%s == -1)\n" n; - pr " croak (\"%s: %%s\", last_error);\n" name; + pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name; pr " RETVAL = newSViv (%s);\n" n; pr " OUTPUT:\n"; pr " RETVAL\n" + | RInt64 n -> + pr "PREINIT:\n"; + pr " int64_t %s;\n" n; + pr " CODE:\n"; + pr " %s = guestfs_%s " n name; + generate_call_args ~handle:"g" style; + pr ";\n"; + do_cleanups (); + pr " if (%s == -1)\n" n; + pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name; + pr " RETVAL = my_newSVll (%s);\n" n; + pr " OUTPUT:\n"; + pr " RETVAL\n" | RConstString n -> pr "PREINIT:\n"; pr " const char *%s;\n" n; @@ -2612,8 +4072,9 @@ DESTROY (g) pr " %s = guestfs_%s " n name; generate_call_args ~handle:"g" style; pr ";\n"; + do_cleanups (); pr " if (%s == NULL)\n" n; - pr " croak (\"%s: %%s\", last_error);\n" name; + pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name; pr " RETVAL = newSVpv (%s, 0);\n" n; pr " OUTPUT:\n"; pr " RETVAL\n" @@ -2624,13 +4085,14 @@ DESTROY (g) pr " %s = guestfs_%s " n name; generate_call_args ~handle:"g" style; pr ";\n"; + do_cleanups (); pr " if (%s == NULL)\n" n; - pr " croak (\"%s: %%s\", last_error);\n" name; + pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name; pr " RETVAL = newSVpv (%s, 0);\n" n; pr " free (%s);\n" n; pr " OUTPUT:\n"; pr " RETVAL\n" - | RStringList n -> + | RStringList n | RHashtable n -> pr "PREINIT:\n"; pr " char **%s;\n" n; pr " int i, n;\n"; @@ -2638,8 +4100,9 @@ DESTROY (g) pr " %s = guestfs_%s " n name; generate_call_args ~handle:"g" style; pr ";\n"; + do_cleanups (); pr " if (%s == NULL)\n" n; - pr " croak (\"%s: %%s\", last_error);\n" name; + pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name; pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n; pr " EXTEND (SP, n);\n"; pr " for (i = 0; i < n; ++i) {\n"; @@ -2654,23 +4117,30 @@ DESTROY (g) pr " r = guestfs_%s " name; generate_call_args ~handle:"g" style; pr ";\n"; + do_cleanups (); pr " if (r == NULL)\n"; - pr " croak (\"%s: %%s\", last_error);\n" name; + pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name; pr " EXTEND (SP, 2);\n"; pr " PUSHs (sv_2mortal (newSViv (r->i)));\n"; pr " PUSHs (sv_2mortal (newSViv (r->b)));\n"; pr " guestfs_free_int_bool (r);\n"; | RPVList n -> - generate_perl_lvm_code "pv" pv_cols name style n; + generate_perl_lvm_code "pv" pv_cols name style n do_cleanups | RVGList n -> - generate_perl_lvm_code "vg" vg_cols name style n; + generate_perl_lvm_code "vg" vg_cols name style n do_cleanups | RLVList n -> - generate_perl_lvm_code "lv" lv_cols name style n; + generate_perl_lvm_code "lv" lv_cols name style n do_cleanups + | RStat n -> + generate_perl_stat_code "stat" stat_cols name style n do_cleanups + | RStatVFS n -> + generate_perl_stat_code + "statvfs" statvfs_cols name style n do_cleanups ); + pr "\n" ) all_functions -and generate_perl_lvm_code typ cols name style n = +and generate_perl_lvm_code typ cols name style n do_cleanups = pr "PREINIT:\n"; pr " struct guestfs_lvm_%s_list *%s;\n" typ n; pr " int i;\n"; @@ -2679,8 +4149,9 @@ and generate_perl_lvm_code typ cols name style n = pr " %s = guestfs_%s " n name; generate_call_args ~handle:"g" style; pr ";\n"; + do_cleanups (); pr " if (%s == NULL)\n" n; - pr " croak (\"%s: %%s\", last_error);\n" name; + pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name; pr " EXTEND (SP, %s->len);\n" n; pr " for (i = 0; i < %s->len; ++i) {\n" n; pr " hv = newHV ();\n"; @@ -2706,6 +4177,24 @@ and generate_perl_lvm_code typ cols name style n = pr " }\n"; pr " guestfs_free_lvm_%s_list (%s);\n" typ n +and generate_perl_stat_code typ cols name style n do_cleanups = + pr "PREINIT:\n"; + pr " struct guestfs_%s *%s;\n" typ n; + pr " PPCODE:\n"; + pr " %s = guestfs_%s " n name; + generate_call_args ~handle:"g" style; + pr ";\n"; + do_cleanups (); + pr " if (%s == NULL)\n" n; + pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name; + pr " EXTEND (SP, %d);\n" (List.length cols); + List.iter ( + function + | name, `Int -> + pr " PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n" n name + ) cols; + pr " free (%s);\n" n + (* Generate Sys/Guestfs.pm. *) and generate_perl_pm () = generate_header HashStyle LGPLv2; @@ -2797,9 +4286,9 @@ sub new { pr "\n\n"; pr "%s\n\n" longdesc; if List.mem ProtocolLimitWarning flags then - pr "Because of the message protocol, there is a transfer limit -of somewhere between 2MB and 4MB. To transfer large files you should use -FTP.\n\n"; + 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. *) @@ -2830,6 +4319,7 @@ and generate_perl_prototype name style = | RErr -> () | RBool n | RInt n + | RInt64 n | RConstString n | RString n -> pr "$%s = " n | RIntBool (n, m) -> pr "($%s, $%s) = " n m @@ -2837,6 +4327,9 @@ and generate_perl_prototype name style = | RPVList n | RVGList n | RLVList n -> pr "@%s = " n + | RStat n + | RStatVFS n + | RHashtable n -> pr "%%%s = " n ); pr "$h->%s (" name; let comma = ref false in @@ -2844,10 +4337,768 @@ and generate_perl_prototype name style = fun arg -> if !comma then pr ", "; comma := true; - pr "%s" (name_of_argt arg) + match arg with + | String n | OptString n | Bool n | Int n -> + pr "$%s" n + | StringList n -> + pr "\\@%s" n ) (snd style); pr ");" +(* Generate Python C module. *) +and generate_python_c () = + generate_header CStyle LGPLv2; + + pr "\ +#include +#include +#include + +#include + +#include \"guestfs.h\" + +typedef struct { + PyObject_HEAD + guestfs_h *g; +} Pyguestfs_Object; + +static guestfs_h * +get_handle (PyObject *obj) +{ + assert (obj); + assert (obj != Py_None); + return ((Pyguestfs_Object *) obj)->g; +} + +static PyObject * +put_handle (guestfs_h *g) +{ + assert (g); + return + PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL); +} + +/* This list should be freed (but not the strings) after use. */ +static const char ** +get_string_list (PyObject *obj) +{ + int i, len; + const char **r; + + assert (obj); + + if (!PyList_Check (obj)) { + PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\"); + return NULL; + } + + len = PyList_Size (obj); + r = malloc (sizeof (char *) * (len+1)); + if (r == NULL) { + PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\"); + return NULL; + } + + for (i = 0; i < len; ++i) + r[i] = PyString_AsString (PyList_GetItem (obj, i)); + r[len] = NULL; + + return r; +} + +static PyObject * +put_string_list (char * const * const argv) +{ + PyObject *list; + int argc, i; + + for (argc = 0; argv[argc] != NULL; ++argc) + ; + + list = PyList_New (argc); + for (i = 0; i < argc; ++i) + PyList_SetItem (list, i, PyString_FromString (argv[i])); + + return list; +} + +static PyObject * +put_table (char * const * const argv) +{ + PyObject *list, *item; + int argc, i; + + for (argc = 0; argv[argc] != NULL; ++argc) + ; + + list = PyList_New (argc >> 1); + for (i = 0; i < argc; i += 2) { + PyObject *item; + item = PyTuple_New (2); + PyTuple_SetItem (item, 0, PyString_FromString (argv[i])); + PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1])); + PyList_SetItem (list, i >> 1, item); + } + + return list; +} + +static void +free_strings (char **argv) +{ + int argc; + + for (argc = 0; argv[argc] != NULL; ++argc) + free (argv[argc]); + free (argv); +} + +static PyObject * +py_guestfs_create (PyObject *self, PyObject *args) +{ + guestfs_h *g; + + g = guestfs_create (); + if (g == NULL) { + PyErr_SetString (PyExc_RuntimeError, + \"guestfs.create: failed to allocate handle\"); + return NULL; + } + guestfs_set_error_handler (g, NULL, NULL); + return put_handle (g); +} + +static PyObject * +py_guestfs_close (PyObject *self, PyObject *args) +{ + PyObject *py_g; + guestfs_h *g; + + if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g)) + return NULL; + g = get_handle (py_g); + + guestfs_close (g); + + Py_INCREF (Py_None); + return Py_None; +} + +"; + + (* LVM structures, turned into Python dictionaries. *) + List.iter ( + fun (typ, cols) -> + pr "static PyObject *\n"; + pr "put_lvm_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ; + pr "{\n"; + pr " PyObject *dict;\n"; + pr "\n"; + pr " dict = PyDict_New ();\n"; + List.iter ( + function + | name, `String -> + pr " PyDict_SetItemString (dict, \"%s\",\n" name; + pr " PyString_FromString (%s->%s));\n" + typ name + | name, `UUID -> + pr " PyDict_SetItemString (dict, \"%s\",\n" name; + pr " PyString_FromStringAndSize (%s->%s, 32));\n" + typ name + | name, `Bytes -> + pr " PyDict_SetItemString (dict, \"%s\",\n" name; + pr " PyLong_FromUnsignedLongLong (%s->%s));\n" + typ name + | name, `Int -> + pr " PyDict_SetItemString (dict, \"%s\",\n" name; + pr " PyLong_FromLongLong (%s->%s));\n" + typ name + | name, `OptPercent -> + pr " if (%s->%s >= 0)\n" typ name; + pr " PyDict_SetItemString (dict, \"%s\",\n" name; + pr " PyFloat_FromDouble ((double) %s->%s));\n" + typ name; + pr " else {\n"; + pr " Py_INCREF (Py_None);\n"; + pr " PyDict_SetItemString (dict, \"%s\", Py_None);" name; + pr " }\n" + ) cols; + pr " return dict;\n"; + pr "};\n"; + pr "\n"; + + pr "static PyObject *\n"; + pr "put_lvm_%s_list (struct guestfs_lvm_%s_list *%ss)\n" typ typ typ; + pr "{\n"; + pr " PyObject *list;\n"; + pr " int i;\n"; + pr "\n"; + pr " list = PyList_New (%ss->len);\n" typ; + pr " for (i = 0; i < %ss->len; ++i)\n" typ; + pr " PyList_SetItem (list, i, put_lvm_%s (&%ss->val[i]));\n" typ typ; + pr " return list;\n"; + pr "};\n"; + pr "\n" + ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]; + + (* Stat structures, turned into Python dictionaries. *) + List.iter ( + fun (typ, cols) -> + pr "static PyObject *\n"; + pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ; + pr "{\n"; + pr " PyObject *dict;\n"; + pr "\n"; + pr " dict = PyDict_New ();\n"; + List.iter ( + function + | name, `Int -> + pr " PyDict_SetItemString (dict, \"%s\",\n" name; + pr " PyLong_FromLongLong (%s->%s));\n" + typ name + ) cols; + pr " return dict;\n"; + pr "};\n"; + pr "\n"; + ) ["stat", stat_cols; "statvfs", statvfs_cols]; + + (* Python wrapper functions. *) + List.iter ( + fun (name, style, _, _, _, _, _) -> + pr "static PyObject *\n"; + pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name; + pr "{\n"; + + pr " PyObject *py_g;\n"; + pr " guestfs_h *g;\n"; + pr " PyObject *py_r;\n"; + + let error_code = + match fst style with + | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1" + | RInt64 _ -> pr " int64_t r;\n"; "-1" + | RConstString _ -> pr " const char *r;\n"; "NULL" + | RString _ -> pr " char *r;\n"; "NULL" + | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL" + | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL" + | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL" + | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL" + | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL" + | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL" + | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in + + List.iter ( + function + | String n -> pr " const char *%s;\n" n + | OptString n -> pr " const char *%s;\n" n + | StringList n -> + pr " PyObject *py_%s;\n" n; + pr " const char **%s;\n" n + | Bool n -> pr " int %s;\n" n + | Int n -> pr " int %s;\n" n + ) (snd style); + + pr "\n"; + + (* Convert the parameters. *) + pr " if (!PyArg_ParseTuple (args, (char *) \"O"; + List.iter ( + function + | String _ -> pr "s" + | OptString _ -> pr "z" + | StringList _ -> pr "O" + | Bool _ -> pr "i" (* XXX Python has booleans? *) + | Int _ -> pr "i" + ) (snd style); + pr ":guestfs_%s\",\n" name; + pr " &py_g"; + List.iter ( + function + | String n -> pr ", &%s" n + | OptString n -> pr ", &%s" n + | StringList n -> pr ", &py_%s" n + | Bool n -> pr ", &%s" n + | Int n -> pr ", &%s" n + ) (snd style); + + pr "))\n"; + pr " return NULL;\n"; + + pr " g = get_handle (py_g);\n"; + List.iter ( + function + | String _ | OptString _ | Bool _ | Int _ -> () + | StringList n -> + pr " %s = get_string_list (py_%s);\n" n n; + pr " if (!%s) return NULL;\n" n + ) (snd style); + + pr "\n"; + + pr " r = guestfs_%s " name; + generate_call_args ~handle:"g" style; + pr ";\n"; + + List.iter ( + function + | String _ | OptString _ | Bool _ | Int _ -> () + | StringList n -> + pr " free (%s);\n" n + ) (snd style); + + pr " if (r == %s) {\n" error_code; + pr " PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n"; + pr " return NULL;\n"; + pr " }\n"; + pr "\n"; + + (match fst style with + | RErr -> + pr " Py_INCREF (Py_None);\n"; + pr " py_r = Py_None;\n" + | RInt _ + | RBool _ -> pr " py_r = PyInt_FromLong ((long) r);\n" + | RInt64 _ -> pr " py_r = PyLong_FromLongLong (r);\n" + | RConstString _ -> pr " py_r = PyString_FromString (r);\n" + | RString _ -> + pr " py_r = PyString_FromString (r);\n"; + pr " free (r);\n" + | RStringList _ -> + pr " py_r = put_string_list (r);\n"; + pr " free_strings (r);\n" + | RIntBool _ -> + pr " py_r = PyTuple_New (2);\n"; + pr " PyTuple_SetItem (py_r, 0, PyInt_FromLong ((long) r->i));\n"; + pr " PyTuple_SetItem (py_r, 1, PyInt_FromLong ((long) r->b));\n"; + pr " guestfs_free_int_bool (r);\n" + | RPVList n -> + pr " py_r = put_lvm_pv_list (r);\n"; + pr " guestfs_free_lvm_pv_list (r);\n" + | RVGList n -> + pr " py_r = put_lvm_vg_list (r);\n"; + pr " guestfs_free_lvm_vg_list (r);\n" + | RLVList n -> + pr " py_r = put_lvm_lv_list (r);\n"; + pr " guestfs_free_lvm_lv_list (r);\n" + | RStat n -> + pr " py_r = put_stat (r);\n"; + pr " free (r);\n" + | RStatVFS n -> + pr " py_r = put_statvfs (r);\n"; + pr " free (r);\n" + | RHashtable n -> + pr " py_r = put_table (r);\n"; + pr " free_strings (r);\n" + ); + + pr " return py_r;\n"; + pr "}\n"; + pr "\n" + ) all_functions; + + (* Table of functions. *) + pr "static PyMethodDef methods[] = {\n"; + pr " { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n"; + pr " { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n"; + List.iter ( + fun (name, _, _, _, _, _, _) -> + pr " { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n" + name name + ) all_functions; + pr " { NULL, NULL, 0, NULL }\n"; + pr "};\n"; + pr "\n"; + + (* Init function. *) + pr "\ +void +initlibguestfsmod (void) +{ + static int initialized = 0; + + if (initialized) return; + Py_InitModule ((char *) \"libguestfsmod\", methods); + initialized = 1; +} +" + +(* Generate Python module. *) +and generate_python_py () = + generate_header HashStyle LGPLv2; + + pr "\ +u\"\"\"Python bindings for libguestfs + +import guestfs +g = guestfs.GuestFS () +g.add_drive (\"guest.img\") +g.launch () +g.wait_ready () +parts = g.list_partitions () + +The guestfs module provides a Python binding to the libguestfs API +for examining and modifying virtual machine disk images. + +Amongst the things this is good for: making batch configuration +changes to guests, getting disk used/free statistics (see also: +virt-df), migrating between virtualization systems (see also: +virt-p2v), performing partial backups, performing partial guest +clones, cloning guests and changing registry/UUID/hostname info, and +much else besides. + +Libguestfs uses Linux kernel and qemu code, and can access any type of +guest filesystem that Linux and qemu can, including but not limited +to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition +schemes, qcow, qcow2, vmdk. + +Libguestfs provides ways to enumerate guest storage (eg. partitions, +LVs, what filesystem is in each LV, etc.). It can also run commands +in the context of the guest. Also you can access filesystems over FTP. + +Errors which happen while using the API are turned into Python +RuntimeError exceptions. + +To create a guestfs handle you usually have to perform the following +sequence of calls: + +# Create the handle, call add_drive at least once, and possibly +# several times if the guest has multiple block devices: +g = guestfs.GuestFS () +g.add_drive (\"guest.img\") + +# Launch the qemu subprocess and wait for it to become ready: +g.launch () +g.wait_ready () + +# Now you can issue commands, for example: +logvols = g.lvs () + +\"\"\" + +import libguestfsmod + +class GuestFS: + \"\"\"Instances of this class are libguestfs API handles.\"\"\" + + def __init__ (self): + \"\"\"Create a new libguestfs handle.\"\"\" + self._o = libguestfsmod.create () + + def __del__ (self): + libguestfsmod.close (self._o) + +"; + + 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" style; + pr ":\n"; + pr " u\"\"\"%s\"\"\"\n" doc; + pr " return libguestfsmod.%s " name; + generate_call_args ~handle:"self._o" style; + pr "\n"; + pr "\n"; + ) all_functions + +(* Useful if you need the longdesc POD text as plain text. Returns a + * list of lines. + *) +and pod2text ~width name longdesc = + let filename, chan = Filename.open_temp_file "gen" ".tmp" in + fprintf chan "=head1 %s\n\n%s\n" name longdesc; + close_out chan; + let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in + let chan = Unix.open_process_in cmd in + let lines = ref [] in + let rec loop i = + let line = input_line chan in + if i = 1 then (* discard the first line of output *) + loop (i+1) + else ( + let line = triml line in + lines := line :: !lines; + loop (i+1) + ) in + let lines = try loop 1 with End_of_file -> List.rev !lines in + Unix.unlink filename; + match Unix.close_process_in chan with + | Unix.WEXITED 0 -> lines + | Unix.WEXITED i -> + failwithf "pod2text: process exited with non-zero status (%d)" i + | Unix.WSIGNALED i | Unix.WSTOPPED i -> + failwithf "pod2text: process signalled or stopped by signal %d" i + +(* Generate ruby bindings. *) +and generate_ruby_c () = + generate_header CStyle LGPLv2; + + pr "\ +#include +#include + +#include + +#include \"guestfs.h\" + +#include \"extconf.h\" + +static VALUE m_guestfs; /* guestfs module */ +static VALUE c_guestfs; /* guestfs_h handle */ +static VALUE e_Error; /* used for all errors */ + +static void ruby_guestfs_free (void *p) +{ + if (!p) return; + guestfs_close ((guestfs_h *) p); +} + +static VALUE ruby_guestfs_create (VALUE m) +{ + guestfs_h *g; + + g = guestfs_create (); + if (!g) + rb_raise (e_Error, \"failed to create guestfs handle\"); + + /* Don't print error messages to stderr by default. */ + guestfs_set_error_handler (g, NULL, NULL); + + /* Wrap it, and make sure the close function is called when the + * handle goes away. + */ + return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g); +} + +static VALUE ruby_guestfs_close (VALUE gv) +{ + guestfs_h *g; + Data_Get_Struct (gv, guestfs_h, g); + + ruby_guestfs_free (g); + DATA_PTR (gv) = NULL; + + return Qnil; +} + +"; + + List.iter ( + fun (name, style, _, _, _, _, _) -> + pr "static VALUE ruby_guestfs_%s (VALUE gv" name; + List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style); + pr ")\n"; + pr "{\n"; + pr " guestfs_h *g;\n"; + pr " Data_Get_Struct (gv, guestfs_h, g);\n"; + pr " if (!g)\n"; + pr " rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n" + name; + pr "\n"; + + List.iter ( + function + | String n -> + pr " const char *%s = StringValueCStr (%sv);\n" n n; + pr " if (!%s)\n" n; + 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 + | StringList n -> + pr " char **%s;" n; + pr " {\n"; + pr " int i, len;\n"; + pr " len = RARRAY_LEN (%sv);\n" n; + pr " %s = malloc (sizeof (char *) * (len+1));\n" n; + pr " for (i = 0; i < len; ++i) {\n"; + pr " VALUE v = rb_ary_entry (%sv, i);\n" n; + pr " %s[i] = StringValueCStr (v);\n" n; + pr " }\n"; + pr " }\n"; + | Bool n + | Int n -> + pr " int %s = NUM2INT (%sv);\n" n n + ) (snd style); + pr "\n"; + + let error_code = + match fst style with + | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1" + | RInt64 _ -> pr " int64_t r;\n"; "-1" + | RConstString _ -> pr " const char *r;\n"; "NULL" + | RString _ -> pr " char *r;\n"; "NULL" + | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL" + | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL" + | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL" + | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL" + | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL" + | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL" + | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in + pr "\n"; + + pr " r = guestfs_%s " name; + generate_call_args ~handle:"g" style; + pr ";\n"; + + List.iter ( + function + | String _ | OptString _ | Bool _ | Int _ -> () + | StringList n -> + pr " free (%s);\n" n + ) (snd style); + + pr " if (r == %s)\n" error_code; + pr " rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n"; + pr "\n"; + + (match fst style with + | RErr -> + pr " return Qnil;\n" + | RInt _ | RBool _ -> + pr " return INT2NUM (r);\n" + | RInt64 _ -> + pr " return ULL2NUM (r);\n" + | RConstString _ -> + pr " return rb_str_new2 (r);\n"; + | RString _ -> + pr " VALUE rv = rb_str_new2 (r);\n"; + pr " free (r);\n"; + pr " return rv;\n"; + | RStringList _ -> + pr " int i, len = 0;\n"; + pr " for (i = 0; r[i] != NULL; ++i) len++;\n"; + pr " VALUE rv = rb_ary_new2 (len);\n"; + pr " for (i = 0; r[i] != NULL; ++i) {\n"; + pr " rb_ary_push (rv, rb_str_new2 (r[i]));\n"; + pr " free (r[i]);\n"; + pr " }\n"; + pr " free (r);\n"; + pr " return rv;\n" + | RIntBool _ -> + pr " VALUE rv = rb_ary_new2 (2);\n"; + pr " rb_ary_push (rv, INT2NUM (r->i));\n"; + pr " rb_ary_push (rv, INT2NUM (r->b));\n"; + pr " guestfs_free_int_bool (r);\n"; + pr " return rv;\n" + | RPVList n -> + generate_ruby_lvm_code "pv" pv_cols + | RVGList n -> + generate_ruby_lvm_code "vg" vg_cols + | RLVList n -> + generate_ruby_lvm_code "lv" lv_cols + | RStat n -> + pr " VALUE rv = rb_hash_new ();\n"; + List.iter ( + function + | name, `Int -> + pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name + ) stat_cols; + pr " free (r);\n"; + pr " return rv;\n" + | RStatVFS n -> + pr " VALUE rv = rb_hash_new ();\n"; + List.iter ( + function + | name, `Int -> + pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name + ) statvfs_cols; + pr " free (r);\n"; + pr " return rv;\n" + | RHashtable _ -> + pr " VALUE rv = rb_hash_new ();\n"; + pr " int i;\n"; + pr " for (i = 0; r[i] != NULL; i+=2) {\n"; + pr " rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n"; + pr " free (r[i]);\n"; + pr " free (r[i+1]);\n"; + pr " }\n"; + pr " free (r);\n"; + pr " return rv;\n" + ); + + pr "}\n"; + pr "\n" + ) all_functions; + + pr "\ +/* Initialize the module. */ +void Init__guestfs () +{ + m_guestfs = rb_define_module (\"Guestfs\"); + c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject); + e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError); + + rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0); + rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0); + +"; + (* Define the rest of the methods. *) + List.iter ( + fun (name, style, _, _, _, _, _) -> + pr " rb_define_method (c_guestfs, \"%s\",\n" name; + pr " ruby_guestfs_%s, %d);\n" name (List.length (snd style)) + ) all_functions; + + pr "}\n" + +(* Ruby code to return an LVM struct list. *) +and generate_ruby_lvm_code typ cols = + pr " VALUE rv = rb_ary_new2 (r->len);\n"; + pr " int i;\n"; + pr " for (i = 0; i < r->len; ++i) {\n"; + pr " VALUE hv = rb_hash_new ();\n"; + List.iter ( + function + | name, `String -> + pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name + | name, `UUID -> + pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name + | name, `Bytes + | name, `Int -> + pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name + | name, `OptPercent -> + pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name + ) cols; + pr " rb_ary_push (rv, hv);\n"; + pr " }\n"; + pr " guestfs_free_lvm_%s_list (r);\n" typ; + pr " return rv;\n" + let output_to filename = let filename_new = filename ^ ".new" in chan := open_out filename_new; @@ -2904,6 +5155,10 @@ Run it from the top source directory using the command generate_fish_cmds (); close (); + let close = output_to "fish/completion.c" in + generate_fish_completion (); + close (); + let close = output_to "guestfs-structs.pod" in generate_structs_pod (); close (); @@ -2935,3 +5190,15 @@ Run it from the top source directory using the command let close = output_to "perl/lib/Sys/Guestfs.pm" in generate_perl_pm (); close (); + + let close = output_to "python/guestfs-py.c" in + generate_python_c (); + close (); + + let close = output_to "python/guestfs.py" in + generate_python_py (); + close (); + + let close = output_to "ruby/ext/guestfs/_guestfs.c" in + generate_ruby_c (); + close ();