--- mllib/common_utils.ml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml index f8fa8fd..f9c45cc 100644 --- a/mllib/common_utils.ml +++ b/mllib/common_utils.ml @@ -20,8 +20,6 @@ open Printf open Common_gettext.Gettext -module G = Guestfs - let (//) = Filename.concat let ( +^ ) = Int64.add @@ -357,7 +355,7 @@ let run_main_and_handle_errors main = error (f_"%s: %s: %s") fname (Unix.error_message code) param | Sys_error msg -> (* from a syscall *) error (f_"%s") msg - | G.Error msg -> (* from libguestfs *) + | Guestfs.Error msg -> (* from libguestfs *) error (f_"libguestfs error: %s") msg | Failure msg -> (* from failwith/failwithf *) error (f_"failure: %s") msg -- 2.5.0

On Wed, Oct 07, 2015 at 01:25:57PM +0200, Pino Toscano wrote: Yup, but the one here isn't exported so can't be seen outside the module (and we wouldn't want that). On a per-.ml file, if you're using a lot of 'Guestfs.*' prefixes in that file, then feel free to declare 'module G = Guestfs' at the top of the same file. (The same goes for any other module that is used frequently) Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com virt-p2v converts physical machines to virtual machines. Boot with a live CD or over the network (PXE) and turn machines into KVM guests. http://libguestfs.org/virt-v2v

These functions come from upstream OCaml (4.03) where they were written by Gabriel Scherer under a compatible license. See also: http://caml.inria.fr/mantis/view.php?id=6694 http://caml.inria.fr/mantis/view.php?id=6695 --- mllib/common_utils.ml | 13 +++++++++++++ mllib/common_utils.mli | 6 ++++++ v2v/convert_windows.ml | 3 ++- v2v/utils.ml | 6 +++--- 4 files changed, 24 insertions(+), 4 deletions(-) diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml index f375317..97363df 100644 --- a/mllib/common_utils.ml +++ b/mllib/common_utils.ml @@ -22,10 +22,23 @@ open Common_gettext.Gettext module Char = struct include Char + + let lowercase_ascii c = + if (c >= 'A' && c <= 'Z') + then unsafe_chr (code c + 32) + else c + + let uppercase_ascii c = + if (c >= 'a' && c <= 'z') + then unsafe_chr (code c - 32) + else c end module String = struct include String + + let lowercase_ascii s = map Char.lowercase_ascii s + let uppercase_ascii s = map Char.uppercase_ascii s end let (//) = Filename.concat diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli index f42ae64..c0941f6 100644 --- a/mllib/common_utils.mli +++ b/mllib/common_utils.mli @@ -25,6 +25,9 @@ module Char : sig val lowercase : char -> char val unsafe_chr : int -> char val uppercase : char -> char + + val lowercase_ascii : char -> char + val uppercase_ascii : char -> char end (** Override the Char module from stdlib. *) @@ -58,6 +61,9 @@ module String : sig val unsafe_get : string -> int -> char val unsafe_set : string -> int -> char -> unit val uppercase : string -> string + + val lowercase_ascii : string -> string + val uppercase_ascii : string -> string end (** Override the String module from stdlib. *) diff --git a/v2v/convert_windows.ml b/v2v/convert_windows.ml index 67f5f25..ac281a0 100644 --- a/v2v/convert_windows.ml +++ b/v2v/convert_windows.ml @@ -170,7 +170,8 @@ let convert ~keep_serial_console (g : G.guestfs) inspect source = let len = String.length data in let data = if len >= 8 && - String.lowercase (String.sub data (len-8) 8) = "uninst.exe" then + String.lowercase_ascii (String.sub data (len-8) 8) = "uninst.exe" + then (String.sub data 0 (len-8)) ^ "_uninst.exe" else data in diff --git a/v2v/utils.ml b/v2v/utils.ml index 23d9e51..cdf7535 100644 --- a/v2v/utils.ml +++ b/v2v/utils.ml @@ -230,10 +230,10 @@ let find_virtio_win_drivers virtio_win = fun (path, original_source, basename, get_contents) -> try (* Lowercased path, since the ISO may contain upper or lowercase - * path elements. XXX This won't work if paths contain non-ASCII. + * path elements. *) - let lc_path = String.lowercase path in - let lc_basename = String.lowercase basename in + let lc_path = String.lowercase_ascii path in + let lc_basename = String.lowercase_ascii basename in let extension = match last_part_of lc_basename '.' with -- 2.5.0

This is just a straight refactoring. Various ad hoc string_* functions that appeared in Common_utils have been renamed and placed in the String.* namespace. The old vs "new" functions are: string_prefix -> String.is_prefix string_suffix -> String.is_suffix string_find -> String.find replace_str -> String.replace string_nsplit -> String.nsplit string_split -> String.split string_lines_split -> String.lines_split string_random8 -> String.random8 --- builder/checksums.ml | 2 +- builder/downloader.ml | 2 +- builder/index_parser.ml | 4 +- builder/paths.ml | 2 +- builder/sigchecker.ml | 12 +- customize/customize_run.ml | 2 +- customize/hostname.ml | 2 +- customize/password.ml | 2 +- customize/ssh_key.ml | 2 +- customize/subscription_manager.ml | 4 +- dib/cmdline.ml | 4 +- dib/dib.ml | 12 +- dib/elements.ml | 2 +- dib/utils.ml | 8 +- generator/customize.ml | 10 +- get-kernel/get_kernel.ml | 2 +- mllib/common_utils.ml | 213 +++++++++++++++--------------- mllib/common_utils.mli | 34 +++-- mllib/common_utils_tests.ml | 32 ++--- sparsify/copying.ml | 6 +- sparsify/in_place.ml | 2 +- sysprep/main.ml | 8 +- sysprep/sysprep_operation_net_hostname.ml | 2 +- sysprep/sysprep_operation_net_hwaddr.ml | 2 +- sysprep/sysprep_operation_user_account.ml | 2 +- v2v/OVF.ml | 14 +- v2v/cmdline.ml | 6 +- v2v/convert_linux.ml | 40 +++--- v2v/convert_windows.ml | 2 +- v2v/input_libvirt_vcenter_https.ml | 4 +- v2v/input_libvirtxml.ml | 8 +- v2v/input_ova.ml | 4 +- v2v/linux.ml | 4 +- v2v/output_qemu.ml | 4 +- v2v/output_rhev.ml | 4 +- v2v/output_vdsm.ml | 2 +- v2v/test-harness/v2v_test_harness.ml | 2 +- v2v/utils.ml | 16 +-- v2v/v2v.ml | 2 +- 39 files changed, 246 insertions(+), 239 deletions(-) diff --git a/builder/checksums.ml b/builder/checksums.ml index 5663832..31d3cb3 100644 --- a/builder/checksums.ml +++ b/builder/checksums.ml @@ -49,7 +49,7 @@ let verify_checksum csum filename = | [] -> error (f_"%s did not return any output") prog | line :: _ -> - let csum_actual = fst (string_split " " line) in + let csum_actual = fst (String.split " " line) in if csum_ref <> csum_actual then error (f_"%s checksum of template did not match the expected checksum!\n found checksum: %s\n expected checksum: %s\nTry:\n - Use the '-v' option and look for earlier error messages.\n - Delete the cache: virt-builder --delete-cache\n - Check no one has tampered with the website or your network!") (string_of_csum_t csum) csum_actual csum_ref diff --git a/builder/downloader.ml b/builder/downloader.ml index 46581cb..8aa10d3 100644 --- a/builder/downloader.ml +++ b/builder/downloader.ml @@ -79,7 +79,7 @@ and download_to t ?(progress_bar = false) ~proxy uri filename = * fails, we download to a random name in the cache and then * atomically rename it to the final filename. *) - let filename_new = filename ^ "." ^ string_random8 () in + let filename_new = filename ^ "." ^ String.random8 () in unlink_on_exit filename_new; (match parseduri.URI.protocol with diff --git a/builder/index_parser.ml b/builder/index_parser.ml index 2c78fd9..d232a3a 100644 --- a/builder/index_parser.ml +++ b/builder/index_parser.ml @@ -165,7 +165,7 @@ let get_index ~downloader ~sigchecker corrupt_file () in let aliases = let l = - try string_nsplit " " (List.assoc ("aliases", None) fields) + try String.nsplit " " (List.assoc ("aliases", None) fields) with Not_found -> [] in match l with | [] -> None @@ -209,7 +209,7 @@ let get_index ~downloader ~sigchecker eprintf (f_"%s: zero length path in the index file\n") prog; corrupt_file () ) - else if string_find path "://" >= 0 then ( + else if String.find path "://" >= 0 then ( eprintf (f_"%s: cannot use a URI ('%s') in the index file\n") prog path; corrupt_file () ) diff --git a/builder/paths.ml b/builder/paths.ml index 2b131c0..cbd9d4b 100644 --- a/builder/paths.ml +++ b/builder/paths.ml @@ -36,6 +36,6 @@ let xdg_config_dirs () = let dirs = try Sys.getenv "XDG_CONFIG_DIRS" with Not_found -> "/etc/xdg" in - let dirs = string_nsplit ":" dirs in + let dirs = String.nsplit ":" dirs in let dirs = List.filter (fun x -> x <> "") dirs in List.map (fun x -> x // prog) dirs diff --git a/builder/sigchecker.ml b/builder/sigchecker.ml index 42d55cd..77dc36a 100644 --- a/builder/sigchecker.ml +++ b/builder/sigchecker.ml @@ -44,12 +44,12 @@ let import_keyfile ~gpg ~gpghome ?(trust = true) keyfile = if r <> 0 then error (f_"could not import public key\nUse the '-v' option and look for earlier error messages."); let status = read_whole_file status_file in - let status = string_nsplit "\n" status in + let status = String.nsplit "\n" status in let key_id = ref "" in let fingerprint = ref "" in List.iter ( fun line -> - let line = string_nsplit " " line in + let line = String.nsplit " " line in match line with | "[GNUPG:]" :: "IMPORT_OK" :: _ :: fp :: _ -> fingerprint := fp | "[GNUPG:]" :: "IMPORTED" :: key :: _ -> key_id := key @@ -75,7 +75,7 @@ let import_keyfile ~gpg ~gpghome ?(trust = true) keyfile = let subkeys = ref [] in List.iter ( fun line -> - let line = string_nsplit ":" line in + let line = String.nsplit ":" line in match line with | "sub" :: ("u"|"-") :: _ :: _ :: id :: _ -> current := Some id @@ -83,7 +83,7 @@ let import_keyfile ~gpg ~gpghome ?(trust = true) keyfile = (match !current with | None -> () | Some k -> - if string_suffix id k then ( + if String.is_suffix id k then ( subkeys := id :: !subkeys; ); current := None @@ -216,11 +216,11 @@ and do_verify ?(verify_only = true) t args = (* Check the fingerprint is who it should be. *) let status = read_whole_file status_file in - let status = string_nsplit "\n" status in + let status = String.nsplit "\n" status in let fingerprint = ref "" in List.iter ( fun line -> - let line = string_nsplit " " line in + let line = String.nsplit " " line in match line with | "[GNUPG:]" :: "VALIDSIG" :: fp :: _ -> fingerprint := fp | _ -> () diff --git a/customize/customize_run.ml b/customize/customize_run.ml index 6cb2328..da3a906 100644 --- a/customize/customize_run.ml +++ b/customize/customize_run.ml @@ -171,7 +171,7 @@ exec >>%s 2>&1 (* If the mode string is octal, add the OCaml prefix for octal values * so it is properly converted as octal integer. *) - let mode = if string_prefix mode "0" then "0o" ^ mode else mode in + let mode = if String.is_prefix mode "0" then "0o" ^ mode else mode in g#chmod (int_of_string mode) path | `Command cmd -> diff --git a/customize/hostname.ml b/customize/hostname.ml index 5721e1a..621d4f3 100644 --- a/customize/hostname.ml +++ b/customize/hostname.ml @@ -69,7 +69,7 @@ and replace_line_in_file g filename key value = if g#is_file filename then ( let lines = Array.to_list (g#read_lines filename) in let lines = List.filter ( - fun line -> not (string_prefix line (key ^ "=")) + fun line -> not (String.is_prefix line (key ^ "=")) ) lines in let lines = lines @ [sprintf "%s=%s" key value] in String.concat "\n" lines ^ "\n" diff --git a/customize/password.ml b/customize/password.ml index f6d37cf..d683740 100644 --- a/customize/password.ml +++ b/customize/password.ml @@ -51,7 +51,7 @@ let password_crypto_of_string = function error (f_"password-crypto: unknown algorithm %s, use \"md5\", \"sha256\" or \"sha512\"") arg let rec parse_selector arg = - parse_selector_list arg (string_nsplit ":" arg) + parse_selector_list arg (String.nsplit ":" arg) and parse_selector_list orig_arg = function | [ "lock"|"locked" ] -> diff --git a/customize/ssh_key.ml b/customize/ssh_key.ml index dd6056f..a4e4a51 100644 --- a/customize/ssh_key.ml +++ b/customize/ssh_key.ml @@ -33,7 +33,7 @@ type ssh_key_selector = | KeyString of string let rec parse_selector arg = - parse_selector_list arg (string_nsplit ":" arg) + parse_selector_list arg (String.nsplit ":" arg) and parse_selector_list orig_arg = function | [] | [ "" ] -> diff --git a/customize/subscription_manager.ml b/customize/subscription_manager.ml index c9828d6..1e6e25d 100644 --- a/customize/subscription_manager.ml +++ b/customize/subscription_manager.ml @@ -29,7 +29,7 @@ type sm_pool = | PoolId of string let rec parse_credentials_selector arg = - parse_credentials_selector_list arg (string_nsplit ":" arg) + parse_credentials_selector_list arg (String.nsplit ":" arg) and parse_credentials_selector_list orig_arg = function | [ username; "password"; password ] -> @@ -40,7 +40,7 @@ and parse_credentials_selector_list orig_arg = function error (f_"invalid sm-credentials selector '%s'; see the man page") orig_arg let rec parse_pool_selector arg = - parse_pool_selector_list arg (string_nsplit ":" arg) + parse_pool_selector_list arg (String.nsplit ":" arg) and parse_pool_selector_list orig_arg = function | [ "auto" ] -> diff --git a/dib/cmdline.ml b/dib/cmdline.ml index e2f2ded..4aa6a53 100644 --- a/dib/cmdline.ml +++ b/dib/cmdline.ml @@ -78,7 +78,7 @@ read the man page virt-dib(1). let formats = ref ["qcow2"] in let set_format arg = - let fmts = remove_dups (string_nsplit "," arg) in + let fmts = remove_dups (String.nsplit "," arg) in List.iter ( function | "qcow2" | "tar" | "raw" | "vhd" -> () @@ -123,7 +123,7 @@ read the man page virt-dib(1). let extra_packages = ref [] in let append_extra_packages arg = - extra_packages := List.rev (string_nsplit "," arg) @ !extra_packages in + extra_packages := List.rev (String.nsplit "," arg) @ !extra_packages in let argspec = [ "-p", Arg.String append_element_path, "path" ^ " " ^ s_"Add new a elements location"; diff --git a/dib/dib.ml b/dib/dib.ml index 16149ae..caf13f2 100644 --- a/dib/dib.ml +++ b/dib/dib.ml @@ -37,7 +37,7 @@ let exclude_elements elements = function let read_envvars envvars = filter_map ( fun var -> - let i = string_find var "=" in + let i = String.find var "=" in if i = -1 then ( try Some (var, Sys.getenv var) with Not_found -> None @@ -49,7 +49,7 @@ let read_envvars envvars = let read_dib_envvars () = let vars = Array.to_list (Unix.environment ()) in - let vars = List.filter (fun x -> string_prefix x "DIB_") vars in + let vars = List.filter (fun x -> String.is_prefix x "DIB_") vars in let vars = List.map (fun x -> x ^ "\n") vars in String.concat "" vars @@ -684,7 +684,7 @@ let main () = (match partitions with | [] -> "/dev/sdc" | p -> - let p = List.filter (fun x -> string_prefix x "/dev/sdc") p in + let p = List.filter (fun x -> String.is_prefix x "/dev/sdc") p in if p = [] then error (f_"no partitions found in the helper drive"); List.hd p @@ -724,7 +724,7 @@ let main () = *) let run_losetup device = let lines = g#debug "sh" [| "losetup"; "--show"; "-f"; device |] in - let lines = string_nsplit "\n" lines in + let lines = String.nsplit "\n" lines in let lines = List.filter ((<>) "") lines in (match lines with | [] -> device @@ -734,7 +734,7 @@ let main () = let run_hook_out_eval hook envvar = let lines = run_hook ~sysroot:Out ~blockdev g hook in - let lines = string_nsplit "\n" lines in + let lines = String.nsplit "\n" lines in let lines = List.filter ((<>) "") lines in if lines = [] then None else (try Some (var_from_lines envvar lines) with _ -> None) in @@ -777,7 +777,7 @@ let main () = ignore (g#debug "sh" (Array.of_list ([ "mkfs" ] @ mkfs_options))); g#set_label blockdev root_label; (match fs_type with - | x when string_prefix x "ext" -> g#set_uuid blockdev rootfs_uuid + | x when String.is_prefix x "ext" -> g#set_uuid blockdev rootfs_uuid | _ -> ()); g#mount blockdev "/"; g#mkmountpoint "/tmp"; diff --git a/dib/elements.ml b/dib/elements.ml index 551e174..d1b0abb 100644 --- a/dib/elements.ml +++ b/dib/elements.ml @@ -107,7 +107,7 @@ let load_dependencies elements loaded_elements = let path = path // filename in if Sys.file_exists path then ( let lines = read_whole_file path in - let lines = string_nsplit "\n" lines in + let lines = String.nsplit "\n" lines in let lines = List.filter ((<>) "") lines in stringset_of_list lines ) else diff --git a/dib/utils.ml b/dib/utils.ml index 34705f7..835da88 100644 --- a/dib/utils.ml +++ b/dib/utils.ml @@ -33,7 +33,7 @@ let current_arch () = match Config.host_cpu with | "amd64" | "x86_64" -> "amd64" | "i386" | "i486" | "i586" | "i686" -> "i386" - | arch when string_prefix arch "armv" -> "armhf" + | arch when String.is_prefix arch "armv" -> "armhf" | arch -> arch let output_filename image_name = function @@ -47,12 +47,12 @@ let log_filename () = let var_from_lines var lines = let var_with_equal = var ^ "=" in - let var_lines = List.filter (fun x -> string_prefix x var_with_equal) lines in + let var_lines = List.filter (fun x -> String.is_prefix x var_with_equal) lines in match var_lines with | [] -> error (f_"variable '%s' not found in lines:\n%s") var (String.concat "\n" lines) - | [x] -> snd (string_split "=" x) + | [x] -> snd (String.split "=" x) | _ -> error (f_"variable '%s' has more than one occurrency in lines:\n%s") var (String.concat "\n" lines) @@ -98,7 +98,7 @@ let rec remove_dups = function | x :: xs -> x :: (remove_dups (List.filter ((<>) x) xs)) let which tool = - let paths = string_nsplit ":" (Sys.getenv "PATH") in + let paths = String.nsplit ":" (Sys.getenv "PATH") in let paths = filter_map ( fun p -> let path = p // tool in diff --git a/generator/customize.ml b/generator/customize.ml index 2196e9e..b3d83af 100644 --- a/generator/customize.ml +++ b/generator/customize.ml @@ -609,10 +609,10 @@ let rec argspec () = String.sub arg 0 i, String.sub arg (i+1) (len-(i+1)) in let split_string_list arg = - string_nsplit \",\" arg + String.nsplit \",\" arg in let split_links_list option_name arg = - match string_nsplit \":\" arg with + match String.nsplit \":\" arg with | [] | [_] -> error (f_\"invalid format for '--%%s' parameter, see the man page\") option_name @@ -707,7 +707,7 @@ let rec argspec () = pr " \"--%s\",\n" name; pr " Arg.String (\n"; pr " fun s ->\n"; - pr " let user, selstr = string_split \":\" s in\n"; + pr " let user, selstr = String.split \":\" s in\n"; pr " let sel = Ssh_key.parse_selector selstr in\n"; pr " ops := %s (user, sel) :: !ops\n" discrim; pr " ),\n"; @@ -802,12 +802,12 @@ let rec argspec () = pr " ] in let lines = read_whole_file filename in - let lines = string_lines_split lines in + let lines = String.lines_split lines in let lines = List.filter ( fun line -> String.length line > 0 && line.[0] <> '#' ) lines in - let cmds = List.map (fun line -> string_split \" \" line) lines in + let cmds = List.map (fun line -> String.split \" \" line) lines in (* Check for commands not allowed in files containing commands. *) List.iter ( fun (cmd, _) -> diff --git a/get-kernel/get_kernel.ml b/get-kernel/get_kernel.ml index 8786bf3..2bea559 100644 --- a/get-kernel/get_kernel.ml +++ b/get-kernel/get_kernel.ml @@ -198,7 +198,7 @@ let main () = let dest_filename fn = let fn = Filename.basename fn in let fn = - if unversioned then fst (string_split "-" fn) + if unversioned then fst (String.split "-" fn) else fn in match prefix with | None -> fn diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml index 97363df..27bba5c 100644 --- a/mllib/common_utils.ml +++ b/mllib/common_utils.ml @@ -39,6 +39,106 @@ module String = struct let lowercase_ascii s = map Char.lowercase_ascii s let uppercase_ascii s = map Char.uppercase_ascii s + + let is_prefix str prefix = + let n = length prefix in + length str >= n && sub str 0 n = prefix + + let is_suffix str suffix = + let sufflen = length suffix + and len = length str in + len >= sufflen && sub str (len - sufflen) sufflen = suffix + + let rec find s sub = + let len = length s in + let sublen = 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 s s1 s2 = + let len = length s in + let sublen = length s1 in + let i = find s s1 in + if i = -1 then s + else ( + let s' = sub s 0 i in + let s'' = sub s (i+sublen) (len-i-sublen) in + s' ^ s2 ^ replace s'' s1 s2 + ) + + let rec nsplit sep str = + let len = length str in + let seplen = length sep in + let i = find str sep in + if i = -1 then [str] + else ( + let s' = sub str 0 i in + let s'' = sub str (i+seplen) (len-i-seplen) in + s' :: nsplit sep s'' + ) + + let split sep str = + let len = length sep in + let seplen = length str in + let i = find str sep in + if i = -1 then str, "" + else ( + sub str 0 i, sub str (i + len) (seplen - i - len) + ) + + let rec lines_split str = + let buf = Buffer.create 16 in + let len = length str in + let rec loop start len = + try + let i = index_from str start '\n' in + if i > 0 && str.[i-1] = '\\' then ( + Buffer.add_substring buf str start (i-start-1); + Buffer.add_char buf '\n'; + loop (i+1) len + ) else ( + Buffer.add_substring buf str start (i-start); + i+1 + ) + with Not_found -> + if len > 0 && str.[len-1] = '\\' then ( + Buffer.add_substring buf str start (len-start-1); + Buffer.add_char buf '\n' + ) else + Buffer.add_substring buf str start (len-start); + len+1 + in + let endi = loop 0 len in + let line = Buffer.contents buf in + if endi > len then + [line] + else + line :: lines_split (sub str endi (len-endi)) + + let random8 = + let chars = "abcdefghijklmnopqrstuvwxyz0123456789" in + fun () -> + concat "" ( + List.map ( + fun _ -> + let c = Random.int 36 in + let c = chars.[c] in + make 1 c + ) [1;2;3;4;5;6;7;8] + ) end let (//) = Filename.concat @@ -123,114 +223,6 @@ 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 string_prefix str prefix = - let n = String.length prefix in - String.length str >= n && String.sub str 0 n = prefix - -let string_suffix str suffix = - let sufflen = String.length suffix - and len = String.length str in - len >= sufflen && String.sub str (len - sufflen) sufflen = suffix - -let rec string_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 = string_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 - ) - -(* Split a string into multiple strings at each separator. *) -let rec string_nsplit sep str = - let len = String.length str in - let seplen = String.length sep in - let i = string_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_nsplit sep s'' - ) - -(* Split a string at the first occurrence of the separator, returning - * the part before and the part after. If separator is not found, - * return the whole string and an empty string. - *) -let string_split sep str = - let len = String.length sep in - let seplen = String.length str in - let i = string_find str sep in - - if i = -1 then str, "" - else ( - String.sub str 0 i, String.sub str (i + len) (seplen - i - len) - ) - -let string_random8 = - let chars = "abcdefghijklmnopqrstuvwxyz0123456789" in - fun () -> - String.concat "" ( - List.map ( - fun _ -> - let c = Random.int 36 in - let c = chars.[c] in - String.make 1 c - ) [1;2;3;4;5;6;7;8] - ) - -(* Split a string into lines, keeping continuation characters - * (i.e. \ at the end of lines) into account. *) -let rec string_lines_split str = - let buf = Buffer.create 16 in - let len = String.length str in - let rec loop start len = - try - let i = String.index_from str start '\n' in - if i > 0 && str.[i-1] = '\\' then ( - Buffer.add_substring buf str start (i-start-1); - Buffer.add_char buf '\n'; - loop (i+1) len - ) else ( - Buffer.add_substring buf str start (i-start); - i+1 - ) - with Not_found -> - if len > 0 && str.[len-1] = '\\' then ( - Buffer.add_substring buf str start (len-start-1); - Buffer.add_char buf '\n' - ) else - Buffer.add_substring buf str start (len-start); - len+1 - in - let endi = loop 0 len in - let line = Buffer.contents buf in - if endi > len then - [line] - else - line :: string_lines_split (String.sub str endi (len-endi)) - (* Drop elements from a list while a predicate is true. *) let rec dropwhile f = function | [] -> [] @@ -527,14 +519,15 @@ let long_options = ref ([] : (Arg.key * Arg.spec * Arg.doc) list) let display_short_options () = List.iter ( fun (arg, _, _) -> - if string_prefix arg "-" && not (string_prefix arg "--") then + if String.is_prefix arg "-" && not (String.is_prefix arg "--") then printf "%s\n" arg ) !long_options; exit 0 let display_long_options () = List.iter ( fun (arg, _, _) -> - if string_prefix arg "--" && arg <> "--long-options" && arg <> "--short-options" then + if String.is_prefix arg "--" && arg <> "--long-options" && + arg <> "--short-options" then printf "%s\n" arg ) !long_options; exit 0 diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli index 8083d8d..0b005ef 100644 --- a/mllib/common_utils.mli +++ b/mllib/common_utils.mli @@ -58,6 +58,30 @@ module String : sig val lowercase_ascii : string -> string val uppercase_ascii : string -> string + + val is_prefix : string -> string -> bool + (** [is_prefix str prefix] returns true if [prefix] is a prefix of [str]. *) + val is_suffix : string -> string -> bool + (** [is_suffix str suffix] returns true if [suffix] is a suffix of [str]. *) + val find : string -> string -> int + (** [find str sub] searches for [sub] as a substring of [str]. If + found it returns the index. If not found, it returns [-1]. *) + val replace : string -> string -> string -> string + (** [replace str s1 s2] replaces all instances of [s1] appearing in + [str] with [s2]. *) + val nsplit : string -> string -> string list + (** [nsplit sep str] splits [str] into multiple strings at each + separator [sep]. *) + val split : string -> string -> string * string + (** [split sep str] splits [str] at the first occurrence of the + separator [sep], returning the part before and the part after. + If separator is not found, return the whole string and an + empty string. *) + val lines_split : string -> string list + (** [lines_split str] splits [str] into lines, keeping continuation + characters (i.e. [\] at the end of lines) into account. *) + val random8 : unit -> string + (** Return a string of 8 random printable characters. *) end (** Override the String module from stdlib. *) @@ -86,16 +110,6 @@ val wrap : ?chan:out_channel -> ?indent:int -> string -> unit val output_spaces : out_channel -> int -> unit (** Write [n] spaces to [out_channel]. *) -val string_prefix : string -> string -> bool -val string_suffix : string -> string -> bool -val string_find : string -> string -> int -val replace_str : string -> string -> string -> string -val string_nsplit : string -> string -> string list -val string_split : string -> string -> string * string -val string_random8 : unit -> string -val string_lines_split : string -> string list -(** Various string functions. *) - val dropwhile : ('a -> bool) -> 'a list -> 'a list val takewhile : ('a -> bool) -> 'a list -> 'a list val filter_map : ('a -> 'b option) -> 'a list -> 'b list diff --git a/mllib/common_utils_tests.ml b/mllib/common_utils_tests.ml index 6bfc7e1..e3fb5af 100644 --- a/mllib/common_utils_tests.ml +++ b/mllib/common_utils_tests.ml @@ -84,21 +84,21 @@ let test_human_size ctx = assert_equal_string "3.4G" (human_size 3650722201_L); assert_equal_string "-3.4G" (human_size (-3650722201_L)) -(* Test Common_utils.string_prefix. *) -let test_string_prefix ctx = - assert_bool "string_prefix,," (string_prefix "" ""); - assert_bool "string_prefix,foo," (string_prefix "foo" ""); - assert_bool "string_prefix,foo,foo" (string_prefix "foo" "foo"); - assert_bool "string_prefix,foo123,foo" (string_prefix "foo123" "foo"); - assert_bool "not (string_prefix,,foo" (not (string_prefix "" "foo")) +(* Test Common_utils.String.is_prefix. *) +let test_String.is_prefix ctx = + assert_bool "String.is_prefix,," (String.is_prefix "" ""); + assert_bool "String.is_prefix,foo," (String.is_prefix "foo" ""); + assert_bool "String.is_prefix,foo,foo" (String.is_prefix "foo" "foo"); + assert_bool "String.is_prefix,foo123,foo" (String.is_prefix "foo123" "foo"); + assert_bool "not (String.is_prefix,,foo" (not (String.is_prefix "" "foo")) -(* Test Common_utils.string_suffix. *) -let test_string_suffix ctx = - assert_bool "string_suffix,," (string_suffix "" ""); - assert_bool "string_suffix,foo," (string_suffix "foo" ""); - assert_bool "string_suffix,foo,foo" (string_suffix "foo" "foo"); - assert_bool "string_suffix,123foo,foo" (string_suffix "123foo" "foo"); - assert_bool "not string_suffix,,foo" (not (string_suffix "" "foo")) +(* Test Common_utils.String.is_suffix. *) +let test_String.is_suffix ctx = + assert_bool "String.is_suffix,," (String.is_suffix "" ""); + assert_bool "String.is_suffix,foo," (String.is_suffix "foo" ""); + assert_bool "String.is_suffix,foo,foo" (String.is_suffix "foo" "foo"); + assert_bool "String.is_suffix,123foo,foo" (String.is_suffix "123foo" "foo"); + assert_bool "not String.is_suffix,,foo" (not (String.is_suffix "" "foo")) (* Test Common_utils.string_find. *) let test_string_find ctx = @@ -132,8 +132,8 @@ let suite = "numeric.le32" >:: test_le32; "sizes.parse_resize" >:: test_parse_resize; "sizes.human_size" >:: test_human_size; - "strings.prefix" >:: test_string_prefix; - "strings.suffix" >:: test_string_suffix; + "strings.prefix" >:: test_String.is_prefix; + "strings.suffix" >:: test_String.is_suffix; "strings.find" >:: test_string_find; "strings.string_lines_split" >:: test_string_lines_split; ] diff --git a/sparsify/copying.ml b/sparsify/copying.ml index 80d7c9d..ef196f6 100644 --- a/sparsify/copying.ml +++ b/sparsify/copying.ml @@ -75,7 +75,7 @@ let run indisk outdisk check_tmpdir compress convert | None -> Directory Filename.temp_dir_name (* $TMPDIR or /tmp *) | Some dir when is_directory dir -> Directory dir | Some dev when is_block_device dev -> Block_device dev - | Some file when string_prefix file "prebuilt:" -> + | Some file when String.is_prefix file "prebuilt:" -> let file = String.sub file 9 (String.length file - 9) in if not (Sys.file_exists file) then error (f_"--tmp prebuilt:file: %s: file does not exist") file; @@ -224,7 +224,7 @@ You can ignore this warning or change it to a hard failure using the if is_btrfs then ( try let vol_info = g#btrfs_subvolume_show mp in - string_find (List.assoc "Flags" vol_info) "readonly" <> -1 + String.find (List.assoc "Flags" vol_info) "readonly" <> -1 with G.Error _ -> false ) else false with Not_found -> false @@ -295,7 +295,7 @@ You can ignore this warning or change it to a hard failure using the List.iter ( fun vg -> if not (List.mem vg ignores) then ( - let lvname = string_random8 () in + let lvname = String.random8 () in let lvdev = "/dev/" ^ vg ^ "/" ^ lvname in let created = diff --git a/sparsify/in_place.ml b/sparsify/in_place.ml index 131f8b1..36100de 100644 --- a/sparsify/in_place.ml +++ b/sparsify/in_place.ml @@ -126,7 +126,7 @@ and perform g disk format ignores machine_readable zeroes = List.iter ( fun vg -> if not (List.mem vg ignores) then ( - let lvname = string_random8 () in + let lvname = String.random8 () in let lvdev = "/dev/" ^ vg ^ "/" ^ lvname in let created = diff --git a/sysprep/main.ml b/sysprep/main.ml index bd3eb4d..411c595 100644 --- a/sysprep/main.ml +++ b/sysprep/main.ml @@ -72,7 +72,7 @@ let main () = error (f_"--enable option can only be given once"); if ops = "" then error (f_"you cannot pass an empty argument to --enable"); - let ops = string_nsplit "," ops in + let ops = String.nsplit "," ops in let opset = List.fold_left ( fun opset op_name -> try Sysprep_operation.add_to_set op_name opset @@ -86,11 +86,11 @@ let main () = | Some x -> x | None -> Sysprep_operation.empty_set in - let ops = string_nsplit "," op_string in + let ops = String.nsplit "," op_string in let opset = List.fold_left ( fun opset op_name -> let op = - if string_prefix op_name "-" then + if String.is_prefix op_name "-" then `Remove (String.sub op_name 1 (String.length op_name - 1)) else `Add op_name in @@ -205,7 +205,7 @@ read the man page virt-sysprep(1). *) let mount_opts = !mount_opts in let mount_opts = - List.map (string_split ":") (string_nsplit ";" mount_opts) in + List.map (String.split ":") (String.nsplit ";" mount_opts) in let mount_opts mp = assoc ~default:"" mp mount_opts in message (f_"Examining the guest ..."); diff --git a/sysprep/sysprep_operation_net_hostname.ml b/sysprep/sysprep_operation_net_hostname.ml index bc99662..9b13ffd 100644 --- a/sysprep/sysprep_operation_net_hostname.ml +++ b/sysprep/sysprep_operation_net_hostname.ml @@ -33,7 +33,7 @@ let net_hostname_perform g root side_effects = (* Replace HOSTNAME=... entry. *) let lines = Array.to_list (g#read_lines filename) in let lines = List.filter ( - fun line -> not (string_prefix line "HOSTNAME=") + fun line -> not (String.is_prefix line "HOSTNAME=") ) lines in let file = String.concat "\n" lines ^ "\n" in g#write filename file; diff --git a/sysprep/sysprep_operation_net_hwaddr.ml b/sysprep/sysprep_operation_net_hwaddr.ml index fbf0a33..9052fcb 100644 --- a/sysprep/sysprep_operation_net_hwaddr.ml +++ b/sysprep/sysprep_operation_net_hwaddr.ml @@ -33,7 +33,7 @@ let net_hwaddr_perform g root side_effects = (* Replace HWADDR=... entry. *) let lines = Array.to_list (g#read_lines filename) in let lines = List.filter ( - fun line -> not (string_prefix line "HWADDR=") + fun line -> not (String.is_prefix line "HWADDR=") ) lines in let file = String.concat "\n" lines ^ "\n" in g#write filename file; diff --git a/sysprep/sysprep_operation_user_account.ml b/sysprep/sysprep_operation_user_account.ml index 78c60d0..e71d5ea 100644 --- a/sysprep/sysprep_operation_user_account.ml +++ b/sysprep/sysprep_operation_user_account.ml @@ -31,7 +31,7 @@ module StringSet = Set.Make (String) let remove_users = ref StringSet.empty let keep_users = ref StringSet.empty let add_users set users = - let users = string_nsplit "," users in + let users = String.nsplit "," users in List.iter ( function | "" -> diff --git a/v2v/OVF.ml b/v2v/OVF.ml index 56f529a..17008ee 100644 --- a/v2v/OVF.ml +++ b/v2v/OVF.ml @@ -50,7 +50,7 @@ let iso_time = let get_vmtype = function | { i_type = "linux"; i_distro = "rhel"; i_major_version = major; i_product_name = product } - when major >= 5 && string_find product "Server" >= 0 -> + when major >= 5 && String.find product "Server" >= 0 -> Server | { i_type = "linux"; i_distro = "rhel"; i_major_version = major } @@ -59,12 +59,12 @@ let get_vmtype = function | { i_type = "linux"; i_distro = "rhel"; i_major_version = major; i_product_name = product } - when major >= 3 && string_find product "ES" >= 0 -> + when major >= 3 && String.find product "ES" >= 0 -> Server | { i_type = "linux"; i_distro = "rhel"; i_major_version = major; i_product_name = product } - when major >= 3 && string_find product "AS" >= 0 -> + when major >= 3 && String.find product "AS" >= 0 -> Server | { i_type = "linux"; i_distro = "rhel"; i_major_version = major } @@ -77,21 +77,21 @@ let get_vmtype = function Desktop (* Windows XP *) | { i_type = "windows"; i_major_version = 5; i_minor_version = 2; - i_product_name = product } when string_find product "XP" >= 0 -> + i_product_name = product } when String.find product "XP" >= 0 -> Desktop (* Windows XP *) | { i_type = "windows"; i_major_version = 5; i_minor_version = 2 } -> Server (* Windows 2003 *) | { i_type = "windows"; i_major_version = 6; i_minor_version = 0; - i_product_name = product } when string_find product "Server" >= 0 -> + i_product_name = product } when String.find product "Server" >= 0 -> Server (* Windows 2008 *) | { i_type = "windows"; i_major_version = 6; i_minor_version = 0 } -> Desktop (* Vista *) | { i_type = "windows"; i_major_version = 6; i_minor_version = 1; - i_product_name = product } when string_find product "Server" >= 0 -> + i_product_name = product } when String.find product "Server" >= 0 -> Server (* Windows 2008R2 *) | { i_type = "windows"; i_major_version = 6; i_minor_version = 1 } -> @@ -136,7 +136,7 @@ and get_ostype = function "WindowsXP" (* no architecture differentiation of XP on RHEV *) | { i_type = "windows"; i_major_version = 5; i_minor_version = 2; - i_product_name = product } when string_find product "XP" >= 0 -> + i_product_name = product } when String.find product "XP" >= 0 -> "WindowsXP" (* no architecture differentiation of XP on RHEV *) | { i_type = "windows"; i_major_version = 5; i_minor_version = 2; diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml index 726d2e7..3e04c48 100644 --- a/v2v/cmdline.ml +++ b/v2v/cmdline.ml @@ -68,7 +68,7 @@ let parse_cmdline () = let network_map = ref [] in let add_network, add_bridge = let add t str = - match string_split ":" str with + match String.split ":" str with | "", "" -> error (f_"invalid --bridge or --network parameter") | out, "" | "", out -> network_map := ((t, ""), out) :: !network_map | in_, out -> network_map := ((t, in_), out) :: !network_map @@ -86,7 +86,7 @@ let parse_cmdline () = *) no_trim := ["*"] | mps -> - let mps = string_nsplit "," mps in + let mps = String.nsplit "," mps in List.iter ( fun mp -> if String.length mp = 0 then @@ -126,7 +126,7 @@ let parse_cmdline () = | "ask" -> root_choice := `Ask | "single" -> root_choice := `Single | "first" -> root_choice := `First - | dev when string_prefix dev "/dev/" -> root_choice := `Dev dev + | dev when String.is_prefix dev "/dev/" -> root_choice := `Dev dev | s -> error (f_"unknown --root option: %s") s in diff --git a/v2v/convert_linux.ml b/v2v/convert_linux.ml index c2a2b92..f790e4d 100644 --- a/v2v/convert_linux.ml +++ b/v2v/convert_linux.ml @@ -129,7 +129,7 @@ let rec convert ~keep_serial_console (g : G.guestfs) inspect source = filter_map ( function | { G.app2_name = name } as app - when name = "kernel" || string_prefix name "kernel-" -> + when name = "kernel" || String.is_prefix name "kernel-" -> (try (* For each kernel, list the files directly owned by the kernel. *) let files = Linux.file_list_of_package g inspect app in @@ -141,13 +141,13 @@ let rec convert ~keep_serial_console (g : G.guestfs) inspect source = else ( (* Which of these is the kernel itself? *) let vmlinuz = List.find ( - fun filename -> string_prefix filename "/boot/vmlinuz-" + fun filename -> String.is_prefix filename "/boot/vmlinuz-" ) files in (* Which of these is the modpath? *) let modpath = List.find ( fun filename -> String.length filename >= 14 && - string_prefix filename "/lib/modules/" + String.is_prefix filename "/lib/modules/" ) files in (* Check vmlinuz & modpath exist. *) @@ -173,12 +173,12 @@ let rec convert ~keep_serial_console (g : G.guestfs) inspect source = let files = List.filter ( fun n -> - string_find n app.G.app2_version >= 0 && - string_find n app.G.app2_release >= 0 + String.find n app.G.app2_version >= 0 && + String.find n app.G.app2_release >= 0 ) files in (* Don't consider kdump initramfs images (RHBZ#1138184). *) let files = - List.filter (fun n -> string_find n "kdump.img" == -1) files in + List.filter (fun n -> String.find n "kdump.img" == -1) files in (* If several files match, take the shortest match. This * handles the case where we have a mix of same-version non-Xen * and Xen kernels: @@ -229,8 +229,8 @@ let rec convert ~keep_serial_console (g : G.guestfs) inspect source = * a debug kernel. *) let is_debug = - string_suffix app.G.app2_name "-debug" || - string_suffix app.G.app2_name "-dbg" in + String.is_suffix app.G.app2_name "-debug" || + String.is_suffix app.G.app2_name "-dbg" in Some { ki_app = app; @@ -298,7 +298,7 @@ let rec convert ~keep_serial_console (g : G.guestfs) inspect source = sprintf "/files%s/title[%d]/kernel" grub_config (idx+1) in Some expr with G.Error msg - when string_find msg "aug_get: no matching node" >= 0 -> + when String.find msg "aug_get: no matching node" >= 0 -> None in (* If a default kernel was set, put it at the beginning of the paths @@ -418,7 +418,7 @@ let rec convert ~keep_serial_console (g : G.guestfs) inspect source = let xenmods = filter_map ( fun { G.app2_name = name } -> - if name = "kmod-xenpv" || string_prefix name "kmod-xenpv-" then + if name = "kmod-xenpv" || String.is_prefix name "kmod-xenpv-" then Some name else None @@ -432,7 +432,7 @@ let rec convert ~keep_serial_console (g : G.guestfs) inspect source = *) let dirs = g#find "/lib/modules" in let dirs = Array.to_list dirs in - let dirs = List.filter (fun s -> string_find s "/xenpv" >= 0) dirs in + let dirs = List.filter (fun s -> String.find s "/xenpv" >= 0) dirs in let dirs = List.map ((^) "/lib/modules/") dirs in let dirs = List.filter g#is_dir dirs in @@ -550,13 +550,13 @@ let rec convert ~keep_serial_console (g : G.guestfs) inspect source = let remove = ref [] and libraries = ref [] in List.iter ( fun { G.app2_name = name } -> - if string_prefix name "vmware-tools-libraries-" then + if String.is_prefix name "vmware-tools-libraries-" then libraries := name :: !libraries - else if string_prefix name "vmware-tools-" then + else if String.is_prefix name "vmware-tools-" then remove := name :: !remove else if name = "VMwareTools" then remove := name :: !remove - else if string_prefix name "kmod-vmware-tools" then + else if String.is_prefix name "kmod-vmware-tools" then remove := name :: !remove ) inspect.i_apps; let libraries = !libraries in @@ -578,7 +578,7 @@ let rec convert ~keep_serial_console (g : G.guestfs) inspect source = (* The packages provide themselves, filter this out. *) let provides = - List.filter (fun s -> string_find s library = -1) provides in + List.filter (fun s -> String.find s library = -1) provides in (* Trim whitespace. *) let rex = Str.regexp "^[ \t]*\\([^ \t]+\\)[ \t]*$" in @@ -629,7 +629,7 @@ let rec convert ~keep_serial_console (g : G.guestfs) inspect source = and unconfigure_citrix () = let pkgs = List.filter ( - fun { G.app2_name = name } -> string_prefix name "xe-guest-utilities" + fun { G.app2_name = name } -> String.is_prefix name "xe-guest-utilities" ) inspect.i_apps in let pkgs = List.map (fun { G.app2_name = name } -> name) pkgs in @@ -654,7 +654,7 @@ let rec convert ~keep_serial_console (g : G.guestfs) inspect source = let runlevels = Str.matched_group 2 comment in let process = Str.matched_group 3 comment in - if string_find process "getty" >= 0 then ( + if String.find process "getty" >= 0 then ( updated := true; (* Create a new entry immediately after the comment. *) @@ -743,7 +743,7 @@ let rec convert ~keep_serial_console (g : G.guestfs) inspect source = and grub_set_bootable kernel = match grub with | `Grub1 -> - if not (string_prefix kernel.ki_vmlinuz grub_prefix) then + if not (String.is_prefix kernel.ki_vmlinuz grub_prefix) then error (f_"kernel %s is not under grub tree %s") kernel.ki_vmlinuz grub_prefix; let kernel_under_grub_prefix = @@ -1306,14 +1306,14 @@ let rec convert ~keep_serial_console (g : G.guestfs) inspect source = let replace device = try List.assoc device map with Not_found -> - if string_find device "md" = -1 && string_find device "fd" = -1 && + if String.find device "md" = -1 && String.find device "fd" = -1 && device <> "cdrom" then warning (f_"%s references unknown device \"%s\". You may have to fix this entry manually after conversion.") path device; device in - if string_find path "GRUB_CMDLINE" >= 0 then ( + if String.find path "GRUB_CMDLINE" >= 0 then ( (* Handle grub2 resume=<dev> specially. *) if Str.string_match rex_resume value 0 then ( let start = Str.matched_group 1 value diff --git a/v2v/convert_windows.ml b/v2v/convert_windows.ml index ac281a0..d1aef36 100644 --- a/v2v/convert_windows.ml +++ b/v2v/convert_windows.ml @@ -647,7 +647,7 @@ echo uninstalling Xen PV driver let t = g#hivex_value_type valueh in (* Only add the appended path if it doesn't exist already. *) - if string_find data append = -1 then ( + if String.find data append = -1 then ( (* Remove the explicit [\0\0] at the end of the string. * This is the UTF-16LE NUL-terminator. *) diff --git a/v2v/input_libvirt_vcenter_https.ml b/v2v/input_libvirt_vcenter_https.ml index 3a4868c..99f3ee1 100644 --- a/v2v/input_libvirt_vcenter_https.ml +++ b/v2v/input_libvirt_vcenter_https.ml @@ -124,7 +124,7 @@ let rec get_session_cookie = let len = String.length line in if len >= 12 && String.sub line 0 12 = "Set-Cookie: " then ( let line = String.sub line 12 (len-12) in - let cookie, _ = string_split ";" line in + let cookie, _ = String.split ";" line in session_cookie := cookie ) ) lines; @@ -275,7 +275,7 @@ let map_source_to_uri ?readahead dcPath password uri scheme server path = | None -> true | Some query -> (* XXX only works if the query string is not URI-quoted *) - string_find query "no_verify=1" = -1 in + String.find query "no_verify=1" = -1 in (* Now we have to query the server to get the session cookie. *) let session_cookie = diff --git a/v2v/input_libvirtxml.ml b/v2v/input_libvirtxml.ml index 0e2d946..976848f 100644 --- a/v2v/input_libvirtxml.ml +++ b/v2v/input_libvirtxml.ml @@ -290,10 +290,10 @@ let parse_libvirt_xml ?conn xml = let target_dev = xpath_string "target/@dev" in match target_dev with | None -> None - | Some s when string_prefix s "hd" -> get_drive_slot s 2 - | Some s when string_prefix s "sd" -> get_drive_slot s 2 - | Some s when string_prefix s "vd" -> get_drive_slot s 2 - | Some s when string_prefix s "xvd" -> get_drive_slot s 3 + | Some s when String.is_prefix s "hd" -> get_drive_slot s 2 + | Some s when String.is_prefix s "sd" -> get_drive_slot s 2 + | Some s when String.is_prefix s "vd" -> get_drive_slot s 2 + | Some s when String.is_prefix s "xvd" -> get_drive_slot s 3 | Some s -> warning (f_"<target dev='%s'> was ignored because the device name could not be recognized") s; None in diff --git a/v2v/input_ova.ml b/v2v/input_ova.ml index aeb7ae6..a758e94 100644 --- a/v2v/input_ova.ml +++ b/v2v/input_ova.ml @@ -151,7 +151,7 @@ object | [] -> error (f_"no output from sha1sum command, see previous errors") | [line] -> - let actual, _ = string_split " " line in + let actual, _ = String.split " " line in if actual <> expected then error (f_"checksum of disk %s does not match manifest %s (actual sha1(%s) = %s, expected sha1 (%s) = %s)") disk mf disk actual disk expected; @@ -273,7 +273,7 @@ object *) let filename = if detect_file_type filename = `GZip then ( - let new_filename = tmpdir // string_random8 () ^ ".vmdk" in + let new_filename = tmpdir // String.random8 () ^ ".vmdk" in let cmd = sprintf "zcat %s > %s" (quote filename) (quote new_filename) in if verbose () then printf "%s\n%!" cmd; diff --git a/v2v/linux.ml b/v2v/linux.ml index c8d5b9b..e39ba3b 100644 --- a/v2v/linux.ml +++ b/v2v/linux.ml @@ -52,7 +52,7 @@ and augeas_debug_errors g = * <filename>, <field> and the value of this Augeas field * into a map. *) - let i = string_find path "/error/" in + let i = String.find path "/error/" in assert (i >= 0); let filename = String.sub path 13 (i-13) in let field = String.sub path (i+7) (String.length path - (i+7)) in @@ -166,7 +166,7 @@ let rec file_owner g inspect path = if verbose () then eprintf "%s\n%!" (String.concat " " (Array.to_list cmd)); (try g#command cmd with Guestfs.Error msg as exn -> - if string_find msg "is not owned" >= 0 then + if String.find msg "is not owned" >= 0 then raise Not_found else raise exn diff --git a/v2v/output_qemu.ml b/v2v/output_qemu.ml index 4f9ad77..94ad515 100644 --- a/v2v/output_qemu.ml +++ b/v2v/output_qemu.ml @@ -96,7 +96,7 @@ object | BusSlotEmpty -> () | BusSlotTarget t -> - let qemu_quoted_filename = replace_str t.target_file "," ",," in + let qemu_quoted_filename = String.replace t.target_file "," ",," in let drive_param = sprintf "file=%s,format=%s,if=%s,index=%d,media=disk" qemu_quoted_filename t.target_format if_name i in @@ -119,7 +119,7 @@ object | BusSlotEmpty -> () | BusSlotTarget t -> - let qemu_quoted_filename = replace_str t.target_file "," ",," in + let qemu_quoted_filename = String.replace t.target_file "," ",," in let drive_param = sprintf "file=%s,format=%s,if=scsi,bus=0,unit=%d,media=disk" qemu_quoted_filename t.target_format i in diff --git a/v2v/output_rhev.ml b/v2v/output_rhev.ml index d3f367e..aa0472f 100644 --- a/v2v/output_rhev.ml +++ b/v2v/output_rhev.ml @@ -30,7 +30,7 @@ let rec mount_and_check_storage_domain domain_class os = (* The user can either specify -os nfs:/export, or a local directory * which is assumed to be the already-mounted NFS export. *) - match string_split ":/" os with + match String.split ":/" os with | mp, "" -> (* Already mounted directory. *) check_storage_domain domain_class os mp | server, export -> @@ -172,7 +172,7 @@ object (* See if we can write files as UID:GID 36:36. *) let () = - let testfile = esd_mp // esd_uuid // string_random8 () in + let testfile = esd_mp // esd_uuid // String.random8 () in Kvmuid.make_file kvmuid_t testfile ""; let stat = stat testfile in Kvmuid.unlink kvmuid_t testfile; diff --git a/v2v/output_vdsm.ml b/v2v/output_vdsm.ml index 670d8ba..a5656b1 100644 --- a/v2v/output_vdsm.ml +++ b/v2v/output_vdsm.ml @@ -80,7 +80,7 @@ object (List.length targets); let mp, uuid = - let fields = string_nsplit "/" os in (* ... "data-center" "UUID" *) + let fields = String.nsplit "/" os in (* ... "data-center" "UUID" *) let fields = List.rev fields in (* "UUID" "data-center" ... *) match fields with | "" :: uuid :: rest (* handles trailing "/" case *) diff --git a/v2v/test-harness/v2v_test_harness.ml b/v2v/test-harness/v2v_test_harness.ml index f10ff98..d5b53fa 100644 --- a/v2v/test-harness/v2v_test_harness.ml +++ b/v2v/test-harness/v2v_test_harness.ml @@ -307,7 +307,7 @@ let run ~test ?input_disk ?input_xml ?(test_plan = default_plan) () = | [] -> (* error *) failwithf "external command '%s' exited with error %d" cmd 2; | line::lines -> - if string_prefix line "compare: images too dissimilar" then + if String.is_prefix line "compare: images too dissimilar" then false (* no match *) else loop lines diff --git a/v2v/utils.ml b/v2v/utils.ml index cdf7535..b78ef3c 100644 --- a/v2v/utils.ml +++ b/v2v/utils.ml @@ -31,16 +31,16 @@ let quote = Filename.quote * quotes around the attribute. *) let xml_quote_attr str = - let str = replace_str str "&" "&amp;" in - let str = replace_str str "'" "&apos;" in - let str = replace_str str "<" "&lt;" in - let str = replace_str str ">" "&gt;" in + let str = String.replace str "&" "&amp;" in + let str = String.replace str "'" "&apos;" in + let str = String.replace str "<" "&lt;" in + let str = String.replace str ">" "&gt;" in str let xml_quote_pcdata str = - let str = replace_str str "&" "&amp;" in - let str = replace_str str "<" "&lt;" in - let str = replace_str str ">" "&gt;" in + let str = String.replace str "&" "&amp;" in + let str = String.replace str "<" "&lt;" in + let str = String.replace str ">" "&gt;" in str (* URI quoting. *) @@ -252,7 +252,7 @@ let find_virtio_win_drivers virtio_win = * "./drivers/amd64/Win2012R2/netkvm.sys". * Note we check lowercase paths. *) - let pathelem elem = string_find lc_path ("/" ^ elem ^ "/") >= 0 in + let pathelem elem = String.find lc_path ("/" ^ elem ^ "/") >= 0 in let arch = if pathelem "x86" || pathelem "i386" then "i386" else if pathelem "amd64" then "x86_64" diff --git a/v2v/v2v.ml b/v2v/v2v.ml index f6ebdd5..af4f993 100644 --- a/v2v/v2v.ml +++ b/v2v/v2v.ml @@ -533,7 +533,7 @@ and inspect_source g root_choice = try g#mount dev mp with G.Error msg -> if mp = "/" then ( (* RHBZ#1145995 *) - if string_find msg "Windows" >= 0 && string_find msg "NTFS partition is in an unsafe state" >= 0 then + if String.find msg "Windows" >= 0 && String.find msg "NTFS partition is in an unsafe state" >= 0 then error (f_"unable to mount the disk image for writing. This has probably happened because Windows Hibernation or Fast Restart is being used in this guest. You have to disable this (in the guest) in order to use virt-v2v.\n\nOriginal error message: %s") msg else error "%s" msg -- 2.5.0