X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=src%2Fgenerator.ml;h=29e665133a8b4673a7e644ea73bbaa90e6ced99d;hp=cbe8ca79e3c9bf5fbe225721decae2fd09824a57;hb=b6b2004db1056d628a4d8c30dd61b14fb18cf876;hpb=532009d1ccf16b87859dd58884a82512e8eba937 diff --git a/src/generator.ml b/src/generator.ml index cbe8ca7..29e6651 100755 --- a/src/generator.ml +++ b/src/generator.ml @@ -83,6 +83,8 @@ and ret = * inefficient. Keys should be unique. NULLs are not permitted. *) | RHashtable of string + (* List of directory entries (the result of readdir(3)). *) + | RDirentList of string and args = argt list (* Function parameters, guestfs handle is implicit. *) @@ -133,7 +135,9 @@ can easily destroy all your data>." * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc), and * a fourth squashfs block device with some known files on it (/dev/sdd). * - * Note for partitioning purposes, the 500MB device has 63 cylinders. + * Note for partitioning purposes, the 500MB device has 1015 cylinders. + * Number of cylinders was 63 for IDE emulated disks with precisely + * the same size. How exactly this is calculated is a mystery. * * The squashfs block device (/dev/sdd) comes from images/test.sqsh. * @@ -373,7 +377,8 @@ for whatever operations you want to perform (ie. read access if you just want to read the image or write access if you want to modify the image). -This is equivalent to the qemu parameter C<-drive file=filename,cache=off>. +This is equivalent to the qemu parameter +C<-drive file=filename,cache=off,if=virtio>. Note that this call checks for the existence of C. This stops you from specifying other types of drive which are supported @@ -407,7 +412,7 @@ handle is closed. We don't currently have any method to enable changes to be committed, although qemu can support this. This is equivalent to the qemu parameter -C<-drive file=filename,snapshot=on>. +C<-drive file=filename,snapshot=on,if=virtio>. Note that this call checks for the existence of C. This stops you from specifying other types of drive which are supported @@ -733,7 +738,7 @@ The full block device names are returned, eg. C"); [InitBasicFS, Always, TestOutputListOfDevices ( [["list_partitions"]], ["/dev/sda1"]); InitEmpty, Always, TestOutputListOfDevices ( - [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",200 ,400 ,"]; ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])], "list the partitions", "\ @@ -748,7 +753,7 @@ call C."); [InitBasicFSonLVM, Always, TestOutputListOfDevices ( [["pvs"]], ["/dev/sda1"]); InitEmpty, Always, TestOutputListOfDevices ( - [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",200 ,400 ,"]; ["pvcreate"; "/dev/sda1"]; ["pvcreate"; "/dev/sda2"]; ["pvcreate"; "/dev/sda3"]; @@ -767,7 +772,7 @@ See also C."); [InitBasicFSonLVM, Always, TestOutputList ( [["vgs"]], ["VG"]); InitEmpty, Always, TestOutputList ( - [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",200 ,400 ,"]; ["pvcreate"; "/dev/sda1"]; ["pvcreate"; "/dev/sda2"]; ["pvcreate"; "/dev/sda3"]; @@ -788,7 +793,7 @@ See also C."); [InitBasicFSonLVM, Always, TestOutputList ( [["lvs"]], ["/dev/VG/LV"]); InitEmpty, Always, TestOutputList ( - [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",200 ,400 ,"]; ["pvcreate"; "/dev/sda1"]; ["pvcreate"; "/dev/sda2"]; ["pvcreate"; "/dev/sda3"]; @@ -1141,7 +1146,7 @@ See also C."); ("pvcreate", (RErr, [String "device"]), 39, [], [InitEmpty, Always, TestOutputListOfDevices ( - [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",200 ,400 ,"]; ["pvcreate"; "/dev/sda1"]; ["pvcreate"; "/dev/sda2"]; ["pvcreate"; "/dev/sda3"]; @@ -1154,7 +1159,7 @@ as C."); ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [], [InitEmpty, Always, TestOutputList ( - [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",200 ,400 ,"]; ["pvcreate"; "/dev/sda1"]; ["pvcreate"; "/dev/sda2"]; ["pvcreate"; "/dev/sda3"]; @@ -1168,7 +1173,7 @@ from the non-empty list of physical volumes C."); ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [], [InitEmpty, Always, TestOutputList ( - [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",200 ,400 ,"]; ["pvcreate"; "/dev/sda1"]; ["pvcreate"; "/dev/sda2"]; ["pvcreate"; "/dev/sda3"]; @@ -1296,7 +1301,7 @@ Some internal mounts are not shown."); ["mounts"]], []); (* check that umount_all can unmount nested mounts correctly: *) InitEmpty, Always, TestOutputList ( - [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"]; + [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",200 ,400 ,"]; ["mkfs"; "ext2"; "/dev/sda1"]; ["mkfs"; "ext2"; "/dev/sda2"]; ["mkfs"; "ext2"; "/dev/sda3"]; @@ -2015,7 +2020,10 @@ any partition tables, filesystem superblocks and so on. See also: C."); ("grub_install", (RErr, [String "root"; String "device"]), 86, [], - [InitBasicFS, Always, TestOutputTrue ( + (* Test disabled because grub-install incompatible with virtio-blk driver. + * See also: https://bugzilla.redhat.com/show_bug.cgi?id=479760 + *) + [InitBasicFS, Disabled, TestOutputTrue ( [["grub_install"; "/"; "/dev/sda1"]; ["is_dir"; "/boot"]])], "install GRUB", @@ -2745,6 +2753,20 @@ See also L, C, C. This call returns the previous umask."); + ("readdir", (RDirentList "entries", [String "dir"]), 138, [], + [], + "read directories entries", + "\ +This returns the list of directory entries in directory C. + +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. + +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."); + ] let all_functions = non_daemon_functions @ daemon_functions @@ -2852,6 +2874,13 @@ let statvfs_cols = [ "namemax", `Int; ] +(* Column names in dirent structure. *) +let dirent_cols = [ + "ino", `Int; + "ftyp", `Char; (* 'b' 'c' 'd' 'f' (FIFO) 'l' 'r' (regular file) 's' 'u' '?' *) + "name", `String; +] + (* Used for testing language bindings. *) type callt = | CallString of string @@ -2860,6 +2889,17 @@ type callt = | CallInt of int | CallBool of bool +(* Used to memoize the result of pod2text. *) +let pod2text_memo_filename = "src/.pod2text.data" +let pod2text_memo : ((int * string * string), string list) Hashtbl.t = + try + let chan = open_in pod2text_memo_filename in + let v = input_value chan in + close_in chan; + v + with + _ -> Hashtbl.create 13 + (* Useful functions. * Note we don't want to use any external OCaml libraries which * makes this a bit harder than it should be. @@ -3036,7 +3076,8 @@ let check_functions () = | RInt n | RInt64 n | RBool n | RConstString n | RString n | RStringList n | RPVList n | RVGList n | RLVList n | RStat n | RStatVFS n - | RHashtable n -> + | RHashtable n + | RDirentList n -> check_arg_ret_name n | RIntBool (n,m) -> check_arg_ret_name n; @@ -3241,6 +3282,11 @@ 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" + | RDirentList _ -> + pr "This function returns a C +(see Eguestfs-structs.hE), +or NULL if there was an error. +I after use>.\n\n" ); if List.mem ProtocolLimitWarning flags then pr "%s\n\n" protocol_limit_warning; @@ -3277,7 +3323,41 @@ and generate_structs_pod () = pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n" typ typ; pr "\n" - ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols] + ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]; + + (* Stat *) + List.iter ( + fun (typ, cols) -> + pr "=head2 guestfs_%s\n" typ; + pr "\n"; + pr " struct guestfs_%s {\n" typ; + List.iter ( + function + | name, `Int -> pr " int64_t %s;\n" name + ) cols; + pr " };\n"; + pr "\n"; + ) [ "stat", stat_cols; "statvfs", statvfs_cols ]; + + (* DirentList *) + pr "=head2 guestfs_dirent\n"; + pr "\n"; + pr " struct guestfs_dirent {\n"; + List.iter ( + function + | name, `String -> pr " char *%s;\n" name + | name, `Int -> pr " int64_t %s;\n" name + | name, `Char -> pr " char %s;\n" name + ) dirent_cols; + pr " };\n"; + pr "\n"; + pr " struct guestfs_dirent_list {\n"; + pr " uint32_t len; /* Number of elements in list. */\n"; + pr " struct guestfs_dirent *val; /* Elements. */\n"; + pr " };\n"; + pr " \n"; + pr " void guestfs_free_dirent_list (struct guestfs_free_dirent_list *);\n"; + pr "\n" (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'. @@ -3324,6 +3404,18 @@ and generate_xdr () = pr "\n"; ) ["stat", stat_cols; "statvfs", statvfs_cols]; + (* Dirent structures. *) + pr "struct guestfs_int_dirent {\n"; + List.iter (function + | name, `Int -> pr " hyper %s;\n" name + | name, `Char -> pr " char %s;\n" name + | name, `String -> pr " string %s<>;\n" name + ) dirent_cols; + pr "};\n"; + pr "\n"; + pr "typedef struct guestfs_int_dirent guestfs_int_dirent_list<>;\n"; + pr "\n"; + List.iter ( fun (shortname, style, _, _, _, _, _) -> let name = "guestfs_" ^ shortname in @@ -3396,6 +3488,10 @@ and generate_xdr () = pr "struct %s_ret {\n" name; pr " str %s<>;\n" n; pr "};\n\n" + | RDirentList n -> + pr "struct %s_ret {\n" name; + pr " guestfs_int_dirent_list %s;\n" n; + pr "};\n\n" ); ) daemon_functions; @@ -3523,7 +3619,23 @@ and generate_structs_h () = ) cols; pr "};\n"; pr "\n" - ) ["stat", stat_cols; "statvfs", statvfs_cols] + ) ["stat", stat_cols; "statvfs", statvfs_cols]; + + (* Dirent structures. *) + pr "struct guestfs_dirent {\n"; + List.iter ( + function + | name, `Int -> pr " int64_t %s;\n" name + | name, `Char -> pr " char %s;\n" name + | name, `String -> pr " char *%s;\n" name + ) dirent_cols; + pr "};\n"; + pr "\n"; + pr "struct guestfs_dirent_list {\n"; + pr " uint32_t len;\n"; + pr " struct guestfs_dirent *val;\n"; + pr "};\n"; + pr "\n" (* Generate the guestfs-actions.h file. *) and generate_actions_h () = @@ -3631,7 +3743,8 @@ check_state (guestfs_h *g, const char *caller) | RIntBool _ | RPVList _ | RVGList _ | RLVList _ | RStat _ | RStatVFS _ - | RHashtable _ -> + | RHashtable _ + | RDirentList _ -> pr " struct %s_ret ret;\n" name ); pr "};\n"; @@ -3674,7 +3787,8 @@ check_state (guestfs_h *g, const char *caller) | RIntBool _ | RPVList _ | RVGList _ | RLVList _ | RStat _ | RStatVFS _ - | RHashtable _ -> + | RHashtable _ + | RDirentList _ -> pr " if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name; pr " error (g, \"%%s: failed to parse reply\", \"%s\");\n" name; pr " return;\n"; @@ -3697,7 +3811,8 @@ check_state (guestfs_h *g, const char *caller) | RString _ | RStringList _ | RIntBool _ | RPVList _ | RVGList _ | RLVList _ | RStat _ | RStatVFS _ - | RHashtable _ -> + | RHashtable _ + | RDirentList _ -> "NULL" in pr "{\n"; @@ -3833,7 +3948,8 @@ check_state (guestfs_h *g, const char *caller) pr " /* caller with free this */\n"; pr " return safe_memdup (g, &ctx.ret, sizeof (ctx.ret));\n" | RPVList n | RVGList n | RLVList n - | RStat n | RStatVFS n -> + | RStat n | RStatVFS n + | RDirentList n -> pr " /* caller will free this */\n"; pr " return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n ); @@ -3893,7 +4009,8 @@ and generate_daemon_actions () = | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL" | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL" | RStat _ -> pr " guestfs_int_stat *r;\n"; "NULL" - | RStatVFS _ -> pr " guestfs_int_statvfs *r;\n"; "NULL" in + | RStatVFS _ -> pr " guestfs_int_statvfs *r;\n"; "NULL" + | RDirentList _ -> pr " guestfs_int_dirent_list *r;\n"; "NULL" in (match snd style with | [] -> () @@ -3994,7 +4111,8 @@ and generate_daemon_actions () = name; pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name | RPVList n | RVGList n | RLVList n - | RStat n | RStatVFS n -> + | RStat n | RStatVFS n + | RDirentList n -> pr " struct guestfs_%s_ret ret;\n" name; pr " ret.%s = *r;\n" n; pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" @@ -4775,7 +4893,9 @@ and generate_test_command_call ?(expect_error = false) ?test test_name cmd = | RStat _ -> pr " struct guestfs_stat *r;\n"; "NULL" | RStatVFS _ -> - pr " struct guestfs_statvfs *r;\n"; "NULL" in + pr " struct guestfs_statvfs *r;\n"; "NULL" + | RDirentList _ -> + pr " struct guestfs_dirent_list *r;\n"; "NULL" in pr " suppress_error = %d;\n" (if expect_error then 1 else 0); pr " r = guestfs_%s (g" name; @@ -4831,6 +4951,8 @@ and generate_test_command_call ?(expect_error = false) ?test test_name cmd = pr " guestfs_free_lvm_lv_list (r);\n" | RStat _ | RStatVFS _ -> pr " free (r);\n" + | RDirentList _ -> + pr " guestfs_free_dirent_list (r);\n" ); pr " }\n" @@ -4986,6 +5108,29 @@ and generate_fish_cmds () = pr "\n"; ) ["stat", stat_cols; "statvfs", statvfs_cols]; + (* print_dirent_list function *) + pr "static void print_dirent (struct guestfs_dirent *dirent)\n"; + pr "{\n"; + List.iter ( + function + | name, `String -> + pr " printf (\"%s: %%s\\n\", dirent->%s);\n" name name + | name, `Int -> + pr " printf (\"%s: %%\" PRIi64 \"\\n\", dirent->%s);\n" name name + | name, `Char -> + pr " printf (\"%s: %%c\\n\", dirent->%s);\n" name name + ) dirent_cols; + pr "}\n"; + pr "\n"; + pr "static void print_dirent_list (struct guestfs_dirent_list *dirents)\n"; + pr "{\n"; + pr " int i;\n"; + pr "\n"; + pr " for (i = 0; i < dirents->len; ++i)\n"; + pr " print_dirent (&dirents->val[i]);\n"; + pr "}\n"; + pr "\n"; + (* run_ actions *) List.iter ( fun (name, style, _, flags, _, _, _) -> @@ -5005,6 +5150,7 @@ and generate_fish_cmds () = | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n" | RStat _ -> pr " struct guestfs_stat *r;\n" | RStatVFS _ -> pr " struct guestfs_statvfs *r;\n" + | RDirentList _ -> pr " struct guestfs_dirent_list *r;\n" ); List.iter ( function @@ -5119,6 +5265,11 @@ and generate_fish_cmds () = pr " print_table (r);\n"; pr " free_strings (r);\n"; pr " return 0;\n" + | RDirentList _ -> + pr " if (r == NULL) return -1;\n"; + pr " print_dirent_list (r);\n"; + pr " guestfs_free_dirent_list (r);\n"; + pr " return 0;\n" ); pr "}\n"; pr "\n" @@ -5329,6 +5480,9 @@ and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true) | RStatVFS _ -> if not in_daemon then pr "struct guestfs_statvfs *" else pr "guestfs_int_statvfs *" + | RDirentList _ -> + if not in_daemon then pr "struct guestfs_dirent_list *" + else pr "guestfs_int_dirent_list *" ); pr "%s%s (" prefix name; if handle = None && List.length (snd style) = 0 then @@ -5410,6 +5564,8 @@ val close : t -> unit generate_ocaml_stat_structure_decls (); + generate_ocaml_dirent_structure_decls (); + (* The actions. *) List.iter ( fun (name, style, _, _, _, shortdesc, _) -> @@ -5437,6 +5593,8 @@ let () = generate_ocaml_stat_structure_decls (); + generate_ocaml_dirent_structure_decls (); + (* The actions. *) List.iter ( fun (name, style, _, _, _, shortdesc, _) -> @@ -5579,6 +5737,50 @@ copy_table (char * const * argv) pr "\n"; ) ["stat", stat_cols; "statvfs", statvfs_cols]; + (* Dirent copy functions. *) + pr "static CAMLprim value\n"; + pr "copy_dirent (const struct guestfs_dirent *dirent)\n"; + pr "{\n"; + pr " CAMLparam0 ();\n"; + pr " CAMLlocal2 (rv, v);\n"; + pr "\n"; + pr " rv = caml_alloc (%d, 0);\n" (List.length dirent_cols); + iteri ( + fun i col -> + (match col with + | name, `String -> + pr " v = caml_copy_string (dirent->%s);\n" name + | name, `Int -> + pr " v = caml_copy_int64 (dirent->%s);\n" name + | name, `Char -> + pr " v = Val_int (dirent->%s);\n" name + ); + pr " Store_field (rv, %d, v);\n" i + ) dirent_cols; + pr " CAMLreturn (rv);\n"; + pr "}\n"; + pr "\n"; + + pr "static CAMLprim value\n"; + pr "copy_dirent_list (const struct guestfs_dirent_list *dirents)\n"; + pr "{\n"; + pr " CAMLparam0 ();\n"; + pr " CAMLlocal2 (rv, v);\n"; + pr " int i;\n"; + pr "\n"; + pr " if (dirents->len == 0)\n"; + pr " CAMLreturn (Atom (0));\n"; + pr " else {\n"; + pr " rv = caml_alloc (dirents->len, 0);\n"; + pr " for (i = 0; i < dirents->len; ++i) {\n"; + pr " v = copy_dirent (&dirents->val[i]);\n"; + pr " caml_modify (&Field (rv, i), v);\n"; + pr " }\n"; + pr " CAMLreturn (rv);\n"; + pr " }\n"; + pr "}\n"; + pr "\n"; + (* The wrappers. *) List.iter ( fun (name, style, _, _, _, _, _) -> @@ -5653,7 +5855,9 @@ copy_table (char * const * argv) | RHashtable _ -> pr " int i;\n"; pr " char **r;\n"; - "NULL" in + "NULL" + | RDirentList _ -> + pr " struct guestfs_dirent_list *r;\n"; "NULL" in pr "\n"; pr " caml_enter_blocking_section ();\n"; @@ -5711,6 +5915,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"; + | RDirentList _ -> + pr " rv = copy_dirent_list (r);\n"; + pr " guestfs_free_dirent_list (r);\n"; ); pr " CAMLreturn (rv);\n"; @@ -5757,6 +5964,17 @@ and generate_ocaml_stat_structure_decls () = pr "\n" ) ["stat", stat_cols; "statvfs", statvfs_cols] +and generate_ocaml_dirent_structure_decls () = + pr "type dirent = {\n"; + List.iter ( + function + | name, `Int -> pr " %s : int64;\n" name + | name, `Char -> pr " %s : char;\n" name + | name, `String -> pr " %s : string;\n" name + ) dirent_cols; + pr "}\n"; + pr "\n" + and generate_ocaml_prototype ?(is_external = false) name style = if is_external then pr "external " else pr "val "; pr "%s : t -> " name; @@ -5783,6 +6001,7 @@ and generate_ocaml_prototype ?(is_external = false) name style = | RStat _ -> pr "stat" | RStatVFS _ -> pr "statvfs" | RHashtable _ -> pr "(string * string) list" + | RDirentList _ -> pr "dirent array" ); if is_external then ( pr " = "; @@ -5899,7 +6118,8 @@ DESTROY (g) | RIntBool _ | RPVList _ | RVGList _ | RLVList _ | RStat _ | RStatVFS _ - | RHashtable _ -> + | RHashtable _ + | RDirentList _ -> pr "void\n" (* all lists returned implictly on the stack *) ); (* Call and arguments. *) @@ -6040,6 +6260,9 @@ DESTROY (g) | RStatVFS n -> generate_perl_stat_code "statvfs" statvfs_cols name style n do_cleanups + | RDirentList n -> + generate_perl_dirent_code + "dirent" dirent_cols name style n do_cleanups ); pr "\n" @@ -6078,7 +6301,7 @@ and generate_perl_lvm_code typ cols name style n do_cleanups = pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n" name (String.length name) n name ) cols; - pr " PUSHs (sv_2mortal ((SV *) hv));\n"; + pr " PUSHs (sv_2mortal (newRV ((SV *) hv)));\n"; pr " }\n"; pr " guestfs_free_lvm_%s_list (%s);\n" typ n @@ -6100,6 +6323,37 @@ and generate_perl_stat_code typ cols name style n do_cleanups = ) cols; pr " free (%s);\n" n +and generate_perl_dirent_code typ cols name style n do_cleanups = + pr "PREINIT:\n"; + pr " struct guestfs_%s_list *%s;\n" typ n; + pr " int i;\n"; + pr " HV *hv;\n"; + pr " PPCODE:\n"; + pr " %s = guestfs_%s " n name; + generate_call_args ~handle:"g" (snd style); + pr ";\n"; + do_cleanups (); + pr " if (%s == NULL)\n" n; + pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name; + pr " EXTEND (SP, %s->len);\n" n; + pr " for (i = 0; i < %s->len; ++i) {\n" n; + pr " hv = newHV ();\n"; + List.iter ( + function + | name, `String -> + pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n" + name (String.length name) n name + | name, `Int -> + pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n" + name (String.length name) n name + | name, `Char -> + pr " (void) hv_store (hv, \"%s\", %d, newSVpv (&%s->val[i].%s, 1), 0);\n" + name (String.length name) n name + ) cols; + pr " PUSHs (newRV (sv_2mortal ((SV *) hv)));\n"; + pr " }\n"; + pr " guestfs_free_%s_list (%s);\n" typ n + (* Generate Sys/Guestfs.pm. *) and generate_perl_pm () = generate_header HashStyle LGPLv2; @@ -6233,7 +6487,8 @@ and generate_perl_prototype name style = | RStringList n | RPVList n | RVGList n - | RLVList n -> pr "@%s = " n + | RLVList n + | RDirentList n -> pr "@%s = " n | RStat n | RStatVFS n | RHashtable n -> pr "%%%s = " n @@ -6469,6 +6724,42 @@ py_guestfs_close (PyObject *self, PyObject *args) pr "\n"; ) ["stat", stat_cols; "statvfs", statvfs_cols]; + (* Dirent structures, turned into Python dictionaries. *) + pr "static PyObject *\n"; + pr "put_dirent (struct guestfs_dirent *dirent)\n"; + pr "{\n"; + pr " PyObject *dict;\n"; + pr "\n"; + pr " dict = PyDict_New ();\n"; + List.iter ( + function + | name, `Int -> + pr " PyDict_SetItemString (dict, \"%s\",\n" name; + pr " PyLong_FromLongLong (dirent->%s));\n" name + | name, `Char -> + pr " PyDict_SetItemString (dict, \"%s\",\n" name; + pr " PyString_FromStringAndSize (&dirent->%s, 1));\n" name + | name, `String -> + pr " PyDict_SetItemString (dict, \"%s\",\n" name; + pr " PyString_FromString (dirent->%s));\n" name + ) dirent_cols; + pr " return dict;\n"; + pr "};\n"; + pr "\n"; + + pr "static PyObject *\n"; + pr "put_dirent_list (struct guestfs_dirent_list *dirents)\n"; + pr "{\n"; + pr " PyObject *list;\n"; + pr " int i;\n"; + pr "\n"; + pr " list = PyList_New (dirents->len);\n"; + pr " for (i = 0; i < dirents->len; ++i)\n"; + pr " PyList_SetItem (list, i, put_dirent (&dirents->val[i]));\n"; + pr " return list;\n"; + pr "};\n"; + pr "\n"; + (* Python wrapper functions. *) List.iter ( fun (name, style, _, _, _, _, _) -> @@ -6492,7 +6783,8 @@ py_guestfs_close (PyObject *self, PyObject *args) | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL" | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL" | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL" - | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in + | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" + | RDirentList n -> pr " struct guestfs_dirent_list *r;\n"; "NULL" in List.iter ( function @@ -6596,6 +6888,9 @@ py_guestfs_close (PyObject *self, PyObject *args) | RHashtable n -> pr " py_r = put_table (r);\n"; pr " free_strings (r);\n" + | RDirentList n -> + pr " py_r = put_dirent_list (r);\n"; + pr " guestfs_free_dirent_list (r);\n" ); pr " return py_r;\n"; @@ -6723,7 +7018,9 @@ class GuestFS: | RStatVFS _ -> doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the statvfs structure." | RHashtable _ -> - doc ^ "\n\nThis function returns a dictionary." in + doc ^ "\n\nThis function returns a dictionary." + | RDirentList _ -> + doc ^ "\n\nThis function returns a list of directory entries. Each directory entry is represented as a dictionary." in let doc = if List.mem ProtocolLimitWarning flags then doc ^ "\n\n" ^ protocol_limit_warning @@ -6746,32 +7043,42 @@ 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. + * Because this is very slow (the slowest part of autogeneration), + * we memoize the results. *) and pod2text ~width name longdesc = - let filename, chan = Filename.open_temp_file "gen" ".tmp" in - fprintf chan "=head1 %s\n\n%s\n" name longdesc; - close_out chan; - let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in - let chan = Unix.open_process_in cmd in - let lines = ref [] in - let rec loop i = - let line = input_line chan in - if i = 1 then (* discard the first line of output *) - loop (i+1) - else ( - let line = triml line in - lines := line :: !lines; - loop (i+1) - ) in - let lines = try loop 1 with End_of_file -> List.rev !lines in - Unix.unlink filename; - match Unix.close_process_in chan with - | Unix.WEXITED 0 -> lines - | Unix.WEXITED i -> - failwithf "pod2text: process exited with non-zero status (%d)" i - | Unix.WSIGNALED i | Unix.WSTOPPED i -> - failwithf "pod2text: process signalled or stopped by signal %d" i + let key = width, name, longdesc in + try Hashtbl.find pod2text_memo key + with Not_found -> + let filename, chan = Filename.open_temp_file "gen" ".tmp" in + fprintf chan "=head1 %s\n\n%s\n" name longdesc; + close_out chan; + let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in + let chan = Unix.open_process_in cmd in + let lines = ref [] in + let rec loop i = + let line = input_line chan in + if i = 1 then (* discard the first line of output *) + loop (i+1) + else ( + let line = triml line in + lines := line :: !lines; + loop (i+1) + ) in + let lines = try loop 1 with End_of_file -> List.rev !lines in + Unix.unlink filename; + (match Unix.close_process_in chan with + | Unix.WEXITED 0 -> () + | Unix.WEXITED i -> + failwithf "pod2text: process exited with non-zero status (%d)" i + | Unix.WSIGNALED i | Unix.WSTOPPED i -> + failwithf "pod2text: process signalled or stopped by signal %d" i + ); + Hashtbl.add pod2text_memo key lines; + let chan = open_out pod2text_memo_filename in + output_value chan pod2text_memo; + close_out chan; + lines (* Generate ruby bindings. *) and generate_ruby_c () = @@ -6888,7 +7195,8 @@ static VALUE ruby_guestfs_close (VALUE gv) | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL" | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL" | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL" - | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in + | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" + | RDirentList n -> pr " struct guestfs_dirent_list *r;\n"; "NULL" in pr "\n"; pr " r = guestfs_%s " name; @@ -6969,6 +7277,8 @@ static VALUE ruby_guestfs_close (VALUE gv) pr " }\n"; pr " free (r);\n"; pr " return rv;\n" + | RDirentList n -> + generate_ruby_dirent_code "dirent" dirent_cols ); pr "}\n"; @@ -7019,6 +7329,24 @@ and generate_ruby_lvm_code typ cols = pr " guestfs_free_lvm_%s_list (r);\n" typ; pr " return rv;\n" +(* Ruby code to return a dirent struct list. *) +and generate_ruby_dirent_code typ cols = + pr " VALUE rv = rb_ary_new2 (r->len);\n"; + pr " int i;\n"; + pr " for (i = 0; i < r->len; ++i) {\n"; + pr " VALUE hv = rb_hash_new ();\n"; + List.iter ( + function + | name, `String -> + pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name + | name, (`Char|`Int) -> + pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name + ) cols; + pr " rb_ary_push (rv, hv);\n"; + pr " }\n"; + pr " guestfs_free_%s_list (r);\n" typ; + pr " return rv;\n" + (* Generate Java bindings GuestFS.java file. *) and generate_java_java () = generate_header CStyle LGPLv2; @@ -7034,6 +7362,7 @@ import com.redhat.et.libguestfs.LV; import com.redhat.et.libguestfs.Stat; import com.redhat.et.libguestfs.StatVFS; import com.redhat.et.libguestfs.IntBool; +import com.redhat.et.libguestfs.Dirent; /** * The GuestFS object is a libguestfs handle. @@ -7157,6 +7486,7 @@ and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false) | RStat _ -> pr "Stat "; | RStatVFS _ -> pr "StatVFS "; | RHashtable _ -> pr "HashMap "; + | RDirentList _ -> pr "Dirent[] "; ); if native then pr "_%s " name else pr "%s " name; @@ -7212,6 +7542,7 @@ public class %s { | name, `UUID -> pr " public String %s;\n" name | name, `Bytes | name, `Int -> pr " public long %s;\n" name + | name, `Char -> pr " public char %s;\n" name | name, `OptPercent -> pr " /* The next field is [0..100] or -1 meaning 'not present': */\n"; pr " public float %s;\n" name @@ -7278,7 +7609,7 @@ Java_com_redhat_et_libguestfs_GuestFS__1close | RConstString _ | RString _ -> pr "jstring "; | RIntBool _ | RStat _ | RStatVFS _ | RHashtable _ -> pr "jobject "; - | RStringList _ | RPVList _ | RVGList _ | RLVList _ -> + | RStringList _ | RPVList _ | RVGList _ | RLVList _ | RDirentList _ -> pr "jobjectArray "; ); pr "JNICALL\n"; @@ -7352,7 +7683,13 @@ Java_com_redhat_et_libguestfs_GuestFS__1close 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 + | RHashtable _ -> pr " char **r;\n"; "NULL", "NULL" + | RDirentList _ -> + pr " jobjectArray jr;\n"; + pr " jclass cl;\n"; + pr " jfieldID fl;\n"; + pr " jobject jfl;\n"; + pr " struct guestfs_dirent_list *r;\n"; "NULL", "NULL" in List.iter ( function | String n @@ -7370,7 +7707,8 @@ Java_com_redhat_et_libguestfs_GuestFS__1close let needs_i = (match fst style with - | RStringList _ | RPVList _ | RVGList _ | RLVList _ -> true + | RStringList _ | RPVList _ | RVGList _ | RLVList _ + | RDirentList _ -> true | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _ | RString _ | RIntBool _ | RStat _ | RStatVFS _ | RHashtable _ -> false) || @@ -7504,6 +7842,8 @@ 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" + | RDirentList _ -> + generate_java_dirent_return "dirent" "Dirent" dirent_cols ); pr "}\n"; @@ -7540,6 +7880,25 @@ and generate_java_lvm_return typ jtyp cols = pr " guestfs_free_lvm_%s_list (r);\n" typ; pr " return jr;\n" +and generate_java_dirent_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, (`Char|`Int) -> + pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name; + pr " (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name; + ) cols; + pr " (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n"; + pr " }\n"; + pr " guestfs_free_%s_list (r);\n" typ; + pr " return jr;\n" + and generate_haskell_hs () = generate_header HaskellStyle LGPLv2; @@ -7561,7 +7920,8 @@ and generate_haskell_hs () = | RLVList _, _ | RStat _, _ | RStatVFS _, _ - | RHashtable _, _ -> false in + | RHashtable _, _ + | RDirentList _, _ -> false in pr "\ {-# INCLUDE #-} @@ -7672,7 +8032,7 @@ last_error h = do pr " fail err\n"; | RConstString _ | RString _ | RStringList _ | RIntBool _ | RPVList _ | RVGList _ | RLVList _ | RStat _ | RStatVFS _ - | RHashtable _ -> + | RHashtable _ | RDirentList _ -> pr " if (r == nullPtr)\n"; pr " then do\n"; pr " err <- last_error h\n"; @@ -7696,7 +8056,8 @@ last_error h = do | RLVList _ | RStat _ | RStatVFS _ - | RHashtable _ -> + | RHashtable _ + | RDirentList _ -> pr " else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *) ); pr "\n"; @@ -7738,6 +8099,7 @@ and generate_haskell_prototype ~handle ?(hs = false) style = | RStat _ -> pr "Stat" | RStatVFS _ -> pr "StatVFS" | RHashtable _ -> pr "Hashtable" + | RDirentList _ -> pr "[Dirent]" ); pr ")" @@ -7898,6 +8260,15 @@ print_strings (char * const* const argv) pr " }\n"; pr " strs[n*2] = NULL;\n"; pr " return strs;\n" + | RDirentList _ -> + pr " struct guestfs_dirent_list *r;\n"; + pr " int i;\n"; + pr " r = malloc (sizeof (struct guestfs_dirent_list));\n"; + pr " sscanf (val, \"%%d\", &r->len);\n"; + pr " r->val = calloc (r->len, sizeof (struct guestfs_dirent));\n"; + pr " for (i = 0; i < r->len; ++i)\n"; + pr " r->val[i].ino = i;\n"; + pr " return r;\n" ); pr "}\n"; pr "\n" @@ -7913,7 +8284,8 @@ print_strings (char * const* const argv) | RConstString _ | RString _ | RStringList _ | RIntBool _ | RPVList _ | RVGList _ | RLVList _ | RStat _ | RStatVFS _ - | RHashtable _ -> + | RHashtable _ + | RDirentList _ -> pr " return NULL;\n" ); pr "}\n"; @@ -8338,6 +8710,10 @@ Run it from the top source directory using the command generate_java_struct "StatVFS" statvfs_cols; close (); + let close = output_to "java/com/redhat/et/libguestfs/Dirent.java" in + generate_java_struct "Dirent" dirent_cols; + close (); + let close = output_to "java/com_redhat_et_libguestfs_GuestFS.c" in generate_java_c (); close (); @@ -8357,3 +8733,10 @@ Run it from the top source directory using the command let close = output_to "src/MAX_PROC_NR" in generate_max_proc_nr (); close (); + + (* Always generate this file last, and unconditionally. It's used + * by the Makefile to know when we must re-run the generator. + *) + let chan = open_out "src/stamp-generator" in + fprintf chan "1\n"; + close_out chan