X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=src%2Fgenerator.ml;h=de3b4f62a819fe41addbcf6a93bd60f6d9335ec7;hp=0904afc0435e63dcc854277753e88b0cce1d9d12;hb=23e6fc3f61294acf1bce2003dc4060df25e899f9;hpb=745f1d9ee8480b3a38f778fcc4506ce86da473a6 diff --git a/src/generator.ml b/src/generator.ml index 0904afc..de3b4f6 100755 --- a/src/generator.ml +++ b/src/generator.ml @@ -24,8 +24,9 @@ * 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. + * After editing this file, run it (./src/generator.ml) to regenerate all the + * output files. Note that if you are using a separate build directory you + * must run generator.ml from the _source_ directory. * * IMPORTANT: This script should NOT print any warnings. If it prints * warnings, you should treat them as errors. @@ -84,6 +85,20 @@ and ret = * inefficient. Keys should be unique. NULLs are not permitted. *) | RHashtable of string + (* "RBufferOut" is handled almost exactly like RString, but + * it allows the string to contain arbitrary 8 bit data including + * ASCII NUL. In the C API this causes an implicit extra parameter + * to be added of type . The extra parameter + * returns the actual size of the return buffer in bytes. + * + * Other programming languages support strings with arbitrary 8 bit + * data. + * + * At the RPC layer we have to use the opaque<> type instead of + * string<>. Returned data is still limited to the max message + * size (ie. ~ 2 MB). + *) + | RBufferOut of string and args = argt list (* Function parameters, guestfs handle is implicit. *) @@ -110,6 +125,18 @@ and argt = *) | FileIn of string | FileOut of string +(* Not implemented: + (* Opaque buffer which can contain arbitrary 8 bit data. + * In the C API, this is expressed as pair. + * Most other languages have a string type which can contain + * ASCII NUL. We use whatever type is appropriate for each + * language. + * Buffers are limited by the total message size. To transfer + * large blocks of data, use FileIn/FileOut parameters instead. + * To return an arbitrary buffer, use RBufferOut. + *) + | BufferIn of string +*) type flags = | ProtocolLimitWarning (* display warning about protocol size limits *) @@ -183,6 +210,10 @@ and test = *) | 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 @@ -206,6 +237,7 @@ and test = and test_field_compare = | CompareWithInt of string * int + | CompareWithIntOp of string * string * int | CompareWithString of string * string | CompareFieldsIntEq of string * string | CompareFieldsStrEq of string * string @@ -442,7 +474,8 @@ environment variable. Setting C to C restores the default qemu binary."); ("get_qemu", (RConstString "qemu", []), -1, [], - [], + [InitNone, Always, TestRun ( + [["get_qemu"]])], "get the qemu binary", "\ Return the current qemu binary. @@ -462,7 +495,8 @@ C environment variable. Setting C to C restores the default path."); ("get_path", (RConstString "path", []), -1, [], - [], + [InitNone, Always, TestRun ( + [["get_path"]])], "get the search path", "\ Return the current search path. @@ -470,7 +504,7 @@ Return the current search path. This is always non-NULL. If it wasn't set already, then this will return the default path."); - ("set_append", (RErr, [String "append"]), -1, [FishAlias "append"], + ("set_append", (RErr, [OptString "append"]), -1, [FishAlias "append"], [], "add options to kernel command line", "\ @@ -484,6 +518,10 @@ Setting C to C means I additional options are passed (libguestfs always adds a few of its own)."); ("get_append", (RConstString "append", []), -1, [], + (* This cannot be tested with the current framework. The + * function can return NULL in normal operations, which the + * test framework interprets as an error. + *) [], "get the additional kernel options", "\ @@ -505,7 +543,8 @@ This is disabled by default (except in guestfish where it is enabled by default)."); ("get_autosync", (RBool "autosync", []), -1, [], - [], + [InitNone, Always, TestRun ( + [["get_autosync"]])], "get autosync mode", "\ Get the autosync flag."); @@ -526,7 +565,8 @@ C is defined and set to C<1>."); This returns the verbose messages flag."); ("is_ready", (RBool "ready", []), -1, [], - [], + [InitNone, Always, TestOutputTrue ( + [["is_ready"]])], "is ready to accept commands", "\ This returns true iff this handle is ready to accept commands @@ -535,7 +575,8 @@ This returns true iff this handle is ready to accept commands For more information on states, see L."); ("is_config", (RBool "config", []), -1, [], - [], + [InitNone, Always, TestOutputFalse ( + [["is_config"]])], "is in configuration state", "\ This returns true iff this handle is being configured @@ -544,7 +585,8 @@ This returns true iff this handle is being configured For more information on states, see L."); ("is_launching", (RBool "launching", []), -1, [], - [], + [InitNone, Always, TestOutputFalse ( + [["is_launching"]])], "is launching subprocess", "\ This returns true iff this handle is launching the subprocess @@ -553,7 +595,8 @@ This returns true iff this handle is launching the subprocess For more information on states, see L."); ("is_busy", (RBool "busy", []), -1, [], - [], + [InitNone, Always, TestOutputFalse ( + [["is_busy"]])], "is busy processing a command", "\ This returns true iff this handle is busy processing a command @@ -599,7 +642,9 @@ actions using the low-level API. For more information on states, see L."); ("set_memsize", (RErr, [Int "memsize"]), -1, [FishAlias "memsize"], - [], + [InitNone, Always, TestOutputInt ( + [["set_memsize"; "500"]; + ["get_memsize"]], 500)], "set memory allocated to the qemu subprocess", "\ This sets the memory size in megabytes allocated to the @@ -614,7 +659,8 @@ For more information on the architecture of libguestfs, see L."); ("get_memsize", (RInt "memsize", []), -1, [], - [], + [InitNone, Always, TestOutputIntOp ( + [["get_memsize"]], ">=", 256)], "get memory allocated to the qemu subprocess", "\ This gets the memory size in megabytes allocated to the @@ -628,7 +674,8 @@ For more information on the architecture of libguestfs, see L."); ("get_pid", (RInt "pid", []), -1, [FishAlias "pid"], - [], + [InitNone, Always, TestOutputIntOp ( + [["get_pid"]], ">=", 1)], "get PID of qemu subprocess", "\ Return the process ID of the qemu subprocess. If there is no @@ -637,7 +684,7 @@ qemu subprocess, then this will return an error. This is an internal call used for debugging and testing."); ("version", (RStruct ("version", "version"), []), -1, [], - [InitBasicFS, Always, TestOutputStruct ( + [InitNone, Always, TestOutputStruct ( [["version"]], [CompareWithInt ("major", 1)])], "get the library version number", "\ @@ -729,8 +776,8 @@ 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 -function which has a more complex interface."); +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, [], [], (* XXX Tricky to test because it depends on the exact format @@ -1327,7 +1374,9 @@ contains the filesystem."); This returns the list of currently mounted filesystems. It returns the list of devices (eg. C, C). -Some internal mounts are not shown."); +Some internal mounts are not shown. + +See also: C"); ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"], [InitBasicFS, Always, TestOutputList ( @@ -1674,8 +1723,8 @@ This uses the L command."); ("upload", (RErr, [FileIn "filename"; String "remotefilename"]), 66, [], [InitBasicFS, Always, TestOutput ( (* Pick a file from cwd which isn't likely to change. *) - [["upload"; "../COPYING.LIB"; "/COPYING.LIB"]; - ["checksum"; "md5"; "/COPYING.LIB"]], "e3eda01d9815f8d24aae2dbd89b68b06")], + [["upload"; "../COPYING.LIB"; "/COPYING.LIB"]; + ["checksum"; "md5"; "/COPYING.LIB"]], "e3eda01d9815f8d24aae2dbd89b68b06")], "upload a file from the local machine", "\ Upload local file C to C on the @@ -1688,10 +1737,10 @@ See also C."); ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [], [InitBasicFS, Always, TestOutput ( (* Pick a file from cwd which isn't likely to change. *) - [["upload"; "../COPYING.LIB"; "/COPYING.LIB"]; - ["download"; "/COPYING.LIB"; "testdownload.tmp"]; - ["upload"; "testdownload.tmp"; "/upload"]; - ["checksum"; "md5"; "/upload"]], "e3eda01d9815f8d24aae2dbd89b68b06")], + [["upload"; "../COPYING.LIB"; "/COPYING.LIB"]; + ["download"; "/COPYING.LIB"; "testdownload.tmp"]; + ["upload"; "testdownload.tmp"; "/upload"]; + ["checksum"; "md5"; "/upload"]], "e3eda01d9815f8d24aae2dbd89b68b06")], "download a file to the local machine", "\ Download file C and save it as C @@ -2313,19 +2362,19 @@ are activated or deactivated."); ("lvresize", (RErr, [String "device"; Int "mbytes"]), 105, [], [InitNone, Always, TestOutput ( - [["sfdiskM"; "/dev/sda"; ","]; - ["pvcreate"; "/dev/sda1"]; - ["vgcreate"; "VG"; "/dev/sda1"]; - ["lvcreate"; "LV"; "VG"; "10"]; - ["mkfs"; "ext2"; "/dev/VG/LV"]; - ["mount"; "/dev/VG/LV"; "/"]; - ["write_file"; "/new"; "test content"; "0"]; - ["umount"; "/"]; - ["lvresize"; "/dev/VG/LV"; "20"]; - ["e2fsck_f"; "/dev/VG/LV"]; - ["resize2fs"; "/dev/VG/LV"]; - ["mount"; "/dev/VG/LV"; "/"]; - ["cat"; "/new"]], "test content")], + [["sfdiskM"; "/dev/sda"; ","]; + ["pvcreate"; "/dev/sda1"]; + ["vgcreate"; "VG"; "/dev/sda1"]; + ["lvcreate"; "LV"; "VG"; "10"]; + ["mkfs"; "ext2"; "/dev/VG/LV"]; + ["mount"; "/dev/VG/LV"; "/"]; + ["write_file"; "/new"; "test content"; "0"]; + ["umount"; "/"]; + ["lvresize"; "/dev/VG/LV"; "20"]; + ["e2fsck_f"; "/dev/VG/LV"]; + ["resize2fs"; "/dev/VG/LV"]; + ["mount"; "/dev/VG/LV"; "/"]; + ["cat"; "/new"]], "test content")], "resize an LVM logical volume", "\ This resizes (expands or shrinks) an existing LVM logical @@ -2397,7 +2446,7 @@ This command is only needed because of C ("sleep", (RErr, [Int "secs"]), 109, [], [InitNone, Always, TestRun ( - [["sleep"; "1"]])], + [["sleep"; "1"]])], "sleep for some seconds", "\ Sleep for C seconds."); @@ -2797,6 +2846,50 @@ All entries in the directory are returned, including C<.> and C<..>. The entries are I sorted, but returned in the same order as the underlying filesystem. +Also this call returns basic file type information about each +file. The C field will contain one of the following characters: + +=over 4 + +=item 'b' + +Block special + +=item 'c' + +Char special + +=item 'd' + +Directory + +=item 'f' + +FIFO (named pipe) + +=item 'l' + +Symbolic link + +=item 'r' + +Regular file + +=item 's' + +Socket + +=item 'u' + +Unknown file type + +=item '?' + +The L returned a C field with an +unexpected value + +=back + This function is primarily intended for use by programs. To get a simple list of names, use C. To get a printable directory for human consumption, use C."); @@ -2813,6 +2906,134 @@ were rarely if ever used anyway. See also C and the L manpage."); + ("zfile", (RString "description", [String "method"; String "path"]), 140, [], + [], + "determine file type inside a compressed file", + "\ +This command runs C after first decompressing C +using C. + +C must be one of C, C or C. + +See also: C"); + + ("getxattrs", (RStructList ("xattrs", "xattr"), [String "path"]), 141, [], + [], + "list extended attributes of a file or directory", + "\ +This call lists the extended attributes of the file or directory +C. + +At the system call level, this is a combination of the +L and L calls. + +See also: C, L."); + + ("lgetxattrs", (RStructList ("xattrs", "xattr"), [String "path"]), 142, [], + [], + "list extended attributes of a file or directory", + "\ +This is the same as C, but if C +is a symbolic link, then it returns the extended attributes +of the link itself."); + + ("setxattr", (RErr, [String "xattr"; + String "val"; Int "vallen"; (* will be BufferIn *) + String "path"]), 143, [], + [], + "set extended attribute of a file or directory", + "\ +This call sets the extended attribute named C +of the file C to the value C (of length C). +The value is arbitrary 8 bit data. + +See also: C, L."); + + ("lsetxattr", (RErr, [String "xattr"; + String "val"; Int "vallen"; (* will be BufferIn *) + String "path"]), 144, [], + [], + "set extended attribute of a file or directory", + "\ +This is the same as C, but if C +is a symbolic link, then it sets an extended attribute +of the link itself."); + + ("removexattr", (RErr, [String "xattr"; String "path"]), 145, [], + [], + "remove extended attribute of a file or directory", + "\ +This call removes the extended attribute named C +of the file C. + +See also: C, L."); + + ("lremovexattr", (RErr, [String "xattr"; String "path"]), 146, [], + [], + "remove extended attribute of a file or directory", + "\ +This is the same as C, but if C +is a symbolic link, then it removes an extended attribute +of the link itself."); + + ("mountpoints", (RHashtable "mps", []), 147, [], + [], + "show mountpoints", + "\ +This call is similar to C. That call returns +a list of devices. This one returns a hash table (map) of +device name to directory where the device is mounted."); + + ("mkmountpoint", (RErr, [String "path"]), 148, [], + [], + "create a mountpoint", + "\ +C and C are +specialized calls that can be used to create extra mountpoints +before mounting the first filesystem. + +These calls are I necessary in some very limited circumstances, +mainly the case where you want to mount a mix of unrelated and/or +read-only filesystems together. + +For example, live CDs often contain a \"Russian doll\" nest of +filesystems, an ISO outer layer, with a squashfs image inside, with +an ext2/3 image inside that. You can unpack this as follows +in guestfish: + + add-ro Fedora-11-i686-Live.iso + run + mkmountpoint /cd + mkmountpoint /squash + mkmountpoint /ext3 + mount /dev/sda /cd + mount-loop /cd/LiveOS/squashfs.img /squash + mount-loop /squash/LiveOS/ext3fs.img /ext3 + +The inner filesystem is now unpacked under the /ext3 mountpoint."); + + ("rmmountpoint", (RErr, [String "path"]), 149, [], + [], + "remove a mountpoint", + "\ +This calls removes a mountpoint that was previously created +with C. See C +for full details."); + + ("read_file", (RBufferOut "content", [String "path"]), 150, [ProtocolLimitWarning], + [InitBasicFS, Always, TestOutput ( + [["write_file"; "/new"; "new file contents"; "0"]; + ["read_file"; "/new"]], "new file contents")], + "read a file", + "\ +This calls returns the contents of the file C as a +buffer. + +Unlike C, this function can correctly +handle files that contain embedded ASCII NUL characters. +However unlike C, this function is limited +in the total size of file that can be handled."); + ] let all_functions = non_daemon_functions @ daemon_functions @@ -2828,6 +3049,7 @@ let all_functions_sorted = type field = | FChar (* C 'char' (really, a 7 bit byte). *) | FString (* nul-terminated ASCII string. *) + | FBuffer (* opaque buffer of bytes, (char *, int) pair *) | FUInt32 | FInt32 | FUInt64 @@ -2966,6 +3188,12 @@ let structs = [ "release", FInt64; "extra", FString; ]; + + (* Extended attribute. *) + "xattr", [ + "attrname", FString; + "attrval", FBuffer; + ]; ] (* end of structs *) (* Ugh, Java has to be different .. @@ -2980,6 +3208,7 @@ let java_structs = [ "statvfs", "StatVFS"; "dirent", "Dirent"; "version", "Version"; + "xattr", "XAttr"; ] (* Used for testing language bindings. *) @@ -3130,7 +3359,8 @@ let cols_of_struct typ = let seq_of_test = function | TestRun s | TestOutput (s, _) | TestOutputList (s, _) | TestOutputListOfDevices (s, _) - | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s + | TestOutputInt (s, _) | TestOutputIntOp (s, _, _) + | TestOutputTrue s | TestOutputFalse s | TestOutputLength (s, _) | TestOutputStruct (s, _) | TestLastFail s -> s @@ -3187,7 +3417,7 @@ let check_functions () = | RErr -> () | RInt n | RInt64 n | RBool n | RConstString n | RString n | RStringList n | RStruct (n, _) | RStructList (n, _) - | RHashtable n -> + | RHashtable n | RBufferOut n -> check_arg_ret_name n ); List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style) @@ -3369,6 +3599,10 @@ 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" + | RBufferOut _ -> + pr "This function returns a buffer, or NULL on error. +The size of the returned buffer is written to C<*size_r>. +I.\n\n" ); if List.mem ProtocolLimitWarning flags then pr "%s\n\n" protocol_limit_warning; @@ -3392,6 +3626,10 @@ and generate_structs_pod () = | name, (FUInt64|FBytes) -> pr " uint64_t %s;\n" name | name, FInt64 -> pr " int64_t %s;\n" name | name, FString -> pr " char *%s;\n" name + | name, FBuffer -> + pr " /* The next two fields describe a byte array. */\n"; + pr " uint32_t %s_len;\n" name; + pr " char *%s;\n" name | name, FUUID -> pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n"; pr " char %s[32];\n" name @@ -3435,6 +3673,7 @@ and generate_xdr () = List.iter (function | name, FChar -> pr " char %s;\n" name | name, FString -> pr " string %s<>;\n" name + | name, FBuffer -> pr " opaque %s<>;\n" name | name, FUUID -> pr " opaque %s[32];\n" name | name, (FInt32|FUInt32) -> pr " int %s;\n" name | name, (FInt64|FUInt64|FBytes) -> pr " hyper %s;\n" name @@ -3501,6 +3740,10 @@ and generate_xdr () = pr "struct %s_ret {\n" name; pr " str %s<>;\n" n; pr "};\n\n" + | RBufferOut n -> + pr "struct %s_ret {\n" name; + pr " opaque %s<>;\n" n; + pr "};\n\n" ); ) daemon_functions; @@ -3596,6 +3839,9 @@ and generate_structs_h () = function | name, FChar -> pr " char %s;\n" name | name, FString -> pr " char *%s;\n" name + | name, FBuffer -> + pr " uint32_t %s_len;\n" name; + pr " char *%s;\n" name | name, FUUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name | name, FUInt32 -> pr " uint32_t %s;\n" name | name, FInt32 -> pr " int32_t %s;\n" name @@ -3681,7 +3927,7 @@ check_state (guestfs_h *g, const char *caller) { if (!guestfs_is_ready (g)) { if (guestfs_is_config (g)) - error (g, \"%%s: call launch() before using this function\", + error (g, \"%%s: call launch before using this function\\n(in guestfish, don't forget to use the 'run' command)\", caller); else if (guestfs_is_launching (g)) error (g, \"%%s: call wait_ready() before using this function\", @@ -3719,7 +3965,7 @@ check_state (guestfs_h *g, const char *caller) | RInt _ | RInt64 _ | RBool _ | RString _ | RStringList _ | RStruct _ | RStructList _ - | RHashtable _ -> + | RHashtable _ | RBufferOut _ -> pr " struct %s_ret ret;\n" name ); pr "};\n"; @@ -3760,7 +4006,7 @@ check_state (guestfs_h *g, const char *caller) | RInt _ | RInt64 _ | RBool _ | RString _ | RStringList _ | RStruct _ | RStructList _ - | RHashtable _ -> + | RHashtable _ | RBufferOut _ -> pr " if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name; pr " error (g, \"%%s: failed to parse reply\", \"%s\");\n" name; pr " return;\n"; @@ -3782,7 +4028,7 @@ check_state (guestfs_h *g, const char *caller) failwithf "RConstString cannot be returned from a daemon function" | RString _ | RStringList _ | RStruct _ | RStructList _ - | RHashtable _ -> + | RHashtable _ | RBufferOut _ -> "NULL" in pr "{\n"; @@ -3920,6 +4166,9 @@ check_state (guestfs_h *g, const char *caller) | RStructList (n, _) -> pr " /* caller will free this */\n"; pr " return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n + | RBufferOut n -> + pr " *size_r = ctx.ret.%s.%s_len;\n" n n; + pr " return ctx.ret.%s.%s_val; /* caller will free */\n" n n ); pr "}\n\n" @@ -4000,7 +4249,11 @@ and generate_daemon_actions () = | RString _ -> pr " char *r;\n"; "NULL" | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL" | RStruct (_, typ) -> pr " guestfs_int_%s *r;\n" typ; "NULL" - | RStructList (_, typ) -> pr " guestfs_int_%s_list *r;\n" typ; "NULL" in + | RStructList (_, typ) -> pr " guestfs_int_%s_list *r;\n" typ; "NULL" + | RBufferOut _ -> + pr " size_t size;\n"; + pr " char *r;\n"; + "NULL" in (match snd style with | [] -> () @@ -4054,11 +4307,11 @@ and generate_daemon_actions () = (* Don't want to call the impl with any FileIn or FileOut * parameters, since these go "outside" the RPC protocol. *) - let argsnofile = + let args' = List.filter (function FileIn _ | FileOut _ -> false | _ -> true) (snd style) in pr " r = do_%s " name; - generate_call_args argsnofile; + generate_c_call_args (fst style, args'); pr ";\n"; pr " if (r == %s)\n" error_code; @@ -4110,6 +4363,13 @@ and generate_daemon_actions () = name; pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name + | RBufferOut n -> + pr " struct guestfs_%s_ret ret;\n" name; + pr " ret.%s.%s_val = r;\n" n n; + pr " ret.%s.%s_len = size;\n" n n; + pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" + name; + pr " free (r);\n" ); (* Free the args. *) @@ -4213,7 +4473,7 @@ and generate_daemon_actions () = pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name; pr " return -1;\n"; pr " }\n"; - | FInt32 | FUInt32 | FUInt64 | FChar -> + | FBuffer | FInt32 | FUInt32 | FUInt64 | FChar -> assert false (* can never be an LVM column *) ); pr " tok = next;\n"; @@ -4621,7 +4881,11 @@ static int %s (void) and generate_one_test_body name i test_name init test = (match init with - | InitNone + | InitNone (* XXX at some point, InitNone and InitEmpty became + * folded together as the same thing. Really we should + * make InitNone do nothing at all, but the tests may + * need to be checked to make sure this is OK. + *) | InitEmpty -> pr " /* InitNone|InitEmpty for %s */\n" test_name; List.iter (generate_test_command_call test_name) @@ -4747,6 +5011,19 @@ and generate_one_test_body name i test_name init test = in List.iter (generate_test_command_call test_name) seq; generate_test_command_call ~test test_name last + | TestOutputIntOp (seq, op, expected) -> + pr " /* TestOutputIntOp for %s (%d) */\n" name i; + let seq, last = get_seq_last seq in + let test () = + pr " if (! (r %s %d)) {\n" op expected; + pr " fprintf (stderr, \"%s: expected %s %d but got %%d\\n\"," + test_name op 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 @@ -4805,6 +5082,13 @@ and generate_one_test_body name i test_name init test = pr " (int) r->%s);\n" field; pr " return -1;\n"; pr " }\n" + | CompareWithIntOp (field, op, expected) -> + pr " if (!(r->%s %s %d)) {\n" field op expected; + pr " fprintf (stderr, \"%s: %s was %%d, expected %s %d\\n\",\n" + test_name field op 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" @@ -4894,7 +5178,11 @@ and generate_test_command_call ?(expect_error = false) ?test test_name cmd = | RStruct (_, typ) -> pr " struct guestfs_%s *r;\n" typ; "NULL" | RStructList (_, typ) -> - pr " struct guestfs_%s_list *r;\n" typ; "NULL" in + pr " struct guestfs_%s_list *r;\n" typ; "NULL" + | RBufferOut _ -> + pr " char *r;\n"; + pr " size_t size;\n"; + "NULL" in pr " suppress_error = %d;\n" (if expect_error then 1 else 0); pr " r = guestfs_%s (g" name; @@ -4920,7 +5208,13 @@ and generate_test_command_call ?(expect_error = false) ?test test_name cmd = let b = bool_of_string arg in pr ", %d" (if b then 1 else 0) ) (List.combine (snd style) args); + (match fst style with + | RBufferOut _ -> pr ", &size" + | _ -> () + ); + pr ");\n"; + if not expect_error then pr " if (r == %s)\n" error_code else @@ -4935,7 +5229,7 @@ and generate_test_command_call ?(expect_error = false) ?test test_name cmd = (match fst style with | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ -> () - | RString _ -> pr " free (r);\n" + | RString _ | RBufferOut _ -> pr " free (r);\n" | RStringList _ | RHashtable _ -> pr " for (i = 0; r[i] != NULL; ++i)\n"; pr " free (r[i]);\n"; @@ -4972,6 +5266,7 @@ and generate_fish_cmds () = pr "#include \n"; pr "#include \n"; pr "#include \n"; + pr "#include \n"; pr "\n"; pr "#include \n"; pr "#include \"fish.h\"\n"; @@ -5049,7 +5344,7 @@ and generate_fish_cmds () = List.iter ( fun (typ, cols) -> let needs_i = - List.exists (function (_, FUUID) -> true | _ -> false) cols in + List.exists (function (_, (FUUID|FBuffer)) -> true | _ -> false) cols in pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ; pr "{\n"; @@ -5066,6 +5361,14 @@ and generate_fish_cmds () = pr " for (i = 0; i < 32; ++i)\n"; pr " printf (\"%%c\", %s->%s[i]);\n" typ name; pr " printf (\"\\n\");\n" + | name, FBuffer -> + pr " printf (\"%s: \");\n" name; + pr " for (i = 0; i < %s->%s_len; ++i)\n" typ name; + pr " if (isprint (%s->%s[i]))\n" typ name; + pr " printf (\"%%c\", %s->%s[i]);\n" typ name; + pr " else\n"; + pr " printf (\"\\\\x%%02x\", %s->%s[i]);\n" typ name; + pr " printf (\"\\n\");\n" | name, (FUInt64|FBytes) -> pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name | name, FInt64 -> @@ -5109,6 +5412,9 @@ and generate_fish_cmds () = | RStringList _ | RHashtable _ -> pr " char **r;\n" | RStruct (_, typ) -> pr " struct guestfs_%s *r;\n" typ | RStructList (_, typ) -> pr " struct guestfs_%s_list *r;\n" typ + | RBufferOut _ -> + pr " char *r;\n"; + pr " size_t size;\n"; ); List.iter ( function @@ -5155,7 +5461,7 @@ and generate_fish_cmds () = try find_map (function FishAction n -> Some n | _ -> None) flags with Not_found -> sprintf "guestfs_%s" name in pr " r = %s " fn; - generate_call_args ~handle:"g" (snd style); + generate_c_call_args ~handle:"g" style; pr ";\n"; (* Check return value for errors and display command results. *) @@ -5202,6 +5508,11 @@ and generate_fish_cmds () = pr " print_table (r);\n"; pr " free_strings (r);\n"; pr " return 0;\n" + | RBufferOut _ -> + pr " if (r == NULL) return -1;\n"; + pr " fwrite (r, size, 1, stdout);\n"; + pr " free (r);\n"; + pr " return 0;\n" ); pr "}\n"; pr "\n" @@ -5392,7 +5703,7 @@ and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true) | RInt64 _ -> pr "int64_t " | RBool _ -> pr "int " | RConstString _ -> pr "const char *" - | RString _ -> pr "char *" + | RString _ | RBufferOut _ -> pr "char *" | RStringList _ | RHashtable _ -> pr "char **" | RStruct (_, typ) -> if not in_daemon then pr "struct guestfs_%s *" typ @@ -5401,8 +5712,9 @@ and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true) if not in_daemon then pr "struct guestfs_%s_list *" typ else pr "guestfs_int_%s_list *" typ ); + let is_RBufferOut = match fst style with RBufferOut _ -> true | _ -> false in pr "%s%s (" prefix name; - if handle = None && List.length (snd style) = 0 then + if handle = None && List.length (snd style) = 0 && not is_RBufferOut then pr "void" else ( let comma = ref false in @@ -5433,25 +5745,37 @@ and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true) | FileOut n -> if not in_daemon then (next (); pr "const char *%s" n) ) (snd style); + if is_RBufferOut then (next (); pr "size_t *size_r"); ); pr ")"; if semicolon then pr ";"; if newline then pr "\n" (* Generate C call arguments, eg "(handle, foo, bar)" *) -and generate_call_args ?handle args = +and generate_c_call_args ?handle ?(decl = false) style = pr "("; let comma = ref false in + let next () = + if !comma then pr ", "; + comma := true + in (match handle with | None -> () | Some handle -> pr "%s" handle; comma := true ); List.iter ( fun arg -> - if !comma then pr ", "; - comma := true; + next (); pr "%s" (name_of_argt arg) - ) args; + ) (snd style); + (* For RBufferOut calls, add implicit &size parameter. *) + if not decl then ( + match fst style with + | RBufferOut _ -> + next (); + pr "&size" + | _ -> () + ); pr ")" (* Generate the OCaml bindings interface. *) @@ -5581,6 +5905,10 @@ copy_table (char * const * argv) (match col with | name, FString -> pr " v = caml_copy_string (%s->%s);\n" typ name + | name, FBuffer -> + pr " v = caml_alloc_string (%s->%s_len);\n" typ name; + pr " memcpy (String_val (v), %s->%s, %s->%s_len);\n" + typ name typ name | name, FUUID -> pr " v = caml_alloc_string (32);\n"; pr " memcpy (String_val (v), %s->%s, 32);\n" typ name @@ -5692,12 +6020,16 @@ copy_table (char * const * argv) | RHashtable _ -> pr " int i;\n"; pr " char **r;\n"; + "NULL" + | RBufferOut _ -> + pr " char *r;\n"; + pr " size_t size;\n"; "NULL" in pr "\n"; pr " caml_enter_blocking_section ();\n"; pr " r = guestfs_%s " name; - generate_call_args ~handle:"g" (snd style); + generate_c_call_args ~handle:"g" style; pr ";\n"; pr " caml_leave_blocking_section ();\n"; @@ -5736,6 +6068,9 @@ copy_table (char * const * argv) pr " rv = copy_table (r);\n"; pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n"; pr " free (r);\n"; + | RBufferOut _ -> + pr " rv = caml_alloc_string (size);\n"; + pr " memcpy (String_val (rv), r, size);\n"; ); pr " CAMLreturn (rv);\n"; @@ -5761,6 +6096,7 @@ and generate_ocaml_structure_decls () = List.iter ( function | name, FString -> pr " %s : string;\n" name + | name, FBuffer -> pr " %s : string;\n" name | name, FUUID -> pr " %s : string;\n" name | name, (FBytes|FInt64|FUInt64) -> pr " %s : int64;\n" name | name, (FInt32|FUInt32) -> pr " %s : int32;\n" name @@ -5788,7 +6124,7 @@ and generate_ocaml_prototype ?(is_external = false) name style = | RInt64 _ -> pr "int64" | RBool _ -> pr "bool" | RConstString _ -> pr "string" - | RString _ -> pr "string" + | RString _ | RBufferOut _ -> pr "string" | RStringList _ -> pr "string array" | RStruct (_, typ) -> pr "%s" typ | RStructList (_, typ) -> pr "%s array" typ @@ -5905,6 +6241,7 @@ DESTROY (g) | RBool _ -> pr "SV *\n" | RConstString _ -> pr "SV *\n" | RString _ -> pr "SV *\n" + | RBufferOut _ -> pr "SV *\n" | RStringList _ | RStruct _ | RStructList _ | RHashtable _ -> @@ -5912,7 +6249,7 @@ DESTROY (g) ); (* Call and arguments. *) pr "%s " name; - generate_call_args ~handle:"g" (snd style); + generate_c_call_args ~handle:"g" ~decl:true style; pr "\n"; pr " guestfs_h *g;\n"; iteri ( @@ -5946,7 +6283,7 @@ DESTROY (g) pr " int r;\n"; pr " PPCODE:\n"; pr " r = guestfs_%s " name; - generate_call_args ~handle:"g" (snd style); + generate_c_call_args ~handle:"g" style; pr ";\n"; do_cleanups (); pr " if (r == -1)\n"; @@ -5957,7 +6294,7 @@ DESTROY (g) pr " int %s;\n" n; pr " CODE:\n"; pr " %s = guestfs_%s " n name; - generate_call_args ~handle:"g" (snd style); + generate_c_call_args ~handle:"g" style; pr ";\n"; do_cleanups (); pr " if (%s == -1)\n" n; @@ -5970,7 +6307,7 @@ DESTROY (g) pr " int64_t %s;\n" n; pr " CODE:\n"; pr " %s = guestfs_%s " n name; - generate_call_args ~handle:"g" (snd style); + generate_c_call_args ~handle:"g" style; pr ";\n"; do_cleanups (); pr " if (%s == -1)\n" n; @@ -5983,7 +6320,7 @@ DESTROY (g) pr " const char *%s;\n" n; pr " CODE:\n"; pr " %s = guestfs_%s " n name; - generate_call_args ~handle:"g" (snd style); + generate_c_call_args ~handle:"g" style; pr ";\n"; do_cleanups (); pr " if (%s == NULL)\n" n; @@ -5996,7 +6333,7 @@ DESTROY (g) pr " char *%s;\n" n; pr " CODE:\n"; pr " %s = guestfs_%s " n name; - generate_call_args ~handle:"g" (snd style); + generate_c_call_args ~handle:"g" style; pr ";\n"; do_cleanups (); pr " if (%s == NULL)\n" n; @@ -6011,7 +6348,7 @@ DESTROY (g) pr " int i, n;\n"; pr " PPCODE:\n"; pr " %s = guestfs_%s " n name; - generate_call_args ~handle:"g" (snd style); + generate_c_call_args ~handle:"g" style; pr ";\n"; do_cleanups (); pr " if (%s == NULL)\n" n; @@ -6029,6 +6366,21 @@ DESTROY (g) | RStructList (n, typ) -> let cols = cols_of_struct typ in generate_perl_struct_list_code typ cols name style n do_cleanups + | RBufferOut n -> + pr "PREINIT:\n"; + pr " char *%s;\n" n; + pr " size_t size;\n"; + pr " CODE:\n"; + pr " %s = guestfs_%s " n name; + generate_c_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 " RETVAL = newSVpv (%s, size);\n" n; + pr " free (%s);\n" n; + pr " OUTPUT:\n"; + pr " RETVAL\n" ); pr "\n" @@ -6041,7 +6393,7 @@ and generate_perl_struct_list_code typ cols name style n do_cleanups = pr " HV *hv;\n"; pr " PPCODE:\n"; pr " %s = guestfs_%s " n name; - generate_call_args ~handle:"g" (snd style); + generate_c_call_args ~handle:"g" style; pr ";\n"; do_cleanups (); pr " if (%s == NULL)\n" n; @@ -6057,6 +6409,9 @@ and generate_perl_struct_list_code typ cols name style n do_cleanups = | name, FUUID -> pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n" name (String.length name) n name + | name, FBuffer -> + pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, %s->val[i].%s_len), 0);\n" + name (String.length name) n name n name | name, (FBytes|FUInt64) -> pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n" name (String.length name) n name @@ -6082,7 +6437,7 @@ and generate_perl_struct_code typ cols name style n do_cleanups = pr " struct guestfs_%s *%s;\n" typ n; pr " PPCODE:\n"; pr " %s = guestfs_%s " n name; - generate_call_args ~handle:"g" (snd style); + generate_c_call_args ~handle:"g" style; pr ";\n"; do_cleanups (); pr " if (%s == NULL)\n" n; @@ -6096,6 +6451,9 @@ and generate_perl_struct_code typ cols name style n do_cleanups = | name, FString -> pr " PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n" n name + | name, FBuffer -> + pr " PUSHs (sv_2mortal (newSVpv (%s->%s, %s->%s_len)));\n" + n name n name | name, FUUID -> pr " PUSHs (sv_2mortal (newSVpv (%s->%s, 32)));\n" n name @@ -6252,7 +6610,8 @@ and generate_perl_prototype name style = | RInt n | RInt64 n | RConstString n - | RString n -> pr "$%s = " n + | RString n + | RBufferOut n -> pr "$%s = " n | RStruct (n,_) | RHashtable n -> pr "%%%s = " n | RStringList n @@ -6428,6 +6787,10 @@ py_guestfs_close (PyObject *self, PyObject *args) pr " PyDict_SetItemString (dict, \"%s\",\n" name; pr " PyString_FromString (%s->%s));\n" typ name + | name, FBuffer -> + pr " PyDict_SetItemString (dict, \"%s\",\n" name; + pr " PyString_FromStringAndSize (%s->%s, %s->%s_len));\n" + typ name typ name | name, FUUID -> pr " PyDict_SetItemString (dict, \"%s\",\n" name; pr " PyString_FromStringAndSize (%s->%s, 32));\n" @@ -6499,7 +6862,11 @@ py_guestfs_close (PyObject *self, PyObject *args) | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL" | RStruct (_, typ) -> pr " struct guestfs_%s *r;\n" typ; "NULL" | RStructList (_, typ) -> - pr " struct guestfs_%s_list *r;\n" typ; "NULL" in + pr " struct guestfs_%s_list *r;\n" typ; "NULL" + | RBufferOut _ -> + pr " char *r;\n"; + pr " size_t size;\n"; + "NULL" in List.iter ( function @@ -6550,7 +6917,7 @@ py_guestfs_close (PyObject *self, PyObject *args) pr "\n"; pr " r = guestfs_%s " name; - generate_call_args ~handle:"g" (snd style); + generate_c_call_args ~handle:"g" style; pr ";\n"; List.iter ( @@ -6589,6 +6956,9 @@ py_guestfs_close (PyObject *self, PyObject *args) | RHashtable n -> pr " py_r = put_table (r);\n"; pr " free_strings (r);\n" + | RBufferOut _ -> + pr " py_r = PyString_FromStringAndSize (r, size);\n"; + pr " free (r);\n" ); pr " return py_r;\n"; @@ -6692,7 +7062,7 @@ class GuestFS: List.iter ( fun (name, style, _, flags, _, _, longdesc) -> pr " def %s " name; - generate_call_args ~handle:"self" (snd style); + generate_py_call_args ~handle:"self" (snd style); pr ":\n"; if not (List.mem NotInDocs flags) then ( @@ -6700,7 +7070,7 @@ class GuestFS: let doc = match fst style with | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ - | RString _ -> doc + | RString _ | RBufferOut _ -> doc | RStringList _ -> doc ^ "\n\nThis function returns a list of strings." | RStruct (_, typ) -> @@ -6723,11 +7093,17 @@ class GuestFS: pr " u\"\"\"%s\"\"\"\n" doc; ); pr " return libguestfsmod.%s " name; - generate_call_args ~handle:"self._o" (snd style); + generate_py_call_args ~handle:"self._o" (snd style); pr "\n"; pr "\n"; ) all_functions +(* Generate Python call arguments, eg "(handle, foo, bar)" *) +and generate_py_call_args ~handle args = + pr "(%s" handle; + List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args; + pr ")" + (* Useful if you need the longdesc POD text as plain text. Returns a * list of lines. * @@ -6880,11 +7256,15 @@ static VALUE ruby_guestfs_close (VALUE gv) | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL" | RStruct (_, typ) -> pr " struct guestfs_%s *r;\n" typ; "NULL" | RStructList (_, typ) -> - pr " struct guestfs_%s_list *r;\n" typ; "NULL" in + pr " struct guestfs_%s_list *r;\n" typ; "NULL" + | RBufferOut _ -> + pr " char *r;\n"; + pr " size_t size;\n"; + "NULL" in pr "\n"; pr " r = guestfs_%s " name; - generate_call_args ~handle:"g" (snd style); + generate_c_call_args ~handle:"g" style; pr ";\n"; List.iter ( @@ -6937,6 +7317,10 @@ static VALUE ruby_guestfs_close (VALUE gv) pr " }\n"; pr " free (r);\n"; pr " return rv;\n" + | RBufferOut _ -> + pr " VALUE rv = rb_str_new (r, size);\n"; + pr " free (r);\n"; + pr " return rv;\n"; ); pr "}\n"; @@ -6971,6 +7355,8 @@ and generate_ruby_struct_code typ cols = function | name, FString -> pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->%s));\n" name name + | name, FBuffer -> + pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, r->%s_len));\n" name name name | name, FUUID -> pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, 32));\n" name name | name, (FBytes|FUInt64) -> @@ -6999,6 +7385,8 @@ and generate_ruby_struct_list_code typ cols = function | name, FString -> pr " rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name + | name, FBuffer -> + pr " rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, r->val[i].%s_len));\n" name name name | name, FUUID -> pr " rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name | name, (FBytes|FUInt64) -> @@ -7126,7 +7514,7 @@ public class GuestFS { pr " "; if fst style <> RErr then pr "return "; pr "_%s " name; - generate_call_args ~handle:"g" (snd style); + generate_java_call_args ~handle:"g" (snd style); pr ";\n"; pr " }\n"; pr " "; @@ -7137,6 +7525,12 @@ public class GuestFS { pr "}\n" +(* Generate Java call arguments, eg "(handle, foo, bar)" *) +and generate_java_call_args ~handle args = + pr "(%s" handle; + List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args; + pr ")" + and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false) ?(semicolon=true) name style = if privat then pr "private "; @@ -7149,7 +7543,7 @@ and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false) | RInt _ -> pr "int "; | RInt64 _ -> pr "long "; | RBool _ -> pr "boolean "; - | RConstString _ | RString _ -> pr "String "; + | RConstString _ | RString _ | RBufferOut _ -> pr "String "; | RStringList _ -> pr "String[] "; | RStruct (_, typ) -> let name = java_name_of_struct typ in @@ -7210,7 +7604,8 @@ public class %s { List.iter ( function | name, FString - | name, FUUID -> pr " public String %s;\n" name + | name, FUUID + | name, FBuffer -> pr " public String %s;\n" name | name, (FBytes|FUInt64|FInt64) -> pr " public long %s;\n" name | name, (FUInt32|FInt32) -> pr " public int %s;\n" name | name, FChar -> pr " public char %s;\n" name @@ -7277,7 +7672,7 @@ Java_com_redhat_et_libguestfs_GuestFS__1close | RInt _ -> pr "jint "; | RInt64 _ -> pr "jlong "; | RBool _ -> pr "jboolean "; - | RConstString _ | RString _ -> pr "jstring "; + | RConstString _ | RString _ | RBufferOut _ -> pr "jstring "; | RStruct _ | RHashtable _ -> pr "jobject "; | RStringList _ | RStructList _ -> @@ -7332,7 +7727,12 @@ Java_com_redhat_et_libguestfs_GuestFS__1close pr " jfieldID fl;\n"; pr " jobject jfl;\n"; pr " struct guestfs_%s_list *r;\n" typ; "NULL", "NULL" - | RHashtable _ -> pr " char **r;\n"; "NULL", "NULL" in + | RHashtable _ -> pr " char **r;\n"; "NULL", "NULL" + | RBufferOut _ -> + pr " jstring jr;\n"; + pr " char *r;\n"; + pr " size_t size;\n"; + "NULL", "NULL" in List.iter ( function | String n @@ -7352,7 +7752,7 @@ Java_com_redhat_et_libguestfs_GuestFS__1close (match fst style with | RStringList _ | RStructList _ -> true | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _ - | RString _ | RStruct _ | RHashtable _ -> false) || + | RString _ | RBufferOut _ | RStruct _ | RHashtable _ -> false) || List.exists (function StringList _ -> true | _ -> false) (snd style) in if needs_i then pr " int i;\n"; @@ -7387,7 +7787,7 @@ Java_com_redhat_et_libguestfs_GuestFS__1close (* Make the call. *) pr " r = guestfs_%s " name; - generate_call_args ~handle:"g" (snd style); + generate_c_call_args ~handle:"g" style; pr ";\n"; (* Release the parameters. *) @@ -7452,6 +7852,10 @@ Java_com_redhat_et_libguestfs_GuestFS__1close (* XXX *) pr " throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name; pr " return NULL;\n" + | RBufferOut _ -> + pr " jr = (*env)->NewStringUTF (env, r); /* XXX size */\n"; + pr " free (r);\n"; + pr " return jr;\n" ); pr "}\n"; @@ -7474,6 +7878,15 @@ and generate_java_struct_return typ jtyp cols = pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name; pr " (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n"; pr " }\n"; + | name, FBuffer -> + pr " {\n"; + pr " int len = r->%s_len;\n" name; + pr " char s[len+1];\n"; + pr " memcpy (s, r->%s, len);\n" name; + pr " s[len] = 0;\n"; + pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name; + pr " (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n"; + pr " }\n"; | name, (FBytes|FUInt64|FInt64) -> pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name; pr " (*env)->SetLongField (env, jr, fl, r->%s);\n" name; @@ -7508,6 +7921,15 @@ and generate_java_struct_list_return typ jtyp cols = pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name; pr " (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n"; pr " }\n"; + | name, FBuffer -> + pr " {\n"; + pr " int len = r->val[i].%s_len;\n" name; + pr " char s[len+1];\n"; + pr " memcpy (s, r->val[i].%s, len);\n" name; + pr " s[len] = 0;\n"; + pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name; + pr " (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n"; + pr " }\n"; | name, (FBytes|FUInt64|FInt64) -> pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name; pr " (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name; @@ -7543,7 +7965,8 @@ and generate_haskell_hs () = | RStringList _, _ | RStruct _, _ | RStructList _, _ - | RHashtable _, _ -> false in + | RHashtable _, _ + | RBufferOut _, _ -> false in pr "\ {-# INCLUDE #-} @@ -7653,7 +8076,7 @@ last_error h = do pr " err <- last_error h\n"; pr " fail err\n"; | RConstString _ | RString _ | RStringList _ | RStruct _ - | RStructList _ | RHashtable _ -> + | RStructList _ | RHashtable _ | RBufferOut _ -> pr " if (r == nullPtr)\n"; pr " then do\n"; pr " err <- last_error h\n"; @@ -7673,7 +8096,8 @@ last_error h = do | RStringList _ | RStruct _ | RStructList _ - | RHashtable _ -> + | RHashtable _ + | RBufferOut _ -> pr " else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *) ); pr "\n"; @@ -7715,6 +8139,7 @@ and generate_haskell_prototype ~handle ?(hs = false) style = let name = java_name_of_struct typ in pr "[%s]" name | RHashtable _ -> pr "Hashtable" + | RBufferOut _ -> pr "%s" string ); pr ")" @@ -7838,6 +8263,8 @@ print_strings (char * const* const argv) pr " }\n"; pr " strs[n*2] = NULL;\n"; pr " return strs;\n" + | RBufferOut _ -> + pr " return strdup (val);\n" ); pr "}\n"; pr "\n" @@ -7853,7 +8280,8 @@ print_strings (char * const* const argv) | RConstString _ | RString _ | RStringList _ | RStruct _ | RStructList _ - | RHashtable _ -> + | RHashtable _ + | RBufferOut _ -> pr " return NULL;\n" ); pr "}\n"; @@ -8271,6 +8699,15 @@ Run it from the top source directory using the command close (); ) java_structs; + let close = output_to "java/Makefile.inc" in + pr "java_built_sources ="; + List.iter ( + fun (typ, jtyp) -> + pr " com/redhat/et/libguestfs/%s.java" jtyp; + ) java_structs; + pr " com/redhat/et/libguestfs/GuestFS.java\n"; + close (); + let close = output_to "java/com_redhat_et_libguestfs_GuestFS.c" in generate_java_c (); close ();