Libguestfs - Jan 2019 - [PATCH 3/3] OCaml: use the new behaviour of Std_utils.which

---
 common/mlstdutils/std_utils_tests.ml | 12 ++++++++++++
 1 file changed, 12 insertions(+)

diff --git a/common/mlstdutils/std_utils_tests.ml
b/common/mlstdutils/std_utils_tests.ml
index 81f512cbf..f7b0247a4 100644
--- a/common/mlstdutils/std_utils_tests.ml
+++ b/common/mlstdutils/std_utils_tests.ml
@@ -29,6 +29,11 @@ let assert_equal_int = assert_equal ~printer:(fun x ->
string_of_int x)
 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 assert_nonempty_string str +  if str = "" then
+    assert_failure (sprintf "Expected empty string, got '%s'"
str)
+let assert_raises_executable_not_found exe +  assert_raises
(Executable_not_found exe) (fun () -> which exe)
 
 (* Test Std_utils.int_of_X and Std_utils.X_of_int byte swapping
  * functions.
@@ -140,6 +145,12 @@ let test_string_chomp ctx    assert_equal_string
"" (String.chomp "\n");
   assert_equal_string "\n" (String.chomp "\n\n") (* only
removes one *)
 
+(* Test Std_utils.which. *)
+let test_which ctx +  assert_nonempty_string (which "true");
+  assert_raises_executable_not_found
"this-command-does-not-really-exist";
+  ()
+
 (* Suites declaration. *)
 let suite    "mllib Std_utils" >:::
@@ -154,6 +165,7 @@ let suite        "strings.lines_split" >::
test_string_lines_split;
       "strings.span" >:: test_string_span;
       "strings.chomp" >:: test_string_chomp;
+      "which" >:: test_which;
     ]
 
 let () -- 
2.17.2

Make Std_utils.which behave a bit more like which(1), checking the
existance of relative/absolute paths specified.
---
 common/mlstdutils/std_utils.ml       | 29 ++++++++++++++++------------
 common/mlstdutils/std_utils.mli      |  5 ++++-
 common/mlstdutils/std_utils_tests.ml | 10 ++++++++++
 3 files changed, 31 insertions(+), 13 deletions(-)

diff --git a/common/mlstdutils/std_utils.ml b/common/mlstdutils/std_utils.ml
index 5a92dccc9..70156d1ba 100644
--- a/common/mlstdutils/std_utils.ml
+++ b/common/mlstdutils/std_utils.ml
@@ -610,18 +610,23 @@ let failwithf fs = ksprintf failwith fs
 exception Executable_not_found of string (* executable *)
 
 let which executable -  let paths -    try String.nsplit ":"
(Sys.getenv "PATH")
-    with Not_found -> [] in
-  let paths = List.filter_map (
-    fun p ->
-      let path = p // executable in
-      try Unix.access path [Unix.X_OK]; Some path
-      with Unix.Unix_error _ -> None
-  ) paths in
-  match paths with
-  | [] -> raise (Executable_not_found executable)
-  | x :: _ -> x
+  if String.find executable Filename.dir_sep <> -1 then (
+    try Unix.access executable [Unix.X_OK]; executable
+    with Unix.Unix_error _ -> raise (Executable_not_found executable)
+  ) else (
+    let paths +      try String.nsplit ":" (Sys.getenv
"PATH")
+      with Not_found -> [] in
+    let paths = List.filter_map (
+      fun p ->
+        let path = p // executable in
+        try Unix.access path [Unix.X_OK]; Some path
+        with Unix.Unix_error _ -> None
+    ) paths in
+    match paths with
+    | [] -> raise (Executable_not_found executable)
+    | x :: _ -> x
+  )
 
 (* Program name. *)
 let prog = Filename.basename Sys.executable_name
diff --git a/common/mlstdutils/std_utils.mli b/common/mlstdutils/std_utils.mli
index ca4e940cf..5e5242f7a 100644
--- a/common/mlstdutils/std_utils.mli
+++ b/common/mlstdutils/std_utils.mli
@@ -359,7 +359,10 @@ exception Executable_not_found of string (* executable *)
     in [$PATH]. *)
 
 val which : string -> string
-(** Return the full path of the specified executable from [$PATH].
+(** Return the full path of the specified executable from [$PATH],
+    in case it is only a name.  In case of a relative or absolute path
+    (i.e. more than just a name), return the same path specified if
+    exists.
 
     Throw [Executable_not_found] if not available. *)
 
diff --git a/common/mlstdutils/std_utils_tests.ml
b/common/mlstdutils/std_utils_tests.ml
index f7b0247a4..d161b5e7e 100644
--- a/common/mlstdutils/std_utils_tests.ml
+++ b/common/mlstdutils/std_utils_tests.ml
@@ -149,6 +149,16 @@ let test_string_chomp ctx  let test_which ctx   
assert_nonempty_string (which "true");
   assert_raises_executable_not_found
"this-command-does-not-really-exist";
+  begin
+    let exe_name = "true" in
+    let exe = which exe_name in
+    assert_equal_string exe (which exe);
+    with_bracket_chdir ctx (Filename.dirname exe) (
+      fun ctx ->
+        let exe_relative = "./" ^ exe_name in
+        assert_equal_string exe_relative (which exe_relative)
+    )
+  end;
   ()
 
 (* Suites declaration. *)
-- 
2.17.2

Since Std_utils.which can handle relative/absolute paths, remove the
manual checks, and use Std_utils.which directly.
---
 common/mltools/tools_utils.ml |  4 +---
 dib/cmdline.ml                | 12 +-----------
 2 files changed, 2 insertions(+), 14 deletions(-)

diff --git a/common/mltools/tools_utils.ml b/common/mltools/tools_utils.ml
index 3c7e1b846..24641369e 100644
--- a/common/mltools/tools_utils.ml
+++ b/common/mltools/tools_utils.ml
@@ -408,9 +408,7 @@ and do_run ?(echo_cmd = true) ?stdout_fd ?stderr_fd args    
fd
   in
   try
-    let app -      if Filename.is_relative app then which app
-      else (Unix.access app [Unix.X_OK]; app) in
+    let app = which app in
     let outfd = get_fd Unix.stdout stdout_fd in
     let errfd = get_fd Unix.stderr stderr_fd in
     if echo_cmd then
diff --git a/dib/cmdline.ml b/dib/cmdline.ml
index 220350d9d..11ff57341 100644
--- a/dib/cmdline.ml
+++ b/dib/cmdline.ml
@@ -251,17 +251,7 @@ read the man page virt-dib(1).
   if elements = [] then
     error (f_"at least one distribution root element must be
specified");
 
-  let python -    match python with
-    | Some exe ->
-      let p -        if String.find exe Filename.dir_sep <> -1 then (
-          Unix.access exe [Unix.X_OK];
-          exe
-        ) else
-          get_required_tool exe in
-      Some p
-    | None -> None in
+  let python = Option.map get_required_tool python in
 
   { debug = debug; basepath = basepath; elements = elements;
     excluded_elements = excluded_elements; element_paths = element_paths;
-- 
2.17.2

Hey Pino,

ACK series.

If you want this to go into 1.40 then please push it as soon as possible.

Thanks,

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
virt-df lists disk usage of guests without needing to install any
software inside the virtual machine.  Supports Linux and Windows.
http://people.redhat.com/~rjones/virt-df/