diff --git a/src/client/opamCommands.ml b/src/client/opamCommands.ml index 7cd32baee4d..95de4cfdb69 100644 --- a/src/client/opamCommands.ml +++ b/src/client/opamCommands.ml @@ -259,6 +259,10 @@ let init = ~init_config ?repo ~bypass_checks shell dot_profile update_config in + let switch_defaults = + OpamFile.InitConfig.switch_defaults init_config + |> OpamStd.Option.default OpamInitDefaults.switch_defaults + in if not no_compiler && OpamFile.Config.installed_switches gt.config = [] then match compiler with @@ -269,7 +273,8 @@ let init = OpamConsole.header_msg "Creating initial switch (%s)" (OpamFormula.string_of_atoms packages); OpamSwitchCommand.install - gt ~rt ~packages ~update_config:true (OpamSwitch.of_string comp) + gt ~rt ~packages ~update_config:true ~switch_defaults + (OpamSwitch.of_string comp) |> ignore | None -> let candidates = OpamFormula.to_dnf default_compiler in @@ -288,7 +293,7 @@ let init = OpamConsole.header_msg "Creating initial switch (%s)" (OpamFormula.string_of_atoms packages); OpamSwitchCommand.install - gt ~rt ~packages ~update_config:true + gt ~rt ~packages ~update_config:true ~switch_defaults (OpamSwitch.of_string "default") |> ignore | None -> @@ -1827,11 +1832,54 @@ let switch = allowing to re-import even if they don't exist in the repositories (the \ default is to include only the metadata of pinned packages)" in + let config_file = + mk_opt_all ["config"] "FILE" + "Use the given init config file. If repeated, latest has the highest \ + priority ($(b,i.e.) each field gets its value from where it was defined \ + latest). Specifying a URL pointing to a config file instead is \ + allowed." + OpamArg.url + in + let no_config_file = + mk_flag ["no-opamrc"] + (Printf.sprintf + "Don't read `/etc/opamrc' or `~%s.opamrc': use the default settings and \ + the files specified through $(b,--config) only" Filename.dir_sep) + in let switch global_options build_options command print_short - no_switch packages empty descr full repos params = + no_switch packages empty descr full config_file no_config_file repos params = apply_global_options global_options; apply_build_options build_options; + let config_files = + let principal_config_files = + if no_config_file then [] + else + let f f = + if OpamFile.exists f then + Some (OpamFile.to_string f |> OpamFilename.of_string, `InitConfig) + else + None + in + OpamStd.List.filter_map f (OpamPath.init_config_files ()) + in + principal_config_files + @ List.map (fun url -> + match OpamUrl.local_file url with + | Some f -> (f, `SwitchDefaults) + | None -> + let f = OpamFilename.of_string (OpamSystem.temp_file "conf") in + OpamProcess.Job.run (OpamDownload.download_as ~overwrite:false url f); + let hash = OpamHash.compute ~kind:`SHA256 (OpamFilename.to_string f) in + if OpamConsole.confirm + "Using configuration file from %s. \ + Please verify the following SHA256:\n %s\n\ + Is this correct ?" + (OpamUrl.to_string url) (OpamHash.contents hash) + then (f, `SwitchDefaults) + else OpamStd.Sys.exit 10 + ) config_file + in let packages = match packages, empty with | None, true -> Some [] @@ -1905,6 +1953,29 @@ let switch = compilers; `Ok () | Some `install, switch::params -> + let switch_defaults = + try + OpamConsole.note "Will configure switch from built-in defaults%s." + (OpamStd.List.concat_map ~nil:"" ~left:", " ", " + (fun (f, _) -> OpamFilename.to_string f) config_files); + List.fold_left (fun acc (f, kind) -> + let config = + match kind with + | `InitConfig -> + OpamFile.InitConfig.read (OpamFile.make f) |> OpamFile.InitConfig.switch_defaults + | `SwitchDefaults -> + Some (OpamFile.SwitchDefaults.read (OpamFile.make f)) + in + OpamStd.Option.map_default (OpamFile.SwitchDefaults.add acc) acc config) + OpamInitDefaults.switch_defaults + config_files + with e -> + OpamConsole.error + "Error in configuration file, fix it, use '--no-opamrc', or check \ + your '--config FILE' arguments:"; + OpamConsole.errmsg "%s\n" (Printexc.to_string e); + OpamStd.Sys.exit 10 + in OpamGlobalState.with_ `Lock_write @@ fun gt -> let repos, rt = get_repos_rt gt repos in let switch = OpamSwitch.of_string switch in @@ -1915,7 +1986,7 @@ let switch = OpamSwitchCommand.install gt ~rt ?synopsis:descr ?repos ~update_config:(not no_switch) - ~packages + ~packages ~switch_defaults switch in ignore (OpamSwitchState.unlock st); @@ -2016,7 +2087,7 @@ let switch = $global_options $build_options $command $print_short_flag $no_switch - $packages $empty $descr $full $repos $params)), + $packages $empty $descr $full $config_file $no_config_file $repos $params)), term_info "switch" ~doc ~man (* PIN *) diff --git a/src/client/opamSwitchCommand.ml b/src/client/opamSwitchCommand.ml index 77da157a42c..d2453132bca 100644 --- a/src/client/opamSwitchCommand.ml +++ b/src/client/opamSwitchCommand.ml @@ -251,7 +251,7 @@ let install_compiler_packages t atoms = OpamSolution.check_solution ~quiet:OpamClientConfig.(not !r.show) t result; t -let install gt ?rt ?synopsis ?repos ~update_config ~packages switch = +let install gt ?rt ?synopsis ?repos ~update_config ~packages ~switch_defaults switch = let update_config = update_config && not (OpamSwitch.is_external switch) in let old_switch_opt = OpamFile.Config.switch gt.config in let comp_dir = OpamPath.Switch.root gt.root switch in @@ -266,7 +266,51 @@ let install gt ?rt ?synopsis ?repos ~update_config ~packages switch = let gt, st = if not (OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.show)) then let gt = - OpamSwitchAction.create_empty_switch gt ?synopsis ?repos switch + let env full_var = + let open OpamVariable.Full in + match scope full_var with + | Global -> + OpamPackageVar.resolve_global gt full_var + | Self -> + None + | Package name -> + match variable full_var |> OpamVariable.to_string with + | "installed" -> + let f (package, _) = + OpamPackage.Name.compare name package = 0 + in + Some (B (List.exists f packages)) + | _ -> + None + in + let configure_switch conf = + let variables = + (* XXX Should be able to use description in the same way as for + eval_variables *) + let f ((name, value, _description), filter) = + let eval = OpamFilter.eval_to_bool ~default:false env in + if OpamStd.Option.map_default eval true filter then + let value = + match value with + | B _ -> + value + | S value -> + let resolve = (OpamPackageVar.resolve_global gt) in + S (OpamFilter.expand_string resolve value) + in + Some (name, value) + else + None + in + let switch_variables = + OpamFile.SwitchDefaults.switch_variables switch_defaults + in + OpamFile.Switch_config.(conf.variables) + @ OpamStd.List.filter_map f switch_variables + in + {conf with OpamFile.Switch_config.variables} + in + OpamSwitchAction.create_empty_switch gt ?synopsis ?repos ~configure_switch switch in if update_config then gt, OpamSwitchAction.set_current_switch `Lock_write gt ?rt switch diff --git a/src/client/opamSwitchCommand.mli b/src/client/opamSwitchCommand.mli index c7804e97f1a..7100d6175b2 100644 --- a/src/client/opamSwitchCommand.mli +++ b/src/client/opamSwitchCommand.mli @@ -24,7 +24,8 @@ val install: ?synopsis:string -> ?repos:repository_name list -> update_config:bool -> - packages:atom conjunction -> switch -> + packages:atom conjunction -> + switch_defaults: OpamFile.SwitchDefaults.t -> switch -> unlocked global_state * rw switch_state (** Install a compiler's base packages *) diff --git a/src/state/opamSwitchAction.ml b/src/state/opamSwitchAction.ml index e09e328d786..e44b945040c 100644 --- a/src/state/opamSwitchAction.ml +++ b/src/state/opamSwitchAction.ml @@ -16,7 +16,7 @@ open OpamPackage.Set.Op let log fmt = OpamConsole.log "SWACT" fmt let slog = OpamConsole.slog -let gen_switch_config root ?(synopsis="") ?repos _switch = +let gen_switch_config root ?(synopsis="") ?repos ?(configure_switch = fun x -> x) _switch = let vars = List.map (fun (s,p) -> OpamVariable.of_string s, S p) [ ("user" , @@ -29,6 +29,7 @@ let gen_switch_config root ?(synopsis="") ?repos _switch = ("os" , OpamStd.Sys.os_string ()); ] in + configure_switch { OpamFile.Switch_config. opam_version = OpamVersion.current_nopatch; synopsis; @@ -45,7 +46,7 @@ let install_switch_config root switch config = (OpamPath.Switch.switch_config root switch) config -let create_empty_switch gt ?synopsis ?repos switch = +let create_empty_switch gt ?synopsis ?repos ?configure_switch switch = log "create_empty_switch at %a" (slog OpamSwitch.to_string) switch; let root = gt.root in let switch_dir = OpamPath.Switch.root root switch in @@ -59,7 +60,9 @@ let create_empty_switch gt ?synopsis ?repos switch = (* Create base directories *) OpamFilename.mkdir switch_dir; - let config = gen_switch_config root ?synopsis ?repos switch in + let config = + gen_switch_config root ?synopsis ?repos ?configure_switch switch + in OpamFilename.mkdir (OpamPath.Switch.lib_dir root switch config); OpamFilename.mkdir (OpamPath.Switch.stublibs root switch config); diff --git a/src/state/opamSwitchAction.mli b/src/state/opamSwitchAction.mli index b1f2d1847d4..f235e01d9ed 100644 --- a/src/state/opamSwitchAction.mli +++ b/src/state/opamSwitchAction.mli @@ -18,6 +18,7 @@ open OpamStateTypes registers it in the global config and returns the updated global state *) val create_empty_switch: rw global_state -> ?synopsis:string -> ?repos:repository_name list -> + ?configure_switch:(OpamFile.Switch_config.t -> OpamFile.Switch_config.t) -> switch -> rw global_state (** Writes the current state file to disk (installed, pinned, root packages etc.). @@ -33,6 +34,7 @@ val set_current_switch: prefix *) val gen_switch_config: dirname -> ?synopsis:string -> ?repos:repository_name list -> + ?configure_switch:(OpamFile.Switch_config.t -> OpamFile.Switch_config.t) -> switch -> OpamFile.Switch_config.t (** (Re-)install the configuration for a given root and switch *)