Make sure every *.ml file has a corresponding *.mli file.

This commit is contained in:
Richard W.M. Jones
2017-09-18 11:13:36 +01:00
parent f04561a1fe
commit a706ecb8f7
41 changed files with 1134 additions and 330 deletions

5
.gitignore vendored
View File

@@ -181,10 +181,12 @@ Makefile.in
/daemon/optgroups.c
/daemon/optgroups.h
/daemon/optgroups.ml
/daemon/optgroups.mli
/daemon/stamp-guestfsd.pod
/daemon/structs-cleanups.c
/daemon/structs-cleanups.h
/daemon/structs.ml
/daemon/structs.mli
/daemon/stubs-?.c
/daemon/stubs.h
/daemon/types.ml
@@ -193,6 +195,7 @@ Makefile.in
/df/virt-df
/df/virt-df.1
/dib/.depend
/dib/output_format_*.mli
/dib/stamp-virt-dib.pod
/dib/virt-dib
/dib/virt-dib.1
@@ -376,6 +379,7 @@ Makefile.in
/missing
/mllib/.depend
/mllib/common_gettext.ml
/mllib/common_gettext.mli
/mllib/common_utils_tests
/mllib/getopt_tests
/mllib/JSON_tests
@@ -551,6 +555,7 @@ Makefile.in
/sysprep/stamp-virt-sysprep.pod
/sysprep/sysprep-extra-options.pod
/sysprep/sysprep-operations.pod
/sysprep/sysprep_operation_*.mli
/sysprep/virt-sysprep
/sysprep/virt-sysprep.1
/tests/c-api/test-add-drive-opts

View File

@@ -42,6 +42,7 @@ EXTRA_DIST = \
yajl_tests.ml
SOURCES_MLI = \
builder.mli \
cache.mli \
cmdline.mli \
downloader.mli \
@@ -50,11 +51,13 @@ SOURCES_MLI = \
ini_reader.mli \
languages.mli \
list_entries.mli \
paths.mli \
pxzcat.mli \
setlocale.mli \
sigchecker.mli \
simplestreams_parser.mli \
sources.mli \
utils.mli \
yajl.mli
SOURCES_ML = \

19
builder/builder.mli Normal file
View File

@@ -0,0 +1,19 @@
(* virt-builder
* Copyright (C) 2017 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.
*)
(* Nothing is exported. *)

28
builder/paths.mli Normal file
View File

