Merge pull request #5991 from dra27/resolving

Disentangle `OpamProcess.resolve_command` and `OpamSystem.resolve_command`

master_changes.md

@@ -185,3 +185,5 @@ users)
   * `OpamStubs.get_initial_environment`: on Windows, returns the pristine environment for new shells [#5963 @dra27]
   * `OpamConsole`: Add `formatted_errmsg` [#5999 @kit-ty-kate]
   * `OpamConsole.menu` now supports up to 35 menu items [#5992 @dra27]
+  * `OpamStd.Sys.resolve_command`: extracted the logic from `OpamSystem.resolve_command`, without the default environment handling from OpamProcess. [#5991 @dra27]
+  * `OpamStd.Sys.resolve_in_path`: split the logic of `OpamStd.Sys.resolve_command` to allow searching for an arbitrary file in the search path [#5991 @dra27]

src/core/opamProcess.ml

@@ -302,14 +302,11 @@ let string_of_info ?(color=`yellow) info =
         (OpamConsole.colorise color k) v) info;
   Buffer.contents b
 
-let resolve_command_fn = ref (fun ?env:_ ?dir:_ _ -> None)
-let set_resolve_command =
-  let called = ref false in
-  fun resolve_command ->
-    if !called then invalid_arg "Just what do you think you're doing, Dave?";
-    called := true;
-    resolve_command_fn := resolve_command
-let resolve_command cmd = !resolve_command_fn cmd
+let resolve_command ?env ?dir name =
+  let env = match env with None -> default_env () | Some e -> e in
+  match OpamStd.Sys.resolve_command ~env ?dir name with
+  | `Cmd cmd -> Some cmd
+  | `Denied | `Not_found -> None
 
 let create_process_env =
   if Sys.win32 then

src/core/opamProcess.mli

@@ -223,8 +223,9 @@ end
 type 'a job = 'a Job.Op.job
 
 (**/**)
-val set_resolve_command :
-  (?env:string array -> ?dir:string -> string -> string option) -> unit
+(** As {!OpamStd.Sys.resolve_command}, except the default for [~env] is
+    {!default_env}. *)
+val resolve_command: ?env:string array -> ?dir:string -> string -> string option
 
 (** Like Unix.create_process_env, but with correct escaping of arguments when
     invoking a cygwin executable from a native Windows executable. *)

src/core/opamStd.ml

@@ -1206,6 +1206,120 @@ module OpamSys = struct
       (fun f -> try f () with _ -> ())
       !registered_at_exit
 
+  let env_var env var =
+    let len = Array.length env in
+    let f = if Sys.win32 then String.uppercase_ascii else fun x -> x in
+    let prefix = f var^"=" in
+    let pfxlen = String.length prefix in
+    let rec aux i =
+      if (i : int) >= len then "" else
+      let s = env.(i) in
+      if OpamString.starts_with ~prefix (f s) then
+        String.sub s pfxlen (String.length s - pfxlen)
+      else aux (i+1)
+    in
+    aux 0
+
+  let is_external_cmd name =
+    let forward_to_back =
+      if Sys.win32 then
+        String.map (function '/' -> '\\' | c -> c)
+      else
+        fun x -> x
+    in
+    let name = forward_to_back name in
+    OpamString.contains_char name Filename.dir_sep.[0]
+
+  let resolve_in_path_t env name =
+    if not (Filename.is_relative name) || is_external_cmd name then
+      invalid_arg "OpamStd.Sys.resolve_in_path: bare command expected"
+    else
+    let path = split_path_variable (env_var env "PATH") in
+    List.filter_map (fun path ->
+        let candidate = Filename.concat path name in
+        (* TODO: use Sys.is_regular_file once opam requires OCaml >= 5.1 *)
+        match Sys.is_directory candidate with
+        | false -> Some candidate
+        | true | exception (Sys_error _) -> None)
+      path
+
+  (* OCaml 4.05.0 no longer follows the updated PATH to resolve commands. This
+     makes unqualified commands absolute as a workaround. *)
+  let resolve_command =
+    let check_perms =
+      if Sys.win32 then fun f ->
+        try (Unix.stat f).Unix.st_kind = Unix.S_REG
+        with e -> fatal e; false
+      else fun f ->
+        try
+          let {Unix.st_uid; st_gid; st_perm; st_kind; _} = Unix.stat f in
+          if st_kind <> Unix.S_REG then false else
+          let groups =
+            IntSet.of_list (Unix.getegid () :: Array.to_list (Unix.getgroups ()))
+          in
+          let mask =
+            if Unix.geteuid () = (st_uid : int) then
+              0o100
+            else if IntSet.mem st_gid groups then
+              0o010
+            else
+              0o001
+          in
+          if (st_perm land mask) <> 0 then
+            true
+          else
+          match OpamACL.get_acl_executable_info f st_uid with
+          | None -> false
+          | Some [] -> true
+          | Some gids ->
+            not (IntSet.is_empty (IntSet.inter (IntSet.of_list gids) groups))
+        with e -> fatal e; false
+    in
+    let resolve ?dir env name =
+      if not (Filename.is_relative name) then begin
+        (* absolute path *)
+        if not (Sys.file_exists name) then `Not_found
+        else if not (check_perms name) then `Denied
+        else `Cmd name
+      end else if is_external_cmd name then begin
+        (* relative path *)
+        let cmd = match dir with
+          | None -> name
+          | Some d -> Filename.concat d name
+        in
+        if not (Sys.file_exists cmd) then `Not_found
+        else if not (check_perms cmd) then `Denied
+        else `Cmd cmd
+      end else
+      (* bare command, lookup in PATH *)
+      let name =
+        if Sys.win32 && not (Filename.check_suffix name ".exe") then
+          name ^ ".exe"
+        else name
+      in
+      let possibles = resolve_in_path_t env name in
+      (* Following the shell sematics for looking up PATH, programs with the
+         expected name but not the right permissions are skipped silently.
+         Therefore, only two outcomes are possible in that case, [`Cmd ..] or
+         [`Not_found]. *)
+      match List.find check_perms possibles with
+      | cmdname -> `Cmd cmdname
+      | exception Not_found ->
+        if possibles = [] then
+          `Not_found
+        else
+          `Denied
+    in
+    fun ?env ?dir name ->
+      let env = match env with None -> Env.raw_env () | Some e -> e in
+      resolve env ?dir name
+
+  let resolve_in_path ?env name =
+    let env = match env with None -> Env.raw_env () | Some e -> e in
+    match resolve_in_path_t env name with
+    | result::_ -> Some result
+    | [] -> None
+
   let get_windows_executable_variant =
     if Sys.win32 then
       let results = Hashtbl.create 17 in

src/core/opamStd.mli

@@ -548,6 +548,17 @@ module Sys : sig
       Optional argument [clean] permits to keep those empty strings. *)
   val split_path_variable: ?clean:bool -> string -> string list
 
+  (** Test whether a command exists in the environment, and returns it (resolved
+      if found in PATH). [~env] defaults to {!Env.raw_env}. *)
+  val resolve_command: ?env:string array -> ?dir:string -> string ->
+    [ `Cmd of string | `Denied | `Not_found ]
+
+  (** Search for an arbitrary file in PATH. Unlike {!resolve_command}, no
+      transformations take place on the name in Windows (i.e. .exe, etc. is
+      never appended) and no executable check takes place. The name passed
+      must be a basename (no directory component). *)
+  val resolve_in_path: ?env:string array -> string -> string option
+
   (** For native Windows builds, returns [`Cygwin] if the command is a Cygwin-
       compiled executable, [`Msys2] if the command is a MSYS2-compiled
       executable, and [`Tainted of [ `Msys2 | `Cygwin ]] if the command links

src/core/opamSystem.ml

@@ -399,20 +399,6 @@ let remove file =
 
 type command = string list
 
-let env_var env var =
-  let len = Array.length env in
-  let f = if Sys.win32 then String.uppercase_ascii else fun x -> x in
-  let prefix = f var^"=" in
-  let pfxlen = String.length prefix in
-  let rec aux i =
-    if i >= len then "" else
-    let s = env.(i) in
-    if OpamStd.String.starts_with ~prefix (f s) then
-      String.sub s pfxlen (String.length s - pfxlen)
-    else aux (i+1)
-  in
-  aux 0
-
 let forward_to_back =
   if Sys.win32 then
     String.map (function '/' -> '\\' | c -> c)
@@ -425,91 +411,7 @@ let back_to_forward =
   else
     fun x -> x
 
-(* OCaml 4.05.0 no longer follows the updated PATH to resolve commands. This
-   makes unqualified commands absolute as a workaround. *)
-let t_resolve_command =
-  let is_external_cmd name =
-    let name = forward_to_back name in
-    OpamStd.String.contains_char name Filename.dir_sep.[0]
-  in
-  let check_perms =
-    if Sys.win32 then fun f ->
-      try (Unix.stat f).Unix.st_kind = Unix.S_REG
-      with e -> OpamStd.Exn.fatal e; false
-    else fun f ->
-      try
-        let open Unix in
-        let {st_uid; st_gid; st_perm; st_kind; _} = stat f in
-        if st_kind <> Unix.S_REG then false else
-        let groups = OpamStd.IntSet.of_list (getegid () :: Array.to_list (getgroups ())) in
-        let mask =
-          if geteuid () = st_uid then
-            0o100
-          else if OpamStd.IntSet.mem st_gid groups then
-            0o010
-          else
-            0o001
-        in
-        if (st_perm land mask) <> 0 then
-          true
-        else
-          match OpamACL.get_acl_executable_info f st_uid with
-          | None -> false
-          | Some [] -> true
-          | Some gids -> OpamStd.IntSet.(not (is_empty (inter (of_list gids) groups)))
-      with e -> OpamStd.Exn.fatal e; false
-  in
-  let resolve ?dir env name =
-    if not (Filename.is_relative name) then begin
-      (* absolute path *)
-      if not (Sys.file_exists name) then `Not_found
-      else if not (check_perms name) then `Denied
-      else `Cmd name
-    end else if is_external_cmd name then begin
-      (* relative path *)
-      let cmd = match dir with
-        | None -> name
-        | Some d -> Filename.concat d name
-      in
-      if not (Sys.file_exists cmd) then `Not_found
-      else if not (check_perms cmd) then `Denied
-      else `Cmd cmd
-    end else
-    (* bare command, lookup in PATH *)
-    (* Following the shell sematics for looking up PATH, programs with the
-       expected name but not the right permissions are skipped silently.
-       Therefore, only two outcomes are possible in that case, [`Cmd ..] or
-       [`Not_found]. *)
-    let path = OpamStd.Sys.split_path_variable (env_var env "PATH") in
-    let name =
-      if Sys.win32 && not (Filename.check_suffix name ".exe") then
-        name ^ ".exe"
-      else name
-    in
-    let possibles =
-      OpamStd.List.filter_map (fun path ->
-          let candidate = Filename.concat path name in
-          match Sys.is_directory candidate with
-          | false -> Some candidate
-          | true | exception (Sys_error _) -> None)
-        path
-    in
-    match List.find check_perms possibles with
-    | cmdname -> `Cmd cmdname
-    | exception Not_found ->
-      if possibles = [] then
-        `Not_found
-      else
-        `Denied
-  in
-  fun ?env ?dir name ->
-    let env = match env with None -> OpamProcess.default_env () | Some e -> e in
-    resolve env ?dir name
-
-let resolve_command ?env ?dir name =
-  match t_resolve_command ?env ?dir name with
-  | `Cmd cmd -> Some cmd
-  | `Denied | `Not_found -> None
+let resolve_command = OpamProcess.resolve_command
 
 let bin_contains_bash =
   if not Sys.win32 && not Sys.cygwin then fun _ -> false else
@@ -596,7 +498,7 @@ let make_command
     OpamStd.Option.default OpamCoreConfig.(!r.verbose_level >= 2) verbose
   in
   let full_cmd =
-    if resolve_path then t_resolve_command ~env ?dir cmd
+    if resolve_path then OpamStd.Sys.resolve_command ~env ?dir cmd
     else `Cmd cmd
   in
   match full_cmd with
@@ -615,7 +517,7 @@ let run_process
   match command with
   | []          -> invalid_arg "run_process"
   | cmd :: args ->
-    match t_resolve_command ~env cmd with
+    match OpamStd.Sys.resolve_command ~env cmd with
     | `Cmd full_cmd ->
       let verbose = match verbose with
         | None   -> OpamCoreConfig.(!r.verbose_level) >= 2
@@ -1707,6 +1609,3 @@ let init () =
   Sys.catch_break true;
   try Sys.set_signal Sys.sigpipe (Sys.Signal_handle (fun _ -> ()))
   with Invalid_argument _ -> ()
-
-let () =
-  OpamProcess.set_resolve_command resolve_command

src/core/opamSystem.mli

@@ -181,8 +181,8 @@ val make_command:
 (** a command is a list of words *)
 type command = string list
 
-(** Test whether a command exists in the environment, and returns it (resolved
-    if found in PATH) *)
+(** As {!OpamStd.Sys.resolve_command}, except the default for [~env] is
+    {!OpamProcess.default_env}. *)
 val resolve_command: ?env:string array -> ?dir:string -> string -> string option
 
 val bin_contains_bash: string -> bool