[Libguestfs] [PATCH 05/27] daemon: Reimplement several devsparts APIs in OCaml.
Pino Toscano
ptoscano at redhat.com
Wed Jul 19 13:17:31 UTC 2017
On Friday, 14 July 2017 15:39:13 CEST Richard W.M. Jones wrote:
> + let devs =
> + List.filter (
> + fun dev ->
> + try close (openfile ("/dev/" ^ dev) [O_RDONLY; O_CLOEXEC] 0); true
Note Unix.O_CLOEXEC does not exist in OCaml < 4, see also commit
ece9c35e58a3ba18ac9bed955251482bb774ab97.
> + let devices =
> + map_block_devices ~return_md:false (fun dev -> "/dev/" ^ dev) in
This IIRC can be simplified slightly:
let devices = map_block_devices ~return_md:false ((^) "/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
Ditto: List.map ((^) "/dev/") 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
Isn't this a bit more complicated than a simpler:
let r = (String.length dev_b) - (String.length dev_a) 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
IMHO all the changes above would fit in patch #2 already, although here
is fine too.
--
Pino Toscano
-------------- next part --------------
A non-text attachment was scrubbed...
Name: signature.asc
Type: application/pgp-signature
Size: 819 bytes
Desc: This is a digitally signed message part.
URL: <http://listman.redhat.com/archives/libguestfs/attachments/20170719/b865ab14/attachment.sig>
More information about the Libguestfs
mailing list