Richard W.M. Jones
2015-Oct-06 12:30 UTC
[Libguestfs] [PATCH 0/5] mllib: Hide bad String functions and miscellaneous refactoring.
Hide/prevent the use of bad string functions like String.lowercase. These are replaced by safe functions that won't break UTF-8 strings. Other miscellaneous refactoring. Rich.
Richard W.M. Jones
2015-Oct-06 12:30 UTC
[Libguestfs] [PATCH 1/5] mllib: Don't alias G = Guestfs in Common_utils module.
---
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
Richard W.M. Jones
2015-Oct-06 12:30 UTC
[Libguestfs] [PATCH 2/5] mllib: Override Char and String modules from stdlib.
In Common_utils, override the Char and String modules from stdlib. This hides the original (stdlib) modules, and means that whenever you use Char.foo or String.foo you are in fact calling the Common_utils.Char.foo or Common_utils.String.foo function. As it stands, this change does nothing, but it will allow us to drop unsafe functions (like String.lowercase) and add extra functions. --- mllib/common_utils.ml | 8 ++++++++ mllib/common_utils.mli | 45 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 53 insertions(+) diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml index f9c45cc..f375317 100644 --- a/mllib/common_utils.ml +++ b/mllib/common_utils.ml @@ -20,6 +20,14 @@ open Printf open Common_gettext.Gettext +module Char = struct + include Char +end + +module String = struct + include String +end + let (//) = Filename.concat let ( +^ ) = Int64.add diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli index 7d886cf..f42ae64 100644 --- a/mllib/common_utils.mli +++ b/mllib/common_utils.mli @@ -16,6 +16,51 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) +module Char : sig + type t = char + val chr : int -> char + val code : char -> int + val compare: t -> t -> int + val escaped : char -> string + val lowercase : char -> char + val unsafe_chr : int -> char + val uppercase : char -> char +end +(** Override the Char module from stdlib. *) + +module String : sig + type t = string + val blit : string -> int -> string -> int -> int -> unit + val capitalize : string -> string + val compare: t -> t -> int + val concat : string -> string list -> string + val contains : string -> char -> bool + val contains_from : string -> int -> char -> bool + val copy : string -> string + val create : int -> string + val escaped : string -> string + val fill : string -> int -> int -> char -> unit + val get : string -> int -> char + val index : string -> char -> int + val index_from : string -> int -> char -> int + val iter : (char -> unit) -> string -> unit + val length : string -> int + val lowercase : string -> string + val make : int -> char -> string + val rcontains_from : string -> int -> char -> bool + val rindex : string -> char -> int + val rindex_from : string -> int -> char -> int + val set : string -> int -> char -> unit + val sub : string -> int -> int -> string + val uncapitalize : string -> string + val unsafe_blit : string -> int -> string -> int -> int -> unit + val unsafe_fill : string -> int -> int -> char -> unit + val unsafe_get : string -> int -> char + val unsafe_set : string -> int -> char -> unit + val uppercase : string -> string +end +(** Override the String module from stdlib. *) + val ( // ) : string -> string -> string (** Concatenate directory and filename. *) -- 2.5.0
Richard W.M. Jones
2015-Oct-06 12:30 UTC
[Libguestfs] [PATCH 3/5] mllib: Add (Char|String).(lower|upper)case_ascii functions.
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
Richard W.M. Jones
2015-Oct-06 12:30 UTC
[Libguestfs] [PATCH 4/5] mllib: Hide unsafe lower/uppercase functions.
The ones in the OCaml stdlib assume ISO-8859-1 bytes and strings, and
so can end up corrupting UTF-8 strings.
---
mllib/common_utils.mli | 6 ------
1 file changed, 6 deletions(-)
diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli
index c0941f6..8083d8d 100644
--- a/mllib/common_utils.mli
+++ b/mllib/common_utils.mli
@@ -22,9 +22,7 @@ module Char : sig
val code : char -> int
val compare: t -> t -> int
val escaped : char -> string
- val lowercase : char -> char
val unsafe_chr : int -> char
- val uppercase : char -> char
val lowercase_ascii : char -> char
val uppercase_ascii : char -> char
@@ -34,7 +32,6 @@ end
module String : sig
type t = string
val blit : string -> int -> string -> int -> int -> unit
- val capitalize : string -> string
val compare: t -> t -> int
val concat : string -> string list -> string
val contains : string -> char -> bool
@@ -48,19 +45,16 @@ module String : sig
val index_from : string -> int -> char -> int
val iter : (char -> unit) -> string -> unit
val length : string -> int
- val lowercase : string -> string
val make : int -> char -> string
val rcontains_from : string -> int -> char -> bool
val rindex : string -> char -> int
val rindex_from : string -> int -> char -> int
val set : string -> int -> char -> unit
val sub : string -> int -> int -> string
- val uncapitalize : string -> string
val unsafe_blit : string -> int -> string -> int -> int ->
unit
val unsafe_fill : string -> int -> int -> char -> unit
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
--
2.5.0
Richard W.M. Jones
2015-Oct-06 12:30 UTC
[Libguestfs] [PATCH 5/5] mllib: Replace various ad hoc string_* functions with String.*
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 "&"
"&" in
- let str = replace_str str "'" "'" in
- let str = replace_str str "<" "<" in
- let str = replace_str str ">" ">" in
+ let str = String.replace str "&" "&" in
+ let str = String.replace str "'" "'" in
+ let str = String.replace str "<" "<" in
+ let str = String.replace str ">" ">" in
str
let xml_quote_pcdata str - let str = replace_str str "&"
"&" in
- let str = replace_str str "<" "<" in
- let str = replace_str str ">" ">" in
+ let str = String.replace str "&" "&" in
+ let str = String.replace str "<" "<" in
+ let str = String.replace str ">" ">" 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
Richard W.M. Jones
2015-Oct-06 12:38 UTC
Re: [Libguestfs] [PATCH 5/5] mllib: Replace various ad hoc string_* functions with String.*
On Tue, Oct 06, 2015 at 01:30:50PM +0100, Richard W.M. Jones wrote:> -(* 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"))Hmm, that's not right! An overenthusiastic Perl script. Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com libguestfs lets you edit virtual machines. Supports shell scripting, bindings from many languages. http://libguestfs.org
Pino Toscano
2015-Oct-07 11:25 UTC
Re: [Libguestfs] [PATCH 1/5] mllib: Don't alias G = Guestfs in Common_utils module.
On Tuesday 06 October 2015 13:30:46 Richard W.M. Jones wrote:> --- > 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 > -Hm weren't we using that alias in our .ml files, usually? Not a big deal, I just remember changes in the opposite way of this patch, so just wondering what would be the preferred way (especially that there is a .mli for this, so the alias won't pollute users of the module). -- Pino Toscano
Pino Toscano
2015-Oct-07 11:26 UTC
Re: [Libguestfs] [PATCH 3/5] mllib: Add (Char|String).(lower|upper)case_ascii functions.
On Tuesday 06 October 2015 13:30:48 Richard W.M. Jones wrote:> 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 '.' withI guess these usages of String.lowercase reveal actual bugs in v2v, which is not handling non-ASCII paths in Windows guests? -- Pino Toscano
Pino Toscano
2015-Oct-07 11:48 UTC
Re: [Libguestfs] [PATCH 5/5] mllib: Replace various ad hoc string_* functions with String.*
On Tuesday 06 October 2015 13:30:50 Richard W.M. Jones wrote:> 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 > ---As mentioned yesterday on IRC, I'm torn about this one: the functions would automatically alias functions with the same name, whenever available in OCaml' stdlib. Also (but this is more personal), reading String.foo would make me think that it is part of the String module, and go reading its help on the documentation of the String module. -- Pino Toscano
Pino Toscano
2015-Oct-07 11:59 UTC
Re: [Libguestfs] [PATCH 0/5] mllib: Hide bad String functions and miscellaneous refactoring.
On Tuesday 06 October 2015 13:30:45 Richard W.M. Jones wrote:> Hide/prevent the use of bad string functions like String.lowercase. > These are replaced by safe functions that won't break UTF-8 strings. > > Other miscellaneous refactoring.Patches #1 to #4 LGTM. I'm personally not convinced by patch #5, although I won't argue much the other way round though. -- Pino Toscano
Reasonably Related Threads
- [PATCH 1/2] configure: look for the oUnit OCaml module
- Re: [PATCH 5/5] mllib: Replace various ad hoc string_* functions with String.*
- [PATCH v3 0/2] v2v: When picking a default kernel, favour non-debug
- [PATCH 5/5] mllib: Replace various ad hoc string_* functions with String.*
- [PATCH v7 00/13] Refactor utilities