[PATCH 0/2] generic function for temporary path generation
by Matteo Cafasso
Cosmetic change as suggested in this previous patch:
https://www.redhat.com/archives/libguestfs/2016-November/msg00111.html
Matteo Cafasso (2):
lib: generic function for temporary path generation
lib: use guestfs_int_make_temp_path to generate temporary files
src/drives.c | 5 ++---
src/file.c | 22 +++++++++-------------
src/guestfs-internal.h | 1 +
src/journal.c | 4 ++--
src/tmpdirs.c | 17 +++++++++++++++++
src/tsk.c | 17 ++---------------
6 files changed, 33 insertions(+), 33 deletions(-)
--
2.10.2
7 years, 7 months
- 2
- 3
[PATCH] inspect: improve canonical_mountpoint implementation
by Pino Toscano
Use a simplier version using a loop, skipping multiple '/' at once,
reducing the amount of memmove and strlen needed.
Updates commit 865d070ddcbb071a919614f45c8eef8fcb4497ff.
---
src/inspect-fs-unix.c | 56 ++++++++++++++++++---------------------------------
1 file changed, 20 insertions(+), 36 deletions(-)
diff --git a/src/inspect-fs-unix.c b/src/inspect-fs-unix.c
index 49ac3f9..7e940d6 100644
--- a/src/inspect-fs-unix.c
+++ b/src/inspect-fs-unix.c
@@ -2130,44 +2130,28 @@ make_augeas_path_expression (guestfs_h *g, const char **configfiles)
* the same length or shorter than the argument passed.
*/
static void
-drop_char (char *mp)
+canonical_mountpoint (char *s)
{
- size_t len = strlen (mp);
- memmove (&mp[0], &mp[1], len);
-}
+ size_t len = strlen (s);
+ char *orig = s;
-static void
-canonical_mountpoint_recursive (char *mp)
-{
- if (mp[0] == '\0')
- return;
+ s = strchr (s, '/');
+ while (s != NULL && *s != 0) {
+ char *pos = s + 1;
+ char *p = pos;
+ /* Find how many consecutive slashes are there after the one found,
+ * and shift the characters after them accordingly. */
+ while (*p == '/')
+ ++p;
+ if (p - pos > 0) {
+ memmove (pos, p, len - (p - orig) + 1);
+ len -= p - pos;
+ }
- /* Remove trailing slashes. */
- if (mp[0] == '/' && mp[1] == '\0') {
- mp[0] = '\0';
- return;
+ s = strchr (pos, '/');
}
-
- /* Replace multiple slashes with single slashes. */
- if (mp[0] == '/' && mp[1] == '/') {
- drop_char (mp);
- canonical_mountpoint_recursive (mp);
- return;
- }
-
- canonical_mountpoint_recursive (&mp[1]);
-}
-
-static void
-canonical_mountpoint (char *mp)
-{
- /* Collapse multiple leading slashes into a single slash ... */
- while (mp[0] == '/' && mp[1] == '/')
- drop_char (mp);
-
- /* ... and then continue, skipping the leading slash. */
- if (mp[0] == '/')
- canonical_mountpoint_recursive (&mp[1]);
- else
- canonical_mountpoint_recursive (mp);
+ /* Ignore the trailing slash, but avoid removing it for "/". */
+ if (len > 1 && orig[len-1] == '/')
+ --len;
+ orig[len] = 0;
}
--
2.7.4
7 years, 7 months
- 2
- 1
[PATCH 1/2] Remove most instances of OCaml warning 52.
by Richard W.M. Jones
See:
http://caml.inria.fr/pub/docs/manual-ocaml/comp.html#s:comp-warnings
---
builder/index_parser.ml | 8 ++++----
generator/tests_c_api.ml | 4 ++--
mllib/common_utils.ml | 2 +-
v2v/inspect_source.ml | 2 +-
v2v/linux.ml | 2 +-
v2v/xpath_helpers.ml | 2 +-
6 files changed, 10 insertions(+), 10 deletions(-)
diff --git a/builder/index_parser.ml b/builder/index_parser.ml
index e5e4c6c..a3cae7d 100644
--- a/builder/index_parser.ml
+++ b/builder/index_parser.ml
@@ -113,7 +113,7 @@ let get_index ~downloader ~sigchecker
try Rev_int (int_of_string (List.assoc ("revision", None) fields))
with
| Not_found -> Rev_int 1
- | Failure "int_of_string" ->
+ | Failure _ ->
eprintf (f_"%s: cannot parse 'revision' field for '%s'\n") prog n;
corrupt_file () in
let format =
@@ -124,7 +124,7 @@ let get_index ~downloader ~sigchecker
| Not_found ->
eprintf (f_"%s: no 'size' field for '%s'\n") prog n;
corrupt_file ()
- | Failure "int_of_string" ->
+ | Failure _ ->
eprintf (f_"%s: cannot parse 'size' field for '%s'\n") prog n;
corrupt_file () in
let compressed_size =
@@ -132,7 +132,7 @@ let get_index ~downloader ~sigchecker
with
| Not_found ->
None
- | Failure "int_of_string" ->
+ | Failure _ ->
eprintf (f_"%s: cannot parse 'compressed_size' field for '%s'\n")
prog n;
corrupt_file () in
@@ -157,7 +157,7 @@ let get_index ~downloader ~sigchecker
try bool_of_string (List.assoc ("hidden", None) fields)
with
| Not_found -> false
- | Failure "bool_of_string" ->
+ | Failure _ ->
eprintf (f_"%s: cannot parse 'hidden' field for '%s'\n")
prog n;
corrupt_file () in
diff --git a/generator/tests_c_api.ml b/generator/tests_c_api.ml
index 8b98927..4a70433 100644
--- a/generator/tests_c_api.ml
+++ b/generator/tests_c_api.ml
@@ -557,13 +557,13 @@ and generate_test_command_call ?(expect_error = false) ?(do_return = true) ?test
| Int _, arg, _ ->
let i =
try int_of_string arg
- with Failure "int_of_string" ->
+ with Failure _ ->
failwithf "%s: expecting an int, but got '%s'" test_name arg in
pr ", %d" i
| Int64 _, arg, _ ->
let i =
try Int64.of_string arg
- with Failure "int_of_string" ->
+ with Failure _ ->
failwithf "%s: expecting an int64, but got '%s'" test_name arg in
pr ", %Ld" i
| Bool _, arg, _ ->
diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
index f4ddf01..f948dce 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -730,7 +730,7 @@ let compare_version v1 v2 =
let rest = Str.matched_group 2 str in
let n =
try `Number (int_of_string n)
- with Failure "int_of_string" -> `String n in
+ with Failure _ -> `String n in
n, rest
)
else if Str.string_match rex_letters str 0 then
diff --git a/v2v/inspect_source.ml b/v2v/inspect_source.ml
index cf8c98f..ae9940d 100644
--- a/v2v/inspect_source.ml
+++ b/v2v/inspect_source.ml
@@ -120,7 +120,7 @@ and choose_root root_choice g = function
try i := int_of_string input
with
| End_of_file -> error (f_"connection closed")
- | Failure "int_of_string" -> ()
+ | Failure _ -> ()
)
done;
List.nth roots (!i - 1)
diff --git a/v2v/linux.ml b/v2v/linux.ml
index d449e10..729bb5d 100644
--- a/v2v/linux.ml
+++ b/v2v/linux.ml
@@ -145,7 +145,7 @@ let rec file_owner (g : G.guestfs) inspect path =
raise Not_found
else
raise exn
- | Invalid_argument "index out of bounds" ->
+ | Invalid_argument _ (* pkgs.(0) raises index out of bounds *) ->
error (f_"internal error: file_owner: rpm command returned no output")
)
diff --git a/v2v/xpath_helpers.ml b/v2v/xpath_helpers.ml
index 5d925fe..70af72da 100644
--- a/v2v/xpath_helpers.ml
+++ b/v2v/xpath_helpers.ml
@@ -31,7 +31,7 @@ let xpath_eval parsefn xpathctx expr =
let node = Xml.xpathobj_node obj 0 in
let str = Xml.node_as_string node in
try Some (parsefn str)
- with Failure "int_of_string" ->
+ with Failure _ ->
error (f_"expecting XML expression to return an integer (expression: %s, matching string: %s)")
expr str
)
--
2.10.2
7 years, 7 months
- 2
- 5
[PATCH] generator: Share Common_utils code.
by Richard W.M. Jones
For a very long time we have maintained two sets of utility functions,
in mllib/common_utils.ml and generator/utils.ml. This changes things
so that the same set of utility functions can be shared with both
directories.
It's not possible to use common_utils.ml directly in the generator
because it provides several functions that use modules outside the
OCaml stdlib. Therefore we add some lightweight post-processing which
extracts the functions using only the stdlib:
(*<stdlib>*)
...
(*</stdlib>*)
and creates generator/common_utils.ml and generator/common_utils.mli
from that. The effect is we only need to write utility functions
once.
As with other tools, we still have generator-specific utility
functions in generator/utils.ml.
Also in this change:
- Use String.uppercase_ascii and String.lowercase_ascii in place
of deprecated String.uppercase/String.lowercase.
- Implement String.capitalize_ascii to replace deprecated
String.capitalize.
- Move isspace, isdigit, isxdigit functions to Char module.
---
.gitignore | 3 +
dib/utils.ml | 2 +-
generator/Makefile.am | 23 ++++++-
generator/bindtests.ml | 25 +++----
generator/c.ml | 53 ++++++++-------
generator/daemon.ml | 10 +--
generator/docstrings.ml | 3 +-
generator/erlang.ml | 23 ++++---
generator/events.ml | 1 +
generator/fish.ml | 34 +++++-----
generator/gobject.ml | 32 +++++----
generator/java.ml | 8 ++-
generator/lua.ml | 3 +-
generator/ocaml.ml | 11 +--
generator/perl.ml | 11 +--
generator/pr.ml | 3 +-
generator/python.ml | 25 +++----
generator/ruby.ml | 11 +--
generator/tests_c_api.ml | 13 ++--
generator/uefi.ml | 1 +
generator/utils.ml | 173 ++++-------------------------------------------
generator/utils.mli | 64 +-----------------
mllib/common_utils.ml | 126 ++++++++++++++++++++++++++++++----
mllib/common_utils.mli | 76 ++++++++++++++++++---
v2v/convert_windows.ml | 3 +-
25 files changed, 373 insertions(+), 364 deletions(-)
diff --git a/.gitignore b/.gitignore
index 633b39d..da59e44 100644
--- a/.gitignore
+++ b/.gitignore
@@ -255,8 +255,11 @@ Makefile.in
/fuse/test-guestunmount-fd
/generator/.depend
/generator/bytes.ml
+/generator/common_utils.ml
+/generator/common_utils.mli
/generator/files-generated.txt
/generator/generator
+/generator/guestfs_config.ml
/generator/.pod2text.data*
/generator/stamp-generator
/get-kernel/.depend
diff --git a/dib/utils.ml b/dib/utils.ml
index 3df5171..4026ee8 100644
--- a/dib/utils.ml
+++ b/dib/utils.ml
@@ -74,7 +74,7 @@ let digit_prefix_compare a b =
let split_prefix str =
let len = String.length str in
let digits =
- try string_index_fn (fun x -> not (isdigit x)) str
+ try string_index_fn (fun x -> not (Char.isdigit x)) str
with Not_found -> len in
match digits with
| 0 -> "", str
diff --git a/generator/Makefile.am b/generator/Makefile.am
index 31c33fa..0c2ae33 100644
--- a/generator/Makefile.am
+++ b/generator/Makefile.am
@@ -27,6 +27,8 @@ sources = \
c.mli \
checks.ml \
checks.mli \
+ common_utils.ml \
+ common_utils.mli \
csharp.ml \
csharp.mli \
customize.ml \
@@ -47,6 +49,7 @@ sources = \
gobject.mli \
golang.ml \
golang.mli \
+ guestfs_config.ml \
haskell.ml \
haskell.mli \
java.ml \
@@ -85,6 +88,8 @@ sources = \
# In build dependency order.
objects = \
$(OCAML_GENERATOR_BYTES_COMPAT_CMO) \
+ guestfs_config.cmo \
+ common_utils.cmo \
types.cmo \
utils.cmo \
actions.cmo \
@@ -133,7 +138,7 @@ generator: $(objects)
# Dependencies.
depend: .depend
-.depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml)
+.depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml) common_utils.ml common_utils.mli guestfs_config.ml
rm -f $@ $@-t
$(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) $^ | \
$(SED) 's/ *$$//' | \
@@ -174,6 +179,22 @@ stamp-generator: generator
cd $(top_srcdir) && $(abs_builddir)/generator
touch $@
+# We share common_utils.ml{,i} with the mllib directory. However we
+# have to remove functions which depend on any modules which are not
+# part of the OCaml stdlib.
+common_utils.ml: $(top_srcdir)/mllib/common_utils.ml
+ rm -f $@ $@-t
+ echo '(* This file is generated from mllib/common_utils.ml *)' > $@-t
+ sed -n '/^(\*<stdlib>\*)$$/,/^(\*<\/stdlib>\*)$$/p' $< >> $@-t
+ mv $@-t $@
+common_utils.mli: $(top_srcdir)/mllib/common_utils.mli
+ rm -f $@ $@-t
+ echo '(* This file is generated from mllib/common_utils.mli *)' > $@-t
+ sed -n '/^(\*<stdlib>\*)$$/,/^(\*<\/stdlib>\*)$$/p' $< >> $@-t
+ mv $@-t $@
+guestfs_config.ml: ../mllib/guestfs_config.ml
+ cp $< $@
+
CLEANFILES += $(noinst_DATA) $(noinst_PROGRAM)
DISTCLEANFILES += .pod2text.data.version.2
diff --git a/generator/bindtests.ml b/generator/bindtests.ml
index 742cb1b..ffb3ee7 100644
--- a/generator/bindtests.ml
+++ b/generator/bindtests.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -176,7 +177,7 @@ fill_lvm_pv (guestfs_h *g, struct guestfs_lvm_pv *pv, size_t i)
let check_optarg n printf_args =
pr " fprintf (fp, \"%s: \");\n" n;
pr " if (optargs->bitmask & %s_%s_BITMASK) {\n" c_optarg_prefix
- (String.uppercase n);
+ (String.uppercase_ascii n);
pr " fprintf (fp, %s);\n" printf_args;
pr " } else {\n";
pr " fprintf (fp, \"unset\\n\");\n";
@@ -200,7 +201,7 @@ fill_lvm_pv (guestfs_h *g, struct guestfs_lvm_pv *pv, size_t i)
| OStringList n ->
pr " fprintf (fp, \"%s: \");\n" n;
pr " if (optargs->bitmask & %s_%s_BITMASK) {\n" c_optarg_prefix
- (String.uppercase n);
+ (String.uppercase_ascii n);
pr " print_strings (g, optargs->%s);\n" n;
pr " } else {\n";
pr " fprintf (fp, \"unset\\n\");\n";
@@ -583,7 +584,7 @@ public class Bindtests {
| CallBool b -> string_of_bool b
| CallBuffer s ->
"new byte[] { " ^ String.concat "," (
- map_chars (fun c -> string_of_int (Char.code c)) s
+ String.map_chars (fun c -> string_of_int (Char.code c)) s
) ^ " }"
) args
)
@@ -845,7 +846,7 @@ and generate_golang_bindtests () =
generate_lang_bindtests (
fun f args optargs ->
- pr " if err := g.%s (" (String.capitalize f);
+ pr " if err := g.%s (" (String.capitalize_ascii f);
let needs_comma = ref false in
List.iter (
@@ -869,13 +870,13 @@ and generate_golang_bindtests () =
| c -> sprintf "'%c'" c
in
pr "[]byte{%s}"
- (String.concat ", " (List.map quote_char (explode s)))
+ (String.concat ", " (List.map quote_char (String.explode s)))
) args;
if !needs_comma then pr ", ";
(match optargs with
| None -> pr "nil"
| Some optargs ->
- pr "&guestfs.Optargs%s{" (String.capitalize f);
+ pr "&guestfs.Optargs%s{" (String.capitalize_ascii f);
needs_comma := false;
List.iter (
fun optarg ->
@@ -883,19 +884,19 @@ and generate_golang_bindtests () =
needs_comma := true;
match optarg with
| CallOBool (n, v) ->
- let n = String.capitalize n in
+ let n = String.capitalize_ascii n in
pr "%s_is_set: true, %s: %b" n n v
| CallOInt (n, v) ->
- let n = String.capitalize n in
+ let n = String.capitalize_ascii n in
pr "%s_is_set: true, %s: %d" n n v
| CallOInt64 (n, v) ->
- let n = String.capitalize n in
+ let n = String.capitalize_ascii n in
pr "%s_is_set: true, %s: %Ld" n n v
| CallOString (n, v) ->
- let n = String.capitalize n in
+ let n = String.capitalize_ascii n in
pr "%s_is_set: true, %s: \"%s\"" n n v
| CallOStringList (n, xs) ->
- let n = String.capitalize n in
+ let n = String.capitalize_ascii n in
pr "%s_is_set: true, %s: []string{%s}"
n n (String.concat ", " (List.map (sprintf "\"%s\"") xs))
) optargs;
@@ -971,7 +972,7 @@ and generate_php_bindtests () =
let chan = open_in filename in
let rec loop () =
let line = input_line chan in
- (match string_split ":" line with
+ (match String.nsplit ":" line with
| ("obool"|"oint"|"oint64"|"ostring"|"ostringlist") as x :: _ ->
pr "%s: unset\n" x
| _ -> pr "%s\n" line
diff --git a/generator/c.ml b/generator/c.ml
index 6f5a517..79d3811 100644
--- a/generator/c.ml
+++ b/generator/c.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -102,7 +103,7 @@ let rec generate_prototype ?(extern = true) ?(static = false)
else (
let namelen = String.length prefix + String.length name +
String.length suffix + 2 in
- pr ",\n%s%s" indent (spaces namelen)
+ pr ",\n%s%s" indent (String.spaces namelen)
)
);
comma := true
@@ -230,7 +231,8 @@ and generate_actions_pod_entry ({ c_name = c_name;
List.iter (
fun argt ->
let n = name_of_optargt argt in
- pr " GUESTFS_%s_%s, " (String.uppercase c_name) (String.uppercase n);
+ pr " GUESTFS_%s_%s, " (String.uppercase_ascii c_name)
+ (String.uppercase_ascii n);
match argt with
| OBool n -> pr "int %s,\n" n
| OInt n -> pr "int %s,\n" n
@@ -508,7 +510,7 @@ extern GUESTFS_DLL_PUBLIC guestfs_abort_cb guestfs_get_out_of_memory_handler (gu
List.iter (
fun (name, bitmask) ->
pr "#define GUESTFS_EVENT_%-16s 0x%04x\n"
- (String.uppercase name) bitmask
+ (String.uppercase_ascii name) bitmask
) events;
pr "#define GUESTFS_EVENT_%-16s 0x%04x\n" "ALL" all_events_bitmask;
pr "\n";
@@ -601,7 +603,7 @@ extern GUESTFS_DLL_PUBLIC void *guestfs_next_private (guestfs_h *g, const char *
(* Public structures. *)
let generate_all_structs = List.iter (
fun { s_name = typ; s_cols = cols } ->
- pr "#define GUESTFS_HAVE_STRUCT_%s 1\n" (String.uppercase typ);
+ pr "#define GUESTFS_HAVE_STRUCT_%s 1\n" (String.uppercase_ascii typ);
pr "\n";
pr "struct guestfs_%s {\n" typ;
List.iter (
@@ -645,14 +647,14 @@ extern GUESTFS_DLL_PUBLIC void *guestfs_next_private (guestfs_h *g, const char *
let generate_action_header { name = shortname;
style = ret, args, optargs as style;
deprecated_by = deprecated_by } =
- pr "#define GUESTFS_HAVE_%s 1\n" (String.uppercase shortname);
+ pr "#define GUESTFS_HAVE_%s 1\n" (String.uppercase_ascii shortname);
if optargs <> [] then (
iteri (
fun i argt ->
- let uc_shortname = String.uppercase shortname in
+ let uc_shortname = String.uppercase_ascii shortname in
let n = name_of_optargt argt in
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr "#define GUESTFS_%s_%s %d\n" uc_shortname uc_n i;
) optargs;
);
@@ -682,9 +684,9 @@ extern GUESTFS_DLL_PUBLIC void *guestfs_next_private (guestfs_h *g, const char *
| OInt64 n -> "int64_t "
| OString n -> "const char *"
| OStringList n -> "char *const *" in
- let uc_shortname = String.uppercase shortname in
+ let uc_shortname = String.uppercase_ascii shortname in
let n = name_of_optargt argt in
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr "# define GUESTFS_%s_%s_BITMASK (UINT64_C(1)<<%d)\n" uc_shortname uc_n i;
pr " %s%s;\n" c_type n
) optargs;
@@ -759,7 +761,7 @@ pr "\
List.iter (
fun { name = shortname } ->
- pr "#define LIBGUESTFS_HAVE_%s 1\n" (String.uppercase shortname);
+ pr "#define LIBGUESTFS_HAVE_%s 1\n" (String.uppercase_ascii shortname);
) public_functions_sorted;
pr "
@@ -810,9 +812,9 @@ and generate_internal_frontend_cleanups_h () =
List.iter (
fun { s_name = name } ->
- pr "#define CLEANUP_FREE_%s \\\n" (String.uppercase name);
+ pr "#define CLEANUP_FREE_%s \\\n" (String.uppercase_ascii name);
pr " __attribute__((cleanup(guestfs_int_cleanup_free_%s)))\n" name;
- pr "#define CLEANUP_FREE_%s_LIST \\\n" (String.uppercase name);
+ pr "#define CLEANUP_FREE_%s_LIST \\\n" (String.uppercase_ascii name);
pr " __attribute__((cleanup(guestfs_int_cleanup_free_%s_list)))\n" name
) structs;
@@ -820,8 +822,8 @@ and generate_internal_frontend_cleanups_h () =
List.iter (
fun { s_name = name } ->
- pr "#define CLEANUP_FREE_%s\n" (String.uppercase name);
- pr "#define CLEANUP_FREE_%s_LIST\n" (String.uppercase name)
+ pr "#define CLEANUP_FREE_%s\n" (String.uppercase_ascii name);
+ pr "#define CLEANUP_FREE_%s_LIST\n" (String.uppercase_ascii name)
) structs;
pr "\
@@ -1409,7 +1411,7 @@ and generate_client_actions actions () =
function
| OString n ->
pr " if ((optargs->bitmask & GUESTFS_%s_%s_BITMASK) &&\n"
- (String.uppercase c_name) (String.uppercase n);
+ (String.uppercase_ascii c_name) (String.uppercase_ascii n);
pr " optargs->%s == NULL) {\n" n;
pr " error (g, \"%%s: %%s: optional parameter cannot be NULL\",\n";
pr " \"%s\", \"%s\");\n" c_name n;
@@ -1423,7 +1425,7 @@ and generate_client_actions actions () =
| OStringList n ->
pr " if ((optargs->bitmask & GUESTFS_%s_%s_BITMASK) &&\n"
- (String.uppercase c_name) (String.uppercase n);
+ (String.uppercase_ascii c_name) (String.uppercase_ascii n);
pr " optargs->%s == NULL) {\n" n;
pr " error (g, \"%%s: %%s: optional list cannot be NULL\",\n";
pr " \"%s\", \"%s\");\n" c_name n;
@@ -1587,7 +1589,7 @@ and generate_client_actions actions () =
fun argt ->
let n = name_of_optargt argt in
pr " if (optargs->bitmask & GUESTFS_%s_%s_BITMASK) {\n"
- (String.uppercase c_name) (String.uppercase n);
+ (String.uppercase_ascii c_name) (String.uppercase_ascii n);
(match argt with
| OString n ->
pr " fprintf (trace_buffer.fp, \" \\\"%%s:%%s\\\"\", \"%s\", optargs->%s);\n" n n
@@ -1614,7 +1616,7 @@ and generate_client_actions actions () =
in
let trace_return ?(indent = 2) name (ret, _, _) rv =
- let indent = spaces indent in
+ let indent = String.spaces indent in
pr "%sif (trace_flag) {\n" indent;
@@ -1679,7 +1681,7 @@ and generate_client_actions actions () =
in
let trace_return_error ?(indent = 2) name (ret, _, _) errcode =
- let indent = spaces indent in
+ let indent = String.spaces indent in
pr "%sif (trace_flag)\n" indent;
@@ -1876,7 +1878,7 @@ and generate_client_actions actions () =
(* Send the main header and arguments. *)
if args_passed_to_daemon = [] && optargs = [] then (
pr " serial = guestfs_int_send (g, GUESTFS_PROC_%s, progress_hint, 0,\n"
- (String.uppercase name);
+ (String.uppercase_ascii name);
pr " NULL, NULL);\n"
) else (
List.iter (
@@ -1913,7 +1915,7 @@ and generate_client_actions actions () =
fun argt ->
let n = name_of_optargt argt in
pr " if (optargs->bitmask & GUESTFS_%s_%s_BITMASK) {\n"
- (String.uppercase c_name) (String.uppercase n);
+ (String.uppercase_ascii c_name) (String.uppercase_ascii n);
(match argt with
| OBool n
| OInt n
@@ -1938,7 +1940,7 @@ and generate_client_actions actions () =
) optargs;
pr " serial = guestfs_int_send (g, GUESTFS_PROC_%s,\n"
- (String.uppercase name);
+ (String.uppercase_ascii name);
pr " progress_hint, %s,\n"
(if optargs <> [] then "optargs->bitmask" else "0");
pr " (xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
@@ -1989,7 +1991,7 @@ and generate_client_actions actions () =
pr "\n";
pr " if (guestfs_int_check_reply_header (g, &hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
- (String.uppercase name);
+ (String.uppercase_ascii name);
trace_return_error ~indent:4 name style errcode;
pr " return %s;\n" (string_of_errcode errcode);
pr " }\n";
@@ -2160,7 +2162,7 @@ and generate_client_actions_variants () =
fun argt ->
let n = name_of_optargt argt in
pr " case GUESTFS_%s_%s:\n"
- (String.uppercase c_name) (String.uppercase n);
+ (String.uppercase_ascii c_name) (String.uppercase_ascii n);
pr " optargs_s.%s = va_arg (args, " n;
(match argt with
| OBool _ | OInt _ -> pr "int"
@@ -2273,7 +2275,8 @@ guestfs_event_to_string (uint64_t event)
List.iter (
fun name ->
- pr " if ((event & GUESTFS_EVENT_%s) != 0) {\n" (String.uppercase name);
+ pr " if ((event & GUESTFS_EVENT_%s) != 0) {\n"
+ (String.uppercase_ascii name);
pr " strcpy (&ret[len], \"%s,\");\n" name;
pr " len += %d + 1;\n" (String.length name);
pr " }\n";
diff --git a/generator/daemon.ml b/generator/daemon.ml
index ce5dada..f05d5b7 100644
--- a/generator/daemon.ml
+++ b/generator/daemon.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -49,9 +50,9 @@ let generate_daemon_actions_h () =
| { name = shortname; style = _, _, (_::_ as optargs) } ->
iteri (
fun i arg ->
- let uc_shortname = String.uppercase shortname in
+ let uc_shortname = String.uppercase_ascii shortname in
let n = name_of_optargt arg in
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr "#define GUESTFS_%s_%s_BITMASK (UINT64_C(1)<<%d)\n"
uc_shortname uc_n i
) optargs
@@ -541,7 +542,7 @@ let generate_daemon_dispatch () =
List.iter (
fun { name = name } ->
- pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
+ pr " case GUESTFS_PROC_%s:\n" (String.uppercase_ascii name);
pr " %s_stub (xdr_in);\n" name;
pr " break;\n"
) (actions |> daemon_functions);
@@ -819,7 +820,8 @@ let generate_daemon_optgroups_h () =
";
List.iter (
fun (group, fns) ->
- pr "#define OPTGROUP_%s_NOT_AVAILABLE \\\n" (String.uppercase group);
+ pr "#define OPTGROUP_%s_NOT_AVAILABLE \\\n"
+ (String.uppercase_ascii group);
List.iter (
fun { name = name; style = ret, args, optargs } ->
let style = ret, args @ args_of_optargs optargs, [] in
diff --git a/generator/docstrings.ml b/generator/docstrings.ml
index 9d3fd0b..845ec63 100644
--- a/generator/docstrings.ml
+++ b/generator/docstrings.ml
@@ -21,6 +21,7 @@
open Unix
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -41,7 +42,7 @@ let deprecation_notice ?(prefix = "") ?(replace_underscores = false) =
| { deprecated_by = None } -> None
| { deprecated_by = Some alt } ->
let alt =
- if replace_underscores then replace_char alt '_' '-' else alt in
+ if replace_underscores then String.replace_char alt '_' '-' else alt in
let txt =
sprintf "I<This function is deprecated.>
In new code, use the L</%s%s> call instead.
diff --git a/generator/erlang.ml b/generator/erlang.ml
index fab92a0..3753835 100644
--- a/generator/erlang.ml
+++ b/generator/erlang.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -105,7 +106,7 @@ loop(Port) ->
pr "%s(G" name;
List.iter (
fun arg ->
- pr ", %s" (String.capitalize (name_of_argt arg))
+ pr ", %s" (String.capitalize_ascii (name_of_argt arg))
) args;
if optargs <> [] then
pr ", Optargs";
@@ -114,7 +115,7 @@ loop(Port) ->
pr " call_port(G, {%s" name;
List.iter (
fun arg ->
- pr ", %s" (String.capitalize (name_of_argt arg))
+ pr ", %s" (String.capitalize_ascii (name_of_argt arg))
) args;
if optargs <> [] then
pr ", Optargs";
@@ -128,14 +129,14 @@ loop(Port) ->
pr "%s(G" name;
List.iter (
fun arg ->
- pr ", %s" (String.capitalize (name_of_argt arg))
+ pr ", %s" (String.capitalize_ascii (name_of_argt arg))
) args;
pr ") ->\n";
pr " %s(G" name;
List.iter (
fun arg ->
- pr ", %s" (String.capitalize (name_of_argt arg))
+ pr ", %s" (String.capitalize_ascii (name_of_argt arg))
) args;
pr ", []";
pr ").\n"
@@ -147,7 +148,7 @@ loop(Port) ->
pr "%s(G" alias;
List.iter (
fun arg ->
- pr ", %s" (String.capitalize (name_of_argt arg))
+ pr ", %s" (String.capitalize_ascii (name_of_argt arg))
) args;
if optargs <> [] then
pr ", Optargs";
@@ -156,7 +157,7 @@ loop(Port) ->
pr " %s(G" name;
List.iter (
fun arg ->
- pr ", %s" (String.capitalize (name_of_argt arg))
+ pr ", %s" (String.capitalize_ascii (name_of_argt arg))
) args;
if optargs <> [] then
pr ", Optargs";
@@ -166,14 +167,14 @@ loop(Port) ->
pr "%s(G" alias;
List.iter (
fun arg ->
- pr ", %s" (String.capitalize (name_of_argt arg))
+ pr ", %s" (String.capitalize_ascii (name_of_argt arg))
) args;
pr ") ->\n";
pr " %s(G" name;
List.iter (
fun arg ->
- pr ", %s" (String.capitalize (name_of_argt arg))
+ pr ", %s" (String.capitalize_ascii (name_of_argt arg))
) args;
pr ").\n"
)
@@ -404,7 +405,7 @@ instead of erl_interface.
List.iter (
fun argt ->
let n = name_of_optargt argt in
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr " if (atom_equals (hd_name, \"%s\")) {\n" n;
pr " optargs_s.bitmask |= %s_%s_BITMASK;\n"
c_optarg_prefix uc_n;
@@ -457,12 +458,12 @@ instead of erl_interface.
function
| OBool _ | OInt _ | OInt64 _ -> ()
| OString n ->
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr " if ((optargs_s.bitmask & %s_%s_BITMASK))\n"
c_optarg_prefix uc_n;
pr " free ((char *) optargs_s.%s);\n" n
| OStringList n ->
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr " if ((optargs_s.bitmask & %s_%s_BITMASK))\n"
c_optarg_prefix uc_n;
pr " guestfs_int_free_string_list ((char **) optargs_s.%s);\n" n
diff --git a/generator/events.ml b/generator/events.ml
index c92c760..7188e12 100644
--- a/generator/events.ml
+++ b/generator/events.ml
@@ -18,6 +18,7 @@
(* Please read generator/README first. *)
+open Common_utils
open Utils
(* NB: DO NOT REORDER THESE, as doing so will change the ABI. Only
diff --git a/generator/fish.ml b/generator/fish.ml
index 62752e8..9ef7a30 100644
--- a/generator/fish.ml
+++ b/generator/fish.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -53,7 +54,7 @@ let doc_opttype_of = function
let get_aliases { fish_alias = fish_alias; non_c_aliases = non_c_aliases } =
let non_c_aliases =
- List.map (fun n -> replace_char n '_' '-') non_c_aliases in
+ List.map (fun n -> String.replace_char n '_' '-') non_c_aliases in
fish_alias @ non_c_aliases
let all_functions_commands_and_aliases_sorted =
@@ -73,7 +74,7 @@ let all_functions_commands_and_aliases_sorted =
let c_quoted_indented ~indent str =
let str = c_quote str in
- let str = replace_str str "\\n" ("\\n\"\n" ^ indent ^ "\"") in
+ let str = String.replace str "\\n" ("\\n\"\n" ^ indent ^ "\"") in
str
(* Generate run_* functions and header for libguestfs API functions. *)
@@ -322,7 +323,7 @@ let generate_fish_run_cmds actions () =
List.iter (
fun argt ->
let n = name_of_optargt argt in
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
let len = String.length n in
pr "if (STRPREFIX (argv[i], \"%s:\")) {\n" n;
(match argt with
@@ -466,7 +467,7 @@ let generate_fish_run_cmds actions () =
List.iter (
function
| OStringList n ->
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr " if ((optargs_s.bitmask & %s_%s_BITMASK) &&\n"
c_optarg_prefix uc_n;
pr " optargs_s.%s != NULL)\n" n;
@@ -539,9 +540,9 @@ let generate_fish_cmd_entries actions () =
shortdesc = shortdesc; longdesc = longdesc } as f) ->
let aliases = get_aliases f in
- let name2 = replace_char name '_' '-' in
+ let name2 = String.replace_char name '_' '-' in
- let longdesc = replace_str longdesc "C<guestfs_" "C<" in
+ let longdesc = String.replace longdesc "C<guestfs_" "C<" in
let synopsis =
match args with
| [] -> name2
@@ -625,7 +626,7 @@ let generate_fish_cmds () =
fun ({ name = name; shortdesc = shortdesc; longdesc = longdesc } as f) ->
let aliases = get_aliases f in
- let name2 = replace_char name '_' '-' in
+ let name2 = String.replace_char name '_' '-' in
let describe_alias =
if aliases <> [] then
sprintf "\n\nYou can use %s as an alias for this command."
@@ -656,13 +657,13 @@ let generate_fish_cmds () =
pr " list_builtin_commands ();\n";
List.iter (
fun (name, f) ->
- let name = replace_char name '_' '-' in
+ let name = String.replace_char name '_' '-' in
match f with
| Function shortdesc ->
pr " printf (\"%%-20s %%s\\n\", \"%s\", _(\"%s\"));\n"
name shortdesc
| Alias f ->
- let f = replace_char f '_' '-' in
+ let f = String.replace_char f '_' '-' in
pr " printf (\"%%-20s \", \"%s\");\n" name;
pr " printf (_(\"alias for '%%s'\"), \"%s\");\n" f;
pr " putchar ('\\n');\n"
@@ -771,7 +772,7 @@ struct command_table;
List.iter (
fun ({ name = name } as f) ->
let aliases = get_aliases f in
- let name2 = replace_char name '_' '-' in
+ let name2 = String.replace_char name '_' '-' in
(* The basic command. *)
pr "%s, &%s_cmd_entry\n" name name;
@@ -817,7 +818,7 @@ static const char *const commands[] = {
List.map (
fun ({ name = name } as f) ->
let aliases = get_aliases f in
- let name2 = replace_char name '_' '-' in
+ let name2 = String.replace_char name '_' '-' in
name2 :: aliases
) (fish_functions_and_commands_sorted) in
let commands = List.flatten commands in
@@ -894,9 +895,9 @@ and generate_fish_actions_pod () =
try Str.matched_group 1 s
with Not_found ->
failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
- "L</" ^ replace_char sub '_' '-' ^ ">"
+ "L</" ^ String.replace_char sub '_' '-' ^ ">"
) longdesc in
- let name = replace_char name '_' '-' in
+ let name = String.replace_char name '_' '-' in
List.iter (
fun name ->
@@ -961,7 +962,7 @@ and generate_fish_commands_pod () =
List.iter (
fun ({ name = name; longdesc = longdesc } as f) ->
let aliases = get_aliases f in
- let name = replace_char name '_' '-' in
+ let name = String.replace_char name '_' '-' in
List.iter (
fun name ->
@@ -1127,7 +1128,8 @@ event_bitmask_of_event_set (const char *arg, uint64_t *eventset_r)
List.iter (
fun (name, _) ->
pr "if (STREQLEN (arg, \"%s\", n))\n" name;
- pr " *eventset_r |= GUESTFS_EVENT_%s;\n" (String.uppercase name);
+ pr " *eventset_r |= GUESTFS_EVENT_%s;\n"
+ (String.uppercase_ascii name);
pr " else ";
) events;
@@ -1166,7 +1168,7 @@ $VG guestfish \\
fun i (name, _, _, _) ->
let params = [name] in
let params =
- if find name "lv" <> -1 then (
+ if String.find name "lv" <> -1 then (
incr vg_count;
sprintf "/dev/VG%d/LV" !vg_count :: params
) else params in
diff --git a/generator/gobject.ml b/generator/gobject.ml
index 7ee73a6..e14ea20 100644
--- a/generator/gobject.ml
+++ b/generator/gobject.ml
@@ -22,6 +22,7 @@
open Printf
+open Common_utils
open Actions
open Docstrings
open Events
@@ -125,7 +126,7 @@ let filenames =
let header_start filename =
generate_header CStyle GPLv2plus;
let guard = Str.global_replace (Str.regexp "-") "_" filename in
- let guard = "GUESTFS_GOBJECT_" ^ String.uppercase guard ^ "_H__" in
+ let guard = "GUESTFS_GOBJECT_" ^ String.uppercase_ascii guard ^ "_H__" in
pr "#ifndef %s\n" guard;
pr "#define %s\n" guard;
pr "
@@ -139,7 +140,7 @@ G_BEGIN_DECLS
and header_end filename =
let guard = Str.global_replace (Str.regexp "-") "_" filename in
- let guard = "GUESTFS_GOBJECT_" ^ String.uppercase guard ^ "_H__" in
+ let guard = "GUESTFS_GOBJECT_" ^ String.uppercase_ascii guard ^ "_H__" in
pr "
G_END_DECLS
@@ -299,7 +300,7 @@ let generate_gobject_struct_source filename typ () =
let generate_gobject_optargs_header filename name f () =
header_start filename;
- let uc_name = String.uppercase name in
+ let uc_name = String.uppercase_ascii name in
let camel_name = camel_of_name f in
let type_define = "GUESTFS_TYPE_" ^ uc_name in
@@ -358,7 +359,7 @@ let generate_gobject_optargs_source filename name optargs f () =
"An object encapsulating optional arguments for guestfs_session_" ^ name in
source_start ~shortdesc:desc ~longdesc:desc filename;
- let uc_name = String.uppercase name in
+ let uc_name = String.uppercase_ascii name in
let camel_name = camel_of_name f in
let type_define = "GUESTFS_TYPE_" ^ uc_name in
@@ -386,7 +387,7 @@ let generate_gobject_optargs_source filename name optargs f () =
pr " PROP_GUESTFS_%s_PROP0" uc_name;
List.iter (
fun optargt ->
- let uc_optname = String.uppercase (name_of_optargt optargt) in
+ let uc_optname = String.uppercase_ascii (name_of_optargt optargt) in
pr ",\n PROP_GUESTFS_%s_%s" uc_name uc_optname;
) optargs;
pr "\n};\n\n";
@@ -402,7 +403,7 @@ let generate_gobject_optargs_source filename name optargs f () =
function OStringList _ -> () (* XXX *)
| optargt ->
let optname = name_of_optargt optargt in
- let uc_optname = String.uppercase optname in
+ let uc_optname = String.uppercase_ascii optname in
pr " case PROP_GUESTFS_%s_%s:\n" uc_name uc_optname;
(match optargt with
| OString n ->
@@ -435,7 +436,7 @@ let generate_gobject_optargs_source filename name optargs f () =
function OStringList _ -> () (* XXX *)
| optargt ->
let optname = name_of_optargt optargt in
- let uc_optname = String.uppercase optname in
+ let uc_optname = String.uppercase_ascii optname in
pr " case PROP_GUESTFS_%s_%s:\n" uc_name uc_optname;
let set_value_func = match optargt with
| OBool _ -> "enum"
@@ -508,7 +509,7 @@ let generate_gobject_optargs_source filename name optargs f () =
pr " */\n";
pr " g_object_class_install_property (\n";
pr " object_class,\n";
- pr " PROP_GUESTFS_%s_%s,\n" uc_name (String.uppercase optname);
+ pr " PROP_GUESTFS_%s_%s,\n" uc_name (String.uppercase_ascii optname);
pr " g_param_spec_%s (\n" type_spec;
pr " \"%s\",\n" optname;
pr " \"%s\",\n" optname;
@@ -607,7 +608,7 @@ let generate_gobject_session_header () =
List.iter (
fun (name, _) ->
pr " * @GUESTFS_SESSION_EVENT_%s: The %s event\n"
- (String.uppercase name) name;
+ (String.uppercase_ascii name) name;
) events;
pr " *
@@ -618,7 +619,7 @@ typedef enum {";
List.iter (
fun (name, _) ->
- pr "\n GUESTFS_SESSION_EVENT_%s," (String.uppercase name);
+ pr "\n GUESTFS_SESSION_EVENT_%s," (String.uppercase_ascii name);
) events;
pr "
@@ -776,8 +777,8 @@ guestfs_session_event_from_guestfs_event (uint64_t event)
List.iter (
fun (name, _) ->
- let enum_name = "GUESTFS_SESSION_EVENT_" ^ String.uppercase name in
- let guestfs_name = "GUESTFS_EVENT_" ^ String.uppercase name in
+ let enum_name = "GUESTFS_SESSION_EVENT_" ^ String.uppercase_ascii name in
+ let guestfs_name = "GUESTFS_EVENT_" ^ String.uppercase_ascii name in
pr "\n case %s: return %s;" guestfs_name enum_name;
) events;
@@ -830,7 +831,7 @@ guestfs_session_event_get_type (void)
List.iter (
fun (name, _) ->
- let enum_name = "GUESTFS_SESSION_EVENT_" ^ String.uppercase name in
+ let enum_name = "GUESTFS_SESSION_EVENT_" ^ String.uppercase_ascii name in
pr "\n { %s, \"%s\", \"%s\" }," enum_name enum_name name
) events;
@@ -887,7 +888,8 @@ guestfs_session_class_init (GuestfsSessionClass *klass)
pr " * See \"SETTING CALLBACKS TO HANDLE EVENTS\" in guestfs(3) for\n";
pr " * more details about this event.\n";
pr " */\n";
- pr " signals[GUESTFS_SESSION_EVENT_%s] =\n" (String.uppercase name);
+ pr " signals[GUESTFS_SESSION_EVENT_%s] =\n"
+ (String.uppercase_ascii name);
pr " g_signal_new (g_intern_static_string (\"%s\"),\n" name;
pr " G_OBJECT_CLASS_TYPE (object_class),\n";
pr " G_SIGNAL_RUN_LAST,\n";
@@ -1156,7 +1158,7 @@ guestfs_session_close (GuestfsSession *session, GError **err)
pr " if (optargs) {\n";
pr " argv.bitmask = 0;\n\n";
let set_property name typ v_typ get_typ unset =
- let uc_name = String.uppercase name in
+ let uc_name = String.uppercase_ascii name in
pr " GValue %s_v = {0, };\n" name;
pr " g_value_init (&%s_v, %s);\n" name v_typ;
pr " g_object_get_property (G_OBJECT (optargs), \"%s\", &%s_v);\n" name name;
diff --git a/generator/java.ml b/generator/java.ml
index 260e28c..a68054c 100644
--- a/generator/java.ml
+++ b/generator/java.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -156,7 +157,8 @@ public class GuestFS {
pr " *\n";
pr " * @see #set_event_callback\n";
pr " */\n";
- pr " public static final long EVENT_%s = 0x%x;\n" (String.uppercase name) bitmask;
+ pr " public static final long EVENT_%s = 0x%x;\n"
+ (String.uppercase_ascii name) bitmask;
pr "\n";
) events;
@@ -259,7 +261,7 @@ public class GuestFS {
let ret, args, optargs = f.style in
if is_documented f then (
- let doc = replace_str f.longdesc "C<guestfs_" "C<g." in
+ let doc = String.replace f.longdesc "C<guestfs_" "C<g." in
let doc =
if optargs <> [] then
doc ^ "\n\nOptional arguments are supplied in the final Map<String,Object> parameter, which is a hash of the argument name to its value (cast to Object). Pass an empty Map or null for no optional arguments."
@@ -625,7 +627,7 @@ throw_out_of_memory (JNIEnv *env, const char *msg)
);
pr "JNICALL\n";
pr "Java_com_redhat_et_libguestfs_GuestFS_";
- pr "%s" (replace_str ("_" ^ name) "_" "_1");
+ pr "%s" (String.replace ("_" ^ name) "_" "_1");
pr " (JNIEnv *env, jobject obj, jlong jg";
List.iter (
function
diff --git a/generator/lua.ml b/generator/lua.ml
index d3b0b27..e48bb3e 100644
--- a/generator/lua.ml
+++ b/generator/lua.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -529,7 +530,7 @@ guestfs_int_lua_delete_event_callback (lua_State *L)
List.iter (
fun optarg ->
let n = name_of_optargt optarg in
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr " OPTARG_IF_SET (%d, \"%s\",\n" optarg_index n;
pr " optargs_s.bitmask |= %s_%s_BITMASK;\n"
c_optarg_prefix uc_n;
diff --git a/generator/ocaml.ml b/generator/ocaml.ml
index f76a3ab..5a85d38 100644
--- a/generator/ocaml.ml
+++ b/generator/ocaml.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -98,7 +99,7 @@ type event =
";
List.iter (
fun (name, _) ->
- pr " | EVENT_%s\n" (String.uppercase name)
+ pr " | EVENT_%s\n" (String.uppercase_ascii name)
) events;
pr "\n";
@@ -310,7 +311,7 @@ type event =
";
List.iter (
fun (name, _) ->
- pr " | EVENT_%s\n" (String.uppercase name)
+ pr " | EVENT_%s\n" (String.uppercase_ascii name)
) events;
pr "\n";
@@ -319,7 +320,7 @@ let event_all = [
";
List.iter (
fun (name, _) ->
- pr " EVENT_%s;\n" (String.uppercase name)
+ pr " EVENT_%s;\n" (String.uppercase_ascii name)
) events;
pr "\
@@ -342,7 +343,7 @@ module Errno = struct
";
List.iter (
fun e ->
- let le = String.lowercase e in
+ let le = String.lowercase_ascii e in
pr " external %s : unit -> int = \"guestfs_int_ocaml_get_%s\" \"noalloc\"\n"
le e;
pr " let errno_%s = %s ()\n" e le
@@ -637,7 +638,7 @@ copy_table (char * const * argv)
List.iter (
fun argt ->
let n = name_of_optargt argt in
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr " if (%sv != Val_int (0)) {\n" n;
pr " optargs_s.bitmask |= %s_%s_BITMASK;\n" c_optarg_prefix uc_n;
(match argt with
diff --git a/generator/perl.ml b/generator/perl.ml
index 94d7c4f..290b687 100644
--- a/generator/perl.ml
+++ b/generator/perl.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -455,7 +456,7 @@ PREINIT:
List.iter (
fun argt ->
let n = name_of_optargt argt in
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr "if (STREQ (this_arg, \"%s\")) {\n" n;
(match argt with
| OBool _
@@ -787,14 +788,14 @@ when the final reference is cleaned up is OK).
List.iter (
fun (name, bitmask) ->
- pr "=item $Sys::Guestfs::EVENT_%s\n" (String.uppercase name);
+ pr "=item $Sys::Guestfs::EVENT_%s\n" (String.uppercase_ascii name);
pr "\n";
pr "See L<guestfs(3)/GUESTFS_EVENT_%s>.\n"
- (String.uppercase name);
+ (String.uppercase_ascii name);
pr "\n";
pr "=cut\n";
pr "\n";
- pr "our $EVENT_%s = 0x%x;\n" (String.uppercase name) bitmask;
+ pr "our $EVENT_%s = 0x%x;\n" (String.uppercase_ascii name) bitmask;
pr "\n"
) events;
@@ -888,7 +889,7 @@ errnos:
List.iter (
fun ({ name = name; style = style;
longdesc = longdesc; non_c_aliases = non_c_aliases } as f) ->
- let longdesc = replace_str longdesc "C<guestfs_" "C<$g-E<gt>" in
+ let longdesc = String.replace longdesc "C<guestfs_" "C<$g-E<gt>" in
pr "=item ";
generate_perl_prototype name style;
pr "\n\n";
diff --git a/generator/pr.ml b/generator/pr.ml
index 616e6f9..666cd41 100644
--- a/generator/pr.ml
+++ b/generator/pr.ml
@@ -21,6 +21,7 @@
open Unix
open Printf
+open Common_utils
open Utils
(* Output channel, 'pr' prints to this. *)
@@ -39,7 +40,7 @@ let fileshash = Hashtbl.create 13
let pr fs =
ksprintf
(fun str ->
- let i = count_chars '\n' str in
+ let i = String.count_chars '\n' str in
lines := !lines + i;
output_string !chan str
) fs
diff --git a/generator/python.ml b/generator/python.ml
index 281fb0a..1e24a59 100644
--- a/generator/python.ml
+++ b/generator/python.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -94,14 +95,14 @@ extern PyObject *guestfs_int_py_put_table (char * const * const argv);
";
let emit_put_list_decl typ =
- pr "#ifdef GUESTFS_HAVE_STRUCT_%s\n" (String.uppercase typ);
+ pr "#ifdef GUESTFS_HAVE_STRUCT_%s\n" (String.uppercase_ascii typ);
pr "extern PyObject *guestfs_int_py_put_%s_list (struct guestfs_%s_list *%ss);\n" typ typ typ;
pr "#endif\n";
in
List.iter (
fun { s_name = typ } ->
- pr "#ifdef GUESTFS_HAVE_STRUCT_%s\n" (String.uppercase typ);
+ pr "#ifdef GUESTFS_HAVE_STRUCT_%s\n" (String.uppercase_ascii typ);
pr "extern PyObject *guestfs_int_py_put_%s (struct guestfs_%s *%s);\n" typ typ typ;
pr "#endif\n";
) external_structs;
@@ -118,7 +119,7 @@ extern PyObject *guestfs_int_py_put_table (char * const * const argv);
List.iter (
fun { name = name; c_name = c_name } ->
- pr "#ifdef GUESTFS_HAVE_%s\n" (String.uppercase c_name);
+ pr "#ifdef GUESTFS_HAVE_%s\n" (String.uppercase_ascii c_name);
pr "extern PyObject *guestfs_int_py_%s (PyObject *self, PyObject *args);\n" name;
pr "#endif\n"
) (actions |> external_functions |> sort);
@@ -147,7 +148,7 @@ and generate_python_structs () =
";
let emit_put_list_function typ =
- pr "#ifdef GUESTFS_HAVE_STRUCT_%s\n" (String.uppercase typ);
+ pr "#ifdef GUESTFS_HAVE_STRUCT_%s\n" (String.uppercase_ascii typ);
pr "PyObject *\n";
pr "guestfs_int_py_put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
pr "{\n";
@@ -166,7 +167,7 @@ and generate_python_structs () =
(* Structures, turned into Python dictionaries. *)
List.iter (
fun { s_name = typ; s_cols = cols } ->
- pr "#ifdef GUESTFS_HAVE_STRUCT_%s\n" (String.uppercase typ);
+ pr "#ifdef GUESTFS_HAVE_STRUCT_%s\n" (String.uppercase_ascii typ);
pr "PyObject *\n";
pr "guestfs_int_py_put_%s (struct guestfs_%s *%s)\n" typ typ typ;
pr "{\n";
@@ -279,7 +280,7 @@ and generate_python_actions actions () =
blocking = blocking;
c_name = c_name;
c_function = c_function; c_optarg_prefix = c_optarg_prefix } ->
- pr "#ifdef GUESTFS_HAVE_%s\n" (String.uppercase c_name);
+ pr "#ifdef GUESTFS_HAVE_%s\n" (String.uppercase_ascii c_name);
pr "PyObject *\n";
pr "guestfs_int_py_%s (PyObject *self, PyObject *args)\n" name;
pr "{\n";
@@ -415,7 +416,7 @@ and generate_python_actions actions () =
List.iter (
fun optarg ->
let n = name_of_optargt optarg in
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr "#ifdef %s_%s_BITMASK\n" c_optarg_prefix uc_n;
pr " if (py_%s != Py_None) {\n" n;
pr " optargs_s.bitmask |= %s_%s_BITMASK;\n" c_optarg_prefix uc_n;
@@ -560,7 +561,7 @@ and generate_python_actions actions () =
function
| OBool _ | OInt _ | OInt64 _ | OString _ -> ()
| OStringList n ->
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr "#ifdef %s_%s_BITMASK\n" c_optarg_prefix uc_n;
pr " if (py_%s != Py_None && (optargs_s.bitmask & %s_%s_BITMASK) != 0)\n"
n c_optarg_prefix uc_n;
@@ -606,7 +607,7 @@ and generate_python_module () =
pr " guestfs_int_py_event_to_string, METH_VARARGS, NULL },\n";
List.iter (
fun { name = name; c_name = c_name } ->
- pr "#ifdef GUESTFS_HAVE_%s\n" (String.uppercase c_name);
+ pr "#ifdef GUESTFS_HAVE_%s\n" (String.uppercase_ascii c_name);
pr " { (char *) \"%s\", guestfs_int_py_%s, METH_VARARGS, NULL },\n"
name name;
pr "#endif\n"
@@ -732,7 +733,7 @@ import libguestfsmod
List.iter (
fun (name, bitmask) ->
- pr "EVENT_%s = 0x%x\n" (String.uppercase name) bitmask
+ pr "EVENT_%s = 0x%x\n" (String.uppercase_ascii name) bitmask
) events;
pr "EVENT_ALL = 0x%x\n" all_events_bitmask;
pr "\n";
@@ -855,7 +856,7 @@ class GuestFS(object):
f.name (indent_python decl_string (9 + len_name) 78);
if is_documented f then (
- let doc = replace_str f.longdesc "C<guestfs_" "C<g." in
+ let doc = String.replace f.longdesc "C<guestfs_" "C<g." in
let doc =
match ret with
| RErr | RInt _ | RInt64 _ | RBool _
@@ -883,7 +884,7 @@ class GuestFS(object):
| Some opt ->
doc ^ sprintf "\n\nThis function depends on the feature C<%s>. See also C<g.feature-available>." opt in
let doc = pod2text ~width:60 f.name doc in
- let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
+ let doc = List.map (fun line -> String.replace line "\\" "\\\\") doc in
let doc =
match doc with
| [] -> ""
diff --git a/generator/ruby.ml b/generator/ruby.ml
index 74d206f..0b7cbed 100644
--- a/generator/ruby.ml
+++ b/generator/ruby.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -127,7 +128,7 @@ and generate_ruby_c actions () =
(* Generate rdoc. *)
if is_documented f then (
- let doc = replace_str f.longdesc "C<guestfs_" "C<g." in
+ let doc = String.replace f.longdesc "C<guestfs_" "C<g." in
let doc =
if optargs <> [] then
doc ^ "\n\nOptional arguments are supplied in the final hash parameter, which is a hash of the argument name to its value. Pass an empty {} for no optional arguments."
@@ -138,7 +139,7 @@ and generate_ruby_c actions () =
else doc in
let doc = pod2text ~width:60 f.name doc in
let doc = String.concat "\n * " doc in
- let doc = trim doc in
+ let doc = String.trim doc in
let doc =
match version_added f with
| None -> doc
@@ -157,7 +158,7 @@ and generate_ruby_c actions () =
(* Because Ruby documentation appears as C comments, we must
* replace any instance of "/*".
*)
- let doc = replace_str doc "/*" "/ *" in
+ let doc = String.replace doc "/*" "/ *" in
let args = List.map name_of_argt args in
let args = if optargs <> [] then args @ ["{optargs...}"] else args in
@@ -295,7 +296,7 @@ and generate_ruby_c actions () =
List.iter (
fun argt ->
let n = name_of_optargt argt in
- let uc_n = String.uppercase n in
+ let uc_n = String.uppercase_ascii n in
pr " v = rb_hash_lookup (optargsv, ID2SYM (rb_intern (\"%s\")));\n" n;
pr " if (v != Qnil) {\n";
(match argt with
@@ -483,7 +484,7 @@ Init__guestfs (void)
List.iter (
fun (name, bitmask) ->
pr " rb_define_const (m_guestfs, \"EVENT_%s\",\n"
- (String.uppercase name);
+ (String.uppercase_ascii name);
pr " ULL2NUM (UINT64_C (0x%x)));\n" bitmask;
) events;
pr " rb_define_const (m_guestfs, \"EVENT_ALL\",\n";
diff --git a/generator/tests_c_api.ml b/generator/tests_c_api.ml
index 21ef6e3..8b98927 100644
--- a/generator/tests_c_api.ml
+++ b/generator/tests_c_api.ml
@@ -20,6 +20,7 @@
open Printf
+open Common_utils
open Types
open Utils
open Pr
@@ -201,7 +202,9 @@ static int
return 0;
}
-" test_name name (String.uppercase test_name) (String.uppercase name);
+" test_name name
+ (String.uppercase_ascii test_name)
+ (String.uppercase_ascii name);
if not_disabled then (
generate_test_perform name i test_name test;
@@ -441,7 +444,7 @@ and generate_test_command_call ?(expect_error = false) ?(do_return = true) ?test
| StringList _, arg, sym
| DeviceList _, arg, sym
| FilenameList _, arg, sym ->
- let strs = string_split " " arg in
+ let strs = String.nsplit " " arg in
iteri (
fun i str ->
pr " const char *%s_%d = \"%s\";\n" sym i (c_quote str);
@@ -489,7 +492,7 @@ and generate_test_command_call ?(expect_error = false) ?(do_return = true) ?test
| OStringList n, "" ->
pr " const char *const %s[1] = { NULL };\n" n; true
| OStringList n, arg ->
- let strs = string_split " " arg in
+ let strs = String.nsplit " " arg in
iteri (
fun i str ->
pr " const char *%s_%d = \"%s\";\n" n i (c_quote str);
@@ -519,10 +522,10 @@ and generate_test_command_call ?(expect_error = false) ?(do_return = true) ?test
pr " CLEANUP_FREE_STRING_LIST char **%s;\n" ret;
| RStruct (_, typ) ->
pr " CLEANUP_FREE_%s struct guestfs_%s *%s;\n"
- (String.uppercase typ) typ ret
+ (String.uppercase_ascii typ) typ ret
| RStructList (_, typ) ->
pr " CLEANUP_FREE_%s_LIST struct guestfs_%s_list *%s;\n"
- (String.uppercase typ) typ ret
+ (String.uppercase_ascii typ) typ ret
| RBufferOut _ ->
pr " CLEANUP_FREE char *%s;\n" ret;
pr " size_t size;\n"
diff --git a/generator/uefi.ml b/generator/uefi.ml
index 88e54b8..80b8739 100644
--- a/generator/uefi.ml
+++ b/generator/uefi.ml
@@ -18,6 +18,7 @@
(* Please read generator/README first. *)
+open Common_utils
open Utils
open Pr
open Docstrings
diff --git a/generator/utils.ml b/generator/utils.ml
index 3e81433..ba5e045 100644
--- a/generator/utils.ml
+++ b/generator/utils.ml
@@ -23,6 +23,8 @@
* makes this a bit harder than it should be.
*)
+open Common_utils
+
open Unix
open Printf
@@ -119,85 +121,6 @@ let rstructs_used_by functions =
let failwithf fs = ksprintf failwith fs
-let unique = let i = ref 0 in fun () -> incr i; !i
-
-let replace_char s c1 c2 =
- let b2 = Bytes.of_string s in
- let r = ref false in
- for i = 0 to Bytes.length b2 - 1 do
- if Bytes.unsafe_get b2 i = c1 then (
- Bytes.unsafe_set b2 i c2;
- r := true
- )
- done;
- if not !r then s else Bytes.to_string b2
-
-let isspace c =
- c = ' '
- (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
-
-let triml ?(test = isspace) str =
- let i = ref 0 in
- let n = ref (String.length str) in
- while !n > 0 && test str.[!i]; do
- decr n;
- incr i
- done;
- if !i = 0 then str
- else String.sub str !i !n
-
-let trimr ?(test = isspace) str =
- let n = ref (String.length str) in
- while !n > 0 && test str.[!n-1]; do
- decr n
- done;
- if !n = String.length str then str
- else String.sub str 0 !n
-
-let trim ?(test = isspace) str =
- trimr ~test (triml ~test str)
-
-let rec find s sub =
- let len = String.length s in
- let sublen = String.length sub in
- let rec loop i =
- if i <= len-sublen then (
- let rec loop2 j =
- if j < sublen then (
- if s.[i+j] = sub.[j] then loop2 (j+1)
- else -1
- ) else
- i (* found *)
- in
- let r = loop2 0 in
- if r = -1 then loop (i+1) else r
- ) else
- -1 (* not found *)
- in
- loop 0
-
-let rec replace_str s s1 s2 =
- let len = String.length s in
- let sublen = String.length s1 in
- let i = find s s1 in
- if i = -1 then s
- else (
- let s' = String.sub s 0 i in
- let s'' = String.sub s (i+sublen) (len-i-sublen) in
- s' ^ s2 ^ replace_str s'' s1 s2
- )
-
-let rec string_split sep str =
- let len = String.length str in
- let seplen = String.length sep in
- let i = find str sep in
- if i = -1 then [str]
- else (
- let s' = String.sub str 0 i in
- let s'' = String.sub str (i+seplen) (len-i-seplen) in
- s' :: string_split sep s''
- )
-
let files_equal n1 n2 =
let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
match Sys.command cmd with
@@ -205,70 +128,6 @@ let files_equal n1 n2 =
| 1 -> false
| i -> failwithf "%s: failed with error code %d" cmd i
-let (|>) x f = f x
-
-let rec filter_map f = function
- | [] -> []
- | x :: xs ->
- match f x with
- | Some y -> y :: filter_map f xs
- | None -> filter_map f xs
-
-let rec find_map f = function
- | [] -> raise Not_found
- | x :: xs ->
- match f x with
- | Some y -> y
- | None -> find_map f xs
-
-let iteri f xs =
- let rec loop i = function
- | [] -> ()
- | x :: xs -> f i x; loop (i+1) xs
- in
- loop 0 xs
-
-let mapi f xs =
- let rec loop i = function
- | [] -> []
- | x :: xs -> let r = f i x in r :: loop (i+1) xs
- in
- loop 0 xs
-
-let uniq ?(cmp = Pervasives.compare) xs =
- let rec loop acc = function
- | [] -> acc
- | [x] -> x :: acc
- | x :: (y :: _ as xs) when cmp x y = 0 ->
- loop acc xs
- | x :: (y :: _ as xs) ->
- loop (x :: acc) xs
- in
- List.rev (loop [] xs)
-
-let sort_uniq ?(cmp = Pervasives.compare) xs =
- let xs = List.sort cmp xs in
- let xs = uniq ~cmp xs in
- xs
-
-let count_chars c str =
- let count = ref 0 in
- for i = 0 to String.length str - 1 do
- if c = String.unsafe_get str i then incr count
- done;
- !count
-
-let explode str =
- let r = ref [] in
- for i = 0 to String.length str - 1 do
- let c = String.unsafe_get str i in
- r := c :: !r;
- done;
- List.rev !r
-
-let map_chars f str =
- List.map f (explode str)
-
let name_of_argt = function
| Pathname n | Device n | Mountable n | Dev_or_Path n
| Mountable_or_Path n | String n | OptString n
@@ -290,14 +149,20 @@ let seq_of_test = function
| TestRunOrUnsupported s -> s
let c_quote str =
- let str = replace_str str "\\" "\\\\" in
- let str = replace_str str "\r" "\\r" in
- let str = replace_str str "\n" "\\n" in
- let str = replace_str str "\t" "\\t" in
- let str = replace_str str "\000" "\\0" in
- let str = replace_str str "\"" "\\\"" in
+ let str = String.replace str "\\" "\\\\" in
+ let str = String.replace str "\r" "\\r" in
+ let str = String.replace str "\n" "\\n" in
+ let str = String.replace str "\t" "\\t" in
+ let str = String.replace str "\000" "\\0" in
+ let str = String.replace str "\"" "\\\"" in
str
+let html_escape text =
+ let text = String.replace text "&" "&" in
+ let text = String.replace text "<" "<" in
+ let text = String.replace text ">" ">" in
+ text
+
(* Used to memoize the result of pod2text. *)
type memo_key = int option * bool * bool * string * string
(* width, trim, discard, name, longdesc *)
@@ -356,7 +221,7 @@ let pod2text ?width ?(trim = true) ?(discard = true) name longdesc =
if i = 1 && discard then (* discard the first line of output *)
loop (i+1)
else (
- let line = if trim then triml line else line in
+ let line = if trim then String.triml line else line in
lines := line :: !lines;
loop (i+1)
) in
@@ -376,8 +241,6 @@ let pod2text ?width ?(trim = true) ?(discard = true) name longdesc =
(* Compare two actions (for sorting). *)
let action_compare { name = n1 } { name = n2 } = compare n1 n2
-let spaces n = String.make n ' '
-
let args_of_optargs optargs =
List.map (
function
@@ -387,9 +250,3 @@ let args_of_optargs optargs =
| OString n -> String n
| OStringList n -> StringList n
) optargs
-
-let html_escape text =
- let text = replace_str text "&" "&" in
- let text = replace_str text "<" "<" in
- let text = replace_str text ">" ">" in
- text
diff --git a/generator/utils.mli b/generator/utils.mli
index c7d3f2c..ae6f239 100644
--- a/generator/utils.mli
+++ b/generator/utils.mli
@@ -44,65 +44,10 @@ val rstructs_used_by : Types.action list -> (string * rstructs_used_t) list
val failwithf : ('a, unit, string, 'b) format4 -> 'a
(** Like [failwith] but supports printf-like arguments. *)
-val unique : unit -> int
-(** Returns a unique number each time called. *)
-
-val replace_char : string -> char -> char -> string
-(** Replace character in string. *)
-
-val isspace : char -> bool
-(** Return true if char is a whitespace character. *)
-
-val triml : ?test:(char -> bool) -> string -> string
-(** Trim left. *)
-
-val trimr : ?test:(char -> bool) -> string -> string
-(** Trim right. *)
-
-val trim : ?test:(char -> bool) -> string -> string
-(** Trim left and right. *)
-
-val find : string -> string -> int
-(** [find str sub] searches for [sub] in [str], returning the index
- or -1 if not found. *)
-
-val replace_str : string -> string -> string -> string
-(** [replace_str str s1 s2] replaces [s1] with [s2] throughout [str]. *)
-
-val string_split : string -> string -> string list
-(** [string_split sep str] splits [str] at [sep]. *)
-
val files_equal : string -> string -> bool
(** [files_equal filename1 filename2] returns true if the files contain
the same content. *)
-val (|>) : 'a -> ('a -> 'b) -> 'b
-(** Added in OCaml 4.01, we can remove our definition when we
- can assume this minimum version of OCaml. *)
-
-val filter_map : ('a -> 'b option) -> 'a list -> 'b list
-
-val find_map : ('a -> 'b option) -> 'a list -> 'b
-
-val iteri : (int -> 'a -> unit) -> 'a list -> unit
-
-val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list
-
-val uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list
-(** Uniquify a list (the list must be sorted first). *)
-
-val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list
-(** Sort and uniquify a list. *)
-
-val count_chars : char -> string -> int
-(** Count number of times the character occurs in string. *)
-
-val explode : string -> char list
-(** Explode a string into a list of characters. *)
-
-val map_chars : (char -> 'a) -> string -> 'a list
-(** Explode string, then map function over the characters. *)
-
val name_of_argt : Types.argt -> string
(** Extract argument name. *)
@@ -115,6 +60,9 @@ val seq_of_test : Types.c_api_test -> Types.seq
val c_quote : string -> string
(** Perform quoting on a string so it is safe to include in a C source file. *)
+val html_escape : string -> string
+(** Escape a text for HTML display. *)
+
val pod2text : ?width:int -> ?trim:bool -> ?discard:bool -> string -> string -> string list
(** [pod2text ?width ?trim ?discard name longdesc] converts the POD in
[longdesc] to plain ASCII lines of text.
@@ -133,11 +81,5 @@ val pod2text : ?width:int -> ?trim:bool -> ?discard:bool -> string -> string ->
val action_compare : Types.action -> Types.action -> int
(** Compare the names of two actions, for sorting. *)
-val spaces : int -> string
-(** [spaces n] creates a string of n spaces. *)
-
val args_of_optargs : Types.optargs -> Types.args
(** Convert a list of optargs into an equivalent list of args *)
-
-val html_escape : string -> string
-(** Escape a text for HTML display. *)
diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
index 78618f5..e1d1ab8 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -16,7 +16,13 @@
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
+(* The parts between <stdlib>..</stdlib> are copied into the
+ * generator/common_utils.ml file. These parts must ONLY use
+ * functions from the OCaml stdlib.
+ *)
+(*<stdlib>*)
open Printf
+(*</stdlib>*)
open Common_gettext.Gettext
open Getopt.OptionName
@@ -25,6 +31,8 @@ external c_inspect_decrypt : Guestfs.t -> int64 -> unit = "guestfs_int_mllib_ins
external c_set_echo_keys : unit -> unit = "guestfs_int_mllib_set_echo_keys" "noalloc"
external c_set_keys_from_stdin : unit -> unit = "guestfs_int_mllib_set_keys_from_stdin" "noalloc"
+(*<stdlib>*)
+
module Char = struct
include Char
@@ -37,6 +45,20 @@ module Char = struct
if (c >= 'a' && c <= 'z')
then unsafe_chr (code c - 32)
else c
+
+ let isspace c =
+ c = ' '
+ (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
+
+ let isdigit = function
+ | '0'..'9' -> true
+ | _ -> false
+
+ let isxdigit = function
+ | '0'..'9' -> true
+ | 'a'..'f' -> true
+ | 'A'..'F' -> true
+ | _ -> false
end
module String = struct
@@ -53,6 +75,11 @@ module String = struct
let lowercase_ascii s = map Char.lowercase_ascii s
let uppercase_ascii s = map Char.uppercase_ascii s
+ let capitalize_ascii s =
+ let b = Bytes.of_string s in
+ Bytes.unsafe_set b 0 (Char.uppercase_ascii (Bytes.unsafe_get b 0));
+ Bytes.to_string b
+
let is_prefix str prefix =
let n = length prefix in
length str >= n && sub str 0 n = prefix
@@ -92,6 +119,17 @@ module String = struct
s' ^ s2 ^ replace s'' s1 s2
)
+ let replace_char s c1 c2 =
+ let b2 = Bytes.of_string s in
+ let r = ref false in
+ for i = 0 to Bytes.length b2 - 1 do
+ if Bytes.unsafe_get b2 i = c1 then (
+ Bytes.unsafe_set b2 i c2;
+ r := true
+ )
+ done;
+ if not !r then s else Bytes.to_string b2
+
let rec nsplit sep str =
let len = length str in
let seplen = length sep in
@@ -152,10 +190,49 @@ module String = struct
make 1 c
) [1;2;3;4;5;6;7;8]
)
+
+ let triml ?(test = Char.isspace) str =
+ let i = ref 0 in
+ let n = ref (String.length str) in
+ while !n > 0 && test str.[!i]; do
+ decr n;
+ incr i
+ done;
+ if !i = 0 then str
+ else String.sub str !i !n
+
+ let trimr ?(test = Char.isspace) str =
+ let n = ref (String.length str) in
+ while !n > 0 && test str.[!n-1]; do
+ decr n
+ done;
+ if !n = String.length str then str
+ else String.sub str 0 !n
+
+ let trim ?(test = Char.isspace) str =
+ trimr ~test (triml ~test str)
+
+ let count_chars c str =
+ let count = ref 0 in
+ for i = 0 to String.length str - 1 do
+ if c = String.unsafe_get str i then incr count
+ done;
+ !count
+
+ let explode str =
+ let r = ref [] in
+ for i = 0 to String.length str - 1 do
+ let c = String.unsafe_get str i in
+ r := c :: !r;
+ done;
+ List.rev !r
+
+ let map_chars f str =
+ List.map f (explode str)
+
+ let spaces n = String.make n ' '
end
-exception Executable_not_found of string (* executable *)
-
let (//) = Filename.concat
let ( +^ ) = Int64.add
@@ -191,16 +268,6 @@ let le32_of_int i =
Bytes.unsafe_set b 3 (Char.unsafe_chr (Int64.to_int c3));
Bytes.to_string b
-let isdigit = function
- | '0'..'9' -> true
- | _ -> false
-
-let isxdigit = function
- | '0'..'9' -> true
- | 'a'..'f' -> true
- | 'A'..'F' -> true
- | _ -> false
-
type wrap_break_t = WrapEOS | WrapSpace | WrapNL
let rec wrap ?(chan = stdout) ?(indent = 0) str =
@@ -237,6 +304,8 @@ and _wrap_find_next_break i len str =
and output_spaces chan n = for i = 0 to n-1 do output_char chan ' ' done
+let (|>) x f = f x
+
(* Drop elements from a list while a predicate is true. *)
let rec dropwhile f = function
| [] -> []
@@ -255,6 +324,13 @@ let rec filter_map f = function
| Some y -> y :: filter_map f xs
| None -> filter_map f xs
+let rec find_map f = function
+ | [] -> raise Not_found
+ | x :: xs ->
+ match f x with
+ | Some y -> y
+ | None -> find_map f xs
+
let iteri f xs =
let rec loop i = function
| [] -> ()
@@ -326,6 +402,8 @@ let pop_front xsp =
let append xsp xs = xsp := !xsp @ xs
let prepend xs xsp = xsp := xs @ !xsp
+let unique = let i = ref 0 in fun () -> incr i; !i
+
let may f = function
| None -> ()
| Some x -> f x
@@ -339,6 +417,8 @@ let protect ~f ~finally =
finally ();
match r with Either ret -> ret | Or exn -> raise exn
+exception Executable_not_found of string (* executable *)
+
let which executable =
let paths =
try String.nsplit ":" (Sys.getenv "PATH")
@@ -390,6 +470,8 @@ let ansi_magenta ?(chan = stdout) () =
let ansi_restore ?(chan = stdout) () =
if colours () || istty chan then output_string chan "\x1b[0m"
+(*</stdlib>*)
+
(* Timestamped progress messages, used for ordinary messages when not
* --quiet.
*)
@@ -497,6 +579,8 @@ let print_version_and_exit () =
let generated_by =
sprintf (f_"generated by %s %s") prog Guestfs_config.package_version_full
+(*<stdlib>*)
+
let read_whole_file path =
let buf = Buffer.create 16384 in
let chan = open_in path in
@@ -513,6 +597,8 @@ let read_whole_file path =
close_in chan;
Buffer.contents buf
+(*</stdlib>*)
+
(* Parse a size field, eg. "10G". *)
let parse_size =
let const_re = Str.regexp "^\\([.0-9]+\\)\\([bKMG]\\)$" in
@@ -627,6 +713,8 @@ let create_standard_options argspec ?anon_fun ?(key_opts = false) usage_msg =
else []) in
Getopt.create argspec ?anon_fun usage_msg
+(*<stdlib>*)
+
(* Compare two version strings intelligently. *)
let rex_numbers = Str.regexp "^\\([0-9]+\\)\\(.*\\)$"
let rex_letters = Str.regexp_case_fold "^\\([a-z]+\\)\\(.*\\)$"
@@ -684,6 +772,8 @@ let stringify_args args =
| [] -> ""
| app :: xs -> app ^ quote_args xs
+(*</stdlib>*)
+
(* Run an external command, slurp up the output as a list of lines. *)
let external_command ?(echo_cmd = true) cmd =
if echo_cmd then
@@ -748,6 +838,8 @@ let uuidgen () =
if len < 10 then assert false; (* sanity check on uuidgen *)
uuid
+(*<stdlib>*)
+
(* Unlink a temporary file on exit. *)
let unlink_on_exit =
let files = ref [] in
@@ -769,6 +861,8 @@ let unlink_on_exit =
registered_handlers := true
)
+(*</stdlib>*)
+
(* Remove a temporary directory on exit. *)
let rmdir_on_exit =
let dirs = ref [] in
@@ -905,6 +999,8 @@ let detect_file_type filename =
close_in chan;
ret
+(*<stdlib>*)
+
let is_block_device file =
try (Unix.stat file).Unix.st_kind = Unix.S_BLK
with Unix.Unix_error _ -> false
@@ -913,6 +1009,8 @@ let is_char_device file =
try (Unix.stat file).Unix.st_kind = Unix.S_CHR
with Unix.Unix_error _ -> false
+(*</stdlib>*)
+
let is_partition dev =
try
if not (is_block_device dev) then false
@@ -926,6 +1024,8 @@ let is_partition dev =
)
with Unix.Unix_error _ -> false
+(*<stdlib>*)
+
(* Annoyingly Sys.is_directory throws an exception on failure
* (RHBZ#1022431).
*)
@@ -995,6 +1095,8 @@ let is_regular_file path = (* NB: follows symlinks. *)
try (Unix.stat path).Unix.st_kind = Unix.S_REG
with Unix.Unix_error _ -> false
+(*</stdlib>*)
+
let inspect_mount_root g ?mount_opts_fn root =
let mps = g#inspect_get_mountpoints root in
let cmp (a,_) (b,_) =
diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli
index ad43345..7b142d4 100644
--- a/mllib/common_utils.mli
+++ b/mllib/common_utils.mli
@@ -16,6 +16,12 @@
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
+(* The parts between <stdlib>..</stdlib> are copied into the
+ * generator/common_utils.ml file. These parts must ONLY use
+ * functions from the OCaml stdlib.
+ *)
+(*<stdlib>*)
+
module Char : sig
type t = char
val chr : int -> char
@@ -26,6 +32,13 @@ module Char : sig
val lowercase_ascii : char -> char
val uppercase_ascii : char -> char
+
+ val isspace : char -> bool
+ (** Return true if char is a whitespace character. *)
+ val isdigit : char -> bool
+ (** Return true if the character is a digit [[0-9]]. *)
+ val isxdigit : char -> bool
+ (** Return true if the character is a hex digit [[0-9a-fA-F]]. *)
end
(** Override the Char module from stdlib. *)
@@ -53,6 +66,7 @@ module String : sig
val lowercase_ascii : string -> string
val uppercase_ascii : string -> string
+ val capitalize_ascii : string -> string
val is_prefix : string -> string -> bool
(** [is_prefix str prefix] returns true if [prefix] is a prefix of [str]. *)
@@ -64,6 +78,8 @@ module String : sig
val replace : string -> string -> string -> string
(** [replace str s1 s2] replaces all instances of [s1] appearing in
[str] with [s2]. *)
+ val replace_char : string -> char -> char -> string
+ (** Replace character in string. *)
val nsplit : string -> string -> string list
(** [nsplit sep str] splits [str] into multiple strings at each
separator [sep]. *)
@@ -77,13 +93,23 @@ module String : sig
characters (i.e. [\] at the end of lines) into account. *)
val random8 : unit -> string
(** Return a string of 8 random printable characters. *)
+ val triml : ?test:(char -> bool) -> string -> string
+ (** Trim left. *)
+ val trimr : ?test:(char -> bool) -> string -> string
+ (** Trim right. *)
+ val trim : ?test:(char -> bool) -> string -> string
+ (** Trim left and right. *)
+ val count_chars : char -> string -> int
+ (** Count number of times the character occurs in string. *)
+ val explode : string -> char list
+ (** Explode a string into a list of characters. *)
+ val map_chars : (char -> 'a) -> string -> 'a list
+ (** Explode string, then map function over the characters. *)
+ val spaces : int -> string
+ (** [spaces n] creates a string of n spaces. *)
end
(** Override the String module from stdlib. *)
-(** Exception thrown by [which] when the specified executable is not found
- in [$PATH]. *)
-exception Executable_not_found of string (* executable *)
-
val ( // ) : string -> string -> string
(** Concatenate directory and filename. *)
@@ -105,17 +131,16 @@ val int_of_le32 : string -> int64
val le32_of_int : int64 -> string
(** Pack a 32 bit integer a 4 byte string stored little endian. *)
-val isdigit : char -> bool
-(** Return true if the character is a digit [[0-9]]. *)
-val isxdigit : char -> bool
-(** Return true if the character is a hex digit [[0-9a-fA-F]]. *)
-
val wrap : ?chan:out_channel -> ?indent:int -> string -> unit
(** Wrap text. *)
val output_spaces : out_channel -> int -> unit
(** Write [n] spaces to [out_channel]. *)
+val (|>) : 'a -> ('a -> 'b) -> 'b
+(** Added in OCaml 4.01, we can remove our definition when we
+ can assume this minimum version of OCaml. *)
+
val dropwhile : ('a -> bool) -> 'a list -> 'a list
(** [dropwhile f xs] drops leading elements from [xs] until
[f] returns false. *)
@@ -128,6 +153,10 @@ val takewhile : ('a -> bool) -> 'a list -> 'a list
val filter_map : ('a -> 'b option) -> 'a list -> 'b list
(** [filter_map f xs] applies [f] to each element of [xs]. If
[f x] returns [Some y] then [y] is added to the returned list. *)
+val find_map : ('a -> 'b option) -> 'a list -> 'b
+(** [find_map f xs] applies [f] to each element of [xs] until
+ [f x] returns [Some y]. It returns [y]. If we exhaust the
+ list then this raises [Not_found]. *)
val iteri : (int -> 'a -> 'b) -> 'a list -> unit
(** [iteri f xs] calls [f i x] for each element, with [i] counting from [0]. *)
val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list
@@ -191,6 +220,9 @@ val prepend : 'a list -> 'a list ref -> unit
[prepend] is like {!push_front} above, except it prepends a list
to the list reference. *)
+val unique : unit -> int
+(** Returns a unique number each time called. *)
+
val may : ('a -> unit) -> 'a option -> unit
(** [may f (Some x)] runs [f x]. [may f None] does nothing. *)
@@ -209,6 +241,8 @@ val protect : f:(unit -> 'a) -> finally:(unit -> unit) -> 'a
case, but requires a lot more work by the caller. Perhaps we
will change this in future.) *)
+(*</stdlib>*)
+
val prog : string
(** The program name (derived from {!Sys.executable_name}). *)
@@ -253,9 +287,13 @@ val run_main_and_handle_errors : (unit -> unit) -> unit
val generated_by : string
(** The string ["generated by <prog> <version>"]. *)
+(*<stdlib>*)
+
val read_whole_file : string -> string
(** Read in the whole file as a string. *)
+(*</stdlib>*)
+
val parse_size : string -> int64
(** Parse a size field, eg. [10G] *)
@@ -275,6 +313,8 @@ val create_standard_options : Getopt.speclist -> ?anon_fun:Getopt.anon_fun -> ?k
Returns a new [Getopt.t] handle. *)
+(*<stdlib>*)
+
val compare_version : string -> string -> int
(** Compare two version strings. *)
@@ -285,6 +325,8 @@ val stringify_args : string list -> string
(** Create a "pretty-print" representation of a program invocation
(i.e. executable and its arguments). *)
+(*</stdlib>*)
+
val external_command : ?echo_cmd:bool -> string -> string list
(** Run an external command, slurp up the output as a list of lines.
@@ -306,9 +348,13 @@ val shell_command : ?echo_cmd:bool -> string -> int
val uuidgen : unit -> string
(** Run uuidgen to return a random UUID. *)
+(*<stdlib>*)
+
val unlink_on_exit : string -> unit
(** Unlink a temporary file on exit. *)
+(*</stdlib>*)
+
val rmdir_on_exit : string -> unit
(** Remove a temporary directory on exit (using [rm -rf]). *)
@@ -344,15 +390,21 @@ val debug_augeas_errors : Guestfs.guestfs -> unit
val detect_file_type : string -> [`GZip | `Tar | `XZ | `Zip | `Unknown]
(** Detect type of a file (for a very limited range of file types). *)
+(*<stdlib>*)
+
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. *)
+(*</stdlib>*)
+
val is_partition : string -> bool
(** Return true if the host device [dev] is a partition. If it's
anything else, or missing, returns false. *)
+(*<stdlib>*)
+
val absolute_path : string -> string
(** Convert any path to an absolute path. *)
@@ -381,6 +433,8 @@ val read_first_line_from_file : string -> string
val is_regular_file : string -> bool
(** Checks whether the file is a regular file. *)
+(*</stdlib>*)
+
val inspect_mount_root : Guestfs.guestfs -> ?mount_opts_fn:(string -> string) -> string -> unit
(** Mounts all the mount points of the specified root, just like
[guestfish -i] does.
@@ -395,6 +449,10 @@ val inspect_mount_root_ro : Guestfs.guestfs -> string -> unit
val is_btrfs_subvolume : Guestfs.guestfs -> string -> bool
(** Checks if a filesystem is a btrfs subvolume. *)
+exception Executable_not_found of string (* executable *)
+(** Exception thrown by [which] when the specified executable is not found
+ in [$PATH]. *)
+
val which : string -> string
(** Return the full path of the specified executable from [$PATH].
diff --git a/v2v/convert_windows.ml b/v2v/convert_windows.ml
index f8337a0..558caac 100644
--- a/v2v/convert_windows.ml
+++ b/v2v/convert_windows.ml
@@ -113,7 +113,8 @@ let convert ~keep_serial_console (g : G.guestfs) inspect source rcaps =
*)
let is_gpo_guid name =
let len = String.length name in
- len > 3 && name.[0] = '{' && isxdigit name.[1] && name.[len-1] = '}'
+ len > 3 && name.[0] = '{' &&
+ Char.isxdigit name.[1] && name.[len-1] = '}'
in
List.exists is_gpo_guid children
with
--
2.10.2
7 years, 7 months
- 2
- 4
[PATCH 0/2] mllib: Add quote function to Common_utils module.
by Richard W.M. Jones
Doing this allows us to remove the Customize_utils module
completely, since it becomes empty.
Rich.
7 years, 7 months
- 2
- 3
[PATCH 1/2] inspect: fstab: Canonicalize paths appearing in fstab.
by Richard W.M. Jones
For example, converts "///usr//local//" -> "/usr/local".
---
src/inspect-fs-unix.c | 52 +++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 52 insertions(+)
diff --git a/src/inspect-fs-unix.c b/src/inspect-fs-unix.c
index a1a757c..0fea9c8 100644
--- a/src/inspect-fs-unix.c
+++ b/src/inspect-fs-unix.c
@@ -89,6 +89,7 @@ static char *resolve_fstab_device (guestfs_h *g, const char *spec,
Hash_table *md_map,
enum inspect_os_type os_type);
static int inspect_with_augeas (guestfs_h *g, struct inspect_fs *fs, const char **configfiles, int (*f) (guestfs_h *, struct inspect_fs *));
+static void canonical_mountpoint (char *mp);
/* Hash structure for uuid->path lookups */
typedef struct md_uuid {
@@ -1286,6 +1287,9 @@ check_fstab (guestfs_h *g, struct inspect_fs *fs)
if (mp == NULL)
return -1;
+ /* Canonicalize the path, so "///usr//local//" -> "/usr/local" */
+ canonical_mountpoint (mp);
+
/* Ignore certain mountpoints. */
if (STRPREFIX (mp, "/dev/") ||
STREQ (mp, "/dev") ||
@@ -2081,3 +2085,51 @@ make_augeas_path_expression (guestfs_h *g, const char **configfiles)
debug (g, "augeas pathexpr = %s", ret);
return ret;
}
+
+/* Canonicalize the path, so "///usr//local//" -> "/usr/local"
+ *
+ * The path is modified in place because the result is always
+ * the same length or shorter than the argument passed.
+ */
+static void
+drop_char (char *mp)
+{
+ size_t len = strlen (mp);
+ memmove (&mp[0], &mp[1], len);
+}
+
+static void
+canonical_mountpoint_recursive (char *mp)
+{
+ if (mp[0] == '\0')
+ return;
+
+ /* Remove trailing slashes. */
+ if (mp[0] == '/' && mp[1] == '\0') {
+ mp[0] = '\0';
+ return;
+ }
+
+ /* Replace multiple slashes with single slashes. */
+ if (mp[0] == '/' && mp[1] == '/') {
+ drop_char (mp);
+ canonical_mountpoint_recursive (mp);
+ return;
+ }
+
+ canonical_mountpoint_recursive (&mp[1]);
+}
+
+static void
+canonical_mountpoint (char *mp)
+{
+ /* Collapse multiple leading slashes into a single slash ... */
+ while (mp[0] == '/' && mp[1] == '/')
+ drop_char (mp);
+
+ /* ... and then continue, skipping the leading slash. */
+ if (mp[0] == '/')
+ canonical_mountpoint_recursive (&mp[1]);
+ else
+ canonical_mountpoint_recursive (mp);
+}
--
2.9.3
7 years, 7 months
- 2
- 3
[PATCH v2 0/5] Import directly from OVA tar archive if possible
by Tomáš Golembiovský
This series is related to the problem of inefficient import of OVA
files. The needed enhancements of QEMU were merged into the codebase and
should be available in QEMU 2.8. From there we can use 'size' and
'offset' options in raw driver to tell QEMU to use only subset of a file
as an image.
The patch set is more or less complete. The only outstanding issue is
the missing detection of sparse files inside tar. But this can be done
in a separate patch. As pointed out before I didn't find a way how to
detect that by using the tar tool only and would probably require use of
some external library.
The first three patches are just preparation. The main work is in patch
four. Last patch fixes the tests.
v2:
- rewritten the tar invocations, the output processing is now done in
OcaML rather than with a shell code; it turned out to be easier and
more readable than I have feared.
- added QEMU version check
- addressed Pino's comments
- changed tests; the expected result is now based on the QEMU used
during testing
Tomáš Golembiovský (5):
mllib: compute checksum of file inside tar
v2v: ova: don't detect compressed disks, read the OVF instead
v2v: ova: move the untar function
v2v: ova: don't extract files from OVA if it's not needed
v2v: update tests to match changes in OVA import
mllib/checksums.ml | 11 +-
mllib/checksums.mli | 2 +-
test-data/utils.sh | 21 ++++
v2v/Makefile.am | 1 +
v2v/input_ova.ml | 184 +++++++++++++++++++++++++++-----
v2v/test-v2v-i-ova-formats.sh | 5 +-
v2v/test-v2v-i-ova-gz.ovf | 2 +-
v2v/test-v2v-i-ova-subfolders.expected2 | 18 ++++
v2v/test-v2v-i-ova-subfolders.sh | 12 ++-
v2v/test-v2v-i-ova-tar.expected | 18 ++++
v2v/test-v2v-i-ova-tar.expected2 | 18 ++++
v2v/test-v2v-i-ova-tar.ovf | 138 ++++++++++++++++++++++++
v2v/test-v2v-i-ova-tar.sh | 70 ++++++++++++
v2v/test-v2v-i-ova-two-disks.expected2 | 19 ++++
v2v/test-v2v-i-ova-two-disks.sh | 12 ++-
15 files changed, 493 insertions(+), 38 deletions(-)
create mode 100755 test-data/utils.sh
create mode 100644 v2v/test-v2v-i-ova-subfolders.expected2
create mode 100644 v2v/test-v2v-i-ova-tar.expected
create mode 100644 v2v/test-v2v-i-ova-tar.expected2
create mode 100644 v2v/test-v2v-i-ova-tar.ovf
create mode 100755 v2v/test-v2v-i-ova-tar.sh
create mode 100644 v2v/test-v2v-i-ova-two-disks.expected2
--
2.10.1
7 years, 7 months
- 3
- 19
[PATCH 0/3] Miscellaneous improvements to supermin.
by Richard W.M. Jones
Document what each module does, using *.mli files.
Remove the --dtb option, it's obsolete.
Rename modules according to their purpose.
Rich.
7 years, 7 months
- 2
- 5
[PATCH v3] v2v: -o vdsm: Add --vdsm-compat flag.
by Richard W.M. Jones
v3:
Change the flag from --vdsm-compat-11 to --vdsm-compat=1.1
Also the --machine-readable output has changed.
I have also added a test.
Rich.
7 years, 7 months
- 2
- 4
[PATCH v2 0/2] Improve inspection of /usr filesystems
by Pino Toscano
Hi,
this patch series improves the way /usr filesystems are handled: tag
them appropriately, so later on we can find them and merge results they
contain directly back for the root filesystem.
Changes in v2:
- removed patches #1 and #2, already pushed
- drop patch #3, no more needed
- replace patch #4 with a better suggestion from Rich
- change if into assert in patch #5
Thanks,
Pino Toscano (2):
inspect: fix existance check of /dev/mapper devices
inspect: gather info from /usr filesystems as well (RHBZ#1401474)
src/guestfs-internal.h | 1 +
src/inspect-fs-unix.c | 39 +++++++++++++++++++++++++-
src/inspect-fs.c | 6 ++--
src/inspect.c | 74 ++++++++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 117 insertions(+), 3 deletions(-)
--
2.7.4
7 years, 7 months
- 2
- 3