diff --git a/src/dune_pkg/sys_poll.ml b/src/dune_pkg/sys_poll.ml index d3c00914d19..efc2dc1d2f3 100644 --- a/src/dune_pkg/sys_poll.ml +++ b/src/dune_pkg/sys_poll.ml @@ -50,9 +50,15 @@ let arch ~path = match Sys.os_type with | "Unix" | "Cygwin" -> uname ~path [ "-m" ] | "Win32" -> - if Sys.word_size = 32 && not (OpamStubs.isWoW64 ()) - then Fiber.return @@ Some "i686" - else Fiber.return @@ Some "x86_64" + Fiber.return + @@ + (match OpamStubs.getArchitecture () with + | OpamStubs.AMD64 -> Some "x86_64" + | ARM -> Some "arm32" + | ARM64 -> Some "arm64" + | IA64 -> Some "ia64" + | Intel -> Some "x86_32" + | Unknown -> None) | _ -> Fiber.return None in match raw with diff --git a/vendor/opam/src/core/opamCompat.ml b/vendor/opam/src/core/opamCompat.ml index 973be9d21ee..216376563aa 100644 --- a/vendor/opam/src/core/opamCompat.ml +++ b/vendor/opam/src/core/opamCompat.ml @@ -57,3 +57,93 @@ module Lazy = struct include Stdlib.Lazy end + +module Filename = struct + [@@@warning "-32"] + + let quote s = + let l = String.length s in + let b = Buffer.create (l + 20) in + Buffer.add_char b '\"'; + let rec loop i = + if i = l then Buffer.add_char b '\"' else + match s.[i] with + | '\"' -> loop_bs 0 i; + | '\\' -> loop_bs 0 i; + | c -> Buffer.add_char b c; loop (i+1); + and loop_bs n i = + if i = l then begin + Buffer.add_char b '\"'; + add_bs n; + end else begin + match s.[i] with + | '\"' -> add_bs (2*n+1); Buffer.add_char b '\"'; loop (i+1); + | '\\' -> loop_bs (n+1) (i+1); + | _ -> add_bs n; loop i + end + and add_bs n = for _j = 1 to n do Buffer.add_char b '\\'; done + in + loop 0; + Buffer.contents b + +(* +Quoting commands for execution by cmd.exe is difficult. +1- Each argument is first quoted using the "quote" function above, to + protect it against the processing performed by the C runtime system, + then cmd.exe's special characters are escaped with '^', using + the "quote_cmd" function below. For more details, see + https://blogs.msdn.microsoft.com/twistylittlepassagesallalike/2011/04/23 +2- The command and the redirection files, if any, must be double-quoted + in case they contain spaces. This quoting is interpreted by cmd.exe, + not by the C runtime system, hence the "quote" function above + cannot be used. The two characters we don't know how to quote + inside a double-quoted cmd.exe string are double-quote and percent. + We just fail if the command name or the redirection file names + contain a double quote (not allowed in Windows file names, anyway) + or a percent. See function "quote_cmd_filename" below. +3- The whole string passed to Sys.command is then enclosed in double + quotes, which are immediately stripped by cmd.exe. Otherwise, + some of the double quotes from step 2 above can be misparsed. + See e.g. https://stackoverflow.com/a/9965141 +*) + let quote_cmd s = + let b = Buffer.create (String.length s + 20) in + String.iter + (fun c -> + match c with + | '(' | ')' | '!' | '^' | '%' | '\"' | '<' | '>' | '&' | '|' -> + Buffer.add_char b '^'; Buffer.add_char b c + | _ -> + Buffer.add_char b c) + s; + Buffer.contents b + + let quote_cmd_filename f = + if String.contains f '\"' || String.contains f '%' then + failwith ("Filename.quote_command: bad file name " ^ f) + else if String.contains f ' ' then + "\"" ^ f ^ "\"" + else + f + (* Redirections in cmd.exe: see https://ss64.com/nt/syntax-redirection.html + and https://docs.microsoft.com/en-us/previous-versions/windows/it-pro/windows-xp/bb490982(v=technet.10) + *) + + (** NOTE: OCaml >= 4.10 *) + let quote_command cmd ?stdin ?stdout ?stderr args = + String.concat "" [ + "\""; + quote_cmd_filename cmd; + " "; + quote_cmd (String.concat " " (List.map quote args)); + (match stdin with None -> "" | Some f -> " <" ^ quote_cmd_filename f); + (match stdout with None -> "" | Some f -> " >" ^ quote_cmd_filename f); + (match stderr with None -> "" | Some f -> + if stderr = stdout + then " 2>&1" + else " 2>" ^ quote_cmd_filename f); + "\"" + ] + + include Stdlib.Filename +end diff --git a/vendor/opam/src/core/opamCompat.mli b/vendor/opam/src/core/opamCompat.mli index ea6635c94f0..9596aedbb82 100644 --- a/vendor/opam/src/core/opamCompat.mli +++ b/vendor/opam/src/core/opamCompat.mli @@ -30,3 +30,11 @@ module Unix : sig implementation with double chdir otherwise *) val realpath: string -> string end + +module Filename: sig + (** NOTE: OCaml >= 4.10 *) + + val quote_command : + string -> ?stdin:string -> ?stdout:string -> ?stderr:string + -> string list -> string +end diff --git a/vendor/opam/src/core/opamCoreConfig.ml b/vendor/opam/src/core/opamCoreConfig.ml index a26c78edce6..016027f34c0 100644 --- a/vendor/opam/src/core/opamCoreConfig.ml +++ b/vendor/opam/src/core/opamCoreConfig.ml @@ -63,6 +63,7 @@ type t = { errlog_length: int; merged_output: bool; precise_tracking: bool; + cygbin: string option; set: bool; } @@ -81,6 +82,7 @@ type 'a options_fun = ?errlog_length:int -> ?merged_output:bool -> ?precise_tracking:bool -> + ?cygbin:string -> 'a let default = { @@ -101,6 +103,7 @@ let default = { errlog_length = 12; merged_output = true; precise_tracking = false; + cygbin = None; set = false; } @@ -119,6 +122,7 @@ let setk k t ?errlog_length ?merged_output ?precise_tracking + ?cygbin = let (+) x opt = match opt with Some x -> x | None -> x in k { @@ -139,6 +143,7 @@ let setk k t errlog_length = t.errlog_length + errlog_length; merged_output = t.merged_output + merged_output; precise_tracking = t.precise_tracking + precise_tracking; + cygbin = (match cygbin with Some _ -> cygbin | None -> t.cygbin); set = true; } @@ -179,6 +184,7 @@ let initk k = ?errlog_length:(E.errloglen ()) ?merged_output:(E.mergeout ()) ?precise_tracking:(E.precisetracking ()) + ?cygbin:None let init ?noop:_ = initk (fun () -> ()) diff --git a/vendor/opam/src/core/opamCoreConfig.mli b/vendor/opam/src/core/opamCoreConfig.mli index 1147fa5376f..a575e958307 100644 --- a/vendor/opam/src/core/opamCoreConfig.mli +++ b/vendor/opam/src/core/opamCoreConfig.mli @@ -71,6 +71,7 @@ type t = private { precise_tracking : bool; (** If set, will take full md5 of all files when checking diffs (to track installations), rather than rely on just file size and mtime *) + cygbin: string option; set : bool; (** Options have not yet been initialised (i.e. defaults are active) *) } @@ -90,6 +91,7 @@ type 'a options_fun = ?errlog_length:int -> ?merged_output:bool -> ?precise_tracking:bool -> + ?cygbin:string -> 'a val default : t diff --git a/vendor/opam/src/core/opamFilename.ml b/vendor/opam/src/core/opamFilename.ml index ff4047fce88..d925d439179 100644 --- a/vendor/opam/src/core/opamFilename.ml +++ b/vendor/opam/src/core/opamFilename.ml @@ -109,8 +109,7 @@ let exec dirname ?env ?name ?metadata ?keep_going cmds = (fun () -> OpamSystem.commands ?env ?name ?metadata ?keep_going cmds) let move_dir ~src ~dst = - OpamSystem.command ~verbose:(OpamSystem.verbose_for_base_commands ()) - [ "mv"; Dir.to_string src; Dir.to_string dst ] + OpamSystem.mv (Dir.to_string src) (Dir.to_string dst) let opt_dir dirname = if exists_dir dirname then Some dirname else None @@ -292,8 +291,7 @@ let install ?warning ?exec ~src ~dst () = let move ~src ~dst = if src <> dst then - OpamSystem.command ~verbose:(OpamSystem.verbose_for_base_commands ()) - [ "mv"; to_string src; to_string dst ] + OpamSystem.mv (to_string src) (to_string dst) let readlink src = if exists src then diff --git a/vendor/opam/src/core/opamProcess.ml b/vendor/opam/src/core/opamProcess.ml index ef87346256e..2bb104ea5ea 100644 --- a/vendor/opam/src/core/opamProcess.ml +++ b/vendor/opam/src/core/opamProcess.ml @@ -14,6 +14,14 @@ module Re = Dune_re let log ?level fmt = OpamConsole.log "PROC" ?level fmt +let default_env = + let f () = lazy ( + match OpamCoreConfig.(!r.cygbin) with + | Some cygbin -> OpamStd.Env.cyg_env cygbin + | None -> OpamStd.Env.raw_env () + ) in + fun () -> Lazy.force (f ()) + let cygwin_create_process_env prog args env fd1 fd2 fd3 = (* * Unix.create_process_env correctly converts arguments to a command line for @@ -174,8 +182,7 @@ let cygwin_create_process_env prog args env fd1 fd2 fd3 = List.rev_append prefix (dir::(List.rev_append suffix dirs)) end else f prefix (dir::suffix) dirs - | [] -> - assert false + | [] -> [] in Some (key ^ "=" ^ String.concat ";" (f [] [] path_dirs)) | _ -> @@ -311,11 +318,13 @@ let resolve_command cmd = !resolve_command_fn cmd let create_process_env = if Sys.win32 then fun cmd -> - let resolved_cmd = resolve_command cmd in - if OpamStd.(Option.map_default Sys.is_cygwin_variant `Native resolved_cmd) = `Cygwin then + if OpamStd.Option.map_default + (OpamStd.Sys.is_cygwin_variant + ~cygbin:(OpamCoreConfig.(!r.cygbin))) + false + (resolve_command cmd) then cygwin_create_process_env cmd - else - Unix.create_process_env cmd + else Unix.create_process_env cmd else Unix.create_process_env @@ -341,7 +350,7 @@ let create ?info_file ?env_file ?(allow_stdin=not Sys.win32) ?stdout_file ?stder | None -> (fun f -> f ()) | Some dir -> Unix.chdir dir; - Fun.protect ~finally:(fun () -> Unix.chdir oldcwd) + OpamStd.Exn.finally (fun () -> Unix.chdir oldcwd) in with_chdir dir @@ fun () -> let stdin_fd,close_stdin = @@ -360,7 +369,7 @@ let create ?info_file ?env_file ?(allow_stdin=not Sys.win32) ?stdout_file ?stder else tee f in let env = match env with - | None -> Unix.environment () + | None -> default_env () | Some e -> e in let time = Unix.gettimeofday () in @@ -443,14 +452,8 @@ let create ?info_file ?env_file ?(allow_stdin=not Sys.win32) ?stdout_file ?stder cmd, args else cmd, args in - let create_process, cmd, args = - if Sys.win32 && OpamStd.Sys.is_cygwin_variant cmd = `Cygwin then - cygwin_create_process_env, cmd, args - else - Unix.create_process_env, cmd, args - in try - create_process + create_process_env cmd (Array.of_list (cmd :: args)) env @@ -529,7 +532,7 @@ let run_background command = in let verbose = is_verbose_command command in let allow_stdin = OpamStd.Option.default false allow_stdin in - let env = match env with Some e -> e | None -> Unix.environment () in + let env = match env with Some e -> e | None -> default_env () in let file ext = match name with | None -> None | Some n -> diff --git a/vendor/opam/src/core/opamProcess.mli b/vendor/opam/src/core/opamProcess.mli index bfad59cf4c2..02259649d32 100644 --- a/vendor/opam/src/core/opamProcess.mli +++ b/vendor/opam/src/core/opamProcess.mli @@ -232,3 +232,5 @@ val create_process_env : string -> string array -> string array -> Unix.file_descr -> Unix.file_descr -> Unix.file_descr -> int + +val default_env : unit -> string array diff --git a/vendor/opam/src/core/opamStd.ml b/vendor/opam/src/core/opamStd.ml index 4547027148a..7b3731b8880 100644 --- a/vendor/opam/src/core/opamStd.ml +++ b/vendor/opam/src/core/opamStd.ml @@ -826,17 +826,30 @@ module Env = struct module Map = Map.Make(M) end + let to_list env = + List.rev_map (fun s -> + match OpamString.cut_at s '=' with + | None -> s, "" + | Some p -> p) + (Array.to_list env) + + let raw_env = Unix.environment + let list = - let lazy_env = lazy ( - let e = Unix.environment () in - List.rev_map (fun s -> - match OpamString.cut_at s '=' with - | None -> s, "" - | Some p -> p - ) (Array.to_list e) - ) in + let lazy_env = lazy (to_list (raw_env ())) in fun () -> Lazy.force lazy_env + let cyg_env cygbin = + let env = raw_env () in + let f v = + match OpamString.cut_at v '=' with + | Some (path, c) when Name.equal_string path "path" -> + Printf.sprintf "%s=%s;%s" + path cygbin c + | _ -> v + in + Array.map f env + let get_full n = List.find (fun (k,_) -> Name.equal k n) (list ()) let get n = snd (get_full n) @@ -1026,7 +1039,7 @@ module OpamSys = struct type powershell_host = Powershell_pwsh | Powershell type shell = SH_sh | SH_bash | SH_zsh | SH_csh | SH_fish - | SH_pwsh of powershell_host | SH_win_cmd + | SH_pwsh of powershell_host | SH_cmd let all_shells = [SH_sh; SH_bash; @@ -1035,9 +1048,9 @@ module OpamSys = struct SH_fish; SH_pwsh Powershell_pwsh; SH_pwsh Powershell; - SH_win_cmd] + SH_cmd] - let windows_default_shell = SH_win_cmd + let windows_default_shell = SH_cmd let unix_default_shell = SH_sh let shell_of_string = function @@ -1062,40 +1075,17 @@ module OpamSys = struct else fun x -> x - let windows_max_ancestor_depth = 5 - - (** [windows_ancestor_process_names] finds the names of the parent of the - current process and all of its ancestors up to [max_ancestor_depth] - in length. - - The immediate parent of the current process will be first in the list. - *) - let windows_ancestor_process_names () = - let rec helper pid depth = - if depth > windows_max_ancestor_depth then [] - else - try - OpamStubs.(getProcessName pid :: - helper - (getParentProcessID pid) - (depth + 1)) - with Failure _ -> [] - in - lazy ( - try - let parent = OpamStubs.getCurrentProcessID () in - helper (OpamStubs.getParentProcessID parent) 0 - with Failure _ -> [] - ) + let windows_process_ancestry = Lazy.from_fun OpamStubs.getProcessAncestry type shell_choice = Accept of shell let windows_get_shell = - let categorize_process = function + let categorize_process (_, image) = + match String.lowercase_ascii (Filename.basename image) with | "powershell.exe" | "powershell_ise.exe" -> Some (Accept (SH_pwsh Powershell)) | "pwsh.exe" -> Some (Accept (SH_pwsh Powershell_pwsh)) - | "cmd.exe" -> Some (Accept SH_win_cmd) + | "cmd.exe" -> Some (Accept SH_cmd) | "env.exe" -> Some (Accept SH_sh) | name -> Option.map @@ -1103,9 +1093,8 @@ module OpamSys = struct (shell_of_string (Filename.chop_suffix name ".exe")) in lazy ( - let ancestors = Lazy.force (windows_ancestor_process_names ()) in - match (List.map String.lowercase_ascii ancestors |> - OpamList.filter_map categorize_process) with + let lazy ancestors = windows_process_ancestry in + match OpamList.filter_map categorize_process ancestors with | [] -> None | Accept most_relevant_shell :: _ -> Some most_relevant_shell ) @@ -1161,48 +1150,42 @@ module OpamSys = struct Option.default unix_default_shell shell let guess_dot_profile shell = - let win_my_powershell f = - let p = Filename.concat (home ()) "Documents" in - if Sys.file_exists p then Filename.concat (Filename.concat p "PowerShell") f - else let p = Filename.concat (home ()) "My Documents" in - if Sys.file_exists p then Filename.concat (Filename.concat p "PowerShell") f - else f - in let home f = try Filename.concat (home ()) f with Not_found -> f in match shell with | SH_fish -> - List.fold_left Filename.concat (home ".config") ["fish"; "config.fish"] - | SH_zsh -> home ".zshrc" + Some (List.fold_left Filename.concat (home ".config") ["fish"; "config.fish"]) + | SH_zsh -> Some (home ".zshrc") | SH_bash -> - (try - List.find Sys.file_exists [ - (* Bash looks up these 3 files in order and only loads the first, - for LOGIN shells *) - home ".bash_profile"; - home ".bash_login"; - home ".profile"; - (* Bash loads .bashrc INSTEAD, for interactive NON login shells only; - but it's often included from the above. - We may include our variables in both to be sure ; for now we rely - on non-login shells inheriting their env from a login shell - somewhere... *) - ] - with Not_found -> - (* iff none of the above exist, creating this should be safe *) - home ".bash_profile") + let shell = + (try + List.find Sys.file_exists [ + (* Bash looks up these 3 files in order and only loads the first, + for LOGIN shells *) + home ".bash_profile"; + home ".bash_login"; + home ".profile"; + (* Bash loads .bashrc INSTEAD, for interactive NON login shells only; + but it's often included from the above. + We may include our variables in both to be sure ; for now we rely + on non-login shells inheriting their env from a login shell + somewhere... *) + ] + with Not_found -> + (* iff none of the above exist, creating this should be safe *) + home ".bash_profile") + in + Some shell | SH_csh -> let cshrc = home ".cshrc" in let tcshrc = home ".tcshrc" in - if Sys.file_exists cshrc then cshrc else tcshrc + Some (if Sys.file_exists cshrc then cshrc else tcshrc) | SH_pwsh _ -> - if Sys.win32 then win_my_powershell "Microsoft.Powershell_profile.ps1" else - List.fold_left Filename.concat (home ".config") ["powershell"; "Microsoft.Powershell_profile.ps1"] - | SH_sh -> home ".profile" - | SH_win_cmd -> - (* cmd.exe does not have a concept of profiles *) - home ".profile" + None + | SH_sh -> Some (home ".profile") + | SH_cmd -> + None let registered_at_exit = ref [] @@ -1217,59 +1200,73 @@ module OpamSys = struct let get_windows_executable_variant = if Sys.win32 then let results = Hashtbl.create 17 in - let requires_cygwin name = - let cmd = Printf.sprintf "cygcheck \"%s\"" name in - let ((c, _, _) as process) = Unix.open_process_full cmd (Unix.environment ()) in - let rec f a = + let requires_cygwin cygcheck name = + let env = Env.cyg_env (Filename.dirname cygcheck) in + let cmd = OpamCompat.Filename.quote_command cygcheck [name] in + let ((c, _, _) as process) = Unix.open_process_full cmd env in + let rec check_dll platform = match input_line c with - | x -> - let tx = String.trim x in - if OpamString.ends_with ~suffix:"cygwin1.dll" tx then - if OpamString.starts_with ~prefix:" " x then - f `Cygwin - else if a = `Native then - f (`Tainted `Cygwin) + | dll -> + let tdll = (*String.trim*) dll in + if OpamString.ends_with ~suffix:"cygwin1.dll" tdll then + if OpamString.starts_with ~prefix:" " dll then + check_dll `Cygwin + else if platform = `Native then + check_dll (`Tainted `Cygwin) else - f a - else if OpamString.ends_with ~suffix:"msys-2.0.dll" tx then - if OpamString.starts_with ~prefix:" " x then - f `Msys2 - else if a = `Native then - f (`Tainted `Msys2) + check_dll platform + else if OpamString.ends_with ~suffix:"msys-2.0.dll" tdll then + if OpamString.starts_with ~prefix:" " dll then + check_dll `Msys2 + else if platform = `Native then + check_dll (`Tainted `Msys2) else - f a + check_dll platform else - f a + check_dll platform | exception e -> - Unix.close_process_full process |> ignore; - fatal e; - a + Unix.close_process_full process |> ignore; + fatal e; + platform in - f `Native + check_dll `Native in - fun name -> - if Filename.is_relative name then - requires_cygwin name - else - try - Hashtbl.find results name - with Not_found -> - let result = requires_cygwin name - in - Hashtbl.add results name result; - result + fun ~cygbin name -> + match cygbin with + | Some cygbin -> + (let cygcheck = Filename.concat cygbin "cygcheck.exe" in + if Filename.is_relative name then + requires_cygwin cygcheck name + else + try Hashtbl.find results (cygcheck, name) + with Not_found -> + let result = requires_cygwin cygcheck name in + Hashtbl.add results (cygcheck, name) result; + result) + | None -> `Native else - fun _ -> `Native + fun ~cygbin:_ _ -> `Native - let is_cygwin_variant cmd = + let is_cygwin_cygcheck ~cygbin = + match cygbin with + | Some cygbin -> + let cygpath = Filename.concat cygbin "cygpath.exe" in + Sys.file_exists cygpath + && (get_windows_executable_variant ~cygbin:(Some cygbin) cygpath = `Cygwin) + | None -> false + + let get_cygwin_variant ~cygbin cmd = (* Treat MSYS2's variant of `cygwin1.dll` called `msys-2.0.dll` equivalently. Confer https://www.msys2.org/wiki/How-does-MSYS2-differ-from-Cygwin/ *) - match get_windows_executable_variant cmd with + match get_windows_executable_variant ~cygbin cmd with | `Native -> `Native | `Cygwin | `Msys2 -> `Cygwin | `Tainted _ -> `CygLinked + let is_cygwin_variant ~cygbin cmd = + get_cygwin_variant ~cygbin cmd = `Cygwin + exception Exit of int exception Exec of string * string array * string array @@ -1345,47 +1342,58 @@ module Win32 = struct end let (set_parent_pid, parent_putenv) = - let ppid = ref (lazy (OpamStubs.(getCurrentProcessID () |> getParentProcessID))) in + let ppid = ref (OpamCompat.Lazy.map (function (_::(pid, _)::_) -> pid | _ -> 0l) OpamSys.windows_process_ancestry) in let parent_putenv = lazy ( - let ppid = Lazy.force !ppid in - if OpamStubs.isWoW64 () <> OpamStubs.isWoW64Process ppid then - (* - * Expect to see opam-putenv.exe in the same directory as opam.exe, - * rather than PATH (allow for crazy users like developers who may have - * both builds of opam) - *) - let putenv_exe = - Filename.(concat (dirname Sys.executable_name) "opam-putenv.exe") + let {contents = lazy ppid} = ppid in + let our_architecture = OpamStubs.getProcessArchitecture None in + let their_architecture = OpamStubs.getProcessArchitecture (Some ppid) in + let no_opam_putenv = + let warning = lazy ( + !console.warning "opam-putenv was not found - \ + OPAM is unable to alter environment variables"; + false) in - let ctrl = ref stdout in - let quit_putenv () = - if !ctrl <> stdout then - let () = Printf.fprintf !ctrl "::QUIT\n%!" in - ctrl := stdout - in - at_exit quit_putenv; - if Sys.file_exists putenv_exe then - fun key value -> - if !ctrl = stdout then begin - let (inCh, outCh) = Unix.pipe () in - let _ = - Unix.create_process putenv_exe - [| putenv_exe; Int32.to_string ppid |] - inCh Unix.stdout Unix.stderr - in - ctrl := (Unix.out_channel_of_descr outCh); - set_binary_mode_out !ctrl true; - end; - Printf.fprintf !ctrl "%s\n%s\n%!" key value; - if key = "::QUIT" then ctrl := stdout; - true - else - let warning = lazy ( - !console.warning "opam-putenv was not found - \ - OPAM is unable to alter environment variables"; - false) + fun _ _ -> Lazy.force warning + in + if our_architecture <> their_architecture then + match their_architecture with + | OpamStubs.ARM | ARM64 | IA64 | Unknown -> + (* ARM support not yet implemented - just ensure we don't inject Intel + code into an ARM process! *) + no_opam_putenv + | AMD64 | Intel -> + (* + * Expect to see opam-putenv.exe in the same directory as opam.exe, + * rather than PATH (allow for crazy users like developers who may have + * both builds of opam) + *) + let putenv_exe = + Filename.(concat (dirname Sys.executable_name) "opam-putenv.exe") + in + let ctrl = ref stdout in + let quit_putenv () = + if !ctrl <> stdout then + let () = Printf.fprintf !ctrl "::QUIT\n%!" in + ctrl := stdout in - fun _ _ -> Lazy.force warning + at_exit quit_putenv; + if Sys.file_exists putenv_exe then + fun key value -> + if !ctrl = stdout then begin + let (inCh, outCh) = Unix.pipe () in + let _ = + Unix.create_process putenv_exe + [| putenv_exe; Int32.to_string ppid |] + inCh Unix.stdout Unix.stderr + in + ctrl := (Unix.out_channel_of_descr outCh); + set_binary_mode_out !ctrl true; + end; + Printf.fprintf !ctrl "%s\n%s\n%!" key value; + if key = "::QUIT" then ctrl := stdout; + true + else + no_opam_putenv else function "::QUIT" -> fun _ -> true | key -> OpamStubs.process_putenv ppid key) diff --git a/vendor/opam/src/core/opamStd.mli b/vendor/opam/src/core/opamStd.mli index 5fd460f06a2..ab0b1f04c29 100644 --- a/vendor/opam/src/core/opamStd.mli +++ b/vendor/opam/src/core/opamStd.mli @@ -455,6 +455,8 @@ module Env : sig val getopt_full: Name.t -> Name.t * string option val list: unit -> (Name.t * string) list + val raw_env: unit -> string Array.t + val cyg_env: string -> string Array.t end (** {2 System query and exit handling} *) @@ -504,7 +506,7 @@ module Sys : sig (** The different families of shells we know about *) type powershell_host = Powershell_pwsh | Powershell type shell = SH_sh | SH_bash | SH_zsh | SH_csh | SH_fish - | SH_pwsh of powershell_host | SH_win_cmd + | SH_pwsh of powershell_host | SH_cmd (** List of all supported shells *) val all_shells : shell list @@ -512,8 +514,9 @@ module Sys : sig (** Guess the shell compat-mode *) val guess_shell_compat: unit -> shell - (** Guess the location of .profile *) - val guess_dot_profile: shell -> string + (** Guess the location of .profile. Returns None if the shell doesn't + support the concept of a .profile file. *) + val guess_dot_profile: shell -> string option (** The separator character used in the PATH variable (varies depending on OS) *) @@ -533,11 +536,16 @@ module Sys : sig Note that this returns [`Native] on a Cygwin-build of opam! - Both cygcheck and an unqualified command will be resolved using the - current PATH. *) - val get_windows_executable_variant: + Both cygcheck and an unqualified command will be resolved if necessary + using the current PATH. *) + val get_windows_executable_variant: cygbin:string option -> string -> [ `Native | `Cygwin | `Tainted of [ `Msys2 | `Cygwin] | `Msys2 ] + (** Determines if cygcheck in given cygwin binary directory comes from a + Cygwin or MSYS2 installation. Determined by analysing the cygpath command + found with it. *) + val is_cygwin_cygcheck : cygbin:string option -> bool + (** For native Windows builds, returns [`Cygwin] if the command is a Cygwin- or Msys2- compiled executable, and [`CygLinked] if the command links to a library which is itself Cygwin/Msys2-compiled, or [`Native] otherwise. @@ -546,7 +554,10 @@ module Sys : sig Both cygcheck and an unqualified command will be resolved using the current PATH. *) - val is_cygwin_variant: string -> [ `Native | `Cygwin | `CygLinked ] + val get_cygwin_variant: cygbin:string option -> string -> [ `Native | `Cygwin | `CygLinked ] + + (** Returns true if [get_cygwin_variant] is [`Cygwin] *) + val is_cygwin_variant: cygbin:string option -> string -> bool (** {3 Exit handling} *) diff --git a/vendor/opam/src/core/opamStubs.ml b/vendor/opam/src/core/opamStubs.ml index 33345c4f8ea..2b405782a8c 100644 --- a/vendor/opam/src/core/opamStubs.ml +++ b/vendor/opam/src/core/opamStubs.ml @@ -21,7 +21,7 @@ let fillConsoleOutputCharacter _ _ _ = that's_a_no_no let getConsoleMode = that's_a_no_no let setConsoleMode _ = that's_a_no_no let getWindowsVersion = that's_a_no_no -let isWoW64 () = false +let getArchitecture = that's_a_no_no let waitpids _ = that's_a_no_no let writeRegistry _ _ _ = that's_a_no_no let getConsoleOutputCP = that's_a_no_no @@ -29,11 +29,11 @@ let getCurrentConsoleFontEx _ = that's_a_no_no let create_glyph_checker = that's_a_no_no let delete_glyph_checker = that's_a_no_no let has_glyph _ = that's_a_no_no -let isWoW64Process = that's_a_no_no +let getProcessArchitecture = that's_a_no_no let process_putenv _ = that's_a_no_no let shGetFolderPath _ = that's_a_no_no let sendMessageTimeout _ _ _ _ _ = that's_a_no_no -let getParentProcessID = that's_a_no_no -let getProcessName = that's_a_no_no +let getProcessAncestry = that's_a_no_no let getConsoleAlias _ = that's_a_no_no let win_create_process _ _ _ _ _ = that's_a_no_no +let getConsoleWindowClass = that's_a_no_no diff --git a/vendor/opam/src/core/opamStubs.mli b/vendor/opam/src/core/opamStubs.mli index 4766379ba8f..8ec2aa8de2d 100644 --- a/vendor/opam/src/core/opamStubs.mli +++ b/vendor/opam/src/core/opamStubs.mli @@ -55,9 +55,8 @@ val getWindowsVersion : unit -> int * int * int * int [(major, minor, build, revision)]. This function only works if opam is compiled OCaml 4.06.0 or later, it returns [(0, 0, 0, 0)] otherwise. *) -val isWoW64 : unit -> bool - (** Returns [false] unless this process is a 32-bit Windows process running - in the WoW64 sub-system (i.e. is being run on 64-bit Windows). *) +val getArchitecture : unit -> windows_cpu_architecture + (** Windows only. Equivalent of [uname -m]. *) val waitpids : int list -> int -> int * Unix.process_status (** Windows only. Given a list [pids] with [length] elements, @@ -95,9 +94,9 @@ val has_glyph : handle * handle -> Uchar.t -> bool @raise Failure If the call to [GetGlyphIndicesW] fails. *) -val isWoW64Process : int32 -> bool -(** Windows only. General version of {!isWoW64} for any given process ID. See - https://msdn.microsoft.com/en-us/library/windows/desktop/ms684139.aspx *) +val getProcessArchitecture : int32 option -> windows_cpu_architecture +(** Windows only. Returns the CPU architecture of the given process ID (or the + current process). *) val process_putenv : int32 -> string -> string -> bool (** Windows only. [process_putenv pid name value] sets the environment variable @@ -118,16 +117,11 @@ val sendMessageTimeout : return value from SendMessageTimeout, [snd] depends on both the message and [fst]. See https://msdn.microsoft.com/en-us/library/windows/desktop/ms644952.aspx *) -val getParentProcessID : int32 -> int32 -(** Windows only. [getParentProcessID pid] returns the process ID of the parent - of [pid]. - - @raise Failure If walking the process tree fails to find the process. *) - -val getProcessName : int32 -> string -(** Windows only. [getProcessName pid] returns the executable name of [pid]. - - @raise Failure If the process does not exist. *) +val getProcessAncestry : unit -> (int32 * string) list +(** Windows only. Returns the pid and full path to the image for each entry in + the ancestry list for this process, starting with the process itself. If an + image name can't be determined, then [""] is returned; on failure, returns + [[]]. *) val getConsoleAlias : string -> string -> string (** Windows only. [getConsoleAlias alias exeName] retrieves the value for a @@ -137,3 +131,7 @@ val getConsoleAlias : string -> string -> string val win_create_process : string -> string -> string option -> Unix.file_descr -> Unix.file_descr -> Unix.file_descr -> int (** Windows only. Provided by OCaml's win32unix library. *) + +val getConsoleWindowClass : unit -> string option +(** Windows only. Returns the name of the class for the Console window or [None] + if there is no console. *) diff --git a/vendor/opam/src/core/opamStubsTypes.ml b/vendor/opam/src/core/opamStubsTypes.ml index 0776123832c..25e583588dd 100644 --- a/vendor/opam/src/core/opamStubsTypes.ml +++ b/vendor/opam/src/core/opamStubsTypes.ml @@ -78,3 +78,12 @@ type shGFP_type = type ('a, 'b, 'c) winmessage = | WM_SETTINGCHANGE : (int, string, int) winmessage (** See https://msdn.microsoft.com/en-us/library/windows/desktop/ms725497.aspx *) + +(** Windows CPU Architectures (SYSTEM_INFO.wProcessArchitecture / sysinfoapi.h) *) +type windows_cpu_architecture = +| AMD64 (* 0x9 *) +| ARM (* 0x5 *) +| ARM64 (* 0xc *) +| IA64 (* 0x6 *) +| Intel (* 0x0 *) +| Unknown (* 0xffff *) diff --git a/vendor/opam/src/core/opamSystem.ml b/vendor/opam/src/core/opamSystem.ml index 9d78d9722cf..fad2fe8445a 100644 --- a/vendor/opam/src/core/opamSystem.ml +++ b/vendor/opam/src/core/opamSystem.ml @@ -80,19 +80,68 @@ let mkdir dir = end in aux dir -let rm_command = - if Sys.win32 then - "cmd /d /v:off /c rd /s /q" - else - "rm -rf" +let get_files dirname = + let dir = Unix.opendir dirname in + let rec aux files = + match Unix.readdir dir with + | "." | ".." -> aux files + | file -> aux (file :: files) + | exception End_of_file -> files + in + let files = aux [] in + Unix.closedir dir; + files + +let log_for_file_management () = + OpamCoreConfig.(!r.debug_level) >= 4 + +(* From stdune/src/fpath.ml *) +let win32_unlink fn = + try Unix.unlink fn + with Unix.Unix_error (Unix.EACCES, _, _) as e -> ( + try + (* Try removing the read-only attribute *) + Unix.chmod fn 0o666; + Unix.unlink fn + with _ -> raise e) + +let remove_file_t ?(with_log=true) file = + if + try ignore (Unix.lstat file); true with Unix.Unix_error _ -> false + then ( + try + if with_log || log_for_file_management () then + log "rm %s" file; + if Sys.win32 then + win32_unlink file + else + Unix.unlink file + with Unix.Unix_error _ as e -> + internal_error "Cannot remove %s (%s)." file (Printexc.to_string e) + ) + +let rec remove_dir_t dir = + let files = get_files dir in + List.iter (fun file -> + let file = Filename.concat dir file in + match Unix.lstat file with + | {Unix.st_kind = Unix.S_DIR; _} -> + remove_dir_t file + | {Unix.st_kind = Unix.(S_REG | S_LNK | S_CHR | S_BLK | S_FIFO | S_SOCK); _} -> + remove_file_t ~with_log:false file + ) files; + Unix.rmdir dir + +let remove_file = remove_file_t ~with_log:true let remove_dir dir = log "rmdir %s" dir; - if Sys.file_exists dir then ( - let err = Sys.command (Printf.sprintf "%s %s" rm_command (Filename.quote dir)) in - if err <> 0 then - internal_error "Cannot remove %s (error %d)." dir err - ) + if Sys.file_exists dir then begin + if Sys.is_directory dir then + remove_dir_t dir + else + remove_file dir + end let temp_files = Hashtbl.create 1024 let logs_cleaner = @@ -352,11 +401,6 @@ let real_path p = type command = string list -let default_env () = - (OpamStd.Env.list () :> (string * string) list) - |> List.map (fun (var, v) -> var^"="^v) - |> Array.of_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 @@ -457,7 +501,7 @@ let t_resolve_command = `Denied in fun ?env ?dir name -> - let env = match env with None -> default_env () | Some e -> e in + let env = match env with None -> OpamProcess.default_env () | Some e -> e in resolve env ?dir name let resolve_command ?env ?dir name = @@ -466,23 +510,36 @@ let resolve_command ?env ?dir name = | `Denied | `Not_found -> None let apply_cygpath name = - let r = - OpamProcess.run - (OpamProcess.command ~name:(temp_file "command") ~allow_stdin:false ~verbose:false "cygpath" ["--"; name]) - in - OpamProcess.cleanup ~force:true r; - if OpamProcess.is_success r then - List.hd r.OpamProcess.r_stdout - else + (* XXX Deeper bug, looking in the cygvoke code (see OpamProcess.create) *) + match resolve_command "cygpath" with + | Some cygpath -> + let r = + OpamProcess.run + (OpamProcess.command ~name:(temp_file "command") + ~allow_stdin:false ~verbose:false cygpath ["--"; name]) + in + OpamProcess.cleanup ~force:true r; + if OpamProcess.is_success r then + match r.OpamProcess.r_stdout with + | l::_ -> l + | _ -> "" + else + OpamConsole.error_and_exit `Internal_error "Could not apply cygpath to %s" name + | None -> OpamConsole.error_and_exit `Internal_error "Could not apply cygpath to %s" name let get_cygpath_function = if Sys.win32 then fun ~command -> - lazy (if OpamStd.(Option.map_default Sys.is_cygwin_variant `Native (resolve_command command)) = `Cygwin then - apply_cygpath - else - fun x -> x) + lazy ( + if OpamStd.Option.map_default + (OpamStd.Sys.is_cygwin_variant + ~cygbin:(OpamCoreConfig.(!r.cygbin))) + false + (resolve_command command) then + apply_cygpath + else fun x -> x + ) else let f = Lazy.from_val (fun x -> x) in fun ~command:_ -> f @@ -523,14 +580,11 @@ let make_command ?verbose ?env ?name ?text ?metadata ?allow_stdin ?stdout ?dir ?(resolve_path=true) cmd args = - let env = match env with None -> default_env () | Some e -> e in + let env = match env with None -> OpamProcess.default_env () | Some e -> e in let name = log_file name in let verbose = OpamStd.Option.default OpamCoreConfig.(!r.verbose_level >= 2) verbose in - (* Check that the command doesn't contain whitespaces *) - if None <> try Some (String.index cmd ' ') with Not_found -> None then - OpamConsole.warning "Command %S contains space characters" cmd; let full_cmd = if resolve_path then t_resolve_command ~env ?dir cmd else `Cmd cmd @@ -545,16 +599,12 @@ let make_command let run_process ?verbose ?env ~name ?metadata ?stdout ?allow_stdin command = - let env = match env with None -> default_env () | Some e -> e in + let env = match env with None -> OpamProcess.default_env () | Some e -> e in let chrono = OpamConsole.timer () in runs := command :: !runs; match command with | [] -> invalid_arg "run_process" | cmd :: args -> - - if OpamStd.String.contains_char cmd ' ' then - OpamConsole.warning "Command %S contains space characters" cmd; - match t_resolve_command ~env cmd with | `Cmd full_cmd -> let verbose = match verbose with @@ -617,13 +667,7 @@ let read_command_output ?verbose ?env ?metadata ?allow_stdin let verbose_for_base_commands () = OpamCoreConfig.(!r.verbose_level) >= 3 -let cygify f = - if Sys.win32 then - List.map (Lazy.force f) - else - fun x -> x - -let copy_file src dst = +let copy_file_t ?(with_log=true) src dst = if (try Sys.is_directory src with Sys_error _ -> raise (File_not_found src)) then internal_error "Cannot copy %s: it is a directory." src; @@ -632,75 +676,71 @@ let copy_file src dst = if file_or_symlink_exists dst then remove_file dst; mkdir (Filename.dirname dst); - log "copy %s -> %s" src dst; + if with_log || log_for_file_management () then + log "copy %s -> %s" src dst; copy_file_aux ~src ~dst () -let copy_dir src dst = - (* MSYS2 requires special handling because its uses copying rather than - symlinks for maximum portability on Windows. However copying a source - directory containing symlinks presents a problem. - - As a real example look at https://github.com/OCamlPro/ocp-indent/tree/1.8.2/tests/inplace: - - $ ls -l tests/inplace/ - total 0 - -rw-r--r-- 1 user group 0 Aug 12 20:53 executable.ml - lrwxrwxrwx 1 user group 12 Aug 12 20:53 link.ml -> otherfile.ml - lrwxrwxrwx 1 user group 7 Aug 12 20:53 link2.ml -> link.ml - -rw-r--r-- 1 user group 0 Aug 12 20:53 otherfile.ml - - With a regular copy: - - cp -PRp ...\ocp-indent-1.8.1\tests ... \tmp\ocp-indent.1.8.1 - - it _can_ fail with: - - # /usr/bin/cp: cannot create symbolic link 'C:\somewhere/tests/inplace/link.ml': No such file or directory - # /usr/bin/cp: cannot create symbolic link 'C:\somewhere/tests/inplace/link2.ml': No such file or directory - - What is happening is that _if_ link2.ml is copied before link.ml, then the - copy of link2.ml will fail with "No such file or directory". What is worse, - it depends on the opaque order in which the files are copied; sometimes it - can work and sometimes it won't. - - So we do a two-pass copy. The first pass copies everything except the - symlinks, and the second pass copies everything that remained. Rsync is the - perfect tool for that. - *) - if OpamStd.Sys.get_windows_executable_variant "rsync" = `Msys2 then - let convert_path = Lazy.force (get_cygpath_function ~command:"rsync") in - (* ensure that rsync doesn't recreate a subdir: add trailing '/' even if - cygpath may add one *) - let trailingslash_cygsrc = - (OpamStd.String.remove_suffix ~suffix:"/" (convert_path src)) ^ "/" +let rec link_t ?(with_log=true) src dst = + mkdir (Filename.dirname dst); + if file_or_symlink_exists dst then + remove_file dst; + try + if with_log || log_for_file_management () then + log "ln -s %s %s" src dst; + Unix.symlink src dst + with Unix.Unix_error (Unix.EXDEV, _, _) -> + (* Fall back to copy if symlinks are not supported *) + let src = + if Filename.is_relative src then Filename.dirname dst / src + else src in - let cygdest = convert_path dst in - (if Sys.file_exists dst then () else mkdir (Filename.dirname dst); - command ~verbose:(verbose_for_base_commands ()) - ([ "rsync"; "-a"; "--no-links"; trailingslash_cygsrc; cygdest ]); - command ~verbose:(verbose_for_base_commands ()) - ([ "rsync"; "-a"; "--ignore-existing"; trailingslash_cygsrc; cygdest ])) - else if Sys.file_exists dst then - if Sys.is_directory dst then - match ls src with - | [] -> () - | srcfiles -> - command ~verbose:(verbose_for_base_commands ()) - ([ "cp"; "-PRp" ] @ srcfiles @ [ dst ]) + if Sys.is_directory src then + copy_dir_t src dst else - internal_error - "Can not copy dir %s to %s, which is not a directory" src dst - else - (mkdir (Filename.dirname dst); - command ~verbose:(verbose_for_base_commands ()) - [ "cp"; "-PRp"; src; dst ]) - -let mv_aux f src dst = + copy_file_t src dst + +and copy_dir_t ?(with_log=true) src dst = + if with_log || log_for_file_management () then + log "copydir %s -> %s" src dst; + let files = get_files src in + mkdir dst; + let with_log = false in + List.iter (fun file -> + let src = Filename.concat src file in + let dst = Filename.concat dst file in + match Unix.lstat src with + | {Unix.st_kind = Unix.S_REG; _} -> + copy_file_t ~with_log src dst + | {Unix.st_kind = Unix.S_DIR; _} -> + copy_dir_t ~with_log src dst + | {Unix.st_kind = Unix.S_LNK; _} -> + let src = Unix.readlink src in + link_t ~with_log src dst + | {Unix.st_kind = Unix.S_CHR; _} -> + failwith (Printf.sprintf "Copying character devices (%s) is unsupported" src) + | {Unix.st_kind = Unix.S_BLK; _} -> + failwith (Printf.sprintf "Copying block devices (%s) is unsupported" src) + | {Unix.st_kind = Unix.S_FIFO; _} -> + failwith (Printf.sprintf "Copying named pipes (%s) is unsupported" src) + | {Unix.st_kind = Unix.S_SOCK; _} -> + failwith (Printf.sprintf "Copying sockets (%s) is unsupported" src) + ) files + +let copy_dir = copy_dir_t ~with_log:true +let copy_file = copy_file_t ~with_log:true + +let mv src dst = if file_or_symlink_exists dst then remove_file dst; mkdir (Filename.dirname dst); - command ~verbose:(verbose_for_base_commands ()) ("mv"::(cygify f [src; dst])) - -let mv = mv_aux (get_cygpath_function ~command:"mv") + log "mv %s -> %s" src dst; + try + Unix.rename src dst + with + | Unix.Unix_error(Unix.EXDEV, _, _) -> + let with_log = false in + if Sys.is_directory src + then (copy_dir_t ~with_log src dst; remove_dir_t src) + else (copy_file_t ~with_log src dst; remove_file_t ~with_log src) let is_exec file = let stat = Unix.stat file in @@ -837,11 +877,10 @@ let install ?(warning=default_install_warning) ?exec src dst = in copy_file_aux ~src ~dst (); if cygcheck then - match OpamStd.Sys.get_windows_executable_variant dst with - | `Native -> - () - | (`Cygwin | `Msys2 | `Tainted _) as code -> - warning dst code + match OpamStd.Sys.get_windows_executable_variant + ~cygbin:OpamCoreConfig.(!r.cygbin) dst with + | `Native -> () + | (`Cygwin | `Msys2 | `Tainted _) as code -> warning dst code end else copy_file_aux ~src ~dst () else diff --git a/vendor/opam/src/format/opamFile.ml b/vendor/opam/src/format/opamFile.ml index 689cac471f4..89882569edd 100644 --- a/vendor/opam/src/format/opamFile.ml +++ b/vendor/opam/src/format/opamFile.ml @@ -544,7 +544,8 @@ module Pinned_legacy = struct end -(** Cached environment updates (/.opam-switch/environment) *) +(** Cached environment updates (/.opam-switch/environment + /.opam-switch/last-env/env-* last env files) *) module Environment = LineFile(struct diff --git a/vendor/opam/src/format/opamPath.ml b/vendor/opam/src/format/opamPath.ml index 68aea0b63ff..cefd503cc2b 100644 --- a/vendor/opam/src/format/opamPath.ml +++ b/vendor/opam/src/format/opamPath.ml @@ -140,6 +140,8 @@ module Switch = struct let environment t a = meta t a /- env_filename + let last_env t a = meta t a / "last-env" + let env_relative_to_prefix pfx = pfx / meta_dirname /- env_filename let installed_opams t a = meta t a / "packages" diff --git a/vendor/opam/src/format/opamPath.mli b/vendor/opam/src/format/opamPath.mli index 116ed83939a..e6b09dc6354 100644 --- a/vendor/opam/src/format/opamPath.mli +++ b/vendor/opam/src/format/opamPath.mli @@ -174,6 +174,8 @@ module Switch: sig (** Cached environment updates. *) val environment: t -> switch -> OpamFile.Environment.t OpamFile.t + val last_env: t -> switch -> dirname + (** Like [environment], but from the switch prefix dir *) val env_relative_to_prefix: dirname -> OpamFile.Environment.t OpamFile.t diff --git a/vendor/opam/src/format/opamTypes.mli b/vendor/opam/src/format/opamTypes.mli index a9cea247e7a..0e90f644d46 100644 --- a/vendor/opam/src/format/opamTypes.mli +++ b/vendor/opam/src/format/opamTypes.mli @@ -322,7 +322,7 @@ type pin_kind = [ `version | OpamUrl.backend ] type powershell_host = OpamStd.Sys.powershell_host = Powershell_pwsh | Powershell type shell = OpamStd.Sys.shell = | SH_sh | SH_bash | SH_zsh | SH_csh | SH_fish | SH_pwsh of powershell_host - | SH_win_cmd + | SH_cmd (** {2 Generic command-line definitions with filters} *) diff --git a/vendor/opam/src/format/opamTypesBase.ml b/vendor/opam/src/format/opamTypesBase.ml index 1bfb2d938b3..a1260b833f9 100644 --- a/vendor/opam/src/format/opamTypesBase.ml +++ b/vendor/opam/src/format/opamTypesBase.ml @@ -48,7 +48,7 @@ let string_of_shell = function | SH_bash -> "bash" | SH_pwsh Powershell_pwsh -> "pwsh" | SH_pwsh Powershell -> "powershell" - | SH_win_cmd -> "cmd" + | SH_cmd -> "cmd" let file_null = "" let pos_file filename = diff --git a/vendor/opam/src/repository/opamRepository.ml b/vendor/opam/src/repository/opamRepository.ml index 780581b438a..841f22997be 100644 --- a/vendor/opam/src/repository/opamRepository.ml +++ b/vendor/opam/src/repository/opamRepository.ml @@ -93,15 +93,14 @@ let fetch_from_cache = failwith "Version control not allowed as cache URL" in try - let hit_checksum, hit_file = + let hit_file = OpamStd.List.find_map (fun ck -> let f = cache_file cache_dir ck in - if OpamFilename.exists f then Some (ck, f) else None) + if OpamFilename.exists f then Some f else None) checksums in if List.for_all - (fun ck -> ck = hit_checksum || - OpamHash.check_file (OpamFilename.to_string hit_file) ck) + (fun ck -> OpamHash.check_file (OpamFilename.to_string hit_file) ck) checksums then Done (Up_to_date (hit_file, OpamUrl.empty)) else mismatch hit_file diff --git a/vendor/opam/src/state/opamEnv.ml b/vendor/opam/src/state/opamEnv.ml index cf2db258cb9..6038a2f4521 100644 --- a/vendor/opam/src/state/opamEnv.ml +++ b/vendor/opam/src/state/opamEnv.ml @@ -22,17 +22,37 @@ let slog = OpamConsole.slog (* - Environment and updates handling - *) -let split_var v = OpamStd.Sys.split_path_variable ~clean:false v +type _ env_classification = +| Separator : char env_classification +| Split : (string -> string list) env_classification + +let get_env_property : type s . string -> s env_classification -> s = fun var classification -> + let split_delim = Fun.flip OpamStd.String.split in + let separator, split = + match String.uppercase_ascii var with + | "CAML_LD_LIBRARY_PATH" -> + OpamStd.Sys.path_sep, split_delim OpamStd.Sys.path_sep + | "PKG_CONFIG_PATH" | "MANPATH" -> + ':', split_delim ':' + | _ -> + OpamStd.Sys.path_sep, OpamStd.Sys.split_path_variable ~clean:false + in + match classification with + | Separator -> separator + | Split -> split + +let split_var (var : OpamStd.Env.Name.t) = + get_env_property (var :> string) Split -let join_var l = - String.concat (String.make 1 OpamStd.Sys.path_sep) l +let join_var (var : OpamStd.Env.Name.t) l = + String.concat (String.make 1 (get_env_property (var :> string) Separator)) l (* To allow in-place updates, we store intermediate values of path-like as a pair of list [(rl1, l2)] such that the value is [List.rev_append rl1 l2] and the place where the new value should be inserted is in front of [l2] *) -let unzip_to elt current = +let unzip_to var elt current = (* If [r = l @ rs] then [remove_prefix l r] is [Some rs], otherwise [None] *) let rec remove_prefix l r = match l, r with @@ -41,7 +61,7 @@ let unzip_to elt current = | ([], rs) -> Some rs | _ -> None in - match (if String.equal elt "" then [""] else split_var elt) with + match (if String.equal elt "" then [""] else split_var var elt) with | [] -> invalid_arg "OpamEnv.unzip_to" | hd::tl -> let rec aux acc = function @@ -58,8 +78,8 @@ let unzip_to elt current = let rezip ?insert (l1, l2) = List.rev_append l1 (match insert with None -> l2 | Some i -> i::l2) -let rezip_to_string ?insert z = - join_var (rezip ?insert z) +let rezip_to_string var ?insert z = + join_var var (rezip ?insert z) let apply_op_zip op arg (rl1,l2 as zip) = let colon_eq ?(eqcol=false) = function (* prepend a, but keep ":"s *) @@ -91,23 +111,23 @@ let apply_op_zip op arg (rl1,l2 as zip) = position of the matching element and allow [=+=] to be applied later. A pair or empty lists is returned if the variable should be unset or has an unknown previous value. *) -let reverse_env_update op arg cur_value = +let reverse_env_update var op arg cur_value = if String.equal arg "" && op <> Eq then None else match op with | Eq -> - if arg = join_var cur_value + if arg = join_var var cur_value then Some ([],[]) else None - | PlusEq | EqPlusEq -> unzip_to arg cur_value + | PlusEq | EqPlusEq -> unzip_to var arg cur_value | EqPlus -> - (match unzip_to arg (List.rev cur_value) with + (match unzip_to var arg (List.rev cur_value) with | None -> None | Some (rl1, l2) -> Some (List.rev l2, List.rev rl1)) | ColonEq -> - (match unzip_to arg cur_value with + (match unzip_to var arg cur_value with | Some ([], [""]) -> Some ([], []) | r -> r) | EqColon -> - (match unzip_to arg (List.rev cur_value) with + (match unzip_to var arg (List.rev cur_value) with | Some ([], [""]) -> Some ([], []) | Some (rl1, l2) -> Some (List.rev l2, List.rev rl1) | None -> None) @@ -124,19 +144,33 @@ let map_update_names env_keys updates = in List.map convert updates -let global_env_keys = lazy (OpamStd.Env.Name.Set.of_list (List.map fst (OpamStd.Env.list ()))) +let global_env_keys = lazy ( + OpamStd.Env.list () + |> List.map fst + |> OpamStd.Env.Name.Set.of_list) let updates_from_previous_instance = lazy ( - match OpamStd.Env.getopt "OPAM_SWITCH_PREFIX" with - | None -> None - | Some pfx -> - let env_file = - OpamPath.Switch.env_relative_to_prefix (OpamFilename.Dir.of_string pfx) - in - try OpamStd.Option.map (map_update_names (Lazy.force global_env_keys)) - (OpamFile.Environment.read_opt env_file) - with e -> OpamStd.Exn.fatal e; None -) + let get_env env_file = + OpamStd.Option.map + (map_update_names (Lazy.force global_env_keys)) + (OpamFile.Environment.read_opt env_file) + in + let open OpamStd.Option.Op in + (OpamStd.Env.getopt "OPAM_LAST_ENV" + >>= fun env_file -> + try + OpamFilename.of_string env_file + |> OpamFile.make + |> get_env + with e -> OpamStd.Exn.fatal e; None) + >>+ (fun () -> + OpamStd.Env.getopt "OPAM_SWITCH_PREFIX" + >>= fun pfx -> + let env_file = + OpamPath.Switch.env_relative_to_prefix (OpamFilename.Dir.of_string pfx) + in + try get_env env_file + with e -> OpamStd.Exn.fatal e; None)) let expand (updates: env_update list) : env = let updates = @@ -160,14 +194,27 @@ let expand (updates: env_update list) : env = match Option.map rezip v_opt with | Some v -> v | None -> - OpamStd.Option.map_default split_var [] + OpamStd.Option.map_default (split_var var) [] (OpamStd.Env.getopt (var :> string)) in - match reverse_env_update op arg v with + match reverse_env_update var op arg v with | Some v -> (var, v)::defs | None -> defs0) updates [] in + (* OPAM_LAST_ENV and OPAM_SWITCH_PREFIX must be reverted if they were set *) + let reverts = + if OpamStd.Env.getopt "OPAM_LAST_ENV" <> None then + (OpamStd.Env.Name.of_string "OPAM_LAST_ENV", ([], []))::reverts + else + reverts + in + let reverts = + if OpamStd.Env.getopt "OPAM_SWITCH_PREFIX" <> None then + (OpamStd.Env.Name.of_string "OPAM_SWITCH_PREFIX", ([], []))::reverts + else + reverts + in (* And apply the new ones *) let rec apply_updates reverts acc = function | (var, op, arg, doc) :: updates -> @@ -181,7 +228,7 @@ let expand (updates: env_update list) : env = | Some z, reverts -> z, reverts | None, _ -> match OpamStd.Env.getopt (var :> string) with - | Some s -> ([], split_var s), reverts + | Some s -> ([], split_var var s), reverts | None -> ([], []), reverts in let acc = @@ -195,9 +242,9 @@ let expand (updates: env_update list) : env = | [] -> List.rev @@ List.rev_append - (List.rev_map (fun (var, z, doc) -> var, rezip_to_string z, doc) acc) @@ + (List.rev_map (fun (var, z, doc) -> var, rezip_to_string var z, doc) acc) @@ List.rev_map (fun (var, z) -> - var, rezip_to_string z, Some "Reverting previous opam update") + var, rezip_to_string var z, Some "Reverting previous opam update") reverts in apply_updates reverts [] updates @@ -300,9 +347,7 @@ let get_pure ?(updates=[]) () = let get_opam ~set_opamroot ~set_opamswitch ~force_path st = add [] (updates ~set_opamroot ~set_opamswitch ~force_path st) -let get_opam_raw ~set_opamroot ~set_opamswitch ?(base=[]) - ~force_path - root switch = +let get_opam_raw_updates ~set_opamroot ~set_opamswitch ~force_path root switch = let env_file = OpamPath.Switch.environment root switch in let upd = OpamFile.Environment.safe_read env_file in let upd = @@ -317,9 +362,27 @@ let get_opam_raw ~set_opamroot ~set_opamswitch ?(base=[]) var, to_op, v, doc | e -> e) upd in - add base - (updates_common ~set_opamroot ~set_opamswitch root switch @ - upd) + updates_common ~set_opamroot ~set_opamswitch root switch @ upd + +let get_opam_raw ~set_opamroot ~set_opamswitch ?(base=[]) ~force_path + root switch = + let upd = + get_opam_raw_updates ~set_opamroot ~set_opamswitch ~force_path root switch + in + add base upd + +let hash_env_updates upd = + (* Should we use OpamFile.Environment.write_to_string ? cons: it contains + tabulations *) + let to_string (name, op, value, _) = + String.escaped name + ^ OpamPrinter.FullPos.env_update_op_kind op + ^ String.escaped value + in + List.rev_map to_string upd + |> String.concat "\n" + |> Digest.string + |> Digest.to_hex let get_full ~set_opamroot ~set_opamswitch ~force_path ?updates:(u=[]) ?(scrub=[]) @@ -346,7 +409,7 @@ let is_up_to_date_raw ?(skip=OpamStateConfig.(!r.no_env_notice)) updates = match OpamStd.Env.getopt_full var with | _, None -> upd::notutd | var, Some v -> - if reverse_env_update op arg (split_var v) = None then upd::notutd + if reverse_env_update var op arg (split_var var v) = None then upd::notutd else List.filter (fun (v, _, _, _) -> OpamStd.Env.Name.equal_string var v) notutd) [] @@ -404,7 +467,7 @@ let shell_eval_invocation shell cmd = Printf.sprintf "eval (%s)" cmd | SH_csh -> Printf.sprintf "eval `%s`" cmd - | SH_win_cmd -> + | SH_cmd -> Printf.sprintf {|for /f "tokens=*" %%i in ('%s') do @%%i|} cmd | _ -> Printf.sprintf "eval $(%s)" cmd @@ -447,7 +510,7 @@ let filepath_needs_quote path = let opam_env_invocation ?root ?switch ?(set_opamswitch=false) shell = let shell_arg argname pathval = let quoted = match shell with - | SH_win_cmd | SH_pwsh _ -> + | SH_cmd | SH_pwsh _ -> Printf.sprintf " \"--%s=%s\"" argname | SH_sh | SH_bash | SH_zsh | SH_csh | SH_fish -> Printf.sprintf " '--%s=%s'" argname @@ -500,35 +563,34 @@ let eval_string gt ?(set_opamswitch=false) switch = (** The shells for which we generate init scripts (bash and sh are the same entry) *) -let shells_list = [ SH_sh; SH_zsh; SH_csh; SH_fish ] +let shells_list = [ SH_sh; SH_zsh; SH_csh; SH_fish; SH_pwsh Powershell; SH_cmd ] let complete_file = function | SH_sh | SH_bash -> Some "complete.sh" | SH_zsh -> Some "complete.zsh" - | SH_csh | SH_fish | SH_pwsh _ | SH_win_cmd -> None + | SH_csh | SH_fish | SH_pwsh _ | SH_cmd -> None let env_hook_file = function | SH_sh | SH_bash -> Some "env_hook.sh" | SH_zsh -> Some "env_hook.zsh" | SH_csh -> Some "env_hook.csh" | SH_fish -> Some "env_hook.fish" - | SH_pwsh _ | SH_win_cmd -> - (* N/A because not present in `shells_list` yet *) None + | SH_pwsh _ | SH_cmd -> None let variables_file = function | SH_sh | SH_bash | SH_zsh -> "variables.sh" | SH_csh -> "variables.csh" | SH_fish -> "variables.fish" - | SH_pwsh _ | SH_win_cmd -> - (* N/A because not present in `shells_list` yet *) "variables.sh" + | SH_pwsh _ -> "variables.ps1" + | SH_cmd -> "variables.cmd" let init_file = function | SH_sh | SH_bash -> "init.sh" | SH_zsh -> "init.zsh" | SH_csh -> "init.csh" | SH_fish -> "init.fish" - | SH_pwsh _ | SH_win_cmd -> - (* N/A because not present in `shells_list` yet *) "init.sh" + | SH_pwsh _ -> "init.ps1" + | SH_cmd -> "init.cmd" let export_in_shell shell = let make_comment comment_opt = @@ -565,20 +627,20 @@ let export_in_shell shell = (make_comment comment) k v in let pwsh (k,v,comment) = - Printf.sprintf "%s$env:%s=%s;\n" + Printf.sprintf "%s$env:%s=%s\n" (make_comment comment) k v in - let win_cmd (k,v,comment) = + let cmd (k,v,comment) = let make_cmd_comment comment_opt = - OpamStd.Option.to_string (Printf.sprintf "REM %s\n") comment_opt + OpamStd.Option.to_string (Printf.sprintf ":: %s\n") comment_opt in - Printf.sprintf "%sSET \"%s=%s\"\n" + Printf.sprintf "%sset \"%s=%s\"\n" (make_cmd_comment comment) k v in match shell with | SH_zsh | SH_bash | SH_sh -> sh | SH_fish -> fish | SH_csh -> csh | SH_pwsh _ -> pwsh - | SH_win_cmd -> win_cmd + | SH_cmd -> cmd let source root shell f = let fname = OpamFilename.to_string (OpamPath.init root // f) in @@ -593,10 +655,10 @@ let source root shell f = | SH_zsh -> Printf.sprintf "[[ ! -r %s ]] || source %s > /dev/null 2> /dev/null\n" fname fname - | SH_win_cmd -> - Printf.sprintf "if exist \"%s\" ( \"%s\" >NUL 2>NUL )\n" fname fname + | SH_cmd -> + Printf.sprintf "if exist \"%s\" call \"%s\" >NUL 2>NUL\n" fname fname | SH_pwsh _ -> - Printf.sprintf "& \"%s\" > $null 2> $null\n" fname + Printf.sprintf ". \"%s\" *> $null\n" fname let if_interactive_script shell t e = let ielse else_opt = match else_opt with @@ -620,7 +682,7 @@ let if_interactive_script shell t e = Printf.sprintf "if ( $?prompt ) then\n %s%sendif\n" t @@ ielse e | SH_fish -> Printf.sprintf "if isatty\n %s%send\n" t @@ ielse e - | SH_win_cmd -> + | SH_cmd -> Printf.sprintf "echo %%cmdcmdline%% | find /i \"%%~0\" >nul\nif errorlevel 1 (\n%s%s)\n" t @@ ielse_cmd e | SH_pwsh _ -> Printf.sprintf "if ([Environment]::UserInteractive) {\n %s%s}\n" t @@ ielse_pwsh e @@ -645,11 +707,26 @@ let string_of_update st shell updates = in let key, value = ident, match symbol with - | Eq -> Printf.sprintf "'%s'" string + | Eq -> + (match shell with + | SH_pwsh _ -> + Printf.sprintf "'%s'" (OpamStd.Env.escape_powershell string) + | SH_cmd -> string + | _ -> Printf.sprintf "'%s'" string) | PlusEq | ColonEq | EqPlusEq -> - Printf.sprintf "'%s':\"$%s\"" string ident + let sep = get_env_property ident Separator in + (match shell with + | SH_pwsh _ -> + Printf.sprintf "'%s%c' + \"$env:%s\"" + (OpamStd.Env.escape_powershell string) sep ident + | SH_cmd -> Printf.sprintf "%s%c%%%s%%" string sep ident + | _ -> Printf.sprintf "'%s':\"$%s\"" string ident) | EqColon | EqPlus -> - Printf.sprintf "\"$%s\":'%s'" ident string + let sep = get_env_property ident Separator in + (match shell with + | SH_pwsh _ -> Printf.sprintf "\"$env:%s\" + '%c%s'" ident sep string + | SH_cmd -> Printf.sprintf "%%%s%%%c%s" ident sep string + | _ -> Printf.sprintf "\"$%s\":'%s'" ident string) in export_in_shell shell (key, value, comment) in OpamStd.List.concat_map "" aux updates @@ -703,7 +780,7 @@ let write_dynamic_init_scripts st = (fun shell -> write_script (OpamPath.init st.switch_global.root) (variables_file shell, string_of_update st shell updates)) - [SH_sh; SH_csh; SH_fish] + [SH_sh; SH_csh; SH_fish; SH_pwsh Powershell; SH_cmd] with OpamSystem.Locked -> OpamConsole.warning "Global shell init scripts not installed (could not acquire lock)" @@ -711,7 +788,7 @@ let write_dynamic_init_scripts st = let clear_dynamic_init_scripts gt = List.iter (fun shell -> OpamFilename.remove (OpamPath.init gt.root // variables_file shell)) - [SH_sh; SH_csh; SH_fish] + [SH_sh; SH_csh; SH_fish; SH_pwsh Powershell; SH_cmd] let dot_profile_needs_update root dot_profile = if not (OpamFilename.exists dot_profile) then `yes else @@ -748,21 +825,28 @@ let update_dot_profile root dot_profile shell = pretty_dot_profile | `yes -> let init_file = init_file shell in - let body = + let old_body = if OpamFilename.exists dot_profile then OpamFilename.read dot_profile else "" in OpamConsole.msg " Updating %s.\n" pretty_dot_profile; bash_src(); - let body = + let count_lines str = List.length (String.split_on_char '\n' str) in + let opam_section = Printf.sprintf - "%s\n\n\ - # opam configuration\n\ - %s" - (OpamStd.String.strip body) (source root shell init_file) in - OpamFilename.write dot_profile body - + "\n\n\ + # BEGIN opam configuration\n\ + # This is useful if you're using opam as it adds:\n\ + # - the correct directories to the PATH\n\ + # - auto-completion for the opam binary\n\ + # This section can be safely removed at any time if needed.\n\ + %s\ + # END opam configuration\n" + (source root shell init_file) in + OpamFilename.write dot_profile (old_body ^ opam_section); + OpamConsole.msg " Added %d lines after line %d in %s.\n" + (count_lines opam_section - 1) (count_lines old_body) pretty_dot_profile let update_user_setup root ?dot_profile shell = if dot_profile <> None then ( diff --git a/vendor/opam/src/state/opamEnv.mli b/vendor/opam/src/state/opamEnv.mli index 30e895f981a..250e4604bd0 100644 --- a/vendor/opam/src/state/opamEnv.mli +++ b/vendor/opam/src/state/opamEnv.mli @@ -43,6 +43,16 @@ val get_opam_raw: force_path:bool -> dirname -> switch -> env +(** Like [get_opam_raw], but returns the list of updates instead of the new + environment. *) +val get_opam_raw_updates: + set_opamroot:bool -> set_opamswitch:bool -> force_path:bool -> + dirname -> switch -> env_update list + +(** Returns a hash of the given env_update list suitable for use with + OPAM_LAST_ENV *) +val hash_env_updates: env_update list -> string + (** Returns the running environment, with any opam modifications cleaned out, and optionally the given updates *) val get_pure: ?updates:env_update list -> unit -> env diff --git a/vendor/opam/src/state/opamGlobalState.ml b/vendor/opam/src/state/opamGlobalState.ml index 0d751f2137a..ace635d1647 100644 --- a/vendor/opam/src/state/opamGlobalState.ml +++ b/vendor/opam/src/state/opamGlobalState.ml @@ -44,6 +44,10 @@ let load_config lock_kind global_lock root = let config = OpamFormatUpgrade.as_necessary lock_kind global_lock root config in + OpamStd.Option.iter + (fun cygbin -> + OpamCoreConfig.update ~cygbin:(OpamFilename.Dir.to_string cygbin) ()) + (OpamSysInteract.Cygwin.cygbin_opt (fst config)); config let inferred_from_system = "Inferred from system" diff --git a/vendor/opam/src/state/opamSwitchState.ml b/vendor/opam/src/state/opamSwitchState.ml index e8b74ef6818..1f1649062b2 100644 --- a/vendor/opam/src/state/opamSwitchState.ml +++ b/vendor/opam/src/state/opamSwitchState.ml @@ -180,6 +180,7 @@ module Installed_cache = OpamCached.Make(struct let depexts_status_of_packages_raw ~depexts ?env global_config switch_config packages = + if OpamPackage.Set.is_empty packages then OpamPackage.Map.empty else let open OpamSysPkg.Set.Op in let syspkg_set, syspkg_map = OpamPackage.Set.fold (fun nv (set, map) -> @@ -883,43 +884,33 @@ let avoid_version st nv = has_avoid_flag) +! false) -let universe st - ?(test=OpamStateConfig.(!r.build_test)) - ?(doc=OpamStateConfig.(!r.build_doc)) - ?(dev_setup=OpamStateConfig.(!r.dev_setup)) - ?(force_dev_deps=false) - ?reinstall - ~requested - user_action = - let chrono = OpamConsole.timer () in - let names = OpamPackage.names_of_packages requested in - let requested_allpkgs = - OpamPackage.packages_of_names st.packages names - in - let env nv v = - if List.mem v OpamPackageVar.predefined_depends_variables then - match OpamVariable.Full.to_string v with - | "dev" -> - Some (B (force_dev_deps || is_dev_package st nv)) - | "with-test" -> - Some (B (test && OpamPackage.Set.mem nv requested_allpkgs)) - | "with-doc" -> - Some (B (doc && OpamPackage.Set.mem nv requested_allpkgs)) - | "with-dev-setup" -> - Some (B (dev_setup && OpamPackage.Set.mem nv requested_allpkgs)) - | _ -> None (* Computation delayed to the solver *) - else - let r = OpamPackageVar.resolve_switch ~package:nv st v in - if r = None then - (if OpamFormatConfig.(!r.strict) then - OpamConsole.error_and_exit `File_error - "Undefined filter variable %s in dependencies of %s" - else - log - "ERR: Undefined filter variable %s in dependencies of %s") - (OpamVariable.Full.to_string v) (OpamPackage.to_string nv); - r - in +let package_env_t st ~force_dev_deps ~test ~doc ~dev_setup + ~requested_allpkgs nv v = + if List.mem v OpamPackageVar.predefined_depends_variables then + match OpamVariable.Full.to_string v with + | "dev" -> + Some (B (force_dev_deps || is_dev_package st nv)) + | "with-test" -> + Some (B (test && OpamPackage.Set.mem nv requested_allpkgs)) + | "with-doc" -> + Some (B (doc && OpamPackage.Set.mem nv requested_allpkgs)) + | "with-dev-setup" -> + Some (B (dev_setup && OpamPackage.Set.mem nv requested_allpkgs)) + | _ -> None (* Computation delayed to the solver *) + else + let r = OpamPackageVar.resolve_switch ~package:nv st v in + if r = None then + (if OpamFormatConfig.(!r.strict) then + OpamConsole.error_and_exit `File_error + "Undefined filter variable %s in dependencies of %s" + else + log + "ERR: Undefined filter variable %s in dependencies of %s") + (OpamVariable.Full.to_string v) (OpamPackage.to_string nv); + r + +let get_dependencies_t st ~force_dev_deps ~test ~doc ~dev_setup + ~requested_allpkgs deps opams = let filter_undefined nv = OpamFormula.map (fun (name, fc) -> let fc = @@ -937,10 +928,35 @@ let universe st in Atom (name, fc)) in - let get_deps f opams = - OpamPackage.Map.mapi (fun nv opam -> - OpamFilter.partial_filter_formula (env nv) (f opam) - |> filter_undefined nv) opams + OpamPackage.Map.mapi (fun nv opam -> + OpamFilter.partial_filter_formula + (package_env_t st ~force_dev_deps ~test ~doc + ~dev_setup ~requested_allpkgs nv) + (deps opam) + |> filter_undefined nv) opams + +let universe st + ?(test=OpamStateConfig.(!r.build_test)) + ?(doc=OpamStateConfig.(!r.build_doc)) + ?(dev_setup=OpamStateConfig.(!r.dev_setup)) + ?(force_dev_deps=false) + ?reinstall + ~requested + user_action = + let chrono = OpamConsole.timer () in + let names = OpamPackage.names_of_packages requested in + let requested_allpkgs = + OpamPackage.packages_of_names st.packages names + in + let env = + package_env_t st + ~force_dev_deps ~test ~doc ~dev_setup + ~requested_allpkgs + in + let get_deps = + get_dependencies_t st + ~force_dev_deps ~test ~doc ~dev_setup + ~requested_allpkgs in let u_depends = let depend = @@ -1316,26 +1332,38 @@ let dependencies_filter_to_formula_t ~build ~post st nv = in OpamFilter.filter_formula ~default:true env -let dependencies_t base_deps_compute deps_compute - ~depopts ~installed ?(unavailable=false) universe packages = +let dependencies_t st base_deps_compute deps_compute + ~depopts ~installed ?(unavailable=false) packages = if OpamPackage.Set.is_empty packages then OpamPackage.Set.empty else let base = packages ++ - if installed then universe.u_installed - else if unavailable then universe.u_packages - else universe.u_available + if installed then st.installed + else if unavailable then st.packages + else Lazy.force st.available_packages in log ~level:3 "dependencies packages=%a" (slog OpamPackage.Set.to_string) packages; let timer = OpamConsole.timer () in let base_depends = let filter = base_deps_compute base in + let get_deps = + get_dependencies_t st + ~force_dev_deps:false ~test:false ~doc:false + ~dev_setup:false ~requested_allpkgs:packages + in + let opams = + OpamPackage.Set.fold (fun pkg opams -> + OpamPackage.Map.add pkg (OpamPackage.Map.find pkg st.opams) opams) + base OpamPackage.Map.empty + in + let u_depends = get_deps OpamFile.OPAM.depends opams in let depends = - OpamPackage.Map.filter_map filter universe.u_depends + OpamPackage.Map.filter_map filter u_depends in if depopts then + let u_depopts = get_deps OpamFile.OPAM.depopts opams in let depopts = - OpamPackage.Map.filter_map filter universe.u_depopts + OpamPackage.Map.filter_map filter u_depopts in OpamPackage.Map.union (fun d d' -> OpamFormula.And (d, d')) depopts depends @@ -1348,7 +1376,7 @@ let dependencies_t base_deps_compute deps_compute result let dependencies st ~build ~post = - dependencies_t + dependencies_t st (fun base nv ff -> if OpamPackage.Set.mem nv base then Some ff else None) (fun base base_depends packages -> @@ -1373,7 +1401,7 @@ let dependencies st ~build ~post = aux packages packages) let reverse_dependencies st ~build ~post = - dependencies_t + dependencies_t st (fun base nv ff -> if OpamPackage.Set.mem nv base then Some (dependencies_filter_to_formula_t ~build ~post st nv ff) @@ -1442,7 +1470,7 @@ let invariant_root_packages st = let compute_invariant_packages st = let pkgs = invariant_root_packages st in dependencies ~build:false ~post:true ~depopts:false ~installed:true - ~unavailable:false st (universe st ~requested:pkgs Query) pkgs + ~unavailable:false st pkgs let compiler_packages st = let compiler_packages = @@ -1452,5 +1480,4 @@ let compiler_packages st = st.installed in dependencies ~build:true ~post:false ~depopts:true ~installed:true - ~unavailable:false st (universe st ~requested:compiler_packages Query) - compiler_packages + ~unavailable:false st compiler_packages diff --git a/vendor/opam/src/state/opamSwitchState.mli b/vendor/opam/src/state/opamSwitchState.mli index fd45b539164..186cd45da10 100644 --- a/vendor/opam/src/state/opamSwitchState.mli +++ b/vendor/opam/src/state/opamSwitchState.mli @@ -175,12 +175,12 @@ val depexts: 'a switch_state -> package -> OpamSysPkg.Set.t *) val dependencies: 'a switch_state -> build:bool -> post:bool -> depopts:bool -> - installed:bool -> ?unavailable:bool -> universe -> package_set -> package_set + installed:bool -> ?unavailable:bool -> package_set -> package_set (** Same as [dependencies] but for reverse dependencies. *) val reverse_dependencies: 'a switch_state -> build:bool -> post:bool -> depopts:bool -> - installed:bool -> ?unavailable:bool -> universe -> package_set -> package_set + installed:bool -> ?unavailable:bool -> package_set -> package_set (** Returns required system packages of each of the given packages (elements are not added to the map if they don't have system dependencies) *) diff --git a/vendor/opam/src/state/opamSysInteract.ml b/vendor/opam/src/state/opamSysInteract.ml index 53f11d8706e..1950629f050 100644 --- a/vendor/opam/src/state/opamSysInteract.ml +++ b/vendor/opam/src/state/opamSysInteract.ml @@ -97,10 +97,13 @@ type test_setup = { (* Internal module to get package manager commands defined in global config file *) module Commands = struct + let get_cmd_opt config family = + OpamStd.String.Map.find_opt family + (OpamFile.Config.sys_pkg_manager_cmd config) + let get_cmd config family = - match OpamStd.String.Map.find_opt family - (OpamFile.Config.sys_pkg_manager_cmd config) with - | Some cmd -> OpamFilename.to_string cmd + match get_cmd_opt config family with + | Some cmd -> cmd | None -> let field = "sys-pkg-manager-cmd" in Printf.ksprintf failwith @@ -108,7 +111,11 @@ module Commands = struct Use opam option --global '%s+=[\"%s\" \"\"]'" field family field family family - let msys2 config = get_cmd config "msys2" + let msys2 config = OpamFilename.to_string (get_cmd config "msys2") + + let cygwin_t = "cygwin" + let cygcheck_opt config = get_cmd_opt config cygwin_t + let cygcheck config = OpamFilename.to_string (get_cmd config cygwin_t) end @@ -118,6 +125,7 @@ type families = | Alpine | Arch | Centos + | Cygwin | Debian | Dummy of test_setup | Freebsd @@ -198,16 +206,170 @@ let family ~env () = | "windows" -> (match OpamSysPoll.os_distribution env with | Some "msys2" -> Msys2 + | Some "cygwin" -> Cygwin | _ -> failwith "External dependency handling not supported for Windows unless \ - MSYS2 is installed. In particular 'os-distribution' must be set \ - to 'msys2'.") + MSYS2 or Cygwin is installed. In particular 'os-distribution' \ + must be set to 'msys2' or 'cygwin'.") | family -> Printf.ksprintf failwith "External dependency handling not supported for OS family '%s'." family +module Cygwin = struct + open OpamFilename.Op + + let url_setupexe = OpamUrl.of_string "https://cygwin.com/setup-x86_64.exe" + let url_setupexe_sha512 = OpamUrl.of_string "https://cygwin.com/sha512.sum" + let mirror = "https://cygwin.mirror.constant.com/" + + (* Cygwin setup exe must be stored at Cygwin installation root *) + let setupexe = "setup-x86_64.exe" + let cygcheckexe = "cygcheck.exe" + + let cygcheck_opt = Commands.cygcheck_opt + open OpamStd.Option.Op + let cygbin_opt config = + cygcheck_opt config + >>| OpamFilename.dirname + let cygroot_opt config = + cygbin_opt config + >>| OpamFilename.dirname_dir + let get_opt = function + | Some c -> c + | None -> failwith "Cygwin install not found" + let cygroot config = get_opt (cygroot_opt config) + + let internal_cygwin = + let internal = + Lazy.from_fun @@ fun () -> (OpamStateConfig.((Lazy.force !r.root_dir)) / ".cygwin") + in + fun () -> Lazy.force internal + let internal_cygroot () = internal_cygwin () / "root" + let internal_cygcache () = internal_cygwin () / "cache" + let cygsetup () = internal_cygwin () // setupexe + let is_internal config = + OpamStd.Option.equal OpamFilename.Dir.equal + (cygroot_opt config) + (Some (internal_cygroot ())) + + let download_setupexe dst = + let overwrite = true in + let open OpamProcess.Job.Op in + OpamFilename.with_tmp_dir_job @@ fun dir -> + OpamDownload.download ~overwrite url_setupexe_sha512 dir @@+ fun file -> + let checksum = + let content = OpamFilename.read file in + let re = + (* File content: + >SHA512 setup-x86.exe + >SHA512 setup-x86_64.exe + *) + Re.(compile @@ seq [ + group @@ repn + (alt [ digit ; rg 'A' 'F'; rg 'a' 'f' ]) 128 (Some 128); + rep space; + str "setup-x86_64.exe" + ]) + in + try Some (OpamHash.sha512 Re.(Group.get (exec re content) 1)) + with Not_found -> None + in + OpamDownload.download_as ~overwrite ?checksum url_setupexe dst + + let install ~packages = + let open OpamProcess.Job.Op in + let cygwin_root = internal_cygroot () in + let cygwin_bin = cygwin_root / "bin" in + let cygcheck = cygwin_bin // cygcheckexe in + let local_cygwin_setupexe = cygsetup () in + if OpamFilename.exists cygcheck then + OpamConsole.warning "Cygwin already installed in root %s" + (OpamFilename.Dir.to_string cygwin_root) + else + (* rjbou: dry run ? there is no dry run on install, from where this + function is called *) + (OpamProcess.Job.run @@ + (* download setup.exe *) + download_setupexe local_cygwin_setupexe @@+ fun () -> + (* launch install *) + let args = [ + "--root"; OpamFilename.Dir.to_string cygwin_root; + "--arch"; "x86_64"; + "--only-site"; + "--site"; mirror; + "--local-package-dir"; + OpamFilename.Dir.to_string (internal_cygcache ()); + "--no-admin"; + "--no-desktop"; + "--no-replaceonreboot"; + "--no-shortcuts"; + "--no-startmenu"; + "--no-write-registry"; + "--quiet-mode"; + ] @ + match packages with + | [] -> [] + | spkgs -> + [ "--packages"; + OpamStd.List.concat_map "," OpamSysPkg.to_string spkgs ] + in + OpamSystem.make_command + (OpamFilename.to_string local_cygwin_setupexe) + args @@> fun r -> + OpamSystem.raise_on_process_error r; + Done ()); + cygcheck + + let default_cygroot = "C:\\cygwin64" + + let check_install path = + if not (Sys.file_exists path) then + Error (Printf.sprintf "%s not found!" path) + else if Filename.basename path = "cygcheck.exe" then + (* We have cygcheck.exe path *) + let cygbin = Some (Filename.dirname path) in + if OpamStd.Sys.is_cygwin_cygcheck ~cygbin then + Ok (OpamFilename.of_string path) + else + Error + (Printf.sprintf + "%s found, but it is not from a Cygwin installation" + path) + else if not (Sys.is_directory path) then + Error (Printf.sprintf "%s is not a directory" path) + else + let cygbin = Filename.concat path "bin" in + (* We have cygroot path *) + if Sys.file_exists cygbin then + if OpamStd.Sys.is_cygwin_cygcheck ~cygbin:(Some cygbin) then + Ok (OpamFilename.of_string (Filename.concat cygbin "cygcheck.exe")) + else + Error + (Printf.sprintf + "%s found, but it does not appear to be a Cygwin installation" + path) + else + Error + (Printf.sprintf "bin\\cygcheck.exe not found in %s" + path) + + (* Set setup.exe in the good place, ie in .opam/.cygwin/ *) + let check_setup setup = + let dst = cygsetup () in + if OpamFilename.exists dst then () else + (match setup with + | Some setup -> + log "Copying %s into %s" + (OpamFilename.to_string setup) + (OpamFilename.to_string dst); + OpamFilename.copy ~src:setup ~dst + | None -> + log "Donwloading setup exe"; + OpamProcess.Job.run @@ download_setupexe dst) +end + let yum_cmd = lazy begin if OpamSystem.resolve_command "yum" <> None then "yum" @@ -456,6 +618,25 @@ let packages_status ?(env=OpamVariable.Map.empty) config packages = |> OpamSysPkg.Set.of_list in compute_sets sys_installed + | Cygwin -> + (* Output format: + >Cygwin Package Information + >Package Version + >git 2.35.1-1 + >binutils 2.37-2 + *) + let sys_installed = + run_query_command (Commands.cygcheck config) + ([ "-c"; "-d" ] @ to_string_list packages) + |> (function | _::_::l -> l | _ -> []) + |> OpamStd.List.filter_map (fun l -> + match OpamStd.String.split l ' ' with + | pkg::_ -> Some pkg + | _ -> None) + |> List.map OpamSysPkg.of_string + |> OpamSysPkg.Set.of_list + in + compute_sets sys_installed | Debian -> let get_avail_w_virtuals () = let provides_sep = Re.(compile @@ str ", ") in @@ -752,8 +933,30 @@ let install_packages_commands_t ?(env=OpamVariable.Map.empty) config sys_package |> OpamStd.String.Set.remove epel_release |> OpamStd.String.Set.elements); `AsUser "rpm", "-q"::"--whatprovides"::packages], None - | Debian -> [`AsAdmin "apt-get", "install"::yes ["-qq"; "-yy"] packages], - (if unsafe_yes then Some ["DEBIAN_FRONTEND", "noninteractive"] else None) + | Cygwin -> + (* We use setp_x86_64 to install package instead of `cygcheck` that is + stored in `sys-pkg-manager-cmd` field *) + [`AsUser (OpamFilename.to_string (Cygwin.cygsetup ())), + [ "--root"; (OpamFilename.Dir.to_string (Cygwin.cygroot config)); + "--quiet-mode"; + "--no-shortcuts"; + "--no-startmenu"; + "--no-desktop"; + "--no-admin"; + "--packages"; + String.concat "," packages; + ] @ (if Cygwin.is_internal config then + [ "--upgrade-also"; + "--only-site"; + "--site"; Cygwin.mirror; + "--local-package-dir"; + OpamFilename.Dir.to_string (Cygwin.internal_cygcache ()); + ] else []) + ], + None + | Debian -> + [`AsAdmin "apt-get", "install"::yes ["-qq"; "-yy"] packages], + (if unsafe_yes then Some ["DEBIAN_FRONTEND", "noninteractive"] else None) | Dummy test -> if test.install then [`AsUser "echo", packages], None @@ -828,17 +1031,18 @@ let update ?(env=OpamVariable.Map.empty) config = | Alpine -> Some (`AsAdmin "apk", ["update"]) | Arch -> Some (`AsAdmin "pacman", ["-Sy"]) | Centos -> Some (`AsAdmin (Lazy.force yum_cmd), ["makecache"]) + | Cygwin -> None | Debian -> Some (`AsAdmin "apt-get", ["update"]) | Dummy test -> - if test.install then None else - Some (`AsUser "false", []) + if test.install then None else Some (`AsUser "false", []) + | Freebsd -> None | Gentoo -> Some (`AsAdmin "emerge", ["--sync"]) | Homebrew -> Some (`AsUser "brew", ["update"]) | Macports -> Some (`AsAdmin "port", ["sync"]) | Msys2 -> Some (`AsUser (Commands.msys2 config), ["-Sy"]) + | Netbsd -> None + | Openbsd -> None | Suse -> Some (`AsAdmin "zypper", ["--non-interactive"; "refresh"]) - | Freebsd | Netbsd | Openbsd -> - None in match cmd with | None -> diff --git a/vendor/opam/src/state/opamSysInteract.mli b/vendor/opam/src/state/opamSysInteract.mli index 791fe6e0753..d639d66edf4 100644 --- a/vendor/opam/src/state/opamSysInteract.mli +++ b/vendor/opam/src/state/opamSysInteract.mli @@ -39,3 +39,37 @@ val package_manager_name: ?env:gt_variables -> OpamFile.Config.t -> string Presently used to check for epel-release on CentOS and RHEL. [env] is used to determine host specification. *) val repo_enablers: ?env:gt_variables -> OpamFile.Config.t -> string option + + +module Cygwin : sig + + (* Default Cygwin installation prefix C:\cygwin64 *) + val default_cygroot: string + + (* Install an internal Cygwin install, in /.cygwin *) + val install: packages:OpamSysPkg.t list -> OpamFilename.t + + (* [check_install path] checks a Cygwin installation at [path]. It checks + that 'path\cygcheck.exe' or 'path\bin\cygcheck.exe' exists. *) + val check_install: + string -> (OpamFilename.t, string) result + + (* Returns true if Cygwin install is internal *) + val is_internal: OpamFile.Config.t -> bool + + (* [check_setup path] checks and store Cygwin setup executable. Is [path] is + [None], it downloads it, otherwise it copies it to + /.cygwin/setup-x86_64.exe. If the file is already existent, it + is a no-op. *) + val check_setup: OpamFilename.t option -> unit + + (* Return Cygwin binary path *) + val cygbin_opt: OpamFile.Config.t -> OpamFilename.Dir.t option + + (* Return Cygwin cygcheck.exe path *) + val cygcheck_opt: OpamFile.Config.t -> OpamFilename.t option + + (* Return Cygwin installation prefix *) + val cygroot_opt: OpamFile.Config.t -> OpamFilename.Dir.t option + +end diff --git a/vendor/opam/src/state/opamSysPoll.ml b/vendor/opam/src/state/opamSysPoll.ml index 37af8c2d221..2930d973d77 100644 --- a/vendor/opam/src/state/opamSysPoll.ml +++ b/vendor/opam/src/state/opamSysPoll.ml @@ -37,10 +37,14 @@ let poll_arch () = let raw = match Sys.os_type with | "Unix" | "Cygwin" -> OpamStd.Sys.uname "-m" | "Win32" -> - if Sys.word_size = 32 && not (OpamStubs.isWoW64 ()) then - Some "i686" - else - Some "x86_64" + begin match OpamStubs.getArchitecture () with + | OpamStubs.AMD64 -> Some "x86_64" + | ARM -> Some "arm32" + | ARM64 -> Some "arm64" + | IA64 -> Some "ia64" + | Intel -> Some "x86_32" + | Unknown -> None + end | _ -> None in match raw with @@ -98,13 +102,26 @@ let poll_os_distribution () = (if is_android () then Some "android" else os_release_field "ID" >>= norm >>+ fun () -> command_output ["lsb_release"; "-i"; "-s"] >>= norm >>+ fun () -> - try - List.find Sys.file_exists ["/etc/redhat-release"; - "/etc/centos-release"; - "/etc/gentoo-release"; - "/etc/issue"] |> - fun s -> Scanf.sscanf s " %s " norm - with Not_found -> linux) + let release_file = + List.find_opt Sys.file_exists ["/etc/redhat-release"; + "/etc/centos-release"; + "/etc/gentoo-release"; + "/etc/issue"] + in + match OpamStd.Option.map OpamProcess.read_lines release_file with + | None | Some [] -> linux + | Some (s::_) -> + try Scanf.sscanf s " %s " norm + with Scanf.Scan_failure _ -> linux) + | Some "win32" -> + (* If the user provides a Cygwin installation in PATH, by default we'll use + it. Note that this is _not_ done for MSYS2. *) + let cygwin = + OpamSystem.resolve_command "cygcheck" + >>| Filename.dirname + |> (fun cygbin -> OpamStd.Sys.is_cygwin_cygcheck ~cygbin) + in + if cygwin then Some "cygwin" else os | os -> os let os_distribution = Lazy.from_fun poll_os_distribution diff --git a/vendor/update-opam.sh b/vendor/update-opam.sh index 5b3351d5180..8588f3d3f4c 100755 --- a/vendor/update-opam.sh +++ b/vendor/update-opam.sh @@ -1,6 +1,6 @@ #!/usr/bin/env bash -version=d261e3d4a487f0346dffdf6eadd868095a7d128f +version=7d5c4217c11c18f1405d58702409ed7290668135 set -e -o pipefail