[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