thr3ads.net - Libguestfs - [Libguestfs] [PATCH 2/3] daemon: use the structs from the Structs module [Apr 2018]

If this information is useful, please help other people find it:
Share via:

Pino Toscano

2018-Apr-09 14:06 UTC

[Libguestfs] [PATCH 0/3] daemon: generate almost all the API OCaml interfaces

Hi,

as a followup for the signature fix for mount_vfs [1], here it is a
patch series to generate automatically most of the OCaml interfaces of
daemon actions.  Only the Lvm and Mount modules are left with
hand-written interfaces.

[1] https://www.redhat.com/archives/libguestfs/2018-April/msg00059.html

Thanks,

Pino Toscano (3):
  daemon: directly use Optgroups
  daemon: use the structs from the Structs module
  daemon: autogenerate most of OCaml interfaces

 .gitignore                   | 15 ++++++++
 daemon/blkid.mli             | 19 ----------
 daemon/btrfs.mli             | 26 --------------
 daemon/devsparts.mli         | 25 -------------
 daemon/file.mli              | 19 ----------
 daemon/filearch.mli          | 19 ----------
 daemon/findfs.mli            | 20 -----------
 daemon/inspect.mli           | 41 ---------------------
 daemon/inspect_fs_windows.ml |  4 +--
 daemon/is.mli                | 21 -----------
 daemon/ldm.ml                |  2 --
 daemon/ldm.mli               | 22 ------------
 daemon/link.mli              | 19 ----------
 daemon/listfs.ml             |  8 ++---
 daemon/listfs.mli            | 19 ----------
 daemon/lvm.ml                |  2 --
 daemon/lvm.mli               |  2 --
 daemon/md.mli                | 20 -----------
 daemon/parted.mli            | 34 ------------------
 daemon/realpath.mli          | 20 -----------
 daemon/statvfs.mli           | 33 -----------------
 generator/daemon.ml          | 85 ++++++++++++++++++++++++++++++++++++++++++++
 generator/daemon.mli         |  1 +
 generator/main.ml            | 10 ++++++
 24 files changed, 117 insertions(+), 369 deletions(-)
 delete mode 100644 daemon/blkid.mli
 delete mode 100644 daemon/btrfs.mli
 delete mode 100644 daemon/devsparts.mli
 delete mode 100644 daemon/file.mli
 delete mode 100644 daemon/filearch.mli
 delete mode 100644 daemon/findfs.mli
 delete mode 100644 daemon/inspect.mli
 delete mode 100644 daemon/is.mli
 delete mode 100644 daemon/ldm.mli
 delete mode 100644 daemon/link.mli
 delete mode 100644 daemon/listfs.mli
 delete mode 100644 daemon/md.mli
 delete mode 100644 daemon/parted.mli
 delete mode 100644 daemon/realpath.mli
 delete mode 100644 daemon/statvfs.mli

-- 
2.14.3

Pino Toscano

2018-Apr-09 14:06 UTC

head link

[Libguestfs] [PATCH 1/3] daemon: directly use Optgroups

Avoid extra module variables, and just use Optgroups directly.
---
 daemon/ldm.ml    | 2 --
 daemon/ldm.mli   | 2 --
 daemon/listfs.ml | 4 ++--
 daemon/lvm.ml    | 2 --
 daemon/lvm.mli   | 2 --
 5 files changed, 2 insertions(+), 10 deletions(-)

diff --git a/daemon/ldm.ml b/daemon/ldm.ml
index c17766600..b48b0f4eb 100644
--- a/daemon/ldm.ml
+++ b/daemon/ldm.ml
@@ -20,8 +20,6 @@ open Std_utils
 
 open Utils
 
