X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=src%2Fgenerator.ml;h=a58441a96ae9ad8389949772ad8fff1442089b99;hp=cf5db8764c078aa4f93e0fbc8ffe90a58fa79933;hb=58caa9e5f1dca3916178894876b938a6a45771b0;hpb=749708a7ec8930c34605ec58c18fefe0ed8e7981 diff --git a/src/generator.ml b/src/generator.ml index cf5db87..a58441a 100755 --- a/src/generator.ml +++ b/src/generator.ml @@ -33,6 +33,7 @@ *) #load "unix.cma";; +#load "str.cma";; open Printf @@ -284,6 +285,32 @@ The first character of C string must be a C<-> (dash). C can be NULL."); + ("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", @@ -380,6 +407,25 @@ 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 = [ @@ -1132,10 +1178,10 @@ This is the same as the C system call."); ("tune2fs_l", (RHashtable "superblock", [String "device"]), 55, [], [], (* XXX test *) - "get ext2/ext3 superblock details", + "get ext2/ext3/ext4 superblock details", "\ -This returns the contents of the ext2 or ext3 filesystem superblock -on C. +This returns the contents of the ext2, ext3 or ext4 filesystem +superblock on C. It is the same as running C. See L manpage for more details. The list of fields returned isn't @@ -1254,7 +1300,10 @@ Reread the partition table on C. This uses the L command."); ("upload", (RErr, [FileIn "filename"; String "remotefilename"]), 66, [], - [], + [InitBasicFS, TestOutput ( + (* Pick a file from cwd which isn't likely to change. *) + [["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 @@ -1265,7 +1314,12 @@ C can also be a named pipe. See also C."); ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [], - [], + [InitBasicFS, 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")], "download a file to the local machine", "\ Download file C and save it as C @@ -1275,6 +1329,242 @@ C can also be a named pipe. See also C, C."); + ("checksum", (RString "checksum", [String "csumtype"; String "path"]), 68, [], + [InitBasicFS, TestOutput ( + [["write_file"; "/new"; "test\n"; "0"]; + ["checksum"; "crc"; "/new"]], "935282863"); + InitBasicFS, TestLastFail ( + [["checksum"; "crc"; "/new"]]); + InitBasicFS, TestOutput ( + [["write_file"; "/new"; "test\n"; "0"]; + ["checksum"; "md5"; "/new"]], "d8e8fca2dc0f896fd7cb4cb0031ba249"); + InitBasicFS, TestOutput ( + [["write_file"; "/new"; "test\n"; "0"]; + ["checksum"; "sha1"; "/new"]], "4e1243bd22c66e76c2ba9eddc1f91394e57f9f83"); + InitBasicFS, TestOutput ( + [["write_file"; "/new"; "test\n"; "0"]; + ["checksum"; "sha224"; "/new"]], "52f1bf093f4b7588726035c176c0cdb4376cfea53819f1395ac9e6ec"); + InitBasicFS, TestOutput ( + [["write_file"; "/new"; "test\n"; "0"]; + ["checksum"; "sha256"; "/new"]], "f2ca1bb6c7e907d06dafe4687e579fce76b37e4e93b7605022da52e6ccc26fd2"); + InitBasicFS, TestOutput ( + [["write_file"; "/new"; "test\n"; "0"]; + ["checksum"; "sha384"; "/new"]], "109bb6b5b6d5547c1ce03c7a8bd7d8f80c1cb0957f50c4f7fda04692079917e4f9cad52b878f3d8234e1a170b154b72d"); + InitBasicFS, TestOutput ( + [["write_file"; "/new"; "test\n"; "0"]; + ["checksum"; "sha512"; "/new"]], "0e3e75234abc68f4378a86b3f4b32a198ba301845b0cd6e50106e874345700cc6663a86c1ea125dc5e92be17c98f9a0f85ca9d5f595db2012f7cc3571945c123")], + "compute MD5, SHAx or CRC checksum of file", + "\ +This call computes the MD5, SHAx or CRC checksum of the +file named C. + +The type of checksum to compute is given by the C +parameter which must have one of the following values: + +=over 4 + +=item C + +Compute the cyclic redundancy check (CRC) specified by POSIX +for the C command. + +=item C + +Compute the MD5 hash (using the C program). + +=item C + +Compute the SHA1 hash (using the C program). + +=item C + +Compute the SHA224 hash (using the C program). + +=item C + +Compute the SHA256 hash (using the C program). + +=item C + +Compute the SHA384 hash (using the C program). + +=item C + +Compute the SHA512 hash (using the C program). + +=back + +The checksum is returned as a printable string."); + + ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [], + [InitBasicFS, TestOutput ( + [["tar_in"; "images/helloworld.tar"; "/"]; + ["cat"; "/hello"]], "hello\n")], + "unpack tarfile to directory", + "\ +This command uploads and unpacks local file C (an +I tar file) into C. + +To upload a compressed tarball, use C."); + + ("tar_out", (RErr, [String "directory"; FileOut "tarfile"]), 70, [], + [], + "pack directory into tarfile", + "\ +This command packs the contents of C and downloads +it to local file C. + +To download a compressed tarball, use C."); + + ("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [], + [InitBasicFS, TestOutput ( + [["tgz_in"; "images/helloworld.tar.gz"; "/"]; + ["cat"; "/hello"]], "hello\n")], + "unpack compressed tarball to directory", + "\ +This command uploads and unpacks local file C (a +I tar file) into C. + +To upload an uncompressed tarball, use C."); + + ("tgz_out", (RErr, [String "directory"; FileOut "tarball"]), 72, [], + [], + "pack directory into compressed tarball", + "\ +This command packs the contents of C and downloads +it to local file C. + +To download an uncompressed tarball, use C."); + + ("mount_ro", (RErr, [String "device"; String "mountpoint"]), 73, [], + [InitBasicFS, TestLastFail ( + [["umount"; "/"]; + ["mount_ro"; "/dev/sda1"; "/"]; + ["touch"; "/new"]]); + InitBasicFS, TestOutput ( + [["write_file"; "/new"; "data"; "0"]; + ["umount"; "/"]; + ["mount_ro"; "/dev/sda1"; "/"]; + ["cat"; "/new"]], "data")], + "mount a guest disk, read-only", + "\ +This is the same as the C command, but it +mounts the filesystem with the read-only (I<-o ro>) flag."); + + ("mount_options", (RErr, [String "options"; String "device"; String "mountpoint"]), 74, [], + [], + "mount a guest disk with mount options", + "\ +This is the same as the C command, but it +allows you to set the mount options as for the +L I<-o> flag."); + + ("mount_vfs", (RErr, [String "options"; String "vfstype"; String "device"; String "mountpoint"]), 75, [], + [], + "mount a guest disk with mount options and vfstype", + "\ +This is the same as the C command, but it +allows you to set both the mount options and the vfstype +as for the L I<-o> and I<-t> flags."); + + ("debug", (RString "result", [String "subcmd"; StringList "extraargs"]), 76, [], + [], + "debugging and internals", + "\ +The C command exposes some internals of +C (the guestfs daemon) that runs inside the +qemu subprocess. + +There is no comprehensive help for this command. You have +to look at the file C in the libguestfs source +to find out what you can do."); + + ("lvremove", (RErr, [String "device"]), 77, [], + [InitEmpty, TestOutputList ( + [["pvcreate"; "/dev/sda"]; + ["vgcreate"; "VG"; "/dev/sda"]; + ["lvcreate"; "LV1"; "VG"; "50"]; + ["lvcreate"; "LV2"; "VG"; "50"]; + ["lvremove"; "/dev/VG/LV1"]; + ["lvs"]], ["/dev/VG/LV2"]); + InitEmpty, TestOutputList ( + [["pvcreate"; "/dev/sda"]; + ["vgcreate"; "VG"; "/dev/sda"]; + ["lvcreate"; "LV1"; "VG"; "50"]; + ["lvcreate"; "LV2"; "VG"; "50"]; + ["lvremove"; "/dev/VG"]; + ["lvs"]], []); + InitEmpty, TestOutputList ( + [["pvcreate"; "/dev/sda"]; + ["vgcreate"; "VG"; "/dev/sda"]; + ["lvcreate"; "LV1"; "VG"; "50"]; + ["lvcreate"; "LV2"; "VG"; "50"]; + ["lvremove"; "/dev/VG"]; + ["vgs"]], ["VG"])], + "remove an LVM logical volume", + "\ +Remove an LVM logical volume C, where C is +the path to the LV, such as C. + +You can also remove all LVs in a volume group by specifying +the VG name, C."); + + ("vgremove", (RErr, [String "vgname"]), 78, [], + [InitEmpty, TestOutputList ( + [["pvcreate"; "/dev/sda"]; + ["vgcreate"; "VG"; "/dev/sda"]; + ["lvcreate"; "LV1"; "VG"; "50"]; + ["lvcreate"; "LV2"; "VG"; "50"]; + ["vgremove"; "VG"]; + ["lvs"]], []); + InitEmpty, TestOutputList ( + [["pvcreate"; "/dev/sda"]; + ["vgcreate"; "VG"; "/dev/sda"]; + ["lvcreate"; "LV1"; "VG"; "50"]; + ["lvcreate"; "LV2"; "VG"; "50"]; + ["vgremove"; "VG"]; + ["vgs"]], [])], + "remove an LVM volume group", + "\ +Remove an LVM volume group C, (for example C). + +This also forcibly removes all logical volumes in the volume +group (if any)."); + + ("pvremove", (RErr, [String "device"]), 79, [], + [InitEmpty, TestOutputList ( + [["pvcreate"; "/dev/sda"]; + ["vgcreate"; "VG"; "/dev/sda"]; + ["lvcreate"; "LV1"; "VG"; "50"]; + ["lvcreate"; "LV2"; "VG"; "50"]; + ["vgremove"; "VG"]; + ["pvremove"; "/dev/sda"]; + ["lvs"]], []); + InitEmpty, TestOutputList ( + [["pvcreate"; "/dev/sda"]; + ["vgcreate"; "VG"; "/dev/sda"]; + ["lvcreate"; "LV1"; "VG"; "50"]; + ["lvcreate"; "LV2"; "VG"; "50"]; + ["vgremove"; "VG"]; + ["pvremove"; "/dev/sda"]; + ["vgs"]], []); + InitEmpty, TestOutputList ( + [["pvcreate"; "/dev/sda"]; + ["vgcreate"; "VG"; "/dev/sda"]; + ["lvcreate"; "LV1"; "VG"; "50"]; + ["lvcreate"; "LV2"; "VG"; "50"]; + ["vgremove"; "VG"]; + ["pvremove"; "/dev/sda"]; + ["pvs"]], [])], + "remove an LVM physical volume", + "\ +This wipes a physical volume C so that LVM will no longer +recognise it. + +The implementation uses the C command which refuses to +wipe physical volumes that contain any volume groups, so you have +to remove those first."); + ] let all_functions = non_daemon_functions @ daemon_functions @@ -1924,9 +2214,17 @@ and generate_xdr () = (* Message header, etc. *) pr "\ +/* The communication protocol is now documented in the guestfs(3) + * manpage. + */ + const GUESTFS_PROGRAM = 0x2000F5F5; const GUESTFS_PROTOCOL_VERSION = 1; +/* These constants must be larger than any possible message length. */ +const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5; +const GUESTFS_CANCEL_FLAG = 0xffffeeee; + enum guestfs_message_direction { GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */ GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */ @@ -1943,19 +2241,6 @@ struct guestfs_message_error { string error_message; }; -/* For normal requests and replies (not involving any FileIn or - * FileOut parameters), the protocol is: - * - * For requests: - * total length (header + args, but not including length word itself) - * header - * guestfs_foo_args struct - * For replies: - * total length (as above) - * header - * guestfs_foo_ret struct - */ - struct guestfs_message_header { unsigned prog; /* GUESTFS_PROGRAM */ unsigned vers; /* GUESTFS_PROTOCOL_VERSION */ @@ -1965,23 +2250,6 @@ struct guestfs_message_header { guestfs_message_status status; }; -/* Chunked encoding used to transfer files, for FileIn and FileOut - * parameters. - * - * For requests which have >= 1 FileIn parameter: - * length of header + args (but not length word itself, and not chunks) - * header - * guestfs_foo_args struct - * sequence of chunks for FileIn param #0 - * sequence of chunks for FileIn param #1 etc - * - * For replies which have >= 1 FileOut parameter: - * length of header + ret (but not length word itself, and not chunks) - * header - * guestfs_foo_ret struct - * sequence of chunks for FileOut param #0 - * sequence of chunks for FileOut param #1 etc - */ const GUESTFS_MAX_CHUNK_SIZE = 8192; struct guestfs_chunk { @@ -2232,6 +2500,7 @@ check_state (guestfs_h *g, const char *caller) pr " int serial;\n"; pr "\n"; pr " if (check_state (g, \"%s\") == -1) return %s;\n" name error_code; + pr " guestfs_set_busy (g);\n"; pr "\n"; pr " memset (&ctx, 0, sizeof ctx);\n"; pr "\n"; @@ -2262,21 +2531,35 @@ check_state (guestfs_h *g, const char *caller) pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n" name; ); - pr " if (serial == -1)\n"; + pr " if (serial == -1) {\n"; + pr " guestfs_set_ready (g);\n"; pr " return %s;\n" error_code; + pr " }\n"; pr "\n"; (* Send any additional files (FileIn) requested. *) + let need_read_reply_label = ref false in List.iter ( function | FileIn n -> - pr " if (guestfs__send_file_sync (g, %s) == -1)\n" n; - pr " return %s;\n" error_code; + pr " {\n"; + pr " int r;\n"; + pr "\n"; + pr " r = guestfs__send_file_sync (g, %s);\n" n; + pr " if (r == -1) {\n"; + pr " guestfs_set_ready (g);\n"; + pr " return %s;\n" error_code; + pr " }\n"; + pr " if (r == -2) /* daemon cancelled */\n"; + pr " goto read_reply;\n"; + need_read_reply_label := true; + pr " }\n"; pr "\n"; | _ -> () ) (snd style); (* Wait for the reply from the remote end. *) + if !need_read_reply_label then pr " read_reply:\n"; pr " guestfs__switch_to_receiving (g);\n"; pr " ctx.cb_sequence = 0;\n"; pr " guestfs_set_reply_callback (g, %s_reply_cb, &ctx);\n" shortname; @@ -2284,17 +2567,21 @@ check_state (guestfs_h *g, const char *caller) pr " guestfs_set_reply_callback (g, NULL, NULL);\n"; pr " if (ctx.cb_sequence != 1001) {\n"; pr " error (g, \"%%s reply failed, see earlier error messages\", \"%s\");\n" name; + pr " guestfs_set_ready (g);\n"; pr " return %s;\n" error_code; pr " }\n"; pr "\n"; - pr " if (check_reply_header (g, &ctx.hdr, GUESTFS_PROC_%s, serial) == -1)\n" + pr " if (check_reply_header (g, &ctx.hdr, GUESTFS_PROC_%s, serial) == -1) {\n" (String.uppercase shortname); + pr " guestfs_set_ready (g);\n"; pr " return %s;\n" error_code; + pr " }\n"; pr "\n"; pr " if (ctx.hdr.status == GUESTFS_STATUS_ERROR) {\n"; pr " error (g, \"%%s\", ctx.err.error_message);\n"; + pr " guestfs_set_ready (g);\n"; pr " return %s;\n" error_code; pr " }\n"; pr "\n"; @@ -2303,12 +2590,16 @@ check_state (guestfs_h *g, const char *caller) List.iter ( function | FileOut n -> - pr " if (guestfs__receive_file_sync (g, %s) == -1)\n" n; + pr " if (guestfs__receive_file_sync (g, %s) == -1) {\n" n; + pr " guestfs_set_ready (g);\n"; pr " return %s;\n" error_code; + pr " }\n"; pr "\n"; | _ -> () ) (snd style); + pr " guestfs_set_ready (g);\n"; + (match fst style with | RErr -> pr " return 0;\n" | RInt n | RInt64 n | RBool n -> @@ -2355,7 +2646,7 @@ and generate_daemon_actions_h () = and generate_daemon_actions () = generate_header CStyle GPLv2; - pr "#define _GNU_SOURCE // for strchrnul\n"; + pr "#include \n"; pr "\n"; pr "#include \n"; pr "#include \n"; @@ -2761,8 +3052,8 @@ int main (int argc, char *argv[]) char c = 0; int failed = 0; const char *srcdir; + const char *filename; int fd; - char buf[256]; int nr_tests, test_num = 0; no_test_warnings (); @@ -2777,89 +3068,90 @@ int main (int argc, char *argv[]) srcdir = getenv (\"srcdir\"); if (!srcdir) srcdir = \".\"; - guestfs_set_path (g, srcdir); + chdir (srcdir); + guestfs_set_path (g, \".\"); - snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir); - fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666); + filename = \"test1.img\"; + fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666); if (fd == -1) { - perror (buf); + perror (filename); exit (1); } if (lseek (fd, %d, SEEK_SET) == -1) { perror (\"lseek\"); close (fd); - unlink (buf); + unlink (filename); exit (1); } if (write (fd, &c, 1) == -1) { perror (\"write\"); close (fd); - unlink (buf); + unlink (filename); exit (1); } if (close (fd) == -1) { - perror (buf); - unlink (buf); + perror (filename); + unlink (filename); exit (1); } - if (guestfs_add_drive (g, buf) == -1) { - printf (\"guestfs_add_drive %%s FAILED\\n\", buf); + if (guestfs_add_drive (g, filename) == -1) { + printf (\"guestfs_add_drive %%s FAILED\\n\", filename); exit (1); } - snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir); - fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666); + filename = \"test2.img\"; + fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666); if (fd == -1) { - perror (buf); + perror (filename); exit (1); } if (lseek (fd, %d, SEEK_SET) == -1) { perror (\"lseek\"); close (fd); - unlink (buf); + unlink (filename); exit (1); } if (write (fd, &c, 1) == -1) { perror (\"write\"); close (fd); - unlink (buf); + unlink (filename); exit (1); } if (close (fd) == -1) { - perror (buf); - unlink (buf); + perror (filename); + unlink (filename); exit (1); } - if (guestfs_add_drive (g, buf) == -1) { - printf (\"guestfs_add_drive %%s FAILED\\n\", buf); + if (guestfs_add_drive (g, filename) == -1) { + printf (\"guestfs_add_drive %%s FAILED\\n\", filename); exit (1); } - snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir); - fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666); + filename = \"test3.img\"; + fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666); if (fd == -1) { - perror (buf); + perror (filename); exit (1); } if (lseek (fd, %d, SEEK_SET) == -1) { perror (\"lseek\"); close (fd); - unlink (buf); + unlink (filename); exit (1); } if (write (fd, &c, 1) == -1) { perror (\"write\"); close (fd); - unlink (buf); + unlink (filename); exit (1); } if (close (fd) == -1) { - perror (buf); - unlink (buf); + perror (filename); + unlink (filename); exit (1); } - if (guestfs_add_drive (g, buf) == -1) { - printf (\"guestfs_add_drive %%s FAILED\\n\", buf); + if (guestfs_add_drive (g, filename) == -1) { + printf (\"guestfs_add_drive %%s FAILED\\n\", filename); exit (1); } @@ -2888,12 +3180,9 @@ int main (int argc, char *argv[]) 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 " unlink (\"test1.img\");\n"; + pr " unlink (\"test2.img\");\n"; + pr " unlink (\"test3.img\");\n"; pr "\n"; pr " if (failed > 0) {\n"; @@ -3619,9 +3908,19 @@ and generate_fish_actions_pod () = fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags) ) all_functions_sorted in + let rex = Str.regexp "C]+\\)>" in + List.iter ( fun (name, style, _, flags, _, _, longdesc) -> - let longdesc = replace_str longdesc "C + let sub = + try Str.matched_group 1 s + with Not_found -> + failwithf "error substituting C in longdesc of function %s" name in + "C<" ^ replace_char sub '_' '-' ^ ">" + ) longdesc in let name = replace_char name '_' '-' in let alias = try find_map (function FishAlias n -> Some n | _ -> None) flags @@ -3637,7 +3936,7 @@ and generate_fish_actions_pod () = function | String n -> pr " %s" n | OptString n -> pr " %s" n - | StringList n -> pr " %s,..." n + | StringList n -> pr " '%s ...'" n | Bool _ -> pr " true|false" | Int n -> pr " %s" n | FileIn n | FileOut n -> pr " (%s|-)" n @@ -3947,6 +4246,8 @@ copy_table (char * const * argv) pr "{\n"; (match params with + | [p1; p2; p3; p4; p5] -> + pr " CAMLparam5 (%s);\n" (String.concat ", " params) | p1 :: p2 :: p3 :: p4 :: p5 :: rest -> pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]); pr " CAMLxparam%d (%s);\n" @@ -5085,6 +5386,8 @@ class GuestFS: (* Useful if you need the longdesc POD text as plain text. Returns a * list of lines. + * + * This is the slowest thing about autogeneration. *) and pod2text ~width name longdesc = let filename, chan = Filename.open_temp_file "gen" ".tmp" in @@ -5197,6 +5500,7 @@ static VALUE ruby_guestfs_close (VALUE gv) pr " VALUE v = rb_ary_entry (%sv, i);\n" n; pr " %s[i] = StringValueCStr (v);\n" n; pr " }\n"; + pr " %s[len] = NULL;\n" n; pr " }\n"; | Bool n | Int n -> @@ -5347,6 +5651,514 @@ and generate_ruby_lvm_code typ cols = pr " guestfs_free_lvm_%s_list (r);\n" typ; pr " return rv;\n" +(* Generate Java bindings GuestFS.java file. *) +and generate_java_java () = + generate_header CStyle LGPLv2; + + pr "\ +package com.redhat.et.libguestfs; + +import java.util.HashMap; +import com.redhat.et.libguestfs.LibGuestFSException; +import com.redhat.et.libguestfs.PV; +import com.redhat.et.libguestfs.VG; +import com.redhat.et.libguestfs.LV; +import com.redhat.et.libguestfs.Stat; +import com.redhat.et.libguestfs.StatVFS; +import com.redhat.et.libguestfs.IntBool; + +/** + * The GuestFS object is a libguestfs handle. + * + * @author rjones + */ +public class GuestFS { + // Load the native code. + static { + System.loadLibrary (\"guestfs_jni\"); + } + + /** + * The native guestfs_h pointer. + */ + long g; + + /** + * Create a libguestfs handle. + * + * @throws LibGuestFSException + */ + public GuestFS () throws LibGuestFSException + { + g = _create (); + } + private native long _create () throws LibGuestFSException; + + /** + * Close a libguestfs handle. + * + * You can also leave handles to be collected by the garbage + * collector, but this method ensures that the resources used + * by the handle are freed up immediately. If you call any + * other methods after closing the handle, you will get an + * exception. + * + * @throws LibGuestFSException + */ + public void close () throws LibGuestFSException + { + if (g != 0) + _close (g); + g = 0; + } + private native void _close (long g) throws LibGuestFSException; + + public void finalize () throws LibGuestFSException + { + close (); + } + +"; + + List.iter ( + fun (name, style, _, flags, _, shortdesc, longdesc) -> + let doc = replace_str longdesc "C RErr then pr "return "; + pr "_%s " name; + generate_call_args ~handle:"g" (snd style); + pr ";\n"; + pr " }\n"; + pr " "; + generate_java_prototype ~privat:true ~native:true name style; + pr "\n"; + pr "\n"; + ) all_functions; + + pr "}\n" + +and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false) + ?(semicolon=true) name style = + if privat then pr "private "; + if public then pr "public "; + if native then pr "native "; + + (* return type *) + (match fst style with + | RErr -> pr "void "; + | RInt _ -> pr "int "; + | RInt64 _ -> pr "long "; + | RBool _ -> pr "boolean "; + | RConstString _ | RString _ -> pr "String "; + | RStringList _ -> pr "String[] "; + | RIntBool _ -> pr "IntBool "; + | RPVList _ -> pr "PV[] "; + | RVGList _ -> pr "VG[] "; + | RLVList _ -> pr "LV[] "; + | RStat _ -> pr "Stat "; + | RStatVFS _ -> pr "StatVFS "; + | RHashtable _ -> pr "HashMap "; + ); + + if native then pr "_%s " name else pr "%s " name; + pr "("; + let needs_comma = ref false in + if native then ( + pr "long g"; + needs_comma := true + ); + + (* args *) + List.iter ( + fun arg -> + if !needs_comma then pr ", "; + needs_comma := true; + + match arg with + | String n + | OptString n + | FileIn n + | FileOut n -> + pr "String %s" n + | StringList n -> + pr "String[] %s" n + | Bool n -> + pr "boolean %s" n + | Int n -> + pr "int %s" n + ) (snd style); + + pr ")\n"; + pr " throws LibGuestFSException"; + if semicolon then pr ";" + +and generate_java_struct typ cols = + generate_header CStyle LGPLv2; + + pr "\ +package com.redhat.et.libguestfs; + +/** + * Libguestfs %s structure. + * + * @author rjones + * @see GuestFS + */ +public class %s { +" typ typ; + + List.iter ( + function + | name, `String + | name, `UUID -> pr " public String %s;\n" name + | name, `Bytes + | name, `Int -> pr " public long %s;\n" name + | name, `OptPercent -> + pr " /* The next field is [0..100] or -1 meaning 'not present': */\n"; + pr " public float %s;\n" name + ) cols; + + pr "}\n" + +and generate_java_c () = + generate_header CStyle LGPLv2; + + pr "\ +#include +#include +#include + +#include \"com_redhat_et_libguestfs_GuestFS.h\" +#include \"guestfs.h\" + +/* Note that this function returns. The exception is not thrown + * until after the wrapper function returns. + */ +static void +throw_exception (JNIEnv *env, const char *msg) +{ + jclass cl; + cl = (*env)->FindClass (env, + \"com/redhat/et/libguestfs/LibGuestFSException\"); + (*env)->ThrowNew (env, cl, msg); +} + +JNIEXPORT jlong JNICALL +Java_com_redhat_et_libguestfs_GuestFS__1create + (JNIEnv *env, jobject obj) +{ + guestfs_h *g; + + g = guestfs_create (); + if (g == NULL) { + throw_exception (env, \"GuestFS.create: failed to allocate handle\"); + return 0; + } + guestfs_set_error_handler (g, NULL, NULL); + return (jlong) (long) g; +} + +JNIEXPORT void JNICALL +Java_com_redhat_et_libguestfs_GuestFS__1close + (JNIEnv *env, jobject obj, jlong jg) +{ + guestfs_h *g = (guestfs_h *) (long) jg; + guestfs_close (g); +} + +"; + + List.iter ( + fun (name, style, _, _, _, _, _) -> + pr "JNIEXPORT "; + (match fst style with + | RErr -> pr "void "; + | RInt _ -> pr "jint "; + | RInt64 _ -> pr "jlong "; + | RBool _ -> pr "jboolean "; + | RConstString _ | RString _ -> pr "jstring "; + | RIntBool _ | RStat _ | RStatVFS _ | RHashtable _ -> + pr "jobject "; + | RStringList _ | RPVList _ | RVGList _ | RLVList _ -> + pr "jobjectArray "; + ); + pr "JNICALL\n"; + pr "Java_com_redhat_et_libguestfs_GuestFS_"; + pr "%s" (replace_str ("_" ^ name) "_" "_1"); + pr "\n"; + pr " (JNIEnv *env, jobject obj, jlong jg"; + List.iter ( + function + | String n + | OptString n + | FileIn n + | FileOut n -> + pr ", jstring j%s" n + | StringList n -> + pr ", jobjectArray j%s" n + | Bool n -> + pr ", jboolean j%s" n + | Int n -> + pr ", jint j%s" n + ) (snd style); + pr ")\n"; + pr "{\n"; + pr " guestfs_h *g = (guestfs_h *) (long) jg;\n"; + let error_code, no_ret = + match fst style with + | RErr -> pr " int r;\n"; "-1", "" + | RBool _ + | RInt _ -> pr " int r;\n"; "-1", "0" + | RInt64 _ -> pr " int64_t r;\n"; "-1", "0" + | RConstString _ -> pr " const char *r;\n"; "NULL", "NULL" + | RString _ -> + pr " jstring jr;\n"; + pr " char *r;\n"; "NULL", "NULL" + | RStringList _ -> + pr " jobjectArray jr;\n"; + pr " int r_len;\n"; + pr " jclass cl;\n"; + pr " jstring jstr;\n"; + pr " char **r;\n"; "NULL", "NULL" + | RIntBool _ -> + pr " jobject jr;\n"; + pr " jclass cl;\n"; + pr " jfieldID fl;\n"; + pr " struct guestfs_int_bool *r;\n"; "NULL", "NULL" + | RStat _ -> + pr " jobject jr;\n"; + pr " jclass cl;\n"; + pr " jfieldID fl;\n"; + pr " struct guestfs_stat *r;\n"; "NULL", "NULL" + | RStatVFS _ -> + pr " jobject jr;\n"; + pr " jclass cl;\n"; + pr " jfieldID fl;\n"; + pr " struct guestfs_statvfs *r;\n"; "NULL", "NULL" + | RPVList _ -> + pr " jobjectArray jr;\n"; + pr " jclass cl;\n"; + pr " jfieldID fl;\n"; + pr " jobject jfl;\n"; + pr " struct guestfs_lvm_pv_list *r;\n"; "NULL", "NULL" + | RVGList _ -> + pr " jobjectArray jr;\n"; + pr " jclass cl;\n"; + pr " jfieldID fl;\n"; + pr " jobject jfl;\n"; + pr " struct guestfs_lvm_vg_list *r;\n"; "NULL", "NULL" + | RLVList _ -> + pr " jobjectArray jr;\n"; + pr " jclass cl;\n"; + pr " jfieldID fl;\n"; + pr " jobject jfl;\n"; + pr " struct guestfs_lvm_lv_list *r;\n"; "NULL", "NULL" + | RHashtable _ -> pr " char **r;\n"; "NULL", "NULL" in + List.iter ( + function + | String n + | OptString n + | FileIn n + | FileOut n -> + pr " const char *%s;\n" n + | StringList n -> + pr " int %s_len;\n" n; + pr " const char **%s;\n" n + | Bool n + | Int n -> + pr " int %s;\n" n + ) (snd style); + + let needs_i = + (match fst style with + | RStringList _ | RPVList _ | RVGList _ | RLVList _ -> true + | RErr _ | RBool _ | RInt _ | RInt64 _ | RConstString _ + | RString _ | RIntBool _ | RStat _ | RStatVFS _ + | RHashtable _ -> false) || + List.exists (function StringList _ -> true | _ -> false) (snd style) in + if needs_i then + pr " int i;\n"; + + pr "\n"; + + (* Get the parameters. *) + List.iter ( + function + | String n + | OptString n + | FileIn n + | FileOut n -> + pr " %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n + | StringList n -> + pr " %s_len = (*env)->GetArrayLength (env, j%s);\n" n n; + pr " %s = malloc (sizeof (char *) * (%s_len+1));\n" n n; + pr " for (i = 0; i < %s_len; ++i) {\n" n; + pr " jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n" + n; + pr " %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n; + pr " }\n"; + pr " %s[%s_len] = NULL;\n" n n; + | Bool n + | Int n -> + pr " %s = j%s;\n" n n + ) (snd style); + + (* Make the call. *) + pr " r = guestfs_%s " name; + generate_call_args ~handle:"g" (snd style); + pr ";\n"; + + (* Release the parameters. *) + List.iter ( + function + | String n + | OptString n + | FileIn n + | FileOut n -> + pr " (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n + | StringList n -> + pr " for (i = 0; i < %s_len; ++i) {\n" n; + pr " jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n" + n; + pr " (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n; + pr " }\n"; + pr " free (%s);\n" n + | Bool n + | Int n -> () + ) (snd style); + + (* Check for errors. *) + pr " if (r == %s) {\n" error_code; + pr " throw_exception (env, guestfs_last_error (g));\n"; + pr " return %s;\n" no_ret; + pr " }\n"; + + (* Return value. *) + (match fst style with + | RErr -> () + | RInt _ -> pr " return (jint) r;\n" + | RBool _ -> pr " return (jboolean) r;\n" + | RInt64 _ -> pr " return (jlong) r;\n" + | RConstString _ -> pr " return (*env)->NewStringUTF (env, r);\n" + | RString _ -> + pr " jr = (*env)->NewStringUTF (env, r);\n"; + pr " free (r);\n"; + pr " return jr;\n" + | RStringList _ -> + pr " for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n"; + pr " cl = (*env)->FindClass (env, \"java/lang/String\");\n"; + pr " jstr = (*env)->NewStringUTF (env, \"\");\n"; + pr " jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n"; + pr " for (i = 0; i < r_len; ++i) {\n"; + pr " jstr = (*env)->NewStringUTF (env, r[i]);\n"; + pr " (*env)->SetObjectArrayElement (env, jr, i, jstr);\n"; + pr " free (r[i]);\n"; + pr " }\n"; + pr " free (r);\n"; + pr " return jr;\n" + | RIntBool _ -> + pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/IntBool\");\n"; + pr " jr = (*env)->AllocObject (env, cl);\n"; + pr " fl = (*env)->GetFieldID (env, cl, \"i\", \"I\");\n"; + pr " (*env)->SetIntField (env, jr, fl, r->i);\n"; + pr " fl = (*env)->GetFieldID (env, cl, \"i\", \"Z\");\n"; + pr " (*env)->SetBooleanField (env, jr, fl, r->b);\n"; + pr " guestfs_free_int_bool (r);\n"; + pr " return jr;\n" + | RStat _ -> + pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/Stat\");\n"; + pr " jr = (*env)->AllocObject (env, cl);\n"; + List.iter ( + function + | name, `Int -> + pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" + name; + pr " (*env)->SetLongField (env, jr, fl, r->%s);\n" name; + ) stat_cols; + pr " free (r);\n"; + pr " return jr;\n" + | RStatVFS _ -> + pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/StatVFS\");\n"; + pr " jr = (*env)->AllocObject (env, cl);\n"; + List.iter ( + function + | name, `Int -> + pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" + name; + pr " (*env)->SetLongField (env, jr, fl, r->%s);\n" name; + ) statvfs_cols; + pr " free (r);\n"; + pr " return jr;\n" + | RPVList _ -> + generate_java_lvm_return "pv" "PV" pv_cols + | RVGList _ -> + generate_java_lvm_return "vg" "VG" vg_cols + | RLVList _ -> + generate_java_lvm_return "lv" "LV" lv_cols + | RHashtable _ -> + (* 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" + ); + + pr "}\n"; + pr "\n" + ) all_functions + +and generate_java_lvm_return typ jtyp cols = + pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp; + pr " jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n"; + pr " for (i = 0; i < r->len; ++i) {\n"; + pr " jfl = (*env)->AllocObject (env, cl);\n"; + List.iter ( + function + | name, `String -> + pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name; + pr " (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name; + | name, `UUID -> + pr " {\n"; + pr " char s[33];\n"; + pr " memcpy (s, r->val[i].%s, 32);\n" name; + pr " s[32] = 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, (`Bytes|`Int) -> + pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name; + pr " (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name; + | name, `OptPercent -> + pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name; + pr " (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\n" name; + ) cols; + pr " (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n"; + pr " }\n"; + pr " guestfs_free_lvm_%s_list (r);\n" typ; + pr " return jr;\n" + let output_to filename = let filename_new = filename ^ ".new" in chan := open_out filename_new; @@ -5450,3 +6262,31 @@ Run it from the top source directory using the command let close = output_to "ruby/ext/guestfs/_guestfs.c" in generate_ruby_c (); close (); + + let close = output_to "java/com/redhat/et/libguestfs/GuestFS.java" in + generate_java_java (); + close (); + + let close = output_to "java/com/redhat/et/libguestfs/PV.java" in + generate_java_struct "PV" pv_cols; + close (); + + let close = output_to "java/com/redhat/et/libguestfs/VG.java" in + generate_java_struct "VG" vg_cols; + close (); + + let close = output_to "java/com/redhat/et/libguestfs/LV.java" in + generate_java_struct "LV" lv_cols; + close (); + + let close = output_to "java/com/redhat/et/libguestfs/Stat.java" in + generate_java_struct "Stat" stat_cols; + close (); + + let close = output_to "java/com/redhat/et/libguestfs/StatVFS.java" in + generate_java_struct "StatVFS" statvfs_cols; + close (); + + let close = output_to "java/com_redhat_et_libguestfs_GuestFS.c" in + generate_java_c (); + close ();