From c6b6f80d2bdcd4488d12d430b3db325f3db89ac6 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Tue, 21 May 2024 14:08:57 +0100 Subject: [PATCH 1/2] Move OpamSystem.t_resolve_command to OpamStd.Sys Allow OpamStd.Sys to be have access to PATH-resolving machinery from OpamSystem. This also allows the dependency knot between OpamSystem and OpamProcess to be solved more simply. --- master_changes.md | 1 + src/core/opamProcess.ml | 13 ++--- src/core/opamProcess.mli | 5 +- src/core/opamStd.ml | 102 +++++++++++++++++++++++++++++++++++++ src/core/opamStd.mli | 5 ++ src/core/opamSystem.ml | 107 ++------------------------------------- src/core/opamSystem.mli | 4 +- 7 files changed, 121 insertions(+), 116 deletions(-) diff --git a/master_changes.md b/master_changes.md index 8c80d59555a..ad6d870d857 100644 --- a/master_changes.md +++ b/master_changes.md @@ -184,3 +184,4 @@ 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] diff --git a/src/core/opamProcess.ml b/src/core/opamProcess.ml index 5da63c8d995..6b23ffeb647 100644 --- a/src/core/opamProcess.ml +++ b/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 diff --git a/src/core/opamProcess.mli b/src/core/opamProcess.mli index 02259649d32..9c73b166c23 100644 --- a/src/core/opamProcess.mli +++ b/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. *) diff --git a/src/core/opamStd.ml b/src/core/opamStd.ml index 03feb6beb97..dbdda1a03ea 100644 --- a/src/core/opamStd.ml +++ b/src/core/opamStd.ml @@ -1206,6 +1206,108 @@ 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 + + (* 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 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] + in + 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 *) + (* 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 = 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 = + 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 -> Env.raw_env () | Some e -> e in + resolve env ?dir name + let get_windows_executable_variant = if Sys.win32 then let results = Hashtbl.create 17 in diff --git a/src/core/opamStd.mli b/src/core/opamStd.mli index ce2a4aee712..d1323ab579b 100644 --- a/src/core/opamStd.mli +++ b/src/core/opamStd.mli @@ -548,6 +548,11 @@ 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 ] + (** 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 diff --git a/src/core/opamSystem.ml b/src/core/opamSystem.ml index 925a232469a..428271cf8c3 100644 --- a/src/core/opamSystem.ml +++ b/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 diff --git a/src/core/opamSystem.mli b/src/core/opamSystem.mli index de977c51c0d..25dc6c1e043 100644 --- a/src/core/opamSystem.mli +++ b/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 From 38859d6736d064ab24761db2a571c84db3f9c20d Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Wed, 5 Jun 2024 19:05:28 +0100 Subject: [PATCH 2/2] Expose OpamStd.Sys.resolve_in_path Exposes the portion of OpamStd.Sys.resolve_command which searches the PATH environment for a given basename. --- master_changes.md | 1 + src/core/opamStd.ml | 56 +++++++++++++++++++++++++++----------------- src/core/opamStd.mli | 6 +++++ 3 files changed, 41 insertions(+), 22 deletions(-) diff --git a/master_changes.md b/master_changes.md index ad6d870d857..97cb5f7906c 100644 --- a/master_changes.md +++ b/master_changes.md @@ -185,3 +185,4 @@ users) * `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] diff --git a/src/core/opamStd.ml b/src/core/opamStd.ml index dbdda1a03ea..97d6e257f11 100644 --- a/src/core/opamStd.ml +++ b/src/core/opamStd.ml @@ -1220,18 +1220,32 @@ module OpamSys = struct 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 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] - in let check_perms = if Sys.win32 then fun f -> try (Unix.stat f).Unix.st_kind = Unix.S_REG @@ -1278,24 +1292,16 @@ module OpamSys = struct 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 = 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 = - 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 + 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 -> @@ -1308,6 +1314,12 @@ module OpamSys = struct 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 diff --git a/src/core/opamStd.mli b/src/core/opamStd.mli index d1323ab579b..960bd4fb114 100644 --- a/src/core/opamStd.mli +++ b/src/core/opamStd.mli @@ -553,6 +553,12 @@ module Sys : sig 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