mirrors/libguestfs
1
0
Fork 0
mirror of https://github.com/libguestfs/libguestfs.git synced 2026-03-21 22:53:37 +00:00
Code Issues Packages Projects Releases Wiki Activity

daemon: autogenerate OCaml interfaces

Browse Source 
Add a way to generate OCaml interfaces for all the 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.

(cherry picked from commit e655676157)
This commit is contained in:
Pino Toscano
2018-04-10 12:31:34 +02:00
committed by Richard W.M. Jones
parent 0644f894ea
commit 2056275f3b
22 changed files with 135 additions and 369 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
.gitignore vendored
View File

@@ -185,21 +185,38 @@ 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.mli
/daemon/lvm-tokenization.c
/daemon/md.mli
/daemon/mount.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

17
daemon/Makefile.am
View File

@@ -36,9 +36,26 @@ BUILT_SOURCES = \
generator_built = \
$(BUILT_SOURCES) \
blkid.mli \
btrfs.mli \
callbacks.ml \
devsparts.mli \
file.mli \
filearch.mli \
findfs.mli \
inspect.mli \
is.mli \
ldm.mli \
link.mli \
listfs.mli \
lvm.mli \
md.mli \
mount.mli \
optgroups.ml \
optgroups.mli \
parted.mli \
realpath.mli \
statvfs.mli \
structs.ml \
structs.mli

19
daemon/blkid.mli
View File

@@ -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

20
daemon/btrfs.mli
View File

@@ -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

25
daemon/devsparts.mli
View File

@@ -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

19
daemon/file.mli
View File

@@ -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

19
daemon/filearch.mli
View File

@@ -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

20
daemon/findfs.mli
View File

@@ -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

41
daemon/inspect.mli
View File

@@ -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

21
daemon/is.mli
View File

@@ -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

20
daemon/ldm.mli
View File

@@ -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

19
daemon/link.mli
View File

@@ -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

19
daemon/listfs.mli
View File

@@ -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

19
daemon/lvm.mli
View File

@@ -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 lvs : unit -> string list

20
daemon/md.mli
View File

@@ -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

22
daemon/mount.mli
View File

@@ -1,22 +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 mount : Mountable.t -> string -> unit
val mount_ro : Mountable.t -> string -> unit
val mount_options : string -> Mountable.t -> string -> unit
val mount_vfs : string -> string -> Mountable.t -> string -> unit

27
daemon/parted.mli
View File

@@ -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

20
daemon/realpath.mli
View File

@@ -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

19
daemon/statvfs.mli
View File

@@ -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

83
generator/daemon.ml
View File

@@ -490,6 +490,89 @@ 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; impl } ->
let ocaml_function =
match 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 (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
pr "val %s : " name;
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)
);
pr "\n"
(* Generate stubs for the functions implemented in OCaml.
* Basically we implement the do_<name> function here, and
* have it call out to OCaml code.

1
generator/daemon.mli
View File

@@ -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

17
generator/main.ml
View File

@@ -155,6 +155,23 @@ 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 =
List.fold_left (
fun set { impl } ->
let ocaml_function =
match impl with
| OCaml f -> fst (String.split "." f)
| C -> assert false in
StringSet.add ocaml_function set
) StringSet.empty (actions |> impl_ocaml_functions) in
StringSet.iter (
fun 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)
) daemon_ocaml_interfaces;
output_to "fish/cmds-gperf.gperf"
Fish.generate_fish_cmds_gperf;