-let available = Optgroups.ldm_available
-
 (* All device mapper devices are called /dev/mapper/ldm_vol_*
  * or /dev/mapper/ldm_part_*.
  *
diff --git a/daemon/ldm.mli b/daemon/ldm.mli
index a45948910..74afdf5d8 100644
--- a/daemon/ldm.mli
+++ b/daemon/ldm.mli
@@ -16,7 +16,5 @@
  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-val available : unit -> bool
-
 val list_ldm_volumes : unit -> string list
 val list_ldm_partitions : unit -> string list
diff --git a/daemon/listfs.ml b/daemon/listfs.ml
index 370ffb4f4..f6e3dcd6e 100644
--- a/daemon/listfs.ml
+++ b/daemon/listfs.ml
@@ -21,8 +21,8 @@ open Printf
 open Std_utils
 
 let rec list_filesystems () -  let has_lvm2 = Lvm.available () in
-  let has_ldm = Ldm.available () in
+  let has_lvm2 = Optgroups.lvm2_available () in
+  let has_ldm = Optgroups.ldm_available () in
 
   let devices = Devsparts.list_devices () in
   let partitions = Devsparts.list_partitions () in
diff --git a/daemon/lvm.ml b/daemon/lvm.ml
index 467495f7e..ed4ed7462 100644
--- a/daemon/lvm.ml
+++ b/daemon/lvm.ml
@@ -23,8 +23,6 @@ open Std_utils
 
 open Utils
 
-let available = Optgroups.lvm2_available
-
 (* Check whether lvs has -S to filter its output.
  * It is available only in lvm2 >= 2.02.107. 
  *)
diff --git a/daemon/lvm.mli b/daemon/lvm.mli
index 94a35d83c..e9a6faeca 100644
--- a/daemon/lvm.mli
+++ b/daemon/lvm.mli
@@ -16,8 +16,6 @@
  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-val available : unit -> bool
-
 val lvs : unit -> string list
 
 val lv_canonical : string -> string option
-- 
2.14.3

Pino Toscano

2018-Apr-09 14:06 UTC

head link

[Libguestfs] [PATCH 2/3] daemon: use the structs from the Structs module

No need to redeclare them again in few modules, just use them from the
Structs module.
---
 daemon/btrfs.mli             |  8 +-------
 daemon/inspect_fs_windows.ml |  4 ++--
 daemon/listfs.ml             |  4 ++--
 daemon/parted.mli            |  9 +--------
 daemon/statvfs.mli           | 16 +---------------
 5 files changed, 7 insertions(+), 34 deletions(-)

diff --git a/daemon/btrfs.mli b/daemon/btrfs.mli
index 8ca91fb47..ce1c2b66f 100644
--- a/daemon/btrfs.mli
+++ b/daemon/btrfs.mli
@@ -16,11 +16,5 @@
  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-type btrfssubvolume = {
-  btrfssubvolume_id : int64;
-  btrfssubvolume_top_level_id : int64;
-  btrfssubvolume_path : string;
-}
-
-val btrfs_subvolume_list : Mountable.t -> btrfssubvolume list
+val btrfs_subvolume_list : Mountable.t -> Structs.btrfssubvolume list
 val btrfs_subvolume_get_default : Mountable.t -> int64
diff --git a/daemon/inspect_fs_windows.ml b/daemon/inspect_fs_windows.ml
index e9d056cd9..8b2aad8d3 100644
--- a/daemon/inspect_fs_windows.ml
+++ b/daemon/inspect_fs_windows.ml
@@ -372,10 +372,10 @@ and map_registry_disk_blob devices blob      let offset =
int_of_le64 offset in
     let partitions = Parted.part_list device in
     let partition -      List.find (fun { Parted.part_start = s } -> s =
offset) partitions in
+      List.find (fun { Structs.part_start = s } -> s = offset) partitions in
 
     (* Construct the full device name. *)
-    Some (sprintf "%s%ld" device partition.Parted.part_num)
+    Some (sprintf "%s%ld" device partition.Structs.part_num)
   with
   | Not_found -> None
 
diff --git a/daemon/listfs.ml b/daemon/listfs.ml
index f6e3dcd6e..56ebadeda 100644
--- a/daemon/listfs.ml
+++ b/daemon/listfs.ml
@@ -125,13 +125,13 @@ and check_with_vfs_type device      let default_volume =
Btrfs.btrfs_subvolume_get_default mountable in
     let vols        List.filter (
-        fun { Btrfs.btrfssubvolume_id = id } -> id <> default_volume
+        fun { Structs.btrfssubvolume_id = id } -> id <> default_volume
       ) vols in
 
     Some (
       (mountable, vfs_type) (* whole device = default volume *)
       :: List.map (
-           fun { Btrfs.btrfssubvolume_path = path } ->
+           fun { Structs.btrfssubvolume_path = path } ->
              let mountable = Mountable.of_btrfsvol device path in
              (mountable, "btrfs")
          ) vols
diff --git a/daemon/parted.mli b/daemon/parted.mli
index d547f2f2a..0b7eb87f4 100644
--- a/daemon/parted.mli
+++ b/daemon/parted.mli
@@ -16,15 +16,8 @@
  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-type partition = {
-  part_num : int32;
-  part_start : int64;
-  part_end : int64;
-  part_size : int64;
-}
-
 val part_get_mbr_id : string -> int -> int
-val part_list : string -> partition list
+val part_list : string -> Structs.partition list
 
 val part_get_parttype : string -> string
 
diff --git a/daemon/statvfs.mli b/daemon/statvfs.mli
index d241f995b..13b22f88d 100644
--- a/daemon/statvfs.mli
+++ b/daemon/statvfs.mli
@@ -16,18 +16,4 @@
  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-type statvfs = {
-  bsize : int64;
-  frsize : int64;
-  blocks : int64;
-  bfree : int64;
-  bavail : int64;
-  files : int64;
-  ffree : int64;
-  favail : int64;
-  fsid : int64;
-  flag : int64;
-  namemax : int64;
-}
-
-val statvfs : string -> statvfs
+val statvfs : string -> Structs.statvfs
-- 
2.14.3

Pino Toscano

2018-Apr-09 14:06 UTC

head link

[Libguestfs] [PATCH 3/3] daemon: autogenerate most of OCaml interfaces

Add a way to generate OCaml interfaces for a whilelist of modules in
the daemon that implement APIs: this makes sure that for them the
interface of each function matches the actual API specified in the
generator.

Only the modules specified in a list are generated for now, although
this coverts almost all the daemon APIs implemented in OCaml.
---
 .gitignore           | 15 ++++++++++
 daemon/blkid.mli     | 19 ------------
 daemon/btrfs.mli     | 20 -------------
 daemon/devsparts.mli | 25 ----------------
 daemon/file.mli      | 19 ------------
 daemon/filearch.mli  | 19 ------------
 daemon/findfs.mli    | 20 -------------
 daemon/inspect.mli   | 41 -------------------------
 daemon/is.mli        | 21 -------------
 daemon/ldm.mli       | 20 -------------
 daemon/link.mli      | 19 ------------
 daemon/listfs.mli    | 19 ------------
 daemon/md.mli        | 20 -------------
 daemon/parted.mli    | 27 -----------------
 daemon/realpath.mli  | 20 -------------
 daemon/statvfs.mli   | 19 ------------
 generator/daemon.ml  | 85 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 generator/daemon.mli |  1 +
 generator/main.ml    | 10 +++++++
 19 files changed, 111 insertions(+), 328 deletions(-)
 delete mode 100644 daemon/blkid.mli
 delete mode 100644 daemon/btrfs.mli
 delete mode 100644 daemon/devsparts.mli
 delete mode 100644 daemon/file.mli
 delete mode 100644 daemon/filearch.mli
 delete mode 100644 daemon/findfs.mli
 delete mode 100644 daemon/inspect.mli
 delete mode 100644 daemon/is.mli
 delete mode 100644 daemon/ldm.mli
 delete mode 100644 daemon/link.mli
 delete mode 100644 daemon/listfs.mli
 delete mode 100644 daemon/md.mli
 delete mode 100644 daemon/parted.mli
 delete mode 100644 daemon/realpath.mli
 delete mode 100644 daemon/statvfs.mli

diff --git a/.gitignore b/.gitignore
index bb7026537..6927b8bb5 100644
--- a/.gitignore
+++ b/.gitignore
@@ -185,21 +185,36 @@ Makefile.in
 /customize/virt-customize.1
 /daemon/.depend
 /daemon/actions.h
+/daemon/blkid.mli
+/daemon/btrfs.mli
 /daemon/callbacks.ml
 /daemon/caml-stubs.c
 /daemon/daemon_config.ml
 /daemon/daemon_utils_tests
+/daemon/devsparts.mli
 /daemon/dispatch.c
+/daemon/file.mli
+/daemon/filearch.mli
+/daemon/findfs.mli
 /daemon/guestfsd
 /daemon/guestfsd.8
 /daemon/guestfsd.exe
+/daemon/inspect.mli
+/daemon/is.mli
+/daemon/ldm.mli
+/daemon/link.mli
+/daemon/listfs.mli
 /daemon/lvm-tokenization.c
+/daemon/md.mli
 /daemon/names.c
 /daemon/optgroups.c
 /daemon/optgroups.h
 /daemon/optgroups.ml
 /daemon/optgroups.mli
+/daemon/parted.mli
+/daemon/realpath.mli
 /daemon/stamp-guestfsd.pod
+/daemon/statvfs.mli
 /daemon/structs-cleanups.c
 /daemon/structs-cleanups.h
 /daemon/structs.ml
diff --git a/daemon/blkid.mli b/daemon/blkid.mli
deleted file mode 100644
index 65a61def4..000000000
--- a/daemon/blkid.mli
+++ /dev/null
@@ -1,19 +0,0 @@
-(* guestfs-inspection
- * Copyright (C) 2009-2018 Red Hat Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along
- * with this program; if not, write to the Free Software Foundation, Inc.,
- * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- *)
-
-val vfs_type : Mountable.t -> string
diff --git a/daemon/btrfs.mli b/daemon/btrfs.mli
deleted file mode 100644
index ce1c2b66f..000000000
--- a/daemon/btrfs.mli
+++ /dev/null
@@ -1,20 +0,0 @@
-(* guestfs-inspection
- * Copyright (C) 2009-2018 Red Hat Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along
- * with this program; if not, write to the Free Software Foundation, Inc.,
- * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- *)
-
-val btrfs_subvolume_list : Mountable.t -> Structs.btrfssubvolume list
-val btrfs_subvolume_get_default : Mountable.t -> int64
diff --git a/daemon/devsparts.mli b/daemon/devsparts.mli
deleted file mode 100644
index 7b669c269..000000000
--- a/daemon/devsparts.mli
+++ /dev/null
@@ -1,25 +0,0 @@
-(* guestfs-inspection
- * Copyright (C) 2009-2018 Red Hat Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along
- * with this program; if not, write to the Free Software Foundation, Inc.,
- * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- *)
-
-val list_devices : unit -> string list
-val list_partitions : unit -> string list
-val part_to_dev : string -> string
-val part_to_partnum : string -> int
-val is_whole_device : string -> bool
-val nr_devices : unit -> int
-val device_index : string -> int
diff --git a/daemon/file.mli b/daemon/file.mli
deleted file mode 100644
index 1e1631840..000000000
--- a/daemon/file.mli
+++ /dev/null
@@ -1,19 +0,0 @@
-(* guestfs-inspection
- * Copyright (C) 2009-2018 Red Hat Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along
- * with this program; if not, write to the Free Software Foundation, Inc.,
- * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- *)
-
-val file : string -> string
diff --git a/daemon/filearch.mli b/daemon/filearch.mli
deleted file mode 100644
index 3f472af51..000000000
--- a/daemon/filearch.mli
+++ /dev/null
@@ -1,19 +0,0 @@
-(* guestfs-inspection
- * Copyright (C) 2009-2018 Red Hat Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along
- * with this program; if not, write to the Free Software Foundation, Inc.,
- * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- *)
-
-val file_architecture : string -> string
diff --git a/daemon/findfs.mli b/daemon/findfs.mli
deleted file mode 100644
index c671782c3..000000000
--- a/daemon/findfs.mli
+++ /dev/null
@@ -1,20 +0,0 @@
-(* guestfs-inspection
- * Copyright (C) 2009-2018 Red Hat Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along
- * with this program; if not, write to the Free Software Foundation, Inc.,
- * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- *)
-
-val findfs_uuid : string -> string
-val findfs_label : string -> string
diff --git a/daemon/inspect.mli b/daemon/inspect.mli
deleted file mode 100644
index 336bbcfae..000000000
--- a/daemon/inspect.mli
+++ /dev/null
@@ -1,41 +0,0 @@
-(* guestfs-inspection
- * Copyright (C) 2009-2018 Red Hat Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along
- * with this program; if not, write to the Free Software Foundation, Inc.,
- * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- *)
-
-val inspect_os : unit -> Mountable.t list
-val inspect_get_roots : unit -> Mountable.t list
-val inspect_get_mountpoints : Mountable.t -> (string * Mountable.t) list
-val inspect_get_filesystems : Mountable.t -> Mountable.t list
-val inspect_get_format : Mountable.t -> string
-val inspect_get_type : Mountable.t -> string
-val inspect_get_distro : Mountable.t -> string
-val inspect_get_package_format : Mountable.t -> string
-val inspect_get_package_management : Mountable.t -> string
-val inspect_get_product_name : Mountable.t -> string
-val inspect_get_product_variant : Mountable.t -> string
-val inspect_get_major_version : Mountable.t -> int
-val inspect_get_minor_version : Mountable.t -> int
-val inspect_get_arch : Mountable.t -> string
-val inspect_get_hostname : Mountable.t -> string
-val inspect_get_windows_systemroot : Mountable.t -> string
-val inspect_get_windows_software_hive : Mountable.t -> string
-val inspect_get_windows_system_hive : Mountable.t -> string
-val inspect_get_windows_current_control_set : Mountable.t -> string
-val inspect_get_drive_mappings : Mountable.t -> (string * string) list
-val inspect_is_live : Mountable.t -> bool
-val inspect_is_netinst : Mountable.t -> bool
-val inspect_is_multipart : Mountable.t -> bool
diff --git a/daemon/is.mli b/daemon/is.mli
deleted file mode 100644
index f64d33dae..000000000
--- a/daemon/is.mli
+++ /dev/null
@@ -1,21 +0,0 @@
-(* guestfs-inspection
- * Copyright (C) 2009-2018 Red Hat Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along
- * with this program; if not, write to the Free Software Foundation, Inc.,
- * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- *)
-
-val is_file : ?followsymlinks:bool -> string -> bool
-val is_dir : ?followsymlinks:bool -> string -> bool
-val is_symlink : string -> bool
diff --git a/daemon/ldm.mli b/daemon/ldm.mli
deleted file mode 100644
index 74afdf5d8..000000000
--- a/daemon/ldm.mli
+++ /dev/null
@@ -1,20 +0,0 @@
-(* guestfs-inspection
- * Copyright (C) 2009-2018 Red Hat Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along
- * with this program; if not, write to the Free Software Foundation, Inc.,
- * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- *)
-
-val list_ldm_volumes : unit -> string list
-val list_ldm_partitions : unit -> string list
diff --git a/daemon/link.mli b/daemon/link.mli
deleted file mode 100644
index f3c6d1564..000000000
--- a/daemon/link.mli
+++ /dev/null
@@ -1,19 +0,0 @@
-(* guestfs-inspection
- * Copyright (C) 2009-2018 Red Hat Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along
- * with this program; if not, write to the Free Software Foundation, Inc.,
- * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- *)
-
-val readlink : string -> string
diff --git a/daemon/listfs.mli b/daemon/listfs.mli
deleted file mode 100644
index 0e8f24080..000000000
--- a/daemon/listfs.mli
+++ /dev/null
@@ -1,19 +0,0 @@
-(* guestfs-inspection
- * Copyright (C) 2009-2018 Red Hat Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along
- * with this program; if not, write to the Free Software Foundation, Inc.,
- * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- *)
-
-val list_filesystems : unit -> (Mountable.t * string) list
diff --git a/daemon/md.mli b/daemon/md.mli
deleted file mode 100644
index e0c3e08ad..000000000
--- a/daemon/md.mli
+++ /dev/null
@@ -1,20 +0,0 @@
-(* guestfs-inspection
- * Copyright (C) 2009-2018 Red Hat Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along
- * with this program; if not, write to the Free Software Foundation, Inc.,
- * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- *)
-
-val list_md_devices : unit -> string list
-val md_detail : string -> (string * string) list
diff --git a/daemon/parted.mli b/daemon/parted.mli
deleted file mode 100644
index 0b7eb87f4..000000000
--- a/daemon/parted.mli
+++ /dev/null
@@ -1,27 +0,0 @@
-(* guestfs-inspection
- * Copyright (C) 2009-2018 Red Hat Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along
- * with this program; if not, write to the Free Software Foundation, Inc.,
- * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- *)
-
-val part_get_mbr_id : string -> int -> int
-val part_list : string -> Structs.partition list
-
-val part_get_parttype : string -> string
-
-val part_get_gpt_type : string -> int -> string
-val part_get_gpt_guid : string -> int -> string
-val part_get_gpt_attributes : string -> int -> int64
-val part_set_gpt_attributes : string -> int -> int64 -> unit
diff --git a/daemon/realpath.mli b/daemon/realpath.mli
deleted file mode 100644
index 10b9ae565..000000000
--- a/daemon/realpath.mli
+++ /dev/null
@@ -1,20 +0,0 @@
-(* guestfs-inspection
- * Copyright (C) 2009-2018 Red Hat Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along
- * with this program; if not, write to the Free Software Foundation, Inc.,
- * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- *)
-
-val realpath : string -> string
-val case_sensitive_path : string -> string
diff --git a/daemon/statvfs.mli b/daemon/statvfs.mli
deleted file mode 100644
index 13b22f88d..000000000
--- a/daemon/statvfs.mli
+++ /dev/null
@@ -1,19 +0,0 @@
-(* guestfs-inspection
- * Copyright (C) 2009-2018 Red Hat Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License along
- * with this program; if not, write to the Free Software Foundation, Inc.,
- * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- *)
-
-val statvfs : string -> Structs.statvfs
diff --git a/generator/daemon.ml b/generator/daemon.ml
index 7fb7052a0..03b191ac8 100644
--- a/generator/daemon.ml
+++ b/generator/daemon.ml
@@ -490,6 +490,91 @@ let generate_daemon_caml_callbacks_ml ()    else
     pr "let init_callbacks () = ()\n"
 
+let rec generate_daemon_caml_interface modname () +  generate_header OCamlStyle
GPLv2plus;
+
+  let is_ocaml_module_function = function
+    | { impl = OCaml m } when String.is_prefix m (modname ^ ".")
-> true
+    | { impl = OCaml _ } -> false
+    | { impl = C } -> false
+  in
+
+  let ocaml_actions = actions |> (List.filter is_ocaml_module_function) in
+  if ocaml_actions == [] then
+    failwithf "no OCaml implementations for module %s" modname;
+
+  let prefix_length = String.length modname + 1 in
+  List.iter (
+    fun ({ name; style } as f) ->
+      let ocaml_function +        match f.impl with
+        | OCaml f -> String.sub f prefix_length (String.length f -
prefix_length)
+        | C -> assert false in
+
+      generate_ocaml_daemon_prototype ocaml_function style
+  ) ocaml_actions
+
+and generate_ocaml_daemon_prototype name style +  pr "val %s : "
name;
+  generate_ocaml_daemon_function_type style;
+  pr "\n"
+
+and generate_ocaml_daemon_function_type (ret, args, optargs) +  let
type_for_stringt = function
+    | Mountable
+    | Mountable_or_Path -> "Mountable.t"
+    | PlainString
+    | Device
+    | Pathname
+    | FileIn
+    | FileOut
+    | Key
+    | GUID
+    | Filename
+    | Dev_or_Path -> "string"
+  in
+  let type_for_rstringt = function
+    | RMountable -> "Mountable.t"
+    | RPlainString
+    | RDevice -> "string"
+  in
+  List.iter (
+    function
+    | OBool n -> pr "?%s:bool -> " n
+    | OInt n -> pr "?%s:int -> " n
+    | OInt64 n -> pr "?%s:int64 -> " n
+    | OString n -> pr "?%s:string -> " n
+    | OStringList n -> pr "?%s:string array -> " n
+  ) optargs;
+  if args <> [] then
+    List.iter (
+      function
+      | String (typ, _)-> pr "%s -> " (type_for_stringt typ)
+      | BufferIn _ -> pr "string -> "
+      | OptString _ -> pr "string option -> "
+      | StringList (typ, _)-> pr "%s array -> "
(type_for_stringt typ)
+      | Bool _ -> pr "bool -> "
+      | Int _ -> pr "int -> "
+      | Int64 _ | Pointer _ -> pr "int64 -> "
+    ) args
+  else
+    pr "unit -> ";
+  (match ret with
+   | RErr -> pr "unit" (* all errors are turned into exceptions *)
+   | RInt _ -> pr "int"
+   | RInt64 _ -> pr "int64"
+   | RBool _ -> pr "bool"
+   | RConstString _ -> pr "string"
+   | RConstOptString _ -> pr "string option"
+   | RString (typ, _) -> pr "%s" (type_for_rstringt typ)
+   | RBufferOut _ -> pr "string"
+   | RStringList (typ, _) -> pr "%s list" (type_for_rstringt typ)
+   | RStruct (_, typ) -> pr "Structs.%s" typ
+   | RStructList (_, typ) -> pr "Structs.%s list" typ
+   | RHashtable (typea, typeb, _) ->
+       pr "(%s * %s) list" (type_for_rstringt typea)
(type_for_rstringt typeb)
+  )
+
 (* Generate stubs for the functions implemented in OCaml.
  * Basically we implement the do_<name> function here, and
  * have it call out to OCaml code.
diff --git a/generator/daemon.mli b/generator/daemon.mli
index 40bf31302..f0268ba99 100644
--- a/generator/daemon.mli
+++ b/generator/daemon.mli
@@ -21,6 +21,7 @@ val generate_daemon_stubs_h : unit -> unit
 val generate_daemon_stubs : Types.action list -> unit -> unit
 val generate_daemon_caml_stubs : unit -> unit
 val generate_daemon_caml_callbacks_ml : unit -> unit
+val generate_daemon_caml_interface : string -> unit -> unit
 val generate_daemon_dispatch : unit -> unit
 val generate_daemon_lvm_tokenization : unit -> unit
 val generate_daemon_names : unit -> unit
diff --git a/generator/main.ml b/generator/main.ml
index 34bca68d9..ed75d1005 100644
--- a/generator/main.ml
+++ b/generator/main.ml
@@ -46,6 +46,11 @@ let output_to_subset fs f    for i = 0 to nr_actions_files-1
do
     ksprintf (fun filename -> output_to filename (f actions_subsets.(i))) fs
i
   done
+let output_to_ocaml_daemon modname +  let fn = Char.escaped
(Char.lowercase_ascii (String.unsafe_get modname 0)) ^
+           String.sub modname 1 (String.length modname - 1) in
+  output_to (sprintf "daemon/%s.mli" fn)
+            (Daemon.generate_daemon_caml_interface modname)
 
 (* Main program. *)
 let () @@ -155,6 +160,11 @@ Run it from the top source directory using the
command
             Daemon.generate_daemon_structs_cleanups_c;
   output_to "daemon/structs-cleanups.h"
             Daemon.generate_daemon_structs_cleanups_h;
+  let daemon_ocaml_interfaces = [
+    "Blkid"; "Btrfs"; "Devsparts";
"File"; "Filearch"; "Findfs"; "Inspect";
+    "Is"; "Ldm"; "Link"; "Listfs";
"Md"; "Parted"; "Realpath"; "Statvfs";
+  ] in
+  List.iter output_to_ocaml_daemon daemon_ocaml_interfaces;
 
   output_to "fish/cmds-gperf.gperf"
             Fish.generate_fish_cmds_gperf;
-- 
2.14.3

Richard W.M. Jones

2018-Apr-09 14:33 UTC

head link

Re: [Libguestfs] [PATCH 3/3] daemon: autogenerate most of OCaml interfaces

On Mon, Apr 09, 2018 at 04:06:32PM +0200, Pino Toscano
wrote:> diff --git a/generator/daemon.ml b/generator/daemon.ml
> index 7fb7052a0..03b191ac8 100644
> --- a/generator/daemon.ml
> +++ b/generator/daemon.ml
> @@ -490,6 +490,91 @@ let generate_daemon_caml_callbacks_ml () >    else
>      pr "let init_callbacks () = ()\n"
>  
> +let rec generate_daemon_caml_interface modname () > +  generate_header
OCamlStyle GPLv2plus;
> +
> +  let is_ocaml_module_function = function
> +    | { impl = OCaml m } when String.is_prefix m (modname ^ ".")
-> true
> +    | { impl = OCaml _ } -> false
> +    | { impl = C } -> false
> +  in
> +
> +  let ocaml_actions = actions |> (List.filter is_ocaml_module_function)
in
> +  if ocaml_actions == [] then
> +    failwithf "no OCaml implementations for module %s" modname;
> +
> +  let prefix_length = String.length modname + 1 in
> +  List.iter (
> +    fun ({ name; style } as f) ->
> +      let ocaml_function > +        match f.impl with
> +        | OCaml f -> String.sub f prefix_length (String.length f -
prefix_length)
> +        | C -> assert false in
> +
> +      generate_ocaml_daemon_prototype ocaml_function style
> +  ) ocaml_actions
> +
> +and generate_ocaml_daemon_prototype name style > +  pr "val %s :
" name;
> +  generate_ocaml_daemon_function_type style;
> +  pr "\n"
> +
> +and generate_ocaml_daemon_function_type (ret, args, optargs) > +  let
type_for_stringt = function
> +    | Mountable
> +    | Mountable_or_Path -> "Mountable.t"
> +    | PlainString
> +    | Device
> +    | Pathname
> +    | FileIn
> +    | FileOut
> +    | Key
> +    | GUID
> +    | Filename
> +    | Dev_or_Path -> "string"
> +  in
> +  let type_for_rstringt = function
> +    | RMountable -> "Mountable.t"
> +    | RPlainString
> +    | RDevice -> "string"
> +  in
> +  List.iter (
> +    function
> +    | OBool n -> pr "?%s:bool -> " n
> +    | OInt n -> pr "?%s:int -> " n
> +    | OInt64 n -> pr "?%s:int64 -> " n
> +    | OString n -> pr "?%s:string -> " n
> +    | OStringList n -> pr "?%s:string array -> " n
> +  ) optargs;
> +  if args <> [] then
> +    List.iter (
> +      function
> +      | String (typ, _)-> pr "%s -> " (type_for_stringt
typ)
> +      | BufferIn _ -> pr "string -> "
> +      | OptString _ -> pr "string option -> "
> +      | StringList (typ, _)-> pr "%s array -> "
(type_for_stringt typ)
> +      | Bool _ -> pr "bool -> "
> +      | Int _ -> pr "int -> "
> +      | Int64 _ | Pointer _ -> pr "int64 -> "
> +    ) args
> +  else
> +    pr "unit -> ";
> +  (match ret with
> +   | RErr -> pr "unit" (* all errors are turned into
exceptions *)
> +   | RInt _ -> pr "int"
> +   | RInt64 _ -> pr "int64"
> +   | RBool _ -> pr "bool"
> +   | RConstString _ -> pr "string"
> +   | RConstOptString _ -> pr "string option"
> +   | RString (typ, _) -> pr "%s" (type_for_rstringt typ)
> +   | RBufferOut _ -> pr "string"
> +   | RStringList (typ, _) -> pr "%s list" (type_for_rstringt
typ)
> +   | RStruct (_, typ) -> pr "Structs.%s" typ
> +   | RStructList (_, typ) -> pr "Structs.%s list" typ
> +   | RHashtable (typea, typeb, _) ->
> +       pr "(%s * %s) list" (type_for_rstringt typea)
(type_for_rstringt typeb)
> +  )
> +
>  (* Generate stubs for the functions implemented in OCaml.
>   * Basically we implement the do_<name> function here, and
>   * have it call out to OCaml code.
> diff --git a/generator/main.ml b/generator/main.ml
> index 34bca68d9..ed75d1005 100644
> --- a/generator/main.ml
> +++ b/generator/main.ml
> @@ -46,6 +46,11 @@ let output_to_subset fs f >    for i = 0 to
nr_actions_files-1 do
>      ksprintf (fun filename -> output_to filename (f
actions_subsets.(i))) fs i
>    done
> +let output_to_ocaml_daemon modname > +  let fn = Char.escaped
(Char.lowercase_ascii (String.unsafe_get modname 0)) ^
> +           String.sub modname 1 (String.length modname - 1) in
> +  output_to (sprintf "daemon/%s.mli" fn)
> +            (Daemon.generate_daemon_caml_interface modname)
>  
>  (* Main program. *)
>  let () > @@ -155,6 +160,11 @@ Run it from the top source directory
using the command
>              Daemon.generate_daemon_structs_cleanups_c;
>    output_to "daemon/structs-cleanups.h"
>              Daemon.generate_daemon_structs_cleanups_h;
> +  let daemon_ocaml_interfaces = [
> +    "Blkid"; "Btrfs"; "Devsparts";
"File"; "Filearch"; "Findfs"; "Inspect";
> +    "Is"; "Ldm"; "Link"; "Listfs";
"Md"; "Parted"; "Realpath"; "Statvfs";
> +  ] in
This list should be generated from the list of APIs, splitting the
OCaml "module.function" fields to get module name.

Also "Mount" is not included in this list (and possibly others, I
didn't check).  Mount has a non-generated interface (umount_all) which
I guess is the reason, but unfortunately this reduces the value of
generating these interfaces.
> +  List.iter output_to_ocaml_daemon daemon_ocaml_interfaces;
Is there a reason this isn't inlined?  It seems a bit awkward
to have the actual body elsewhere in the file.

Rich.
>    output_to "fish/cmds-gperf.gperf"
>              Fish.generate_fish_cmds_gperf;
> -- 
> 2.14.3
> 
> _______________________________________________
> Libguestfs mailing list
> Libguestfs@redhat.com
> https://www.redhat.com/mailman/listinfo/libguestfs
-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
virt-p2v converts physical machines to virtual machines.  Boot with a
live CD or over the network (PXE) and turn machines into KVM guests.
http://libguestfs.org/virt-v2v

Richard W.M. Jones

2018-Apr-09 14:34 UTC

head link

Re: [Libguestfs] [PATCH 2/3] daemon: use the structs from the Structs module

ACK 1/3 and 2/3.

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
Fedora Windows cross-compiler. Compile Windows programs, test, and
build Windows installers. Over 100 libraries supported.
http://fedoraproject.org/wiki/MinGW

Apparently Analagous Threads

Search for more seemingly similar threads

Libguestfs - Apr 2018 - [PATCH 2/3] daemon: use the structs from the Structs module

[Libguestfs] [PATCH 0/3] daemon: generate almost all the API OCaml interfaces

[Libguestfs] [PATCH 1/3] daemon: directly use Optgroups

[Libguestfs] [PATCH 2/3] daemon: use the structs from the Structs module

[Libguestfs] [PATCH 3/3] daemon: autogenerate most of OCaml interfaces

Re: [Libguestfs] [PATCH 3/3] daemon: autogenerate most of OCaml interfaces

Re: [Libguestfs] [PATCH 2/3] daemon: use the structs from the Structs module

Apparently Analagous Threads