From 2cc348448ae3a0ca2f68c36f78b5ae7aeecc80e7 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Thu, 8 Dec 2016 09:53:50 +0000 Subject: [PATCH] generator: Share Common_utils code. 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: (**) ... (**) 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/actions.ml | 10 ++- generator/bindtests.ml | 25 +++--- generator/c.ml | 53 ++++++------ generator/checks.ml | 5 +- generator/customize.ml | 3 +- generator/daemon.ml | 10 ++- generator/docstrings.ml | 3 +- generator/erlang.ml | 23 +++--- generator/errnostring.ml | 3 +- generator/events.ml | 1 + generator/fish.ml | 34 ++++---- generator/gobject.ml | 32 ++++---- generator/golang.ml | 9 +- generator/java.ml | 8 +- generator/lua.ml | 3 +- generator/ocaml.ml | 11 +-- generator/perl.ml | 11 +-- generator/php.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 +-------------- generator/xdr.ml | 5 +- mllib/common_utils.ml | 126 +++++++++++++++++++++++++--- mllib/common_utils.mli | 76 +++++++++++++++-- v2v/convert_windows.ml | 3 +- 32 files changed, 400 insertions(+), 383 deletions(-) diff --git a/.gitignore b/.gitignore index 633b39d38..da59e44fa 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 3df5171da..4026ee86d 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 31c33fad5..0c2ae33d3 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>\*)$$/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>\*)$$/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/actions.ml b/generator/actions.ml index 5e0356ff5..77fca20b0 100644 --- a/generator/actions.ml +++ b/generator/actions.ml @@ -18,6 +18,7 @@ (* Please read generator/README first. *) +open Common_utils open Types open Utils @@ -13584,17 +13585,18 @@ let test_functions, non_daemon_functions, daemon_functions = { f with c_name = f.name; c_function = "guestfs_" ^ f.name; - c_optarg_prefix = "GUESTFS_" ^ String.uppercase f.name } + c_optarg_prefix = "GUESTFS_" ^ String.uppercase_ascii f.name } | { style = _, _, (_::_); once_had_no_optargs = false } -> { f with c_name = f.name; c_function = "guestfs_" ^ f.name ^ "_argv"; - c_optarg_prefix = "GUESTFS_" ^ String.uppercase f.name } + c_optarg_prefix = "GUESTFS_" ^ String.uppercase_ascii f.name } | { style = _, _, (_::_); once_had_no_optargs = true } -> { f with c_name = f.name ^ "_opts"; c_function = "guestfs_" ^ f.name ^ "_opts_argv"; - c_optarg_prefix = "GUESTFS_" ^ String.uppercase f.name ^ "_OPTS"; + c_optarg_prefix = "GUESTFS_" ^ String.uppercase_ascii f.name + ^ "_OPTS"; non_c_aliases = [ f.name ^ "_opts" ] } in let test_functions = List.map make_c_function test_functions in @@ -13609,7 +13611,7 @@ let non_daemon_functions, daemon_functions = let make_camel_case name = List.fold_left ( fun a b -> - a ^ String.uppercase (Str.first_chars b 1) ^ Str.string_after b 1 + a ^ String.uppercase_ascii (Str.first_chars b 1) ^ Str.string_after b 1 ) "" (Str.split (Str.regexp "_") name) in let make_camel_case_if_not_set f = diff --git a/generator/bindtests.ml b/generator/bindtests.ml index 742cb1b71..ffb3ee726 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 6f5a517bd..79d381165 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/checks.ml b/generator/checks.ml index 6c65a9986..b7b409dd8 100644 --- a/generator/checks.ml +++ b/generator/checks.ml @@ -18,6 +18,7 @@ (* Please read generator/README first. *) +open Common_utils open Types open Utils open Actions @@ -155,7 +156,7 @@ let () = (* Check short descriptions. *) List.iter ( fun { name = name; shortdesc = shortdesc } -> - if shortdesc.[0] <> Char.lowercase shortdesc.[0] then + if shortdesc.[0] <> Char.lowercase_ascii shortdesc.[0] then failwithf "short description of %s should begin with lowercase." name; let c = shortdesc.[String.length shortdesc-1] in if c = '\n' || c = '.' then @@ -167,7 +168,7 @@ let () = fun { name = name; longdesc = longdesc } -> if longdesc.[String.length longdesc-1] = '\n' then failwithf "long description of %s should not end with \\n." name; - if longdesc.[0] <> Char.uppercase longdesc.[0] then + if longdesc.[0] <> Char.uppercase_ascii longdesc.[0] then failwithf "long description of %s should begin with uppercase." name ) (actions @ fish_commands); diff --git a/generator/customize.ml b/generator/customize.ml index 12c78a28f..129a46089 100644 --- a/generator/customize.ml +++ b/generator/customize.ml @@ -20,6 +20,7 @@ open Printf +open Common_utils open Docstrings open Pr @@ -1039,7 +1040,7 @@ let generate_customize_options_pod () = n, sprintf "B<--%s> %s" n v, ld ) flags in let cmp (arg1, _, _) (arg2, _, _) = - compare (String.lowercase arg1) (String.lowercase arg2) + compare (String.lowercase_ascii arg1) (String.lowercase_ascii arg2) in let pod = List.sort cmp pod in diff --git a/generator/daemon.ml b/generator/daemon.ml index ce5dada59..f05d5b717 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 9d3fd0ba0..845ec6321 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 In new code, use the L call instead. diff --git a/generator/erlang.ml b/generator/erlang.ml index fab92a005..375383558 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/errnostring.ml b/generator/errnostring.ml index 5033d2e05..d16a07ecd 100644 --- a/generator/errnostring.ml +++ b/generator/errnostring.ml @@ -20,6 +20,7 @@ open Printf +open Common_utils open Types open Utils open Pr @@ -190,7 +191,7 @@ let () = failwithf "%s: errno string does not begin with letter 'E' (%s)" file str; for i = 0 to len-1 do let c = str.[i] in - if Char.uppercase c <> c then + if Char.uppercase_ascii c <> c then failwithf "%s: errno string is not all uppercase (%s)" file str done in diff --git a/generator/events.ml b/generator/events.ml index c92c76014..7188e1203 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 62752e80c..9ef7a302b 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 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 in longdesc of function %s" name in - "L" + "L" ) 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 7ee73a669..e14ea2043 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/golang.ml b/generator/golang.ml index 3140dbbc8..fe74f446e 100644 --- a/generator/golang.ml +++ b/generator/golang.ml @@ -20,6 +20,7 @@ open Printf +open Common_utils open Types open Utils open Pr @@ -261,7 +262,7 @@ func return_hashtable (argv **C.char) map[string]string { List.iter ( fun ({ name = name; shortdesc = shortdesc; style = (ret, args, optargs) } as f) -> - let go_name = String.capitalize name in + let go_name = String.capitalize_ascii name in (* If it has optional arguments, pass them in a struct * after the required arguments. @@ -272,7 +273,7 @@ func return_hashtable (argv **C.char) map[string]string { pr "type Optargs%s struct {\n" go_name; List.iter ( fun optarg -> - let cn = String.capitalize (name_of_optargt optarg) in + let cn = String.capitalize_ascii (name_of_optargt optarg) in pr " /* %s field is ignored unless %s_is_set == true */\n" cn cn; pr " %s_is_set bool\n" cn; @@ -408,10 +409,10 @@ func return_hashtable (argv **C.char) map[string]string { List.iter ( fun optarg -> let n = name_of_optargt optarg in - let cn = String.capitalize n in + let cn = String.capitalize_ascii n in pr " if optargs.%s_is_set {\n" cn; pr " c_optargs.bitmask |= C.%s_%s_BITMASK\n" - f.c_optarg_prefix (String.uppercase n); + f.c_optarg_prefix (String.uppercase_ascii n); (match optarg with | OBool _ -> pr " if optargs.%s { c_optargs.%s = 1 } else { c_optargs.%s = 0}\n" cn n n diff --git a/generator/java.ml b/generator/java.ml index 260e28c9e..a68054cea 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 [] then doc ^ "\n\nOptional arguments are supplied in the final Map 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 d3b0b277a..e48bb3eff 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 f76a3ab32..5a85d380f 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 94d7c4f8d..290b68763 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.\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" in + let longdesc = String.replace longdesc "C" in pr "=item "; generate_perl_prototype name style; pr "\n\n"; diff --git a/generator/php.ml b/generator/php.ml index 415c4635b..ddd805eff 100644 --- a/generator/php.ml +++ b/generator/php.ml @@ -20,6 +20,7 @@ open Printf +open Common_utils open Types open Utils open Pr @@ -436,25 +437,25 @@ PHP_FUNCTION (guestfs_last_error) List.iter ( function | OBool n -> - let uc_n = String.uppercase n in + let uc_n = String.uppercase_ascii n in pr " if (optargs_t_%s != (zend_bool)-1) {\n" n; pr " optargs_s.%s = optargs_t_%s;\n" n n; pr " optargs_s.bitmask |= %s_%s_BITMASK;\n" c_optarg_prefix uc_n; pr " }\n" | OInt n | OInt64 n -> - let uc_n = String.uppercase n in + let uc_n = String.uppercase_ascii n in pr " if (optargs_t_%s != -1) {\n" n; pr " optargs_s.%s = optargs_t_%s;\n" n n; pr " optargs_s.bitmask |= %s_%s_BITMASK;\n" c_optarg_prefix uc_n; pr " }\n" | OString n -> - let uc_n = String.uppercase n in + let uc_n = String.uppercase_ascii n in pr " if (optargs_t_%s != NULL) {\n" n; pr " optargs_s.%s = optargs_t_%s;\n" n n; pr " optargs_s.bitmask |= %s_%s_BITMASK;\n" c_optarg_prefix uc_n; pr " }\n" | OStringList n -> - let uc_n = String.uppercase n in + let uc_n = String.uppercase_ascii n in pr " /* We've seen PHP give us a *long* here when we asked for an array, so\n"; pr " * positively check that it gave us an array, otherwise ignore it.\n"; pr " */\n"; @@ -514,7 +515,7 @@ PHP_FUNCTION (guestfs_last_error) function | OBool n | OInt n | OInt64 n | OString 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) != 0)\n" c_optarg_prefix uc_n; pr " guestfs_efree_stringlist ((char **) optargs_s.%s);\n" n; diff --git a/generator/pr.ml b/generator/pr.ml index 616e6f9dd..666cd416e 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 281fb0a77..1e24a5938 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 doc ^ sprintf "\n\nThis function depends on the feature C<%s>. See also C." 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 74d206f6c..0b7cbedf4 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 [] 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 21ef6e383..8b9892721 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 88e54b8b7..80b87392b 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 3e81433af..ba5e045ad 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 c7d3f2c6b..ae6f239bf 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/generator/xdr.ml b/generator/xdr.ml index 8bd168d71..1d8500267 100644 --- a/generator/xdr.ml +++ b/generator/xdr.ml @@ -20,6 +20,7 @@ open Printf +open Common_utils open Types open Utils open Pr @@ -177,9 +178,9 @@ let generate_xdr () = | [] -> () | { proc_nr = None } :: _ -> assert false | { name = shortname; proc_nr = Some proc_nr } :: [] -> - pr " GUESTFS_PROC_%s = %d\n" (String.uppercase shortname) proc_nr + pr " GUESTFS_PROC_%s = %d\n" (String.uppercase_ascii shortname) proc_nr | { name = shortname; proc_nr = Some proc_nr } :: rest -> - pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr; + pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase_ascii shortname) proc_nr; loop rest in loop (actions |> daemon_functions); diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml index 78618f5df..e1d1ab83a 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 .. are copied into the + * generator/common_utils.ml file. These parts must ONLY use + * functions from the OCaml stdlib. + *) +(**) open Printf +(**) 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" +(**) + 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,9 +190,48 @@ module String = struct make 1 c ) [1;2;3;4;5;6;7;8] ) -end -exception Executable_not_found of string (* executable *) + 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 let (//) = Filename.concat @@ -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" +(**) + (* 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 +(**) + 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 +(**) + (* 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 +(**) + (* 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 +(**) + (* 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 +(**) + (* 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 ) +(**) + (* 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 +(**) + 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 +(**) + 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 +(**) + (* 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 +(**) + 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 ad4334515..7b142d430 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 .. are copied into the + * generator/common_utils.ml file. These parts must ONLY use + * functions from the OCaml 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.) *) +(**) + 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 "]. *) +(**) + val read_whole_file : string -> string (** Read in the whole file as a string. *) +(**) + 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. *) +(**) + 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). *) +(**) + 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. *) +(**) + val unlink_on_exit : string -> unit (** Unlink a temporary file on exit. *) +(**) + val rmdir_on_exit : string -> unit (** Remove a temporary directory on exit (using [rm -rf]). *) @@ -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). *) +(**) + val is_block_device : string -> bool val is_char_device : string -> bool val is_directory : string -> bool (** These don't throw exceptions, unlike the [Sys] functions. *) +(**) + val is_partition : string -> bool (** Return true if the host device [dev] is a partition. If it's anything else, or missing, returns false. *) +(**) + 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. *) +(**) + 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 f8337a098..558caac9d 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