X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=src%2Fgenerator.ml;h=fef03a81db261f564ce75aaac05a151f77689b4c;hp=00f3c4ecfdc3500ba7b24dc61c46b8d5ed932361;hb=7793f8eda6b26002cb751503928e06f7b9c4a7d2;hpb=7c4f90ddb8378dcf90cb0cc219105dccaa8a9d6e diff --git a/src/generator.ml b/src/generator.ml index 00f3c4e..fef03a8 100755 --- a/src/generator.ml +++ b/src/generator.ml @@ -30,7 +30,6 @@ * * 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";; @@ -91,7 +90,7 @@ and ret = (* "RStruct" is a function which returns a single named structure * or an error indication (in C, a struct, and in other languages * with varying representations, but usually very efficient). See - * after the function list below for the structures. + * after the function list below for the structures. *) | RStruct of string * string (* name of retval, name of struct *) @@ -135,8 +134,12 @@ and args = argt list (* Function parameters, guestfs handle is implicit. *) *) and argt = | String of string (* const char *name, cannot be NULL *) + | Device of string (* /dev device name, cannot be NULL *) + | Pathname of string (* file name, cannot be NULL *) + | Dev_or_Path of string (* /dev device name or Pathname, cannot be NULL *) | OptString of string (* const char *name, may be NULL *) | StringList of string(* list of strings (each string cannot be NULL) *) + | DeviceList of string(* list of Device names (each 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 @@ -207,49 +210,60 @@ type tests = (test_init * test_prereq * 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 list of block devices (could be either * "/dev/sd.." or "/dev/hd.." form - we don't check the 5th * character of each string). *) | TestOutputListOfDevices of seq * string list + (* Run the command sequence and expect the output of the final * command to be the integer. *) | TestOutputInt of seq * int + (* Run the command sequence and expect the output of the final * command to be , eg. ">=", "1". *) | TestOutputIntOp of seq * string * 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 buffer (RBufferOut), ie. string + size. *) | TestOutputBuffer of seq * string + (* 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. *) @@ -266,14 +280,17 @@ and test_field_compare = and test_prereq = (* Test always runs. *) | Always + (* Test is currently disabled - eg. it fails, or it tests some * unimplemented feature. *) | Disabled + (* 'string' is some C code (a function body) that should return * true or false. The test will run if the code returns true. *) | If of string + (* As for 'If' but the test runs _unless_ the code returns true. *) | Unless of string @@ -288,6 +305,12 @@ and test_init = (* Block devices are empty and no filesystems are mounted. *) | InitEmpty + (* /dev/sda contains a single partition /dev/sda1, with random + * content. /dev/sdb and /dev/sdc may have random content. + * No LVM. + *) + | InitPartition + (* /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. @@ -320,6 +343,19 @@ and cmd = string list * Apart from that, long descriptions are just perldoc paragraphs. *) +(* Generate a random UUID (used in tests). *) +let uuidgen () = + let chan = Unix.open_process_in "uuidgen" in + let uuid = input_line chan in + (match Unix.close_process_in chan with + | Unix.WEXITED 0 -> () + | Unix.WEXITED _ -> + failwith "uuidgen: process exited with non-zero status" + | Unix.WSIGNALED _ | Unix.WSTOPPED _ -> + failwith "uuidgen: process signalled or stopped by signal" + ); + uuid + (* These test functions are used in the language binding tests. *) let test_all_args = [ @@ -362,9 +398,9 @@ You probably don't want to call this function."); List.map ( fun (name, ret) -> [(name, (ret, [String "val"]), -1, [NotInFish; NotInDocs], - [], - "internal test function - do not use", - "\ + [], + "internal test function - do not use", + "\ This is an internal test function which is used to test whether the automatically generated bindings can handle every possible return type correctly. @@ -373,9 +409,9 @@ It converts string C to the return type. You probably don't want to call this function."); (name ^ "err", (ret, []), -1, [NotInFish; NotInDocs], - [], - "internal test function - do not use", - "\ + [], + "internal test function - do not use", + "\ This is an internal test function which is used to test whether the automatically generated bindings can handle every possible return type correctly. @@ -435,6 +471,8 @@ image). This is equivalent to the qemu parameter C<-drive file=filename,cache=off,if=...>. +C is omitted in cases where it is not supported by +the underlying filesystem. Note that this call checks for the existence of C. This stops you from specifying other types of drive which are supported @@ -512,7 +550,7 @@ 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_path", (RErr, [String "searchpath"]), -1, [FishAlias "path"], [], "set the search path", "\ @@ -742,6 +780,31 @@ C<$major.$minor.$release$extra> I Don't use this call to test for availability of features. Distro backports makes this unreliable."); + ("set_selinux", (RErr, [Bool "selinux"]), -1, [FishAlias "selinux"], + [InitNone, Always, TestOutputTrue ( + [["set_selinux"; "true"]; + ["get_selinux"]])], + "set SELinux enabled or disabled at appliance boot", + "\ +This sets the selinux flag that is passed to the appliance +at boot time. The default is C (disabled). + +Note that if SELinux is enabled, it is always in +Permissive mode (C). + +For more information on the architecture of libguestfs, +see L."); + + ("get_selinux", (RBool "selinux", []), -1, [], + [], + "get SELinux enabled flag", + "\ +This returns the current setting of the selinux flag which +is passed to the appliance at boot time. See C. + +For more information on the architecture of libguestfs, +see L."); + ] (* daemon_functions are any functions which cause some action @@ -749,7 +812,7 @@ of features. Distro backports makes this unreliable."); *) let daemon_functions = [ - ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [], + ("mount", (RErr, [Device "device"; String "mountpoint"]), 1, [], [InitEmpty, Always, TestOutput ( [["sfdiskM"; "/dev/sda"; ","]; ["mkfs"; "ext2"; "/dev/sda1"]; @@ -785,7 +848,7 @@ underlying disk image. You should always call this if you have modified a disk image, before closing the handle."); - ("touch", (RErr, [String "path"]), 3, [], + ("touch", (RErr, [Pathname "path"]), 3, [], [InitBasicFS, Always, TestOutputTrue ( [["touch"; "/new"]; ["exists"; "/new"]])], @@ -795,7 +858,7 @@ Touch acts like the L command. It can be used to 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], + ("cat", (RString "content", [Pathname "path"]), 4, [ProtocolLimitWarning], [InitSquashFS, Always, TestOutput ( [["cat"; "/known-2"]], "abcdef\n")], "list the contents of a file", @@ -807,10 +870,10 @@ Note that this function cannot correctly handle binary files as end of string). For those you need to use the C or C functions which have a more complex interface."); - ("ll", (RString "listing", [String "directory"]), 5, [], + ("ll", (RString "listing", [Pathname "directory"]), 5, [], [], (* XXX Tricky to test because it depends on the exact format - * of the 'ls -l' command, which changes between F10 and F11. - *) + * 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, @@ -819,7 +882,7 @@ there is no cwd) in the format of 'ls -la'. 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, [], + ("ls", (RStringList "listing", [Pathname "directory"]), 6, [], [InitBasicFS, Always, TestOutputList ( [["touch"; "/new"]; ["touch"; "/newer"]; @@ -943,7 +1006,7 @@ of the L command. The \"full\" version includes all fields."); 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, [], + ("read_lines", (RStringList "lines", [Pathname "path"]), 15, [], [InitSquashFS, Always, TestOutputList ( [["read_lines"; "/known-4"]], ["abc"; "def"; "ghi"]); InitSquashFS, Always, TestOutputList ( @@ -960,7 +1023,7 @@ 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", (RErr, [String "root"; Int "flags"]), 16, [], + ("aug_init", (RErr, [Pathname "root"; Int "flags"]), 16, [], [], (* XXX Augeas code needs tests. *) "create a new Augeas handle", "\ @@ -1046,20 +1109,20 @@ On success this returns a pair containing the number of nodes in the nodeset, and a boolean flag if a node was created."); - ("aug_get", (RString "val", [String "path"]), 19, [], + ("aug_get", (RString "val", [String "augpath"]), 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", (RErr, [String "path"; String "val"]), 20, [], + ("aug_set", (RErr, [String "augpath"; String "val"]), 20, [], [], (* XXX Augeas code needs tests. *) "set Augeas path to value", "\ Set the value associated with C to C."); - ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [], + ("aug_insert", (RErr, [String "augpath"; String "label"; Bool "before"]), 21, [], [], (* XXX Augeas code needs tests. *) "insert a sibling Augeas node", "\ @@ -1071,7 +1134,7 @@ C must match exactly one existing node in the tree, and C