From d249fbf2fdcb710a2312783818b663fc97210ad4 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Wed, 10 May 2017 10:33:31 +0100 Subject: [PATCH 1/3] Add switch-specific global variables to opamrc Add a new format for switch-specific global variables along the lines of the the "global-variables" field in /etc/opamrc. This new field "switch-variables" is added to a configuration type "switch-defaults" which may be embedded as a section in /etc/opamrc. The motiviation here is to be able to specific switch-specific global variables which can be fed to opam switch create either by the command line or by specifying an alternate configuration file. Signed-off-by: David Allsopp --- src/format/opamFile.ml | 76 ++++++++++++++++++++++++++++++++++++++++- src/format/opamFile.mli | 19 +++++++++++ 2 files changed, 94 insertions(+), 1 deletion(-) diff --git a/src/format/opamFile.ml b/src/format/opamFile.ml index 4817b6358d8..5ad3f4ee79f 100644 --- a/src/format/opamFile.ml +++ b/src/format/opamFile.ml @@ -1209,6 +1209,69 @@ module Config = struct include SyntaxFile(ConfigSyntax) end +module SwitchDefaultsSyntax = struct + let internal = "switch-defaults" + + type t = { + opam_version : opam_version; + switch_variables : + ((variable * variable_contents * string) * filter option) list; + } + + let opam_version t = t.opam_version + let switch_variables t = t.switch_variables + + let with_opam_version opam_version t = {t with opam_version} + let with_switch_variables switch_variables t = {t with switch_variables} + + let empty = { + opam_version = OpamVersion.current_nopatch; + switch_variables = []; + } + + let fields = + [ + "switch-variables", Pp.ppacc + with_switch_variables switch_variables + (Pp.V.map_list ~depth:2 + (Pp.V.map_option + (Pp.V.map_triple + (Pp.V.ident -| Pp.of_module "variable" (module OpamVariable)) + Pp.V.variable_contents + Pp.V.string) + (Pp.opt Pp.V.filter))); + ] + + let pp_contents = + let name = internal in + Pp.I.fields ~name ~empty fields + -| Pp.I.show_errors ~name ~strict:true () + + let pp = + let name = internal in + let fields = + ("opam-version", Pp.ppacc + with_opam_version opam_version + (Pp.V.string + -| Pp.of_module "opam-version" (module OpamVersion));)::fields + in + Pp.I.map_file @@ + Pp.I.fields ~name ~empty fields -| + Pp.I.show_errors ~name ~strict:true () + + let add t1 t2 = + let list = function [] -> fun l -> l | l -> fun _ -> l in + { + opam_version = t2.opam_version; + switch_variables = list t2.switch_variables t1.switch_variables; + } + +end +module SwitchDefaults = struct + include SwitchDefaultsSyntax + include SyntaxFile(SwitchDefaultsSyntax) +end + module InitConfigSyntax = struct let internal = "init-config" @@ -1228,6 +1291,7 @@ module InitConfigSyntax = struct recommended_tools : (string list * string option * filter option) list; required_tools : (string list * string option * filter option) list; init_scripts : ((string * string) * filter option) list; + switch_defaults : SwitchDefaults.t option; } let opam_version t = t.opam_version @@ -1245,6 +1309,7 @@ module InitConfigSyntax = struct let recommended_tools t = t.recommended_tools let required_tools t = t.required_tools let init_scripts t = t.init_scripts + let switch_defaults t = t.switch_defaults let with_opam_version opam_version t = {t with opam_version} let with_repositories repositories t = {t with repositories} @@ -1261,6 +1326,8 @@ module InitConfigSyntax = struct let with_recommended_tools recommended_tools t = {t with recommended_tools} let with_required_tools required_tools t = {t with required_tools} let with_init_scripts init_scripts t = {t with init_scripts} + let with_switch_defaults switch_defaults t = + {t with switch_defaults = Some switch_defaults} let criterion kind t = try Some (List.assoc kind t.solver_criteria) @@ -1286,6 +1353,7 @@ module InitConfigSyntax = struct recommended_tools = []; required_tools = []; init_scripts = []; + switch_defaults = None; } let pp_repository_def = @@ -1387,11 +1455,16 @@ module InitConfigSyntax = struct (fun (fld, ppacc) -> fld, Pp.embed with_wrappers wrappers ppacc) Wrappers.fields + let sections = [ + "switch-defaults", + Pp.ppacc_opt with_switch_defaults switch_defaults + (Pp.I.anonymous_section SwitchDefaults.pp_contents); + ] let pp = let name = internal in Pp.I.map_file @@ - Pp.I.fields ~name ~empty fields -| + Pp.I.fields ~name ~empty ~sections fields -| Pp.I.show_errors ~name ~strict:true () let add t1 t2 = @@ -1420,6 +1493,7 @@ module InitConfigSyntax = struct recommended_tools = list t2.recommended_tools t1.recommended_tools; required_tools = list t2.required_tools t1.required_tools; init_scripts = list t2.init_scripts t1.init_scripts; + switch_defaults = opt t2.switch_defaults t1.switch_defaults; } end diff --git a/src/format/opamFile.mli b/src/format/opamFile.mli index 976cb86f61e..47cd1af4617 100644 --- a/src/format/opamFile.mli +++ b/src/format/opamFile.mli @@ -173,6 +173,23 @@ module Config: sig end +(** Switch defaults file *) +module SwitchDefaults: sig + include IO_FILE + + val opam_version: t -> opam_version + val switch_variables: + t -> ((variable * variable_contents * string) * filter option) list + + val with_opam_version: opam_version -> t -> t + val with_switch_variables: + ((variable * variable_contents * string) * filter option) list -> t -> t + + (** [add t1 t2] is [t2], with the field values falling back to those of [t1] + when not set in [t2] *) + val add: t -> t -> t +end + (** Init config file [/etc/opamrc] *) module InitConfig: sig include IO_FILE @@ -192,6 +209,7 @@ module InitConfig: sig val recommended_tools: t -> (string list * string option * filter option) list val required_tools: t -> (string list * string option * filter option) list val init_scripts: t -> ((string * string) * filter option) list + val switch_defaults: t -> SwitchDefaults.t option val with_opam_version: opam_version -> t -> t val with_repositories: @@ -209,6 +227,7 @@ module InitConfig: sig val with_recommended_tools: (string list * string option * filter option) list -> t -> t val with_required_tools: (string list * string option * filter option) list -> t -> t val with_init_scripts: ((string * string) * filter option) list -> t -> t + val with_switch_defaults: SwitchDefaults.t -> t -> t (** [add t1 t2] is [t2], with the field values falling back to those of [t1] when not set in [t2] *) From fd53192d083b9b0cfdde47530dd0112da4efab62 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Wed, 10 May 2017 10:36:50 +0100 Subject: [PATCH 2/3] Add OpamInitDefaults.switch_defaults Default switch configuration (empty, at present) Signed-off-by: David Allsopp --- src/client/opamInitDefaults.ml | 6 +++++- src/client/opamInitDefaults.mli | 4 ++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/src/client/opamInitDefaults.ml b/src/client/opamInitDefaults.ml index f5770985fb3..87b37af7873 100644 --- a/src/client/opamInitDefaults.ml +++ b/src/client/opamInitDefaults.ml @@ -127,6 +127,9 @@ module I = OpamFile.InitConfig let (@|) g f = OpamStd.Op.(g @* f) () +let switch_defaults = + OpamFile.SwitchDefaults.empty + let init_config ?(sandboxing=true) () = I.empty |> I.with_repositories @@ -137,4 +140,5 @@ let init_config ?(sandboxing=true) () = I.with_recommended_tools @| recommended_tools |> I.with_required_tools @| required_tools ~sandboxing |> I.with_init_scripts @| init_scripts |> - I.with_dl_tool @| dl_tool + I.with_dl_tool @| dl_tool |> + I.with_switch_defaults switch_defaults diff --git a/src/client/opamInitDefaults.mli b/src/client/opamInitDefaults.mli index 36843f49047..d1cc4c37b7d 100644 --- a/src/client/opamInitDefaults.mli +++ b/src/client/opamInitDefaults.mli @@ -21,6 +21,10 @@ val default_compiler: formula val eval_variables: (OpamVariable.t * string list * string) list +(** Default switch defaults configuration file (also embedded in + {!init_config}). *) +val switch_defaults: OpamFile.SwitchDefaults.t + (** Default initial configuration file for use by [opam init] if nothing is supplied. *) val init_config: ?sandboxing:bool -> unit -> OpamFile.InitConfig.t From 52ddeaeeeca4768220e3efe129bcbfc063418758 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Wed, 26 Apr 2017 16:08:03 +0100 Subject: [PATCH 3/3] Apply switch-defaults opam switch create now also supports the --default-config and --config also found in opam init. For opam switch create, --config specifies a switch-defaults file, not an opamrc, but if not specified, opam will look for a switch-defaults section in opamrc. Signed-off-by: David Allsopp --- src/client/opamCommands.ml | 81 ++++++++++++++++++++++++++++++-- src/client/opamSwitchCommand.ml | 51 +++++++++++++++++++- src/client/opamSwitchCommand.mli | 1 + src/state/opamSwitchAction.ml | 9 ++-- src/state/opamSwitchAction.mli | 2 + 5 files changed, 135 insertions(+), 9 deletions(-) diff --git a/src/client/opamCommands.ml b/src/client/opamCommands.ml index e08a1f999b7..fc4d64a2dfb 100644 --- a/src/client/opamCommands.ml +++ b/src/client/opamCommands.ml @@ -361,6 +361,10 @@ let init = get_init_config ~no_sandboxing ~no_default_config_file:no_config_file ~add_config_file:config_file in + let switch_defaults = + OpamFile.InitConfig.switch_defaults init_config + |> OpamStd.Option.default OpamInitDefaults.switch_defaults + in let repo = OpamStd.Option.map (fun url -> let repo_url = OpamUrl.parse ?backend:repo_kind url in @@ -384,7 +388,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 | _ as nocomp -> if nocomp <> None then @@ -406,7 +411,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 -> @@ -2065,15 +2070,58 @@ let switch = mk_flag ["no-autoinstall"] "This option is deprecated." 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 no_install deps_only repos - d_alias_of d_no_autoinstall params = + d_alias_of d_no_autoinstall config_file no_config_file params = OpamArg.deprecated_option d_alias_of None "alias-of" (Some "opam switch "); OpamArg.deprecated_option d_no_autoinstall false "no-autoinstall" None; 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_because `Aborted + ) config_file + in let packages = match packages, empty with | None, true -> Some [] @@ -2152,6 +2200,29 @@ let switch = compilers; `Ok () | Some `install, switch_arg::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_because `Configuration_error + in OpamGlobalState.with_ `Lock_write @@ fun gt -> with_repos_rt gt repos @@ fun (repos, rt) -> let switch = OpamSwitch.of_string switch_arg in @@ -2163,6 +2234,7 @@ let switch = ?synopsis:descr ?repos ~update_config:(not no_switch) ~packages + ~switch_defaults ~local_compiler switch in @@ -2323,7 +2395,8 @@ let switch = $print_short_flag $no_switch $packages $empty $descr $full $no_install $deps_only - $repos $d_alias_of $d_no_autoinstall $params)), + $repos $d_alias_of $d_no_autoinstall $config_file $no_config_file + $params)), term_info "switch" ~doc ~man (* PIN *) diff --git a/src/client/opamSwitchCommand.ml b/src/client/opamSwitchCommand.ml index bba7abadeeb..c5e23b9becc 100644 --- a/src/client/opamSwitchCommand.ml +++ b/src/client/opamSwitchCommand.ml @@ -270,7 +270,8 @@ let install_compiler_packages t atoms = (Success result); t -let install gt ~rt ?synopsis ?repos ~update_config ~packages ?(local_compiler=false) switch = +let install gt ~rt ?synopsis ?repos ~update_config ~packages ~switch_defaults + ?(local_compiler=false) 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 @@ -285,7 +286,53 @@ let install gt ~rt ?synopsis ?repos ~update_config ~packages ?(local_compiler=fa 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 + let expand = OpamFilter.expand_string (OpamPackageVar.resolve_global gt) in + if OpamStd.Option.map_default eval true filter then + let value = + match value with + | B _ -> + value + | S value -> + S (expand value) + | L values -> + L (List.map expand values) + 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 cfd910f6b22..b16ea851646 100644 --- a/src/client/opamSwitchCommand.mli +++ b/src/client/opamSwitchCommand.mli @@ -25,6 +25,7 @@ val install: ?repos:repository_name list -> update_config:bool -> packages:atom conjunction -> + switch_defaults: OpamFile.SwitchDefaults.t -> ?local_compiler:bool -> switch -> unlocked global_state * rw switch_state diff --git a/src/state/opamSwitchAction.ml b/src/state/opamSwitchAction.ml index 2d5bc1049b4..2f18346fd04 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" , @@ -27,6 +27,7 @@ let gen_switch_config root ?(synopsis="") ?repos _switch = with Not_found -> "group"); ] in + configure_switch { OpamFile.Switch_config. opam_version = OpamVersion.current_nopatch; synopsis; @@ -43,7 +44,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 @@ -57,7 +58,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 7d1ca6996b8..86febd9794c 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 *)