[Libguestfs] [PATCH 13/14] mllib: Add an interface for Common_utils library.
Richard W.M. Jones
rjones at redhat.com
Mon Jun 23 11:32:29 UTC 2014
It turned out that Common_utils was exporting the 'G' module (an alias
for Guestfs). We want any code that uses G as a shortcut to declare:
module G = Guestfs
at the top, since that avoids confusion for newbie (or experienced)
OCaml programmers.
---
mllib/Makefile.am | 1 +
mllib/common_utils.mli | 116 ++++++++++++++++++++++++++++++++++++++++
sparsify/cmdline.ml | 2 +-
v2v/convert_linux_common.ml | 4 +-
v2v/convert_linux_enterprise.ml | 2 +
5 files changed, 122 insertions(+), 3 deletions(-)
create mode 100644 mllib/common_utils.mli
diff --git a/mllib/Makefile.am b/mllib/Makefile.am
index 72a032c..7c242fc 100644
--- a/mllib/Makefile.am
+++ b/mllib/Makefile.am
@@ -26,6 +26,7 @@ CLEANFILES = *~ *.cmi *.cmo *.cmx *.cmxa *.o
SOURCES = \
common_gettext.ml \
common_utils.ml \
+ common_utils.mli \
common_utils_tests.ml \
config.ml \
fsync-c.c \
diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli
new file mode 100644
index 0000000..4368e57
--- /dev/null
+++ b/mllib/common_utils.mli
@@ -0,0 +1,116 @@
+(* Common utilities for OCaml tools in libguestfs.
+ * Copyright (C) 2010-2014 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 ( // ) : string -> string -> string
+(** Concatenate directory and filename. *)
+
+val ( +^ ) : int64 -> int64 -> int64
+val ( -^ ) : int64 -> int64 -> int64
+val ( *^ ) : int64 -> int64 -> int64
+val ( /^ ) : int64 -> int64 -> int64
+val ( &^ ) : int64 -> int64 -> int64
+val ( ~^ ) : int64 -> int64
+(** Various int64 operators. *)
+
+val roundup64 : int64 -> int64 -> int64
+val int_of_le32 : string -> int64
+val le32_of_int : int64 -> string
+
+val wrap : ?chan:out_channel -> ?hanging:int -> string -> unit
+(** Wrap text. *)
+
+val string_prefix : string -> string -> bool
+val string_find : string -> string -> int
+val replace_str : string -> string -> string -> string
+val string_nsplit : string -> string -> string list
+val string_split : string -> string -> string * string
+val string_random8 : unit -> string
+(** Various string functions. *)
+
+val dropwhile : ('a -> bool) -> 'a list -> 'a list
+val takewhile : ('a -> bool) -> 'a list -> 'a list
+val filter_map : ('a -> 'b option) -> 'a list -> 'b list
+val iteri : (int -> 'a -> 'b) -> 'a list -> unit
+val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list
+(** Various higher-order functions. *)
+
+val make_message_function : quiet:bool -> ('a, unit, string, unit) format4 -> 'a
+(** Timestamped progress messages. Used for ordinary messages when
+ not [--quiet]. *)
+
+val error : prog:string -> ?exit_code:int -> ('a, unit, string, 'b) format4 -> 'a
+(** Standard error function. *)
+
+val read_whole_file : string -> string
+(** Read in the whole file as a string. *)
+
+val parse_size : prog:string -> string -> int64
+(** Parse a size field, eg. [10G] *)
+
+val parse_resize : prog:string -> int64 -> string -> int64
+(** Parse a size field, eg. [10G], [+20%] etc. Used particularly by
+ [virt-resize --resize] and [--resize-force] options. *)
+
+val human_size : int64 -> string
+(** Converts a size in bytes to a human-readable string. *)
+
+val skip_dashes : string -> string
+(** Skip any leading '-' characters when comparing command line args. *)
+
+val compare_command_line_args : string -> string -> int
+(** Compare command line arguments for equality, ignoring any leading [-]s. *)
+
+val long_options : (Arg.key * Arg.spec * Arg.doc) list ref
+val display_long_options : unit -> 'a
+(** Implements [--long-options]. *)
+
+val compare_version : string -> string -> int
+(** Compare two version strings. *)
+
+val external_command : prog:string -> string -> string list
+(** Run an external command, slurp up the output as a list of lines. *)
+
+val uuidgen : prog:string -> unit -> string
+(** Run uuidgen to return a random UUID. *)
+
+val unlink_on_exit : string -> unit
+(** Unlink a temporary file on exit. *)
+
+val rmdir_on_exit : string -> unit
+(** Remove a temporary directory on exit (using [rm -rf]). *)
+
+val rm_rf_only_files : Guestfs.guestfs -> string -> unit
+(** Using the libguestfs API, recursively remove only files from the
+ given directory. Useful for cleaning [/var/cache] etc in sysprep
+ without removing the actual directory structure. Also if [dir] is
+ not a directory or doesn't exist, ignore it.
+
+ XXX Could be faster with a specific API for doing this. *)
+
+val detect_compression : string -> [`Unknown | `XZ]
+(** Detect compression of a file.
+
+ XXX Only detects the formats we need in virt-builder so far. *)
+
+val is_block_device : string -> bool
+val is_char_device : string -> bool
+val is_directory : string -> bool
+(** These don't throw exceptions, unlike the [Sys] functions. *)
+
+val absolute_path : string -> string
+(** Convert any path to an absolute path. *)
diff --git a/sparsify/cmdline.ml b/sparsify/cmdline.ml
index 01f66f1..11e5895 100644
--- a/sparsify/cmdline.ml
+++ b/sparsify/cmdline.ml
@@ -131,7 +131,7 @@ read the man page virt-sparsify(1).
printf "check-tmpdir\n";
printf "in-place\n";
printf "tmp-option\n";
- let g = new G.guestfs () in
+ let g = new Guestfs.guestfs () in
g#add_drive "/dev/null";
g#launch ();
if g#feature_available [| "ntfsprogs"; "ntfs3g" |] then
diff --git a/v2v/convert_linux_common.ml b/v2v/convert_linux_common.ml
index 4922e2f..57a171a 100644
--- a/v2v/convert_linux_common.ml
+++ b/v2v/convert_linux_common.ml
@@ -96,7 +96,7 @@ and augeas_debug_errors g =
flush stdout
with
- G.Error msg -> eprintf "%s: augeas: %s (ignored)\n" prog msg
+ Guestfs.Error msg -> eprintf "%s: augeas: %s (ignored)\n" prog msg
let install verbose g inspect packages =
assert false
@@ -125,7 +125,7 @@ let file_owned verbose g inspect file =
match package_format with
| "rpm" ->
let cmd = [| "rpm"; "-qf"; file |] in
- (try ignore (g#command cmd); true with G.Error _ -> false)
+ (try ignore (g#command cmd); true with Guestfs.Error _ -> false)
| format ->
error (f_"don't know how to find package owner using %s") format
diff --git a/v2v/convert_linux_enterprise.ml b/v2v/convert_linux_enterprise.ml
index 6544b27..8bf8f33 100644
--- a/v2v/convert_linux_enterprise.ml
+++ b/v2v/convert_linux_enterprise.ml
@@ -32,6 +32,8 @@ open Common_utils
open Utils
open Types
+module G = Guestfs
+
module StringMap = Map.Make (String)
let rec convert ?(keep_serial_console = true) verbose (g : G.guestfs)
--
1.9.0
More information about the Libguestfs
mailing list