@@ -0,0 +1,28 @@
(* virt-builder
* Copyright (C) 2014-2017 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 xdg_cache_home : string option
(** [$XDG_CACHE_HOME/virt-builder] or [$HOME/.cache/virt-builder] or [None]. *)
val xdg_config_home : unit -> string option
(** [$XDG_CONFIG_HOME/prog] or [$HOME/.config/prog] or [None]. *)
val xdg_config_dirs : unit -> string list
(** [$XDG_CONFIG_DIRS] (which is a colon-separated path), split. Empty
elements are removed from the list. If the environment variable
is not set [["/etc/xdg"]] is returned instead. *)

30
builder/utils.mli Normal file
View File

@@ -0,0 +1,30 @@
(* virt-builder
* Copyright (C) 2013-2017 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.
*)
(** Utilities/common functions used in virt-builder only. *)
type gpgkey_type =
| No_Key
| Fingerprint of string
| KeyFile of string
and revision =
| Rev_int of int
| Rev_string of string
val string_of_revision : revision -> string
(** Convert a {!revision} into a string. *)

View File

@@ -23,6 +23,7 @@ EXTRA_DIST = \
std_utils_tests.ml
SOURCES_MLI = \
guestfs_config.mli \
std_utils.mli \
stringMap.mli \
stringSet.mli

View File

@@ -0,0 +1,35 @@
(* mlstdutils
* Copyright (C) 2017 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 package_name : string
(** The configure value [@PACKAGE_NAME@] *)
val package_version : string
(** The configure value [@PACKAGE_VERSION@] *)
val package_version_full : string
(** The configure value [@PACKAGE_VERSION_FULL@] *)
val prefix : string
(** The configure value [@prefix@] *)
val datadir : string
(** The configure value [@datadir@] *)
val host_cpu : string
(** The configure value [@host_cpu@] *)

View File

@@ -38,6 +38,7 @@ SOURCES_MLI = \
append_line.mli \
crypt.mli \
customize_cmdline.mli \
customize_main.mli \
customize_run.mli \
firstboot.mli \
hostname.mli \

View File

@@ -0,0 +1,19 @@
(* virt-customize
* Copyright (C) 2014-2017 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.
*)
(* Nothing is exported. *)

View File

@@ -36,7 +36,11 @@ BUILT_SOURCES = \
generator_built = \
$(BUILT_SOURCES) \
callbacks.ml
callbacks.ml \
optgroups.ml \
optgroups.mli \
structs.ml \
structs.mli
EXTRA_DIST = \
$(generator_built) \
@@ -245,8 +249,9 @@ guestfsd_CFLAGS = \
SOURCES_MLI = \
blkid.mli \
btrfs.mli \
callbacks.mli \
chroot.mli \
sysroot.mli \
daemon.mli \
devsparts.mli \
file.mli \
filearch.mli \
@@ -266,8 +271,11 @@ SOURCES_MLI = \
md.mli \
mount.mli \
mountable.mli \
optgroups.mli \
parted.mli \
realpath.mli \
structs.mli \
sysroot.mli \
utils.mli
SOURCES_ML = \

20
daemon/callbacks.mli Normal file
View File

@@ -0,0 +1,20 @@
(* guestfsd
* Copyright (C) 2009-2017 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 init_callbacks : unit -> unit
(** Initialize callbacks to OCaml code. (This code is generated.) *)

19
daemon/daemon.mli Normal file
View File

@@ -0,0 +1,19 @@
(* guestfsd
* Copyright (C) 2009-2017 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.
*)
(* Nothing is exported. *)

View File

@@ -24,7 +24,11 @@ EXTRA_DIST = \
SOURCES_MLI = \
cmdline.mli \
output_format.mli
dib.mli \
elements.mli \
output_format.mli \
$(patsubst %,output_format_%.mli,$(formats)) \
utils.mli
# Filenames output_format_<name>.ml in alphabetical order.
formats = \
@@ -119,6 +123,16 @@ virt_dib_LINK = \
$(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLPACKAGES) $(OCAMLLINKFLAGS) \
$(OBJECTS) -o $@
# The output_format_*.mli files are all empty and autogenerated.
CLEANFILES += \
$(patsubst %,output_format_%.mli,$(formats))
output_format_%.mli:
rm -f $@ $@-t
echo '(* This file is generated by Makefile.am. *)' >> $@-t
echo '(* Nothing is exported from output format modules. *)' >> $@-t
mv $@-t $@
# Tests.
TESTS_ENVIRONMENT = $(top_builddir)/run --test
@@ -143,7 +157,7 @@ stamp-virt-dib.pod: virt-dib.pod
touch $@
# OCaml dependencies.
.depend: *.mli *.ml
.depend: $(SOURCES_MLI) $(SOURCES_ML)
$(top_builddir)/ocaml-dep.sh $^
-include .depend

19
dib/dib.mli Normal file
View File

@@ -0,0 +1,19 @@
(* virt-dib
* Copyright (C) 2015 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.
*)
(* Nothing is exported. *)

View File

@@ -34,14 +34,9 @@ and hooks_map = (string, string list) Hashtbl.t (* hook name, scripts *)
exception Duplicate_script of string * string (* hook, script *)
(* These are the elements which we don't ever try to use. *)
let builtin_elements_blacklist = [
]
(* These are the scripts which we don't ever try to run.
* Usual reason could be that they are not compatible the way virt-dib works:
* e.g. they expect the tree of elements outside the chroot, which is not
* available in the appliance. *)
let builtin_scripts_blacklist = [
"01-sahara-version"; (* Gets the Git commit ID of the d-i-b and
* sahara-image-elements repositories. *)

61
dib/elements.mli Normal file
View File

@@ -0,0 +1,61 @@
(* virt-dib
* Copyright (C) 2015 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.
*)
(** Parsing and handling of elements. *)
type element = {
directory : string; (** directory of the element *)
hooks : hooks_map; (** available hooks, and scripts for each hook*)
}
and hooks_map = (string, string list) Hashtbl.t (** hook name, scripts *)
val builtin_elements_blacklist : string list
(** These are the elements which we don't ever try to use. *)
val builtin_scripts_blacklist : string list
(** These are the scripts which we don't ever try to run.
Usual reason could be that they are not compatible the way
virt-dib works, e.g. they expect the tree of elements outside
the chroot, which is not available in the appliance. *)
val load_elements : debug:int -> string list -> (string, element) Hashtbl.t
(** [load_elements ~debug paths] loads elements from the specified
[paths]; returns a [Hashtbl.t] of {!element} structs indexed by
the element name. *)
val load_dependencies : StringSet.elt list -> (string, element) Hashtbl.t -> StringSet.t
(** [load_dependencies element_set elements] returns the whole set of
elements needed to use [element_set], including [element_list]
themselves. In other words, this recursively resolves the
dependencies of [element_set]. *)
val copy_elements : StringSet.t -> (string, element) Hashtbl.t -> string list -> string -> unit
(** [copy_elements element_set elements blacklisted_scripts destdir]
copies the elements in [element_set] (with the element definitions
provided as [elements]) into the [destdir] directory.
[blacklisted_scripts] contains names of scripts to never copy. *)
val load_hooks : debug:int -> string -> hooks_map
(** [load_hooks ~debug path] loads the hooks from the specified
[path] (which usually represents an element). *)
val load_scripts : Guestfs.guestfs -> string -> string list
(** [load_scripts g path] loads the scripts from the specified [path]
(which usually represents a directory of an hook). *)

66
dib/utils.mli Normal file
View File

@@ -0,0 +1,66 @@
(* virt-dib
* Copyright (C) 2015 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 unit_GB : int -> int64
(** [unit_GB n] returns n * 2^30 *)
val current_arch : unit -> string
(** Turn the host_cpu into the dpkg architecture naming. *)
val output_filename : string -> string -> string
(** [output_filename image_name format] generates a suitable output
filename based on the image filename and output format. *)
val log_filename : unit -> string
(** Generate a name for the log file containing the program name and
current date/time. *)
val var_from_lines : string -> string list -> string
(** Find variable definition in a set of lines of the form [var=value]. *)
val string_index_fn : (char -> bool) -> string -> int
(** Apply function to each character in the string. If the function
returns true, return the index of the character.
In other words, like {!String.index} but using a function
instead of a single character.
@raise Not_found if no match *)
val digit_prefix_compare : string -> string -> int
val do_mkdir : string -> unit
(** Wrapper around [mkdir -p -m 0755] *)
val get_required_tool : string -> string
(** Ensure external program is installed. Return the full path of the
program or fail with an error message. *)
val require_tool : string -> unit
(** Same as {!get_required_tool} but only checks the external program
is installed and does not return the path. *)
val do_cp : string -> string -> unit
(** Wrapper around [cp -a src destdir]. *)
val ensure_trailing_newline : string -> string
(** If the input string is not [""], ensure there is a trailing ['\n'],
adding one if necessary. *)
val not_in_list : 'a list -> 'a -> bool
(** Opposite of {!List.mem}. *)

View File

@@ -84,6 +84,7 @@ sources = \
lua.ml \
lua.mli \
main.ml \
main.mli \
OCaml.ml \
OCaml.mli \
optgroups.ml \
@@ -107,6 +108,7 @@ sources = \
tests_c_api.ml \
tests_c_api.mli \
types.ml \
types.mli \
UEFI.ml \
UEFI.mli \
utils.ml \

View File

@@ -1152,6 +1152,14 @@ let generate_daemon_optgroups_ml () =
pr " \"guestfs_int_daemon_optgroup_%s_available\" \"noalloc\"\n" group
) optgroups_names
let generate_daemon_optgroups_mli () =
generate_header OCamlStyle GPLv2plus;
List.iter (
fun group ->
pr "val %s_available : unit -> bool\n" group
) optgroups_names
(* Generate structs-cleanups.c file. *)
let generate_daemon_structs_cleanups_c () =
generate_header CStyle GPLv2plus;

View File

@@ -27,5 +27,6 @@ val generate_daemon_names : unit -> unit
val generate_daemon_optgroups_c : unit -> unit
val generate_daemon_optgroups_h : unit -> unit
val generate_daemon_optgroups_ml : unit -> unit
val generate_daemon_optgroups_mli : unit -> unit
val generate_daemon_structs_cleanups_c : unit -> unit
val generate_daemon_structs_cleanups_h : unit -> unit

View File

@@ -147,6 +147,8 @@ Run it from the top source directory using the command
Daemon.generate_daemon_optgroups_h;
output_to "daemon/optgroups.ml"
Daemon.generate_daemon_optgroups_ml;
output_to "daemon/optgroups.mli"
Daemon.generate_daemon_optgroups_mli;
output_to "daemon/lvm-tokenization.c"
Daemon.generate_daemon_lvm_tokenization;
output_to "daemon/structs-cleanups.c"
@@ -193,6 +195,8 @@ Run it from the top source directory using the command
OCaml.generate_ocaml_c_errnos;
output_to "daemon/structs.ml"
OCaml.generate_ocaml_daemon_structs;
output_to "daemon/structs.mli"
OCaml.generate_ocaml_daemon_structs;
output_to "ocaml/bindtests.ml"
Bindtests.generate_ocaml_bindtests;

19
generator/main.mli Normal file
View File

@@ -0,0 +1,19 @@
(* libguestfs
* Copyright (C) 2009-2017 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
*)
(* Nothing is exported. *)

View File

@@ -18,115 +18,22 @@
(* Please read generator/README first. *)
(* Types used to describe the API. *)
(* Types used to describe the API - see [types.mli] file for the
documentation. *)
type style = ret * args * optargs
(* The [style] is a tuple which describes the return value and
* arguments of a function.
*
* [ret] is the return value, one of the [R*] values below.
*
* The second element is the list of required arguments, a list of
* [argt]s from the list below, eg. [Bool], [String] etc. Each has
* a name so that for example [Int "foo"] corresponds in the C
* bindings to an [int foo] parameter.
*
* The third element is the list of optional arguments. These are
* mapped to optional arguments in the language binding, eg. in
* Perl to:
* $g->fn (required1, required2, opt1 => val, opt2 => val);
* As the name suggests these are optional, and the function can
* tell which optional parameters were supplied by the caller.
*)
and ret =
(* "RErr" as a return value means an int used as a simple error
* indication, ie. 0 or -1.
*)
| RErr
(* "RInt" as a return value means an int which is -1 for error
* or any value >= 0 on success. Only use this for smallish
* positive ints (0 <= i < 2^30).
*)
| RInt of string
(* "RInt64" is the same as RInt, but is guaranteed to be able
* to return a full 64 bit value, _except_ that -1 means error
* (so -1 cannot be a valid, non-error return value).
*)
| RInt64 of string
(* "RBool" is a bool return value which can be true/false or
* -1 for error.
*)
| RBool of string
(* "RConstString" is a string that refers to a constant value.
* The return value must NOT be NULL (since NULL indicates
* an error).
*
* Try to avoid using this. In particular you cannot use this
* for values returned from the daemon, because there is no
* thread-safe way to return them in the C API.
*)
| RConstString of string
(* "RConstOptString" is an even more broken version of
* "RConstString". The returned string may be NULL and there
* is no way to return an error indication. Avoid using this!
*)
| RConstOptString of string
(* "RString" is a returned string. It must NOT be NULL, since
* a NULL return indicates an error. The caller frees this.
*)
| RString of rstringt * string
(* "RStringList" is a list of strings. No string in the list
* can be NULL. The caller frees the strings and the array.
*)
| RStringList of rstringt * string
(* "RStruct" is a function which returns a single named structure
* or an error indication (in C, a struct, and in other languages
* with varying representations, but usually very efficient). See
* after the function list below for the structures.
*)
| RStruct of string * string (* name of retval, name of struct *)
(* "RStructList" is a function which returns either a list/array
* of structures (could be zero-length), or an error indication.
*)
| RStructList of string * string (* name of retval, name of struct *)
(* Key-value pairs of untyped strings. Turns into a hashtable or
* dictionary in languages which support it.
*
* DON'T use this as a general "bucket" for results. Prefer a
* stronger typed return value if one is available, or write a
* custom struct. Don't use this if the list could potentially
* be very long, since it is inefficient.
*
* Keys should be unique. NULLs are not permitted.
* The first rstringt is the type of the keys, the second
* rstringt is the type of the values.
*)
| RHashtable of rstringt * rstringt * string
(* "RBufferOut" is handled almost exactly like RString, but
* it allows the string to contain arbitrary 8 bit data including
* ASCII NUL. In the C API this causes an implicit extra parameter
* to be added of type <size_t *size_r>. The extra parameter
* returns the actual size of the return buffer in bytes.
*
* Other programming languages support strings with arbitrary 8 bit
* data.
*
* At the RPC layer we have to use the opaque<> type instead of
* string<>. Returned data is still limited to the max message
* size (ie. ~ 2 MB).
*)
| RBufferOut of string
and rstringt =
@@ -137,106 +44,37 @@ and rstringt =
and args = argt list (* Function parameters, guestfs handle is implicit. *)
and argt =
| Bool of string (* boolean *)
| Int of string (* int (smallish ints, signed, <= 31 bits) *)
| Int64 of string (* any 64 bit int *)
(* Strings: These can be plain strings, device names, mountable
* filesystems, etc. They cannot be NULL.
*)
| Bool of string
| Int of string
| Int64 of string
| String of stringt * string
| OptString of string (* Plain string, may be NULL. *)
(* List of strings: The strings may be plain strings, device names
* etc., but all of the same type. The strings cannot be NULL.
*)
| OptString of string
| StringList of stringt * string
(* Opaque buffer which can contain arbitrary 8 bit data.
* In the C API, this is expressed as <const char *, size_t> pair.
* Most other languages have a string type which can contain
* ASCII NUL. We use whatever type is appropriate for each
* language.
* Buffers are limited by the total message size. To transfer
* large blocks of data, use FileIn/FileOut parameters instead.
* To return an arbitrary buffer, use RBufferOut.
*)
| BufferIn of string
(* This specifies an opaque pointer that is passed through
* untouched. Only non-daemon functions are supported.
*
* Pointer ("foo *", "bar") translates to "foo *bar" in the
* C API. The pointer ("bar") cannot be NULL.
*
* This is less well supported in other language bindings:
* if the pointer type is known then we may be able to produce
* a suitable binding, otherwise this is translated into a 64
* bit int.
*
* Functions with this parameter type are not supported at all
* in guestfish (the function must be declared "NotInFish" else
* you will get an error). Also the function cannot contain
* tests, although we should fix this in future.
*)
| Pointer of (string * string)
and stringt =
| PlainString (* none of the others *)
| Device (* /dev device name *)
| Mountable (* location of mountable filesystem *)
(* An absolute path within the appliance filesystem. *)
| PlainString
| Device
| Mountable
| Pathname
(* These are treated as filenames (simple string parameters) in
* the C API and bindings. But in the RPC protocol, we transfer
* the actual file content up to or down from the daemon.
* FileIn: local machine -> daemon (in request)
* FileOut: daemon -> local machine (in reply)
* In guestfish (only), the special name "-" means read from
* stdin or write to stdout.
*)
| FileIn
| FileOut
(* Key material / passphrase. Eventually we should treat this
* as sensitive and mlock it into physical RAM. However this
* is highly complex because of all the places that XDR-encoded
* strings can end up. So currently the only difference from
* 'PlainString' is the way that guestfish requests these
* parameters from the user.
*)
| Key
(* A GUID string.
*
* It cannot be NULL, and it will be validated using
* guestfs_int_validate_guid.
*)
| GUID
(* A simple filename (not a path nor a relative path). It cannot
* be NULL, empty, or anything different than a simple file name.
*)
| Filename
(* The following two are DEPRECATED and must not be used in
* any new APIs.
*)
| Dev_or_Path (* Device or Pathname. *)
| Mountable_or_Path (* Mountable or Pathname. *)
| Dev_or_Path
| Mountable_or_Path
and optargs = optargt list
and optargt =
| OBool of string (* boolean *)
| OInt of string (* int (smallish ints, signed, <= 31 bits) *)
| OInt64 of string (* any 64 bit int *)
| OString of string (* const char *name, cannot be NULL *)
| OStringList of string (* char **strings, neither the list nor any
string may be NULL *)
| OBool of string
| OInt of string
| OInt64 of string
| OString of string
| OStringList of string
type errcode = [ `CannotReturnError | `ErrorIsMinusOne | `ErrorIsNULL ]
@@ -247,112 +85,31 @@ type fish_output_t =
(* See guestfs-hacking(1). *)
type c_api_tests = (c_api_test_init * c_api_test_prereq * c_api_test * c_api_test_cleanup) list
and c_api_test =
(* Run the command sequence and just expect nothing to fail. *)
| TestRun of seq
(* Run the command sequence. No command should fail, and the
* output of the command(s) is tested using the C expression which
* should return true.
*
* In the C expression, 'ret' is the result of the final command,
* 'ret1' is the result of the last but one command, and so on
* backwards.
*)
| TestResult of seq * string
(* Run the command sequence. No command should fail, and the
* last command must return the given string or device name.
*)
| TestResultString of seq * string
| TestResultDevice of seq * string
(* Run the command sequence. No command should fail, and the
* last command must return true or false.
*)
| TestResultTrue of seq
| TestResultFalse of seq
(* Run the command sequence and expect the final command (only)
* to fail.
*)
| TestLastFail of seq
(* Run the command sequence and expect either nothing to fail,
* or that the last command only can fail with ENOTSUP.
*)
| TestRunOrUnsupported of seq
(* Test prerequisites. *)
and c_api_test_prereq =
(* Test always runs. *)
| Always
(* Test is currently disabled - eg. it fails, or it tests some
* unimplemented feature.
*)
| Disabled
(* Run the test only if 'string' is available in the daemon. *)
| IfAvailable of string
(* Run the test when the appliance and the OS differ - for example,
* when using a fixed appliance created in a different OS/distribution.
*)
| IfNotCrossAppliance
(* Some initial scenarios for testing. *)
and c_api_test_init =
(* Do nothing, block devices could contain random stuff including
* LVM PVs, and some filesystems might be mounted. This is usually
* a bad idea.
*)
| InitNone
(* Block devices are empty and no filesystems are mounted. *)
| InitEmpty
(* /dev/sda contains a single partition /dev/sda1, with random
* content. No LVM.
*)
| InitPartition
(* Identical to InitPartition, except that the partition table is GPT
* instead of MBR.
*)
| InitGPT
(* /dev/sda contains a single partition /dev/sda1, which is formatted
* as ext2, empty [except for lost+found] and mounted on /.
* No LVM.
*
* Note: for testing filesystem operations, it is quicker to use
* InitScratchFS
*)
| InitBasicFS
(* /dev/sda:
* /dev/sda1 (is a PV):
* /dev/VG/LV (size 8MB):
* formatted as ext2, empty [except for lost+found], mounted on /
*
* Note: only use this if you really need a freshly created filesystem
* on LVM. Normally you should use InitScratchFS instead.
*)
| InitBasicFSonLVM
(* /dev/sdd (the ISO, see images/ directory in source)
* is mounted on /
*)
| InitISOFS
(* /dev/sdb1 (write scratch disk) is mounted on /. The filesystem
* will be empty.
*
* Note that this filesystem is not recreated between tests, and
* could contain random files and directories from previous tests.
* Therefore it is recommended that you create uniquely named files
* and directories for your tests.
*)
| InitScratchFS
(* Cleanup commands which are run whether the test succeeds or fails. *)
@@ -363,43 +120,41 @@ and seq = cmd list
and cmd = string list
type visibility =
| VPublic (* Part of the public API *)
| VPublicNoFish (* Like VPublic, but not exported in
guestfish *)
| VStateTest (* A function which tests the state
of the appliance *)
| VBindTest (* Only used for testing language bindings *)
| VDebug (* Exported everywhere, but not documented *)
| VInternal (* Not exported *)
| VPublic
| VPublicNoFish
| VStateTest
| VBindTest
| VDebug
| VInternal
type version = int * int * int
type deprecated_by =
| Not_deprecated (* function not deprecated *)
| Replaced_by of string (* replaced by another function *)
| Deprecated_no_replacement (* deprecated with no replacement *)
| Not_deprecated
| Replaced_by of string
| Deprecated_no_replacement
type impl =
| C (* implemented in C by "do_<name>" *)
| OCaml of string (* implemented in OCaml by named function *)
| C
| OCaml of string
(* Type of an action as declared in Actions module. *)
type action = {
name : string; (* name, not including "guestfs_" *)
added : version; (* which version was the API first added *)
style : style; (* args and return value *)
impl : impl; (* implementation language (C or OCaml) *)
proc_nr : int option; (* proc number, None for non-daemon *)
tests : c_api_tests; (* C API tests *)
test_excuse : string; (* if there's no tests ... *)
shortdesc : string; (* single line description *)
longdesc : string; (* longer documentation *)
name : string;
added : version;
style : style;
impl : impl;
proc_nr : int option;
tests : c_api_tests;
test_excuse : string;
shortdesc : string;
longdesc : string;
(* Lots of flags ... *)
protocol_limit_warning : bool; (* warn about protocol size limits *)
fish_alias : string list; (* alias(es) for this cmd in guestfish *)
fish_output : fish_output_t option; (* how to display output in guestfish *)
visibility: visibility; (* The visbility of function *)
protocol_limit_warning : bool;
fish_alias : string list;
fish_output : fish_output_t option;
visibility: visibility;
deprecated_by : deprecated_by; (* function is deprecated *)
optional : string option; (* function is part of an optional group *)
progress : bool; (* function can generate progress messages *)

440
generator/types.mli Normal file
View File

@@ -0,0 +1,440 @@
(* libguestfs
* Copyright (C) 2009-2017 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
*)
(** Types used to describe the API. *)
type style = ret * args * optargs
(** The [style] is a tuple which describes the return value and
arguments of a function.
[ret] is the return value, one of the [R*] values below.
The second element is the list of required arguments, a list of
[argt]s from the list below, eg. [Bool], [String] etc. Each has
a name so that for example [Int "foo"] corresponds in the C
bindings to an [int foo] parameter.
The third element is the list of optional arguments. These are
mapped to optional arguments in the language binding, eg. in
Perl to:
{v
$g->fn (required1, required2, opt1 => val, opt2 => val);
v}
As the name suggests these are optional, and the function can
tell which optional parameters were supplied by the caller. *)
and ret =
| RErr
(** "RErr" as a return value means an int used as a simple error
indication, ie. 0 or -1. *)
| RInt of string
(** "RInt" as a return value means an int which is -1 for error
or any value >= 0 on success. Only use this for smallish
positive ints (0 <= i < 2^30). *)
| RInt64 of string
(** "RInt64" is the same as RInt, but is guaranteed to be able
to return a full 64 bit value, _except_ that -1 means error
(so -1 cannot be a valid, non-error return value). *)
| RBool of string
(** "RBool" is a bool return value which can be true/false or
-1 for error. *)
| RConstString of string
(** "RConstString" is a string that refers to a constant value.
The return value must NOT be NULL (since NULL indicates
an error).
Try to avoid using this. In particular you cannot use this
for values returned from the daemon, because there is no
thread-safe way to return them in the C API. *)
| RConstOptString of string
(** "RConstOptString" is an even more broken version of
"RConstString". The returned string may be NULL and there
is no way to return an error indication. Avoid using this! *)
| RString of rstringt * string
(** "RString" is a returned string. It must NOT be NULL, since
a NULL return indicates an error. The caller frees this. *)
| RStringList of rstringt * string
(** "RStringList" is a list of strings. No string in the list
can be NULL. The caller frees the strings and the array. *)
| RStruct of string * string (* name of retval, name of struct *)
(** "RStruct" is a function which returns a single named structure
or an error indication (in C, a struct, and in other languages
with varying representations, but usually very efficient). See
after the function list below for the structures. *)
| RStructList of string * string (* name of retval, name of struct *)
(** "RStructList" is a function which returns either a list/array
of structures (could be zero-length), or an error indication. *)
| RHashtable of rstringt * rstringt * string
(** Key-value pairs of untyped strings. Turns into a hashtable or
dictionary in languages which support it.
DON'T use this as a general "bucket" for results. Prefer a
stronger typed return value if one is available, or write a
custom struct. Don't use this if the list could potentially
be very long, since it is inefficient.
Keys should be unique. NULLs are not permitted.
The first rstringt is the type of the keys, the second
rstringt is the type of the values. *)
| RBufferOut of string
(** "RBufferOut" is handled almost exactly like RString, but
it allows the string to contain arbitrary 8 bit data including
ASCII NUL. In the C API this causes an implicit extra parameter
to be added of type <size_t *size_r>. The extra parameter
returns the actual size of the return buffer in bytes.
Other programming languages support strings with arbitrary 8 bit
data.
At the RPC layer we have to use the opaque<> type instead of
string<>. Returned data is still limited to the max message
size (ie. ~ 2 MB). *)
and rstringt =
| RPlainString (** none of the others *)
| RDevice (** /dev device name *)
| RMountable (** location of mountable filesystem *)
and args = argt list (** Function parameters, guestfs handle is implicit. *)
and argt =
| Bool of string (** boolean *)
| Int of string (** int (smallish ints, signed, <= 31 bits) *)
| Int64 of string (** any 64 bit int *)
| String of stringt * string
(** Strings: These can be plain strings, device names, mountable
filesystems, etc. They cannot be NULL. *)
| OptString of string (** Plain string, may be NULL. *)
| StringList of stringt * string
(** List of strings: The strings may be plain strings, device names
etc., but all of the same type. The strings cannot be NULL. *)
| BufferIn of string
(** Opaque buffer which can contain arbitrary 8 bit data.
In the C API, this is expressed as <const char *, size_t> pair.
Most other languages have a string type which can contain
ASCII NUL. We use whatever type is appropriate for each
language.
Buffers are limited by the total message size. To transfer
large blocks of data, use FileIn/FileOut parameters instead.
To return an arbitrary buffer, use RBufferOut. *)
| Pointer of (string * string)
(** This specifies an opaque pointer that is passed through
untouched. Only non-daemon functions are supported.
Pointer ("foo *", "bar") translates to "foo *bar" in the
C API. The pointer ("bar") cannot be NULL.
This is less well supported in other language bindings:
if the pointer type is known then we may be able to produce
a suitable binding, otherwise this is translated into a 64
bit int.
Functions with this parameter type are not supported at all
in guestfish (the function must be declared "NotInFish" else
you will get an error). Also the function cannot contain
tests, although we should fix this in future. *)
and stringt =
| PlainString (** none of the others *)
| Device (** /dev device name *)
| Mountable (** location of mountable filesystem *)
| Pathname
(** An absolute path within the appliance filesystem. *)
| FileIn
| FileOut
(** These are treated as filenames (simple string parameters) in
the C API and bindings. But in the RPC protocol, we transfer
the actual file content up to or down from the daemon.
FileIn: local machine -> daemon (in request)
FileOut: daemon -> local machine (in reply)
In guestfish (only), the special name "-" means read from
stdin or write to stdout. *)
| Key
(** Key material / passphrase. Eventually we should treat this
as sensitive and mlock it into physical RAM. However this
is highly complex because of all the places that XDR-encoded
strings can end up. So currently the only difference from
'PlainString' is the way that guestfish requests these
parameters from the user. *)
| GUID
(** A GUID string.
It cannot be NULL, and it will be validated using
guestfs_int_validate_guid. *)
| Filename
(** A simple filename (not a path nor a relative path). It cannot
be NULL, empty, or anything different than a simple file name. *)
(* The following two are DEPRECATED and must not be used in
* any new APIs.
*)
| Dev_or_Path (** Device or Pathname. *)
| Mountable_or_Path (** Mountable or Pathname. *)
and optargs = optargt list
and optargt =
| OBool of string (** boolean *)
| OInt of string (** int (smallish ints, signed, <= 31 bits) *)
| OInt64 of string (** any 64 bit int *)
| OString of string (** const char *name, cannot be NULL *)
| OStringList of string (** char **strings, neither the list nor any
string may be NULL *)
type errcode = [ `CannotReturnError | `ErrorIsMinusOne | `ErrorIsNULL ]
type fish_output_t =
| FishOutputOctal (* for int return, print in octal *)
| FishOutputHexadecimal (* for int return, print in hex *)
(* See guestfs-hacking(1). *)
type c_api_tests = (c_api_test_init * c_api_test_prereq * c_api_test * c_api_test_cleanup) list
and c_api_test =
| TestRun of seq
(** Run the command sequence and just expect nothing to fail. *)
| TestResult of seq * string
(** Run the command sequence. No command should fail, and the
output of the command(s) is tested using the C expression which
should return true.
In the C expression, 'ret' is the result of the final command,
'ret1' is the result of the last but one command, and so on
backwards. *)
| TestResultString of seq * string
| TestResultDevice of seq * string
(** Run the command sequence. No command should fail, and the
last command must return the given string or device name. *)
| TestResultTrue of seq
| TestResultFalse of seq
(** Run the command sequence. No command should fail, and the
last command must return true or false. *)
| TestLastFail of seq
(** Run the command sequence and expect the final command (only)
to fail. *)
| TestRunOrUnsupported of seq
(** Run the command sequence and expect either nothing to fail,
or that the last command only can fail with ENOTSUP. *)
(** Test prerequisites. *)
and c_api_test_prereq =
| Always
(** Test always runs. *)
| Disabled
(** Test is currently disabled - eg. it fails, or it tests some
unimplemented feature. *)
| IfAvailable of string
(** Run the test only if 'string' is available in the daemon. *)
| IfNotCrossAppliance
(** Run the test when the appliance and the OS differ - for example,
when using a fixed appliance created in a different OS/distribution. *)
(** Some initial scenarios for testing. *)
and c_api_test_init =
| InitNone
(** Do nothing, block devices could contain random stuff including
LVM PVs, and some filesystems might be mounted. This is usually
a bad idea. *)
| InitEmpty
(** Block devices are empty and no filesystems are mounted. *)
| InitPartition
(** /dev/sda contains a single partition /dev/sda1, with random
content. No LVM. *)
| InitGPT
(** Identical to InitPartition, except that the partition table is GPT
instead of MBR. *)
| InitBasicFS
(** /dev/sda contains a single partition /dev/sda1, which is formatted
as ext2, empty [except for lost+found] and mounted on /.
No LVM.
Note: for testing filesystem operations, it is quicker to use
InitScratchFS *)
| InitBasicFSonLVM
(** /dev/sda:
/dev/sda1 (is a PV):
/dev/VG/LV (size 8MB):
formatted as ext2, empty [except for lost+found], mounted on /
Note: only use this if you really need a freshly created filesystem
on LVM. Normally you should use InitScratchFS instead. *)
| InitISOFS
(** /dev/sdd (the ISO, see images/ directory in source)
is mounted on / *)
| InitScratchFS
(** /dev/sdb1 (write scratch disk) is mounted on /. The filesystem
will be empty.
Note that this filesystem is not recreated between tests, and
could contain random files and directories from previous tests.
Therefore it is recommended that you create uniquely named files
and directories for your tests. *)
and c_api_test_cleanup = cmd list
(** Cleanup commands which are run whether the test succeeds or fails. *)
and seq = cmd list
and cmd = string list
(** Sequence of commands for testing. *)
type visibility =
| VPublic (** Part of the public API *)
| VPublicNoFish (** Like VPublic, but not exported in
guestfish *)
| VStateTest (** A function which tests the state
of the appliance *)
| VBindTest (** Only used for testing language bindings *)
| VDebug (** Exported everywhere, but not documented *)
| VInternal (** Not exported *)
type version = int * int * int
type deprecated_by =
| Not_deprecated (** function not deprecated *)
| Replaced_by of string (** replaced by another function *)
| Deprecated_no_replacement (** deprecated with no replacement *)
type impl =
| C (** implemented in C by "do_<name>" *)
| OCaml of string (** implemented in OCaml by named function *)
(** Type of an action as declared in Actions module. *)
type action = {
name : string; (** name, not including "guestfs_" *)
added : version; (** which version was the API first added *)
style : style; (** args and return value *)
impl : impl; (** implementation language (C or OCaml) *)
proc_nr : int option; (** proc number, None for non-daemon *)
tests : c_api_tests; (** C API tests *)
test_excuse : string; (** if there's no tests ... *)
shortdesc : string; (** single line description *)
longdesc : string; (** longer documentation *)
(* Lots of flags ... *)
protocol_limit_warning : bool; (** warn about protocol size limits *)
fish_alias : string list; (** alias(es) for this cmd in guestfish *)
fish_output : fish_output_t option; (** how to display output in guestfish *)
visibility: visibility; (** The visbility of function *)
deprecated_by : deprecated_by; (** function is deprecated *)
optional : string option; (** function is part of an optional group *)
progress : bool; (** function can generate progress messages *)
camel_name : string; (** Pretty camel case name of
function. Only specify this if the
generator doesn't make a good job of
it, for example if it contains an
abbreviation. *)
cancellable : bool; (** the user can cancel this long-running
function *)
config_only : bool; (** non-daemon-function which can only be used
while in CONFIG state *)
once_had_no_optargs : bool; (** mark functions that once had no optargs
but now do, so we can generate the
required back-compat machinery *)
blocking : bool; (** Function blocks (long-running). All
daemon functions are blocking by
definition. Some functions that just
set flags in the handle are marked
non-blocking so that we don't add
machinery in various bindings. *)
wrapper : bool; (** For non-daemon functions, generate a
wrapper which calls the underlying
guestfs_impl_<name> function. The wrapper
checks arguments and deals with trace
messages. Set this to false for functions
that have to be thread-safe. *)
(* "Internal" data attached by the generator at various stages. This
* doesn't need to (and shouldn't) be set when defining actions.
*)
c_name : string; (** shortname exposed by C API *)
c_function : string; (** full name of C API function called by
non-C bindings *)
c_optarg_prefix : string; (** prefix for optarg names/bitmask names *)
non_c_aliases : string list; (** back-compat aliases that have to be
generated for this function *)
}
(** Default settings for all action fields. So we copy and override
the action struct by writing '{ defaults with name = ... }'. *)
val defaults : action
(** Field types for structures. *)
type field =
| FChar (** C 'char' (really, a 7 bit byte). *)
| FString (** nul-terminated ASCII string, NOT NULL. *)
| FBuffer (** opaque buffer of bytes, (char *, int) pair*)
| FUInt32
| FInt32
| FUInt64
| FInt64
| FBytes (** Any int measure that counts bytes. *)
| FUUID (** 32 bytes long, NOT nul-terminated. *)
| FOptPercent (** [0..100], or -1 meaning "not present". *)
(** Used for testing language bindings. *)
type callt =
| CallString of string
| CallOptString of string option
| CallStringList of string list
| CallInt of int
| CallInt64 of int64
| CallBool of bool
| CallBuffer of string
type call_optargt =
| CallOBool of string * bool
| CallOInt of string * int
| CallOInt64 of string * int64
| CallOString of string * string
| CallOStringList of string * string list

View File

@@ -18,10 +18,13 @@
include $(top_srcdir)/subdir-rules.mk
EXTRA_DIST = \
$(SOURCES_ML) $(SOURCES_C) \
$(SOURCES_MLI) $(SOURCES_ML) $(SOURCES_C) \
test-virt-get-kernel-docs.sh \
virt-get-kernel.pod
SOURCES_MLI = \
get_kernel.mli
SOURCES_ML = \
get_kernel.ml
@@ -126,7 +129,7 @@ stamp-virt-get-kernel.pod: virt-get-kernel.pod
touch $@
# OCaml dependencies.
.depend: *.ml
.depend: *.ml *.mli
$(top_builddir)/ocaml-dep.sh $^
-include .depend

19
get-kernel/get_kernel.mli Normal file
View File

@@ -0,0 +1,19 @@
(* virt-get-kernel
* Copyright (C) 2013-2017 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.
*)
(* Nothing is exported. *)

View File

@@ -28,6 +28,51 @@ AC_DEFUN([GUESTFS_CREATE_COMMON_GETTEXT_ML],[
cat <<EOF > $1
(* This file is generated automatically by ./configure. *)
EOF
if test "x$OCAML_PKG_gettext" != "xno"; then
# ocaml-gettext available: real module.
cat <<EOF >>$1
module Gettext = Gettext.Program (
struct
let textdomain = "$PACKAGE_NAME"
let codeset = None
let dir = None
let dependencies = [[]]
end
) (GettextStub.Native)
EOF
else
# No gettext: module containing dummy gettext functions.
cat <<EOF >>$1
module Gettext = struct
external s_ : string -> string = "%identity"
external f_ : ('a, 'b, 'c, 'd, 'e, 'f) format6
-> ('a, 'b, 'c, 'd, 'e, 'f) format6
= "%identity"
let sn_ : string -> string -> int -> string
= fun s p n -> if n = 1 then s else p
let fn_ : ('a, 'b, 'c, 'd, 'e, 'f) format6
-> ('a, 'b, 'c, 'd, 'e, 'f) format6
-> int -> ('a, 'b, 'c, 'd, 'e, 'f) format6
= fun s p n -> if n = 1 then s else p
end
EOF
fi
chmod -w $1
])
AC_DEFUN([GUESTFS_CREATE_COMMON_GETTEXT_MLI],[
dnl Check for ocaml-gettext package to translate OCaml tools.
AC_CHECK_OCAML_PKG(gettext)
AC_MSG_NOTICE([creating $1])
rm -f $1
cat <<EOF > $1
(* This file is generated automatically by ./configure. *)
(** Gettext functions for OCaml virt tools.
The Common_gettext module provides gettext functions, or dummy
@@ -59,37 +104,17 @@ v}
these functions.
*)
EOF
if test "x$OCAML_PKG_gettext" != "xno"; then
# ocaml-gettext available: real module.
cat <<EOF >>$1
module Gettext = Gettext.Program (
struct
let textdomain = "$PACKAGE_NAME"
let codeset = None
let dir = None
let dependencies = [[]]
end
) (GettextStub.Native)
EOF
else
# No gettext: module containing dummy gettext functions.
cat <<EOF >>$1
module Gettext = struct
external s_ : string -> string = "%identity"
external f_ : ('a, 'b, 'c, 'd, 'e, 'f) format6
-> ('a, 'b, 'c, 'd, 'e, 'f) format6
= "%identity"
let sn_ : string -> string -> int -> string
= fun s p n -> if n = 1 then s else p
let fn_ : ('a, 'b, 'c, 'd, 'e, 'f) format6
-> ('a, 'b, 'c, 'd, 'e, 'f) format6
-> int -> ('a, 'b, 'c, 'd, 'e, 'f) format6
= fun s p n -> if n = 1 then s else p
module Gettext : sig
val s_ : string -> string
val f_ :
('a, 'b, 'c, 'c, 'c, 'd) format6 -> ('a, 'b, 'c, 'c, 'c, 'd) format6
val sn_ : string -> string -> int -> string
val fn_ :
('a, 'b, 'c, 'c, 'c, 'd) format6 ->
('a, 'b, 'c, 'c, 'c, 'd) format6 ->
int -> ('a, 'b, 'c, 'c, 'c, 'd) format6
end
EOF
fi
chmod -w $1
])

View File

@@ -90,13 +90,15 @@ OCAML_PKG_oUnit=no
ounit_is_v2=no
have_Bytes_module=no
AS_IF([test "x$OCAMLC" != "xno"],[
# Create mllib/common_gettext.ml, gettext functions or stubs.
# Create mllib/common_gettext.ml and mllib/commit_gettext.mli,
# gettext functions or stubs.
# If we're building in a different directory, then mllib/ might
# not exist yet, so create it:
mkdir -p mllib
GUESTFS_CREATE_COMMON_GETTEXT_ML([mllib/common_gettext.ml])
GUESTFS_CREATE_COMMON_GETTEXT_MLI([mllib/common_gettext.mli])
AC_CHECK_OCAML_PKG(libvirt)
AC_CHECK_OCAML_PKG(oUnit)

View File

@@ -28,6 +28,7 @@ EXTRA_DIST = \
SOURCES_MLI = \
checksums.mli \
common_gettext.mli \
common_utils.mli \
curl.mli \
getopt.mli \

View File

@@ -23,7 +23,8 @@ EXTRA_DIST = \
test-virt-resize-docs.sh \
virt-resize.pod
SOURCES_MLI =
SOURCES_MLI = \
resize.mli
SOURCES_ML = \
resize.ml
@@ -137,7 +138,7 @@ check-valgrind:
$(MAKE) VG="@VG@" check
# Dependencies.
.depend: *.ml
.depend: *.ml *.mli
$(top_builddir)/ocaml-dep.sh $^
-include .depend

19
resize/resize.mli Normal file
View File

@@ -0,0 +1,19 @@
(* virt-resize
* Copyright (C) 2010-2017 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.
*)
(* Nothing is exported. *)

View File

@@ -26,7 +26,11 @@ EXTRA_DIST = \
virt-sparsify.pod
SOURCES_MLI = \
cmdline.mli
cmdline.mli \
copying.mli \
in_place.mli \
sparsify.mli \
utils.mli
SOURCES_ML = \
utils.ml \

25
sparsify/copying.mli Normal file
View File

@@ -0,0 +1,25 @@
(* virt-sparsify
* Copyright (C) 2011-2017 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.
*)
(** This is the traditional virt-sparsify mode: We copy from a
source disk to a destination disk. *)
type tmp_place =
| Directory of string | Block_device of string | Prebuilt_file of string
val run : string -> string -> Cmdline.check_t -> bool -> string option -> string option -> string list -> bool -> string option -> string option -> string list -> unit

21
sparsify/in_place.mli Normal file
View File

@@ -0,0 +1,21 @@
(* virt-sparsify
* Copyright (C) 2011-2017 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.
*)
(** This is the virt-sparsify --in-place mode. *)
val run : string -> string option -> string list -> bool -> string list -> unit

19
sparsify/sparsify.mli Normal file
View File

@@ -0,0 +1,19 @@
(* virt-sparsify
* Copyright (C) 2011-2017 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.
*)
(* Nothing is exported. *)

22
sparsify/utils.mli Normal file
View File

@@ -0,0 +1,22 @@
(* virt-sparsify
* Copyright (C) 2011-2017 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.
*)
(** Utilities/common functions used in virt-sparsify only. *)
val is_read_only_lv : Guestfs.guestfs -> string -> bool
(* Return true if the filesystem is a read-only LV (RHBZ#1185561). *)

View File

@@ -70,7 +70,9 @@ operations = \
utmp yum_uuid
SOURCES_MLI = \
main.mli \
sysprep_operation.mli \
$(patsubst %,sysprep_operation_%.mli,$(operations)) \
utils.mli
SOURCES_ML = \
@@ -161,6 +163,16 @@ virt_sysprep_LINK = \
$(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLPACKAGES) $(OCAMLLINKFLAGS) \
$(OBJECTS) -o $@
# The sysprep_operation_*.mli files are all empty and autogenerated.
CLEANFILES += \
$(patsubst %,sysprep_operation_%.mli,$(operations))
sysprep_operation_%.mli:
rm -f $@ $@-t
echo '(* This file is generated by Makefile.am. *)' >> $@-t
echo '(* Nothing is exported from operation modules. *)' >> $@-t
mv $@-t $@
# Manual pages and HTML files for the website.
man_MANS = virt-sysprep.1
noinst_DATA = $(top_builddir)/website/virt-sysprep.1.html
@@ -217,7 +229,7 @@ check-valgrind-local-guests:
done
# OCaml dependencies.
.depend: *.mli *.ml
.depend: $(SOURCES_MLI) $(SOURCES_ML)
$(top_builddir)/ocaml-dep.sh $^
-include .depend

19
sysprep/main.mli Normal file
View File

@@ -0,0 +1,19 @@
(* virt-sysprep
* Copyright (C) 2012-2017 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.
*)
(* Nothing is exported. *)

View File

@@ -20,6 +20,7 @@ include $(top_srcdir)/subdir-rules.mk
EXTRA_DIST = \
$(SOURCES_MLI) $(SOURCES_ML) $(SOURCES_C) \
copy_to_local.ml \
copy_to_local.mli \
v2v_unit_tests.ml \
virt-v2v.pod \
virt-v2v-copy-to-local.pod
@@ -63,6 +64,7 @@ SOURCES_MLI = \
types.mli \
uefi.mli \
utils.mli \
v2v.mli \
vCenter.mli \
windows.mli \
windows_virtio.mli

19
v2v/copy_to_local.mli Normal file
View File

@@ -0,0 +1,19 @@
(* virt-v2v
* Copyright (C) 2009-2017 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.
*)
(* Nothing is exported. *)

19
v2v/v2v.mli Normal file
View File

@@ -0,0 +1,19 @@
(* virt-v2v
* Copyright (C) 2009-2017 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.
*)
(* Nothing is exported. *)