X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=src%2Fgenerator.ml;h=a7093768eaac7cbc8603efc0b5ab5b685cc59e0e;hp=b0a715896a9c3a927b1f11e6c25d75af19e69463;hb=afca1dba5eeb989c231a22df26e48f0967387547;hpb=469224a9eca9b575063e6a1ca1b1d97adb3448cb diff --git a/src/generator.ml b/src/generator.ml index b0a7158..a709376 100755 --- a/src/generator.ml +++ b/src/generator.ml @@ -18,32 +18,41 @@ *) (* This script generates a large amount of code and documentation for - * all the daemon actions. To add a new action there are only two - * files you need to change, this one to describe the interface, and + * all the daemon actions. + * + * To add a new action there are only two files you need to change, + * this one to describe the interface (see the big table below), and * daemon/.c to write the implementation. * * After editing this file, run it (./src/generator.ml) to regenerate * all the output files. * - * IMPORTANT: This script should not print any warnings. If it prints + * IMPORTANT: This script should NOT print any warnings. If it prints * warnings, you should treat them as errors. * [Need to add -warn-error to ocaml command line] *) #load "unix.cma";; +#load "str.cma";; open Printf type style = ret * args and ret = - (* "Err" as a return value means an int used as a simple error + (* "RErr" as a return value means an int used as a simple error * indication, ie. 0 or -1. *) - | Err + | 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. *) @@ -63,19 +72,146 @@ 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 + * the final parameter, to allow commands like + * chmod mode file [file(s)...] + * This is not implemented yet, but many commands (such as chmod) + * are currently defined with the argument order keeping this future + * possibility in mind. + *) 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) *) + (* These are treated as filenames (simple string parameters) in + * the C API and bindings. But in the RPC protocol, we transfer + * the actual file content up to or down from the daemon. + * FileIn: local machine -> daemon (in request) + * FileOut: daemon -> local machine (in reply) + * In guestfish (only), the special name "-" means read from + * stdin or write to stdout. + *) + | FileIn of string + | FileOut of string 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 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_init * test) list +and test = + (* Run the command sequence and just expect nothing to fail. *) + | TestRun of seq + (* Run the command sequence and expect the output of the final + * command to be the 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 seq * string list + (* Run the command sequence and expect the output of the final + * command to be the integer. + *) + | 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 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 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 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 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 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. + *) + | InitBasicFS + (* /dev/sda: + * /dev/sda1 (is a PV): + * /dev/VG/LV (size 8MB): + * formatted as ext2, empty [except for lost+found], mounted on / + * /dev/sdb and /dev/sdc may have random content. + *) + | InitBasicFSonLVM + +(* Sequence of commands for testing. *) +and seq = cmd list +and cmd = string list + (* Note about long descriptions: When referring to another * action, use the format C (ie. the full name of * the C function). This will be replaced as appropriate in other @@ -85,7 +221,8 @@ type flags = *) let non_daemon_functions = [ - ("launch", (Err, []), -1, [FishAlias "run"; FishAction "launch"], + ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"], + [], "launch the qemu subprocess", "\ Internally libguestfs is implemented by running a virtual machine @@ -94,7 +231,8 @@ using L. You should call this after configuring the handle (eg. adding drives) but before performing any actions."); - ("wait_ready", (Err, []), -1, [NotInFish], + ("wait_ready", (RErr, []), -1, [NotInFish], + [], "wait until the qemu subprocess launches", "\ Internally libguestfs is implemented by running a virtual machine @@ -103,12 +241,14 @@ using L. You should call this after C to wait for the launch to complete."); - ("kill_subprocess", (Err, []), -1, [], + ("kill_subprocess", (RErr, []), -1, [], + [], "kill the qemu subprocess", "\ This kills the qemu subprocess. You should never need to call this."); - ("add_drive", (Err, [String "filename"]), -1, [FishAlias "add"], + ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"], + [], "add an image to examine or modify", "\ This function adds a virtual machine disk image C to the @@ -124,14 +264,16 @@ image). This is equivalent to the qemu parameter C<-drive file=filename>."); - ("add_cdrom", (Err, [String "filename"]), -1, [FishAlias "cdrom"], + ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"], + [], "add a CD-ROM disk image to examine", "\ This function adds a virtual CD-ROM disk image to the guest. This is equivalent to the qemu parameter C<-cdrom filename>."); - ("config", (Err, [String "qemuparam"; OptString "qemuvalue"]), -1, [], + ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [], + [], "add qemu parameters", "\ This can be used to add arbitrary qemu command line parameters @@ -143,7 +285,34 @@ The first character of C string must be a C<-> (dash). C can be NULL."); - ("set_path", (Err, [String "path"]), -1, [FishAlias "path"], + ("set_qemu", (RErr, [String "qemu"]), -1, [FishAlias "qemu"], + [], + "set the qemu binary", + "\ +Set the qemu binary that we will use. + +The default is chosen when the library was compiled by the +configure script. + +You can also override this by setting the C +environment variable. + +The string C is stashed in the libguestfs handle, so the caller +must make sure it remains valid for the lifetime of the handle. + +Setting C to C restores the default qemu binary."); + + ("get_qemu", (RConstString "qemu", []), -1, [], + [], + "get the qemu binary", + "\ +Return the current qemu binary. + +This is always non-NULL. If it wasn't set already, then this will +return the default qemu binary name."); + + ("set_path", (RErr, [String "path"]), -1, [FishAlias "path"], + [], "set the search path", "\ Set the path that libguestfs searches for kernel and initrd.img. @@ -157,6 +326,7 @@ must make sure it remains valid for the lifetime of the handle. Setting C to C restores the default path."); ("get_path", (RConstString "path", []), -1, [], + [], "get the search path", "\ Return the current search path. @@ -164,7 +334,8 @@ Return the current search path. This is always non-NULL. If it wasn't set already, then this will return the default path."); - ("set_autosync", (Err, [Bool "autosync"]), -1, [FishAlias "autosync"], + ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"], + [], "set autosync mode", "\ If C is true, this enables autosync. Libguestfs will make a @@ -172,11 +343,13 @@ best effort attempt to run C when the handle is closed (also if the program exits without closing handles)."); ("get_autosync", (RBool "autosync", []), -1, [], + [], "get autosync mode", "\ Get the autosync flag."); - ("set_verbose", (Err, [Bool "verbose"]), -1, [FishAlias "verbose"], + ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"], + [], "set verbose mode", "\ If C is true, this turns on verbose messages (to C). @@ -185,13 +358,84 @@ Verbose messages are disabled unless the environment variable C is defined and set to C<1>."); ("get_verbose", (RBool "verbose", []), -1, [], + [], "get verbose mode", "\ -This returns the verbose messages flag.") +This returns the verbose messages flag."); + + ("is_ready", (RBool "ready", []), -1, [], + [], + "is ready to accept commands", + "\ +This returns true iff this handle is ready to accept commands +(in the C state). + +For more information on states, see L."); + + ("is_config", (RBool "config", []), -1, [], + [], + "is in configuration state", + "\ +This returns true iff this handle is being configured +(in the C state). + +For more information on states, see L."); + + ("is_launching", (RBool "launching", []), -1, [], + [], + "is launching subprocess", + "\ +This returns true iff this handle is launching the subprocess +(in the C state). + +For more information on states, see L."); + + ("is_busy", (RBool "busy", []), -1, [], + [], + "is busy processing a command", + "\ +This returns true iff this handle is busy processing a command +(in the C state). + +For more information on states, see L."); + + ("get_state", (RInt "state", []), -1, [], + [], + "get the current state", + "\ +This returns the current state as an opaque integer. This is +only useful for printing debug and internal error messages. + +For more information on states, see L."); + + ("set_busy", (RErr, []), -1, [NotInFish], + [], + "set state to busy", + "\ +This sets the state to C. This is only used when implementing +actions using the low-level API. + +For more information on states, see L."); + + ("set_ready", (RErr, []), -1, [NotInFish], + [], + "set state to ready", + "\ +This sets the state to C. This is only used when implementing +actions using the low-level API. + +For more information on states, see L."); + ] let daemon_functions = [ - ("mount", (Err, [String "device"; String "mountpoint"]), 1, [], + ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [], + [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")], "mount a guest disk at a position in the filesystem", "\ Mount a guest disk at a position in the filesystem. Block devices @@ -211,7 +455,8 @@ on the underlying device. The filesystem options C and C are set with this call, in order to improve reliability."); - ("sync", (Err, []), 2, [], + ("sync", (RErr, []), 2, [], + [ 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 @@ -220,7 +465,10 @@ underlying disk image. You should always call this if you have modified a disk image, before closing the handle."); - ("touch", (Err, [String "path"]), 3, [], + ("touch", (RErr, [String "path"]), 3, [], + [InitBasicFS, TestOutputTrue ( + [["touch"; "/new"]; + ["exists"; "/new"]])], "update file timestamps or create a new file", "\ Touch acts like the L command. It can be used to @@ -228,16 +476,22 @@ update the timestamps on a file, or, if the file does not exist, to create a new zero-length file."); ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning], + [InitBasicFS, TestOutput ( + [["write_file"; "/new"; "new file contents"; "0"]; + ["cat"; "/new"]], "new file contents")], "list the contents of a file", "\ Return the contents of the file named C. Note that this function cannot correctly handle binary files (specifically, files containing C<\\0> character which is treated -as end of string). For those you need to use the C +as end of string). For those you need to use the C function which has a more complex interface."); ("ll", (RString "listing", [String "directory"]), 5, [], + [], (* XXX Tricky to test because it depends on the exact format + * of the 'ls -l' command, which changes between F10 and F11. + *) "list the files in a directory (long format)", "\ List the files in C (relative to the root directory, @@ -247,6 +501,11 @@ This command is mostly useful for interactive sessions. It is I intended that you try to parse the output string."); ("ls", (RStringList "listing", [String "directory"]), 6, [], + [InitBasicFS, TestOutputList ( + [["touch"; "/new"]; + ["touch"; "/newer"]; + ["touch"; "/newest"]; + ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])], "list the files in a directory", "\ List the files in C (relative to the root directory, @@ -257,6 +516,8 @@ This command is mostly useful for interactive sessions. Programs should probably use C instead."); ("list_devices", (RStringList "devices", []), 7, [], + [InitEmpty, TestOutputList ( + [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"])], "list the block devices", "\ List all the block devices. @@ -264,6 +525,11 @@ List all the block devices. The full block device names are returned, eg. C"); ("list_partitions", (RStringList "partitions", []), 8, [], + [InitBasicFS, TestOutputList ( + [["list_partitions"]], ["/dev/sda1"]); + InitEmpty, TestOutputList ( + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; + ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])], "list the partitions", "\ List all the partitions detected on all block devices. @@ -274,6 +540,14 @@ This does not return logical volumes. For that you will need to call C."); ("pvs", (RStringList "physvols", []), 9, [], + [InitBasicFSonLVM, TestOutputList ( + [["pvs"]], ["/dev/sda1"]); + 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"])], "list the LVM physical volumes (PVs)", "\ List all the physical volumes detected. This is the equivalent @@ -285,6 +559,16 @@ PVs (eg. C). See also C."); ("vgs", (RStringList "volgroups", []), 10, [], + [InitBasicFSonLVM, TestOutputList ( + [["vgs"]], ["VG"]); + 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"])], "list the LVM volume groups (VGs)", "\ List all the volumes groups detected. This is the equivalent @@ -296,6 +580,19 @@ detected (eg. C). See also C."); ("lvs", (RStringList "logvols", []), 11, [], + [InitBasicFSonLVM, TestOutputList ( + [["lvs"]], ["/dev/VG/LV"]); + 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"]; + ["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 @@ -307,24 +604,33 @@ This returns a list of the logical volume device names See also C."); ("pvs_full", (RPVList "physvols", []), 12, [], + [], (* 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, [], + [], (* 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, [], + [], (* 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, [], + [InitBasicFS, TestOutputList ( + [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"]; + ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]); + InitBasicFS, TestOutputList ( + [["write_file"; "/new"; ""; "0"]; + ["read_lines"; "/new"]], [])], "read file as lines", "\ Return the contents of the file named C. @@ -337,7 +643,8 @@ Note that this function cannot correctly handle binary files as end of line). For those you need to use the C function which has a more complex interface."); - ("aug_init", (Err, [String "root"; Int "flags"]), 16, [], + ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [], + [], (* XXX Augeas code needs tests. *) "create a new Augeas handle", "\ Create a new Augeas handle for editing configuration files. @@ -387,7 +694,8 @@ To close the handle, you can call C. To find out more about Augeas, see L."); - ("aug_close", (Err, []), 26, [], + ("aug_close", (RErr, []), 26, [], + [], (* XXX Augeas code needs tests. *) "close the current Augeas handle", "\ Close the current Augeas handle and free up any resources @@ -396,6 +704,7 @@ C again before you can use any other Augeas functions."); ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [], + [], (* XXX Augeas code needs tests. *) "define an Augeas variable", "\ Defines an Augeas variable C whose value is the result @@ -406,6 +715,7 @@ On success this returns the number of nodes in C, or C<0> if C evaluates to something which is not a nodeset."); ("aug_defnode", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [], + [], (* XXX Augeas code needs tests. *) "define an Augeas node", "\ Defines a variable C whose value is the result of @@ -420,17 +730,20 @@ number of nodes in the nodeset, and a boolean flag if a node was created."); ("aug_get", (RString "val", [String "path"]), 19, [], + [], (* XXX Augeas code needs tests. *) "look up the value of an Augeas path", "\ Look up the value associated with C. If C matches exactly one node, the C is returned."); - ("aug_set", (Err, [String "path"; String "val"]), 20, [], + ("aug_set", (RErr, [String "path"; String "val"]), 20, [], + [], (* XXX Augeas code needs tests. *) "set Augeas path to value", "\ Set the value associated with C to C."); - ("aug_insert", (Err, [String "path"; String "label"; Bool "before"]), 21, [], + ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [], + [], (* XXX Augeas code needs tests. *) "insert a sibling Augeas node", "\ Create a new sibling C