diff --git a/src/client/opamClient.ml b/src/client/opamClient.ml index 0b6919dbb85..9f3868582d2 100644 --- a/src/client/opamClient.ml +++ b/src/client/opamClient.ml @@ -1591,7 +1591,7 @@ let install_t t ?ask ?(ignore_conflicts=false) ?(depext_only=false) if has_missing_depexts then let gt = t.switch_global in OpamStd.Option.map_default (fun s -> s ^ ".\n\n") "" - (OpamSysInteract.repo_enablers ~env:gt.global_variables gt.config) + (OpamSysInteract.repo_enablers ~env:gt.global_variables t.switch gt.config) else "" in OpamConsole.errmsg "%s%s" diff --git a/src/client/opamSolution.ml b/src/client/opamSolution.ml index 8b37e0c652f..ee0be9c7250 100644 --- a/src/client/opamSolution.ml +++ b/src/client/opamSolution.ml @@ -164,7 +164,7 @@ let check_availability ?permissive t set atoms = msg (OpamStd.Option.map_default (Printf.sprintf "\n%s.") "" (OpamSysInteract.repo_enablers - ~env:t.switch_global.global_variables t.switch_global.config))) + ~env:t.switch_global.global_variables t.switch t.switch_global.config))) | None -> None in let check_atom (name, cstr as atom) = @@ -1115,7 +1115,7 @@ let print_depext_msg (avail, nf) = (* Gets depexts from the state, without checking again, unless [recover] is true. *) let get_depexts ?(force=false) ?(recover=false) t packages = - if not force && OpamStateConfig.(!r.no_depexts) then OpamSysPkg.Set.empty else + if not force && OpamStateConfig.(!r.no_depexts) then OpamSysPkg.Set.empty, OpamSysPkg.Set.empty else let sys_packages = if recover then OpamSwitchState.depexts_status_of_packages t packages @@ -1134,23 +1134,24 @@ let get_depexts ?(force=false) ?(recover=false) t packages = OpamPackage.Map.union (fun _ x -> x) base (OpamSwitchState.depexts_status_of_packages t more_pkgs) in - let avail, nf = - OpamPackage.Set.fold (fun pkg (avail,nf) -> + let avail, required, nf = + OpamPackage.Set.fold (fun pkg (avail,required,nf) -> match OpamPackage.Map.find_opt pkg sys_packages with | Some sys -> OpamSysPkg.(Set.union avail sys.s_available), + OpamSysPkg.(Set.union avail sys.s_required), OpamSysPkg.(Set.union nf sys.s_not_found) - | None -> avail, nf) - packages (OpamSysPkg.Set.empty, OpamSysPkg.Set.empty) + | None -> avail, required, nf) + packages (OpamSysPkg.Set.empty, OpamSysPkg.Set.empty, OpamSysPkg.Set.empty) in print_depext_msg (avail, nf); - avail + avail, required let install_depexts ?(force_depext=false) ?(confirm=true) t packages = let confirm = confirm && not (OpamSysInteract.Cygwin.is_internal t.switch_global.config) in - let sys_packages = + let sys_packages, required = get_depexts ~force:force_depext ~recover:force_depext t packages in let env = t.switch_global.global_variables in @@ -1170,14 +1171,14 @@ let install_depexts ?(force_depext=false) ?(confirm=true) t packages = in { t with sys_packages = lazy sys_packages } in - let rec entry_point t sys_packages = + let rec entry_point t sys_packages required = if OpamClientConfig.(!r.fake) then (print_command sys_packages; t) else if OpamFile.Config.depext_run_installs t.switch_global.config then - if confirm then menu t sys_packages else auto_install t sys_packages + if confirm then menu t sys_packages required else auto_install t sys_packages required else manual_install t sys_packages - and menu t sys_packages = + and menu t sys_packages required = let answer = let pkgman = OpamConsole.colorise `yellow @@ -1200,7 +1201,7 @@ let install_depexts ?(force_depext=false) ?(confirm=true) t packages = in OpamConsole.msg "\n"; match answer with - | `Yes -> auto_install t sys_packages + | `Yes -> auto_install t sys_packages required | `No -> OpamConsole.note "Use 'opam option depext-run-installs=false' \ if you don't want to be prompted again."; @@ -1208,7 +1209,7 @@ let install_depexts ?(force_depext=false) ?(confirm=true) t packages = print_command sys_packages; OpamConsole.pause "Standing by, press enter to continue when done."; OpamConsole.msg "\n"; - check_again t sys_packages + check_again t sys_packages required | `Ignore -> bypass t | `Quit -> give_up_msg (); OpamStd.Sys.exit_because `Aborted and print_command sys_packages = @@ -1237,20 +1238,21 @@ let install_depexts ?(force_depext=false) ?(confirm=true) t packages = in OpamConsole.msg "\n"; match answer with - | `Continue -> check_again t sys_packages + | `Continue -> check_again t sys_packages required | `Ignore -> bypass t | `Quit -> give_up () - and auto_install t sys_packages = + and auto_install t sys_packages required = try - OpamSysInteract.install ~env t.switch config sys_packages; (* handles dry_run *) + let install_packages = OpamSysPkg.Set.union sys_packages required in + OpamSysInteract.install ~env t.switch config install_packages; (* handles dry_run *) map_sysmap (fun _ -> OpamSysPkg.Set.empty) t with Failure msg -> OpamConsole.error "%s" msg; - check_again t sys_packages - and check_again t sys_packages = + check_again t sys_packages required + and check_again t sys_packages required = let open OpamSysPkg.Set.Op in - let needed, notfound = - OpamSysInteract.packages_status ~env config sys_packages + let needed, _required, notfound = + OpamSysInteract.packages_status ~env t.switch config sys_packages in let still_missing = needed ++ notfound in let installed = sys_packages -- still_missing in @@ -1267,7 +1269,7 @@ let install_depexts ?(force_depext=false) ?(confirm=true) t packages = else (OpamConsole.error "These packages are still missing: %s\n" (syspkgs_to_string sys_packages); - if OpamStd.Sys.tty_in then entry_point t sys_packages + if OpamStd.Sys.tty_in then entry_point t sys_packages required else give_up ()) and bypass t = OpamConsole.note @@ -1294,7 +1296,7 @@ let install_depexts ?(force_depext=false) ?(confirm=true) t packages = try OpamConsole.header_msg "Handling external dependencies"; OpamConsole.msg "\n"; - entry_point t sys_packages + entry_point t sys_packages required with Sys.Break as e -> OpamStd.Exn.finalise e give_up_msg (* Apply a solution *) diff --git a/src/format/opamSysPkg.ml b/src/format/opamSysPkg.ml index 0aec85940a0..5edaf6d56d5 100644 --- a/src/format/opamSysPkg.ml +++ b/src/format/opamSysPkg.ml @@ -49,6 +49,9 @@ type status = s_available : Set.t; (** Package available but not installed *) + s_required : Set.t; + (** Package installed but also needs to be passed to the installation *) + s_not_found : Set.t; (** Package unavailable on this system *) } @@ -57,6 +60,7 @@ type status = let status_empty = { s_available = Set.empty; + s_required = Set.empty; s_not_found = Set.empty; } diff --git a/src/format/opamSysPkg.mli b/src/format/opamSysPkg.mli index d0239df4bfd..c76e635b852 100644 --- a/src/format/opamSysPkg.mli +++ b/src/format/opamSysPkg.mli @@ -20,6 +20,9 @@ type status = s_available : Set.t; (** Package available but not installed *) + s_required : Set.t; + (** Package installed but also needs to be passed to the installation *) + s_not_found : Set.t; (** Package unavailable on this system *) } diff --git a/src/state/opamSwitchState.ml b/src/state/opamSwitchState.ml index 1f1649062b2..1eb254baf33 100644 --- a/src/state/opamSwitchState.ml +++ b/src/state/opamSwitchState.ml @@ -179,7 +179,7 @@ module Installed_cache = OpamCached.Make(struct end) let depexts_status_of_packages_raw - ~depexts ?env global_config switch_config packages = + ~depexts ?env global_config switch 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 = @@ -197,8 +197,8 @@ let depexts_status_of_packages_raw in let syspkg_set = syspkg_set -- bypass in let ret = - match OpamSysInteract.packages_status ?env global_config syspkg_set with - | avail, not_found -> + match OpamSysInteract.packages_status ?env switch global_config syspkg_set with + | avail, required, not_found -> let avail, not_found = if OpamStateConfig.(!r.no_depexts) then (* Mark all as available. This is necessary to store the exceptions @@ -211,6 +211,7 @@ let depexts_status_of_packages_raw in OpamPackage.Map.map (fun set -> { OpamSysPkg.s_available = set %% avail; + OpamSysPkg.s_required = set %% required; OpamSysPkg.s_not_found = set %% not_found} ) syspkg_map | exception (Failure msg) -> @@ -514,7 +515,7 @@ let load lock_kind gt rt switch = || OpamStateConfig.(!r.no_depexts) then lazy OpamPackage.Map.empty else lazy ( - depexts_status_of_packages_raw gt.config switch_config + depexts_status_of_packages_raw gt.config switch switch_config ~env:gt.global_variables (Lazy.force available_packages) ~depexts:(fun package -> @@ -772,7 +773,7 @@ let depexts st nv = depexts_raw ~env nv st.opams let depexts_status_of_packages st set = - depexts_status_of_packages_raw st.switch_global.config st.switch_config set + depexts_status_of_packages_raw st.switch_global.config st.switch st.switch_config set ~env:st.switch_global.global_variables ~depexts:(depexts st) let depexts_unavailable st nv = diff --git a/src/state/opamSysInteract.ml b/src/state/opamSysInteract.ml index d936ceca053..dae0a80e4a8 100644 --- a/src/state/opamSysInteract.ml +++ b/src/state/opamSysInteract.ml @@ -409,7 +409,7 @@ let yum_cmd = lazy begin raise (OpamSystem.Command_not_found "yum or dnf") end -let packages_status ?(env=OpamVariable.Map.empty) config packages = +let packages_status ?(env=OpamVariable.Map.empty) switch config packages = let (+++) pkg set = OpamSysPkg.Set.add (OpamSysPkg.of_string pkg) set in (* Some package managers don't permit to request on available packages. In this case, we consider all non installed packages as [available]. *) @@ -426,7 +426,7 @@ let packages_status ?(env=OpamVariable.Map.empty) config packages = let available = packages -- installed in available, OpamSysPkg.Set.empty in - available, not_found + available, OpamSysPkg.Set.empty, not_found in let to_string_list pkgs = OpamSysPkg.(Set.fold (fun p acc -> to_string p :: acc) pkgs []) @@ -907,7 +907,12 @@ let packages_status ?(env=OpamVariable.Map.empty) config packages = be found.' But omitting them will mean that they won't be added to the Nix derivation. *) - packages, OpamSysPkg.Set.empty; + let open OpamFilename in + let dir = OpamPath.Switch.meta OpamStateConfig.(!r.root_dir) switch in + let installedFile = create dir (basename (raw "nix_installed")) in + let packages_str = try read installedFile with _ -> "" in + let installed = OpamSysPkg.Set.of_list (List.map OpamSysPkg.of_string (String.split_on_char ' ' packages_str)) in + packages -- installed, packages, OpamSysPkg.Set.empty; | Openbsd -> let sys_installed = run_query_command "pkg_info" ["-mqP"] @@ -1024,14 +1029,16 @@ let install_packages_commands_t ?(env=OpamVariable.Map.empty) switch config sys_ | Nix -> let open OpamFilename in let dir = OpamPath.Switch.meta OpamStateConfig.(!r.root_dir) switch in + let packages_str = String.concat " " (List.rev (OpamSysPkg.Set.fold (fun p l -> OpamSysPkg.to_string p :: l) sys_packages [])) in + let installedFile = create dir (basename (raw "nix_installed")) in + write installedFile packages_str; let drvFile = create dir (basename (raw "env.nix")) in - let packages = String.concat " " (List.rev (OpamSysPkg.Set.fold (fun p l -> OpamSysPkg.to_string p :: l) sys_packages [])) in - let contents = + let drv = {|{ pkgs ? import {} }: with pkgs; stdenv.mkDerivation { name = "opam-nix-env"; - nativeBuildInputs = with buildPackages; [ |} ^ packages ^ {| ]; + nativeBuildInputs = with buildPackages; [ |} ^ packages_str ^ {| ]; phases = [ "buildPhase" ]; @@ -1047,7 +1054,7 @@ echo "PATH += $PATH Nix" >> $out preferLocalBuild = true; } |} in - write drvFile contents; + write drvFile drv; let envFile = create dir (basename (raw "nix.env")) |> OpamFilename.to_string in [`AsUser "nix-build", [ OpamFilename.to_string drvFile; "--out-link"; envFile ] ], None | Openbsd -> [`AsAdmin "pkg_add", yes ~no:["-i"] ["-I"] packages], None @@ -1123,10 +1130,10 @@ let update ?(env=OpamVariable.Map.empty) config = try sudo_run_command ~env cmd args with Failure msg -> failwith ("System package update " ^ msg) -let repo_enablers ?(env=OpamVariable.Map.empty) config = +let repo_enablers ?(env=OpamVariable.Map.empty) switch config = if family ~env () <> Centos then None else - let (needed, _) = - packages_status ~env config (OpamSysPkg.raw_set + let (needed, _, _) = + packages_status ~env switch config (OpamSysPkg.raw_set (OpamStd.String.Set.singleton "epel-release")) in if OpamSysPkg.Set.is_empty needed then None diff --git a/src/state/opamSysInteract.mli b/src/state/opamSysInteract.mli index 1dba02687f1..f1226cea537 100644 --- a/src/state/opamSysInteract.mli +++ b/src/state/opamSysInteract.mli @@ -14,11 +14,13 @@ open OpamStateTypes system and returns a pair of [sys_package] set: * first one is available set: package that exist on the default repositories, but not installed) - * second one, not found set: packages not found on the defined repositories + * second one, also required set: the list of packages which also need to be + passed to the installation + * third one, not found set: packages not found on the defined repositories [env] is used to determine host specification. *) val packages_status: - ?env:gt_variables -> OpamFile.Config.t -> OpamSysPkg.Set.t -> - OpamSysPkg.Set.t * OpamSysPkg.Set.t + ?env:gt_variables -> OpamSwitch.t -> OpamFile.Config.t -> OpamSysPkg.Set.t -> + OpamSysPkg.Set.t * OpamSysPkg.Set.t * OpamSysPkg.Set.t (* Return the commands to run to install given system packages. [env] is used to determine host specification. *) @@ -38,7 +40,7 @@ val package_manager_name: ?env:gt_variables -> OpamSwitch.t -> OpamFile.Config.t repositories. 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 +val repo_enablers: ?env:gt_variables -> OpamSwitch.t -> OpamFile.Config.t -> string option module Cygwin : sig