December 2016 - Libguestfs - libguestfs List Archives

[PATCH 0/2] generic function for temporary path generation
by Matteo Cafasso 11 Dec '16

11 Dec '16

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

2 3

[PATCH] inspect: improve canonical_mountpoint implementation
by Pino Toscano 09 Dec '16

09 Dec '16

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

2 1

[PATCH 1/2] Remove most instances of OCaml warning 52.
by Richard W.M. Jones 09 Dec '16

09 Dec '16

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

2 5

[PATCH] generator: Share Common_utils code.
by Richard W.M. Jones 09 Dec '16

09 Dec '16

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

2 4

[PATCH 0/2] mllib: Add quote function to Common_utils module.
by Richard W.M. Jones 09 Dec '16

09 Dec '16

Doing this allows us to remove the Customize_utils module completely, since it becomes empty. Rich.

2 3

[PATCH 1/2] inspect: fstab: Canonicalize paths appearing in fstab.
by Richard W.M. Jones 08 Dec '16

08 Dec '16

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

2 3

[PATCH v2 0/5] Import directly from OVA tar archive if possible
by Tomáš Golembiovský 07 Dec '16

07 Dec '16

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

3 19

[PATCH 0/3] Miscellaneous improvements to supermin.
by Richard W.M. Jones 07 Dec '16

07 Dec '16

Document what each module does, using *.mli files. Remove the --dtb option, it's obsolete. Rename modules according to their purpose. Rich.

2 5

[PATCH v3] v2v: -o vdsm: Add --vdsm-compat flag.
by Richard W.M. Jones 07 Dec '16

07 Dec '16

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.

2 4

[PATCH v2 0/2] Improve inspection of /usr filesystems
by Pino Toscano 07 Dec '16

07 Dec '16

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

2 3