This function is ill-defined and unsafe. As a preparation for
removing it completely, inline it in the places where it is used.
---
builder/repository_main.ml | 13 +++++++++++--
common/mlstdutils/std_utils.ml | 9 ---------
common/mlstdutils/std_utils.mli | 10 ----------
common/mlstdutils/std_utils_tests.ml | 7 -------
v2v/parse_ova.ml | 13 +++++++++++--
5 files changed, 22 insertions(+), 30 deletions(-)
diff --git a/builder/repository_main.ml b/builder/repository_main.ml
index c020a6413..5dc4d57cd 100644
--- a/builder/repository_main.ml
+++ b/builder/repository_main.ml
@@ -398,6 +398,15 @@ let process_image acc_entries filename repo tmprepo index
interactive
| None ->
extract_entry_data ~entry:file_entry ()
+let unsafe_remove_directory_prefix parent path =
+ if path = parent then
+ ""
+ else if String.is_prefix path (parent // "") then (
+ let len = String.length parent in
+ String.sub path (len+1) (String.length path - len-1)
+ ) else
+ invalid_arg (sprintf "%S is not a path prefix of %S" parent path)
+
let main () =
let cmdline = parse_cmdline () in
@@ -512,8 +521,8 @@ let main () =
fun (id, entry) ->
let { Index.file_uri } = entry in
let rel_path =
- try
- subdirectory cmdline.repo file_uri
+ try (* XXX wrong *)
+ unsafe_remove_directory_prefix cmdline.repo file_uri
with
| Invalid_argument _ ->
file_uri in
diff --git a/common/mlstdutils/std_utils.ml b/common/mlstdutils/std_utils.ml
index 3fba96b5b..df443058f 100644
--- a/common/mlstdutils/std_utils.ml
+++ b/common/mlstdutils/std_utils.ml
@@ -376,15 +376,6 @@ end
let (//) = Filename.concat
let quote = Filename.quote
-let subdirectory parent path =
- if path = parent then
- ""
- else if String.is_prefix path (parent // "") then (
- let len = String.length parent in
- String.sub path (len+1) (String.length path - len-1)
- ) else
- invalid_arg (sprintf "%S is not a path prefix of %S" parent path)
-
let ( +^ ) = Int64.add
let ( -^ ) = Int64.sub
let ( *^ ) = Int64.mul
diff --git a/common/mlstdutils/std_utils.mli b/common/mlstdutils/std_utils.mli
index 195269a71..c887249a5 100644
--- a/common/mlstdutils/std_utils.mli
+++ b/common/mlstdutils/std_utils.mli
@@ -274,16 +274,6 @@ val ( // ) : string -> string -> string
val quote : string -> string
(** Shell-safe quoting of a string (alias for {!Filename.quote}). *)
-val subdirectory : string -> string -> string
-(** [subdirectory parent path] returns subdirectory part of [path] relative
- to the [parent]. If [path] and [parent] point to the same directory empty
- string is returned.
-
- Note: path normalization on arguments is {b not} performed!
-
- If [parent] is not a path prefix of [path] the function raises
- [Invalid_argument]. *)
-
val ( +^ ) : int64 -> int64 -> int64
val ( -^ ) : int64 -> int64 -> int64
val ( *^ ) : int64 -> int64 -> int64
diff --git a/common/mlstdutils/std_utils_tests.ml b/common/mlstdutils/std_utils_tests.ml
index 5c25650c2..aa48f5f39 100644
--- a/common/mlstdutils/std_utils_tests.ml
+++ b/common/mlstdutils/std_utils_tests.ml
@@ -30,12 +30,6 @@ let assert_equal_int64 = assert_equal ~printer:(fun x ->
Int64.to_string x)
let assert_equal_stringlist = assert_equal ~printer:(fun x -> "(" ^
(String.escaped (String.concat "," x)) ^ ")")
let assert_equal_stringpair = assert_equal ~printer:(fun (x, y) -> sprintf "%S,
%S" x y)
-let test_subdirectory ctx =
- assert_equal_string "" (subdirectory "/foo" "/foo");
- assert_equal_string "" (subdirectory "/foo" "/foo/");
- assert_equal_string "bar" (subdirectory "/foo"
"/foo/bar");
- assert_equal_string "bar/baz" (subdirectory "/foo"
"/foo/bar/baz")
-
(* Test Std_utils.int_of_X and Std_utils.X_of_int byte swapping
* functions.
*)
@@ -150,7 +144,6 @@ let test_string_chomp ctx =
let suite =
"mllib Std_utils" >:::
[
- "subdirectory" >:: test_subdirectory;
"numeric.byteswap" >:: test_byteswap;
"char.mem" >:: test_char_mem;
"strings.is_prefix" >:: test_string_is_prefix;
diff --git a/v2v/parse_ova.ml b/v2v/parse_ova.ml
index 431cbe8d0..c11502667 100644
--- a/v2v/parse_ova.ml
+++ b/v2v/parse_ova.ml
@@ -251,6 +251,15 @@ and get_ovf_file { orig_ova; top_dir } =
| _ :: _ ->
error (f_"more than one .ovf file was found in %s") orig_ova
+let unsafe_remove_directory_prefix parent path =
+ if path = parent then
+ ""
+ else if String.is_prefix path (parent // "") then (
+ let len = String.length parent in
+ String.sub path (len+1) (String.length path - len-1)
+ ) else
+ invalid_arg (sprintf "%S is not a path prefix of %S" parent path)
+
let rex = PCRE.compile "^(SHA1|SHA256)\\((.*)\\)= ([0-9a-fA-F]+)\r?$"
let get_manifest { top_dir; ova_type } =
@@ -260,7 +269,7 @@ let get_manifest { top_dir; ova_type } =
fun mf ->
debug "ova: processing manifest file %s" mf;
let mf_folder = Filename.dirname mf in
- let mf_subfolder = subdirectory top_dir mf_folder in
+ let mf_subfolder = unsafe_remove_directory_prefix top_dir mf_folder in
with_open_in mf (
fun chan ->
let ret = ref [] in
@@ -297,7 +306,7 @@ let get_file_ref ({ top_dir; ova_type } as t) href =
match ova_type with
| Directory -> LocalFile (ovf_folder // href)
| TarOptimized tar ->
- let filename = subdirectory top_dir ovf_folder // href in
+ let filename = unsafe_remove_directory_prefix top_dir ovf_folder // href in
TarFile (tar, filename)
let ws = PCRE.compile "\\s+"
--
2.16.2