Libguestfs - Aug 2016 - [PATCH] mllib: move which and its exception from dib

Rename it from "tool" to "executable" in the process, but
otherwise
it is just code motion (with minimal adjustments in dib).
---
 dib/dib.ml             |  2 +-
 dib/utils.ml           | 16 +---------------
 mllib/common_utils.ml  | 14 ++++++++++++++
 mllib/common_utils.mli |  9 +++++++++
 4 files changed, 25 insertions(+), 16 deletions(-)

diff --git a/dib/dib.ml b/dib/dib.ml
index de4f242..87af4eb 100644
--- a/dib/dib.ml
+++ b/dib/dib.ml
@@ -297,7 +297,7 @@ $cmd \"$@\"
   (try
     let loc = which "dib-run-parts" in
     do_cp loc (destdir // "fake-bin")
-  with Tool_not_found _ ->
+  with Executable_not_found _ ->
     let fake_dib_run_parts = "\
 #!/bin/sh
 echo \"Please install dib-run-parts on the host\"
diff --git a/dib/utils.ml b/dib/utils.ml
index f316264..a2046cb 100644
--- a/dib/utils.ml
+++ b/dib/utils.ml
@@ -21,8 +21,6 @@ open Common_utils
 
 open Printf
 
-exception Tool_not_found of string (* tool *)
-
 let quote = Filename.quote
 
 let unit_GB howmany @@ -97,21 +95,9 @@ 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 = filter_map (
-    fun p ->
-      let path = p // tool in
-      try Unix.access path [Unix.X_OK]; Some path
-      with Unix.Unix_error _ -> None
-  ) paths in
-  match paths with
-  | [] -> raise (Tool_not_found tool)
-  | x :: _ -> x
-
 let require_tool tool    try ignore (which tool)
-  with Tool_not_found tool ->
+  with Executable_not_found tool ->
     error (f_"%s needed but not found") tool
 
 let do_cp src destdir diff --git a/mllib/common_utils.ml
b/mllib/common_utils.ml
index e7ee84a..14f4935 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -142,6 +142,8 @@ module String = struct
       )
 end
 
+exception Executable_not_found of string (* executable *)
+
 let (//) = Filename.concat
 
 let ( +^ ) = Int64.add
@@ -316,6 +318,18 @@ let protect ~f ~finally    finally ();
   match r with Either ret -> ret | Or exn -> raise exn
 
+let which executable +  let paths = String.nsplit ":" (Sys.getenv
"PATH") in
+  let paths = 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/mllib/common_utils.mli b/mllib/common_utils.mli
index de97815..4959de6 100644
--- a/mllib/common_utils.mli
+++ b/mllib/common_utils.mli
@@ -78,6 +78,10 @@ module String : sig
 end
 (** Override the String module from stdlib. *)
 
+(** Exception thrown by [which] when the specified executable is not found
+    in [$PATH]. *)
+exception Executable_not_found of string (* executable *)
+
 val ( // ) : string -> string -> string
 (** Concatenate directory and filename. *)
 
@@ -379,3 +383,8 @@ val inspect_mount_root_ro : Guestfs.guestfs -> string
-> unit
 
 val is_btrfs_subvolume : Guestfs.guestfs -> string -> bool
 (** Checks if a filesystem is a btrfs subvolume. *)
+
+val which : string -> string
+(** Return the full path of the specified executable from [$PATH].
+
+    Throw [Executable_not_found] if not available. *)
-- 
2.7.4

run_command uses Unix.create_process which forks a child process, and
executes execve: the latter fails when the executable does not exist,
triggering the exit which, in older OCaml versions [1], also runs the
at_exit handlers.

Since there is not much that can be done to avoid this on the OCaml
side, to keep run_command working also in older OCaml version then
manually search for the existance of the given executable, exiting with
code 127 (as a shell does) in this case.

[1] http://caml.inria.fr/mantis/view.php?id=7209
---
 mllib/common_utils.ml | 32 ++++++++++++++++++++------------
 1 file changed, 20 insertions(+), 12 deletions(-)

diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
index 14f4935..fdca713 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -677,18 +677,26 @@ let external_command ?(echo_cmd = true) cmd  let
run_command ?(echo_cmd = true) args    if echo_cmd then
     debug "%s" (stringify_args args);
-  let pid -    Unix.create_process (List.hd args) (Array.of_list args)
Unix.stdin
-      Unix.stdout Unix.stderr in
-  let _, stat = Unix.waitpid [] pid in
-  match stat with
-  | Unix.WEXITED i -> i
-  | Unix.WSIGNALED i ->
-    error (f_"external command '%s' killed by signal %d")
-      (stringify_args args) i
-  | Unix.WSTOPPED i ->
-    error (f_"external command '%s' stopped by signal %d")
-      (stringify_args args) i
+  let app = List.hd args in
+  try
+    let app +      if Filename.is_relative app then which app
+      else (Unix.access app [Unix.X_OK]; app) in
+    let pid +      Unix.create_process app (Array.of_list args) Unix.stdin
+        Unix.stdout Unix.stderr in
+    let _, stat = Unix.waitpid [] pid in
+    match stat with
+    | Unix.WEXITED i -> i
+    | Unix.WSIGNALED i ->
+      error (f_"external command '%s' killed by signal %d")
+        (stringify_args args) i
+    | Unix.WSTOPPED i ->
+      error (f_"external command '%s' stopped by signal %d")
+        (stringify_args args) i
+  with
+  | Executable_not_found tool -> 127
+  | Unix.Unix_error (errcode, _, _) when errcode = Unix.ENOENT -> 127
 
 let shell_command ?(echo_cmd = true) cmd    if echo_cmd then
-- 
2.7.4

On Tue, Aug 02, 2016 at 07:14:09PM +0200, Pino Toscano
wrote:
> run_command uses Unix.create_process which forks a child process, and
> executes execve: the latter fails when the executable does not exist,
> triggering the exit which, in older OCaml versions [1], also runs the
> at_exit handlers.
> 
> Since there is not much that can be done to avoid this on the OCaml
> side, to keep run_command working also in older OCaml version then
> manually search for the existance of the given executable, exiting with
> code 127 (as a shell does) in this case.
> 
> [1] http://caml.inria.fr/mantis/view.php?id=7209
ACK both.

virt-dib includes the "which" program in appliance/packagelist.in.
I notice these patches don't use this program.  But is it still needed?

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
virt-builder quickly builds VMs from scratch
http://libguestfs.org/virt-builder.1.html