Re: [Libguestfs] [PATCH 05/27] daemon: Reimplement several devsparts APIs in OCaml.

+ let devs = + List.filter ( + fun dev -> + try close (openfile ("/dev/" ^ dev) [O_RDONLY; O_CLOEXEC] 0); true

+ let devices = + map_block_devices ~return_md:false (fun dev -> "/dev/" ^ dev) in

+ sort_device_names devices + +let rec list_partitions () = + let partitions = map_block_devices ~return_md:true add_partitions in + let partitions = List.flatten partitions in + sort_device_names partitions + +and add_partitions dev = + (* Open the device's directory under /sys/block *) + let parts = Sys.readdir ("/sys/block/" ^ dev) in + let parts = Array.to_list parts in + + (* Look in /sys/block/<device>/ for entries starting with + * <device>, eg. /sys/block/sda/sda1. + *) + let parts = List.filter (fun part -> String.is_prefix part dev) parts in + List.map (fun part -> "/dev/" ^ part) parts

+ (* If device name part is longer, it is always greater, eg. + * "/dev/sdz" < "/dev/sdaa". + *) + let r = compare (String.length dev_a) (String.length dev_b) in

diff --git a/generator/daemon.ml b/generator/daemon.ml index 121634806..3ffe91537 100644 --- a/generator/daemon.ml +++ b/generator/daemon.ml @@ -553,6 +553,26 @@ copy_mountable (const mountable_t *mountable) CAMLreturn (r); } +/* Implement RStringList. */ +static char ** +return_string_list (value retv) +{ + CLEANUP_FREE_STRINGSBUF DECLARE_STRINGSBUF (ret); + value v; + + while (retv != Val_int (0)) { + v = Field (retv, 0); + if (add_string (&ret, String_val (v)) == -1) + return NULL; + retv = Field (retv, 1); + } + + if (end_stringsbuf (&ret) == -1) + return NULL; + + return take_stringsbuf (&ret); /* caller frees */ +} + "; List.iter ( @@ -669,12 +689,14 @@ copy_mountable (const mountable_t *mountable) (match ret with | RErr -> assert false - | RInt _ -> assert false + | RInt _ -> + pr " CAMLreturnT (int, Int_val (retv));\n" | RInt64 _ -> assert false - | RBool _ -> assert false + | RBool _ -> + pr " CAMLreturnT (int, Bool_val (retv));\n" | RConstString _ -> assert false | RConstOptString _ -> assert false - | RString (RPlainString, _) -> + | RString ((RPlainString|RDevice), _) -> pr " char *ret = strdup (String_val (retv));\n"; pr " if (ret == NULL) {\n"; pr " reply_with_perror (\"strdup\");\n"; @@ -682,7 +704,9 @@ copy_mountable (const mountable_t *mountable) pr " }\n"; pr " CAMLreturnT (char *, ret); /* caller frees */\n" | RString _ -> assert false - | RStringList _ -> assert false + | RStringList _ -> + pr " char **ret = return_string_list (retv);\n"; + pr " CAMLreturnT (char **, ret); /* caller frees */\n" | RStruct _ -> assert false | RStructList _ -> assert false | RHashtable _ -> assert false