diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 30aa7251def..b6f8a9d7973 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -207,6 +207,15 @@ jobs: - name: Test "static" binaries on Windows if: endsWith(matrix.host, '-pc-cygwin') == false run: ldd ./opam.exe | test "$(grep -v -F /cygdrive/c/Windows/)" = '' + - name: 'Upload opam binaries for Windows' + if: endsWith(matrix.host, '-pc-windows') + uses: actions/upload-artifact@v3 + with: + name: opam-exe-${{ matrix.host }}-${{ matrix.ocamlv }}-${{ matrix.build }} + path: | + D:\Local\bin\opam.exe + D:\Local\bin\opam-installer.exe + D:\Local\bin\opam-putenv.exe - name: Test (basic - Cygwin) if: endsWith(matrix.host, '-pc-cygwin') run: bash -exu .github/scripts/main/test.sh @@ -219,7 +228,7 @@ jobs: set Path=D:\Cache\ocaml-local\bin;%Path% if "${{ matrix.host }}" equ "x86_64-pc-windows" call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Enterprise\VC\Auxiliary\Build\vcvars64.bat" if "${{ matrix.host }}" equ "i686-pc-windows" call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Enterprise\VC\Auxiliary\Build\vcvars32.bat" - opam init --yes --bare default git+file://D:/opam-repository#${{ env.OPAM_TEST_REPO_SHA }} || exit /b 1 + opam init --yes --bare default git+file://D:/opam-repository#${{ env.OPAM_TEST_REPO_SHA }} --no-git-location || exit /b 1 opam switch --yes create default ocaml-system || exit /b 1 opam env || exit /b 1 opam install --yes lwt || exit /b 1 diff --git a/master_changes.md b/master_changes.md index ccd753beef6..c889b63c5e7 100644 --- a/master_changes.md +++ b/master_changes.md @@ -18,6 +18,8 @@ users) ## Plugins ## Init + * Check and advertise to use Git for Windows [#5718 @rjbou - fix #5617] + * Add the `--git-location` and `--no-git-location` arguments [#5718 @rjbou] ## Config report @@ -39,6 +41,7 @@ users) ## Show ## Var/Option + * Add a new git-location option on Windows [#5718 @rjbou] ## Update / Upgrade diff --git a/src/client/opamAction.ml b/src/client/opamAction.ml index 150633cc094..07cbc2e6e2e 100644 --- a/src/client/opamAction.ml +++ b/src/client/opamAction.ml @@ -531,10 +531,15 @@ let compilation_env t opam = let cygwin_env = match OpamSysInteract.Cygwin.cygbin_opt t.switch_global.config with | Some cygbin -> - [ OpamTypesBase.env_update_resolved "PATH" EqPlus - (OpamFilename.Dir.to_string cygbin) + let cygbin = OpamFilename.Dir.to_string cygbin in + [ OpamTypesBase.env_update_resolved "PATH" EqPlus cygbin ~comment:"Cygwin path" - ] + ] @ (match OpamCoreConfig.(!r.git_location) with + | None -> [] + | Some git_location -> + if String.equal cygbin git_location then [] else + [ OpamTypesBase.env_update_resolved "PATH" PlusEq + git_location ~comment:"Git binary path"]) | None -> [] in let shell_sanitization = "shell env sanitization" in diff --git a/src/client/opamArg.ml b/src/client/opamArg.ml index ca64f7960c3..148f763864d 100644 --- a/src/client/opamArg.ml +++ b/src/client/opamArg.ml @@ -575,7 +575,8 @@ let apply_global_options cli o = (`A (List.map (fun s -> `String s) (Array.to_list Sys.argv))) ); (* We need to retrieve very early cygwin root path to set up 'cygbin' config - field. It is retrieved from config file, and we use a low level reading of + field and git binary path. + It is retrieved from config file, and we use a low level reading of that file instead of OpamStateConfig.safe_load to avoid multiple error messages displayed if an error is detected in the config file. If there is an error, or best effort notification, it will be highlighted after @@ -596,6 +597,9 @@ let apply_global_options cli o = { pelem = String cygcheck; _}::_ -> let cygbin = Filename.dirname cygcheck in OpamCoreConfig.update ~cygbin () + | Some { pelem = String "git-location"; _}, + { pelem = String git_location; _}::_ -> + OpamCoreConfig.update ~git_location () | _, element::elements -> aux (Some element) elements in aux None elements diff --git a/src/client/opamClient.ml b/src/client/opamClient.ml index 7d44490cf71..d85d74fbba3 100644 --- a/src/client/opamClient.ml +++ b/src/client/opamClient.ml @@ -635,12 +635,118 @@ let init_checks ?(hard_fail_exn=true) init_config = if hard_fail && hard_fail_exn then OpamStd.Sys.exit_because `Configuration_error else not (soft_fail || hard_fail) -let windows_checks ?cygwin_setup config = +let git_for_windows_check = + if not Sys.win32 && not Sys.cygwin then fun ?git_location:_ () -> None else + fun ?git_location () -> + let header () = OpamConsole.header_msg "Git" in + let contains_git p = + OpamSystem.resolve_command ~env:[||] (Filename.concat p "git.exe") + in + let gits = + OpamStd.Env.get "PATH" + |> OpamStd.Sys.split_path_variable + |> OpamStd.List.filter_map (fun p -> + match contains_git p with + | Some git -> + Some (git, OpamSystem.bin_contains_bash p) + | None -> None) + in + let get_git_location ?git_location () = + let bin = + match git_location with + | Some _ -> git_location + | None -> + OpamConsole.read "Please enter the path containing git.exe (e.g. C:\\Program Files\\Git\\cmd):" + in + match bin with + | None -> None + | Some git_location -> + match contains_git git_location, OpamSystem.bin_contains_bash git_location with + | Some _, false -> + OpamConsole.msg "Using Git from %s" git_location; + Some git_location + | Some _, true -> + OpamConsole.error + "A bash executable was found in %s, which will override \ + Cygwin's bash. Please check your binary path." + git_location; + None + | None, _ -> + OpamConsole.error "No Git executable found in %s." git_location; + None + in + let rec loop ?git_location () = + match get_git_location ?git_location () with + | Some _ as git_location -> git_location + | None -> menu () + and menu () = + let prompt () = + let options = + (`Default, "Use default Cygwin Git") + :: (List.filter_map (fun (git, bash) -> + if bash then None else + let bin = Filename.dirname git in + Some (`Location bin, "Use found git in "^bin)) + gits) + @ [ + `Specify, "Enter the location of installed Git"; + `Abort, "Abort initialisation to install recommended Git."; + ] + in + OpamConsole.menu "Which Git should opam use?" + ~default:`Default ~no:`Default ~options + in + match prompt () with + | `Default -> None + | `Specify -> loop () + | `Location git_location -> loop ~git_location () + | `Abort -> + OpamConsole.note "Once your choosen Git installed, open a new PowerShell or Command Prompt window, and relaunch opam init."; + OpamStd.Sys.exit_because `Aborted + in + let git_location = + match git_location with + | Some (Right ()) -> None + | Some (Left git_location) -> + header (); + get_git_location ~git_location:(OpamFilename.Dir.to_string git_location) () + | None -> + if OpamStd.Sys.tty_out then + (header (); + OpamConsole.msg + "Cygwin Git is functional but can have credentials issues for private repositories, \ + we recommend using:\n%s\n" + (OpamStd.Format.itemize (fun s -> s) + [ "Install via 'winget install Git.Git'"; + "Git for Windows can be downloaded and installed from https://gitforwindows.org" ]); + menu ()) + else + None + in + OpamStd.Option.iter (fun _ -> + OpamConsole.msg + "You can change that later with \ + 'opam option \"git-location=C:\\A\\Path\\bin\"'") + git_location; + git_location + +let windows_checks ?cygwin_setup ?git_location config = let vars = OpamFile.Config.global_variables config in let env = List.map (fun (v, c, s) -> v, (lazy (Some c), s)) vars |> OpamVariable.Map.of_list in + (* Git handling *) + let git_location : string option = git_for_windows_check ?git_location () in + OpamCoreConfig.update ?git_location (); + let config = + match git_location with + | Some git_location -> + OpamFile.Config.with_git_location + (OpamFilename.Dir.of_string git_location) config + | None -> config + in + (* Cygwin handling *) let success cygcheck = let config = let os_distribution = OpamVariable.of_string "os-distribution" in @@ -681,6 +787,16 @@ let windows_checks ?cygwin_setup config = OpamFilename.(Dir.to_string (dirname_dir (dirname cygcheck)))); config in + let install_cygwin_tools () = + let packages = + match OpamSystem.resolve_command "git" with + | None -> OpamInitDefaults.required_packages_for_cygwin + | Some _ -> + List.filter (fun c -> not OpamSysPkg.(equal (of_string "git") c)) + OpamInitDefaults.required_packages_for_cygwin + in + OpamSysInteract.Cygwin.install ~packages + in let header () = OpamConsole.header_msg "Unix support infrastructure" in let get_cygwin = function | Some cygcheck @@ -777,10 +893,7 @@ let windows_checks ?cygwin_setup config = match prompt () with | `Abort -> OpamStd.Sys.exit_because `Aborted | `Internal -> - let cygcheck = - OpamSysInteract.Cygwin.install - ~packages:OpamInitDefaults.required_packages_for_cygwin - in + let cygcheck = install_cygwin_tools () in let config = success cygcheck in config | `Specify -> @@ -819,9 +932,7 @@ let windows_checks ?cygwin_setup config = header (); let cygcheck = match setup with - | `internal -> - OpamSysInteract.Cygwin.install - ~packages:OpamInitDefaults.required_packages_for_cygwin + | `internal -> install_cygwin_tools () | (`default_location | `location _ as setup) -> let cygroot = match setup with @@ -861,10 +972,11 @@ let windows_checks ?cygwin_setup config = else config in - OpamCoreConfig.update - ?cygbin:OpamStd.Option.Op.( - OpamSysInteract.Cygwin.cygbin_opt config - >>| OpamFilename.Dir.to_string) (); + let cygbin = OpamStd.Option.Op.( + OpamSysInteract.Cygwin.cygbin_opt config + >>| OpamFilename.Dir.to_string) + in + OpamCoreConfig.update ?cygbin (); config let update_with_init_config ?(overwrite=false) config init_config = @@ -898,11 +1010,12 @@ let update_with_init_config ?(overwrite=false) config init_config = let reinit ?(init_config=OpamInitDefaults.init_config()) ~interactive ?dot_profile ?update_config ?env_hook ?completion ?inplace - ?(check_sandbox=true) ?(bypass_checks=false) ?cygwin_setup + ?(check_sandbox=true) ?(bypass_checks=false) + ?cygwin_setup ?git_location config shell = let root = OpamStateConfig.(!r.root_dir) in let config = update_with_init_config config init_config in - let config = windows_checks ?cygwin_setup config in + let config = windows_checks ?cygwin_setup ?git_location config in let _all_ok = if bypass_checks then false else init_checks ~hard_fail_exn:false init_config @@ -943,7 +1056,7 @@ let init ?repo ?(bypass_checks=false) ?dot_profile ?update_config ?env_hook ?(completion=true) ?(check_sandbox=true) - ?cygwin_setup + ?cygwin_setup ?git_location shell = log "INIT %a" (slog @@ OpamStd.Option.to_string OpamRepositoryBackend.to_string) repo; @@ -979,7 +1092,7 @@ let init init_config |> OpamFile.Config.with_repositories (List.map fst repos) in - let config = windows_checks ?cygwin_setup config in + let config = windows_checks ?cygwin_setup ?git_location config in let dontswitch = if bypass_checks then false else diff --git a/src/client/opamClient.mli b/src/client/opamClient.mli index 833f628fbb1..b5c21793d27 100644 --- a/src/client/opamClient.mli +++ b/src/client/opamClient.mli @@ -29,6 +29,7 @@ val init: ?completion:bool -> ?check_sandbox:bool -> ?cygwin_setup: [ `internal | `default_location | `location of dirname | `no ] -> + ?git_location:(dirname, unit) either -> shell -> rw global_state * unlocked repos_state * atom list @@ -46,6 +47,7 @@ val reinit: ?update_config:bool -> ?env_hook:bool -> ?completion:bool -> ?inplace:bool -> ?check_sandbox:bool -> ?bypass_checks:bool -> ?cygwin_setup: [ `internal | `default_location | `location of dirname | `no ] -> + ?git_location:(dirname, unit) either -> OpamFile.Config.t -> shell -> unit (** Install the given list of packages. [add_to_roots], if given, specifies that diff --git a/src/client/opamClientConfig.mli b/src/client/opamClientConfig.mli index 9ec67cdc76a..be286dfc5ea 100644 --- a/src/client/opamClientConfig.mli +++ b/src/client/opamClientConfig.mli @@ -165,4 +165,5 @@ val opam_init: ?merged_output:bool -> ?precise_tracking:bool -> ?cygbin:string -> + ?git_location:string -> unit -> unit diff --git a/src/client/opamCommands.ml b/src/client/opamCommands.ml index aecce33a15e..49d088caec7 100644 --- a/src/client/opamCommands.ml +++ b/src/client/opamCommands.ml @@ -327,12 +327,31 @@ let init cli = else Term.const None in + let git_location = + if Sys.win32 then + mk_opt ~cli (cli_from ~experimental:true cli2_2) + ["git-location"] "DIR" + "Specify git binary directory. \ + Ensure that it doesn't contains bash in the same directory" + Arg.(some dirname) None + else + Term.const None + in + let no_git_location = + if Sys.win32 then + mk_flag ~cli (cli_from ~experimental:true cli2_2) + ["no-git-location"] + "Don't specify nor ask to specify git binary directory." + else + Term.const false + in + let init global_options build_options repo_kind repo_name repo_url interactive update_config completion env_hook no_sandboxing shell dot_profile_o compiler no_compiler config_file no_config_file reinit show_opamrc bypass_checks - cygwin_internal cygwin_location + cygwin_internal cygwin_location git_location no_git_location () = apply_global_options cli global_options; apply_build_options cli build_options; @@ -401,6 +420,15 @@ let init cli = | (`default_location | `none), Some dir -> Some (`location dir) | (`internal | `default_location | `no) as setup, None -> Some setup in + let git_location = + match git_location, no_git_location with + | Some _, true -> + OpamConsole.error_and_exit `Bad_arguments + "Options --no-git-location and --git-location are incompatible"; + | None, false -> None + | Some d, false -> Some (Left d) + | None, true -> Some (Right ()) + in if already_init then if reinit then let init_config = @@ -410,7 +438,7 @@ let init cli = let reinit conf = OpamClient.reinit ~init_config ~interactive ?dot_profile ?update_config ?env_hook ?completion ~inplace ~bypass_checks - ~check_sandbox:(not no_sandboxing) ?cygwin_setup + ~check_sandbox:(not no_sandboxing) ?cygwin_setup ?git_location conf shell in let config = @@ -450,7 +478,7 @@ let init cli = ?repo ~bypass_checks ?dot_profile ?update_config ?env_hook ?completion ~check_sandbox:(not no_sandboxing) - ?cygwin_setup + ?cygwin_setup ?git_location shell in OpamStd.Exn.finally (fun () -> OpamRepositoryState.drop rt) @@ -499,7 +527,7 @@ let init cli = $setup_completion $env_hook $no_sandboxing $shell_opt cli cli_original $dot_profile_flag cli cli_original $compiler $no_compiler $config_file $no_config_file $reinit $show_default_opamrc - $bypass_checks $cygwin_internal $cygwin_location) + $bypass_checks $cygwin_internal $cygwin_location $git_location $no_git_location) (* LIST *) let list_doc = "Display the list of available packages." diff --git a/src/client/opamConfigCommand.ml b/src/client/opamConfigCommand.ml index ccae3369d26..326987acf00 100644 --- a/src/client/opamConfigCommand.ml +++ b/src/client/opamConfigCommand.ml @@ -429,6 +429,7 @@ type 'config fld_updater = ('config -> 'config -> 'config) First argument is the addition function, the second the remove one. *) type 'config fld_policy = | Atomic + | Atomic_pp of ('config -> 'config) | Modifiable of 'config fld_updater * 'config fld_updater | InModifiable of 'config fld_updater * 'config fld_updater @@ -590,8 +591,10 @@ let set_opt ?(inner=false) field value conf = add (updf value) conf.stg_config | `Remove value, (Modifiable (_, rem) | InModifiable (_, rem)) -> rem (updf value) conf.stg_config + | `Overwrite value, Atomic_pp pp -> + pp @@ parse value conf.stg_config | `Overwrite value, _ -> (updf value) - | _, Atomic -> assert false + | _, (Atomic | Atomic_pp _) -> assert false with | (OpamPp.Bad_format (_,_) | Parsing.Parse_error) as e -> OpamConsole.error_and_exit `Bad_arguments @@ -852,14 +855,26 @@ let global_allowed_fields, global_allowed_sections = Config.with_sys_pkg_manager_cmd (Config.sys_pkg_manager_cmd Config.empty); "swh-fallback", Atomic, Config.with_swh_fallback (Config.swh_fallback Config.empty); + "git-location", Atomic_pp + (fun c -> + OpamStd.Option.iter (fun git_location -> + if OpamSystem.bin_contains_bash + (OpamFilename.Dir.to_string git_location) then + OpamConsole.error_and_exit `False + "Found a bash in given git bin directory,\ + which is dangerous!") + (Config.git_location c); + c), + Config.with_git_location_opt + (InitConfig.git_location in_config ++ Config.git_location Config.empty); ] @ List.map (fun f -> - f, Atomic, Config.with_criteria - (Config.criteria Config.empty)) + f, Atomic, Config.with_criteria + (Config.criteria Config.empty)) [ "solver-criteria"; "solver-upgrade-criteria"; "solver-fixup-criteria" ] - @ allwd_wrappers wrapper_init Config.wrappers Config.with_wrappers - ) + @ allwd_wrappers wrapper_init Config.wrappers Config.with_wrappers + ) in (fun () -> Lazy.force allowed_fields), fun () -> [] diff --git a/src/core/opamCoreConfig.ml b/src/core/opamCoreConfig.ml index 016027f34c0..bfbd3b3cea8 100644 --- a/src/core/opamCoreConfig.ml +++ b/src/core/opamCoreConfig.ml @@ -64,6 +64,7 @@ type t = { merged_output: bool; precise_tracking: bool; cygbin: string option; + git_location: string option; set: bool; } @@ -83,6 +84,7 @@ type 'a options_fun = ?merged_output:bool -> ?precise_tracking:bool -> ?cygbin:string -> + ?git_location:string -> 'a let default = { @@ -104,6 +106,7 @@ let default = { merged_output = true; precise_tracking = false; cygbin = None; + git_location = None; set = false; } @@ -123,6 +126,7 @@ let setk k t ?merged_output ?precise_tracking ?cygbin + ?git_location = let (+) x opt = match opt with Some x -> x | None -> x in k { @@ -144,6 +148,7 @@ let setk k t merged_output = t.merged_output + merged_output; precise_tracking = t.precise_tracking + precise_tracking; cygbin = (match cygbin with Some _ -> cygbin | None -> t.cygbin); + git_location = (match git_location with Some _ -> git_location | None -> t.git_location); set = true; } @@ -185,6 +190,7 @@ let initk k = ?merged_output:(E.mergeout ()) ?precise_tracking:(E.precisetracking ()) ?cygbin:None + ?git_location:None let init ?noop:_ = initk (fun () -> ()) diff --git a/src/core/opamCoreConfig.mli b/src/core/opamCoreConfig.mli index a575e958307..8bf7f41150c 100644 --- a/src/core/opamCoreConfig.mli +++ b/src/core/opamCoreConfig.mli @@ -72,6 +72,7 @@ type t = private { (** 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; + git_location: string option; set : bool; (** Options have not yet been initialised (i.e. defaults are active) *) } @@ -92,6 +93,7 @@ type 'a options_fun = ?merged_output:bool -> ?precise_tracking:bool -> ?cygbin:string -> + ?git_location:string -> 'a val default : t diff --git a/src/core/opamProcess.ml b/src/core/opamProcess.ml index 3160272412a..a5221726e6d 100644 --- a/src/core/opamProcess.ml +++ b/src/core/opamProcess.ml @@ -15,7 +15,7 @@ let log ?level fmt = let default_env = let f () = lazy ( match OpamCoreConfig.(!r.cygbin) with - | Some cygbin -> OpamStd.Env.cyg_env cygbin + | Some cygbin -> OpamStd.Env.cyg_env ~cygbin ~git_location:OpamCoreConfig.(!r.git_location) | None -> OpamStd.Env.raw_env () ) in fun () -> Lazy.force (f ()) diff --git a/src/core/opamStd.ml b/src/core/opamStd.ml index 15292be99a5..bc68443bd7c 100644 --- a/src/core/opamStd.ml +++ b/src/core/opamStd.ml @@ -837,13 +837,19 @@ module Env = struct let lazy_env = lazy (to_list (raw_env ())) in fun () -> Lazy.force lazy_env - let cyg_env cygbin = + let cyg_env ~cygbin ~git_location = 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 + (match git_location with + | None -> + Printf.sprintf "%s=%s;%s" path cygbin c + | Some git_location -> + if String.equal git_location cygbin then + Printf.sprintf "%s=%s;%s" path cygbin c + else + Printf.sprintf "%s=%s;%s;%s" path git_location cygbin c) | _ -> v in Array.map f env @@ -1203,7 +1209,7 @@ module OpamSys = struct if Sys.win32 then let results = Hashtbl.create 17 in let requires_cygwin cygcheck name = - let env = Env.cyg_env (Filename.dirname cygcheck) in + let env = Env.cyg_env ~cygbin:(Filename.dirname cygcheck) ~git_location:None 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 = diff --git a/src/core/opamStd.mli b/src/core/opamStd.mli index d87296542bd..a136451adfa 100644 --- a/src/core/opamStd.mli +++ b/src/core/opamStd.mli @@ -456,7 +456,7 @@ module Env : sig val list: unit -> (Name.t * string) list val raw_env: unit -> string Array.t - val cyg_env: string -> string Array.t + val cyg_env: cygbin:string -> git_location:string option -> string Array.t end (** {2 System query and exit handling} *) diff --git a/src/core/opamSystem.ml b/src/core/opamSystem.ml index aa973996df5..cd4169ccd9d 100644 --- a/src/core/opamSystem.ml +++ b/src/core/opamSystem.ml @@ -513,6 +513,12 @@ let resolve_command ?env ?dir name = | `Cmd cmd -> Some cmd | `Denied | `Not_found -> None +let bin_contains_bash = + if not Sys.win32 && not Sys.cygwin then fun _ -> false else + fun bin -> + (resolve_command ~env:[||] (Filename.concat bin "bash.exe")) + <> None + let apply_cygpath name = (* XXX Deeper bug, looking in the cygvoke code (see OpamProcess.create) *) match resolve_command "cygpath" with diff --git a/src/core/opamSystem.mli b/src/core/opamSystem.mli index ceb228a17cc..4023da622cf 100644 --- a/src/core/opamSystem.mli +++ b/src/core/opamSystem.mli @@ -185,6 +185,8 @@ type command = string list if found in PATH) *) val resolve_command: ?env:string array -> ?dir:string -> string -> string option +val bin_contains_bash: string -> bool + (** Returns a function which should be applied to arguments for a given command by determining if the command is the Cygwin variant of the command. Returns the identity function otherwise. *) diff --git a/src/format/opamFile.ml b/src/format/opamFile.ml index b3f27154cf2..bf941c80064 100644 --- a/src/format/opamFile.ml +++ b/src/format/opamFile.ml @@ -865,7 +865,7 @@ module Syntax = struct start = start.Lexing.pos_lnum, start.Lexing.pos_cnum - start.Lexing.pos_bol; - stop = (* XXX here we take current position, where error occurs as end position *) + stop = (* XXX here we take current position, where error occurs as end position *) curr.Lexing.pos_lnum, curr.Lexing.pos_cnum - curr.Lexing.pos_bol; } @@ -1407,6 +1407,7 @@ module ConfigSyntax = struct depext_cannot_install : bool; depext_bypass: OpamSysPkg.Set.t; sys_pkg_manager_cmd: filename OpamStd.String.Map.t; + git_location: dirname option; swh_fallback: bool; } @@ -1451,6 +1452,7 @@ module ConfigSyntax = struct let depext_bypass t = t.depext_bypass let sys_pkg_manager_cmd t = t.sys_pkg_manager_cmd + let git_location t = t.git_location let swh_fallback t = t.swh_fallback @@ -1503,6 +1505,8 @@ module ConfigSyntax = struct let with_sys_pkg_manager_cmd sys_pkg_manager_cmd t = { t with sys_pkg_manager_cmd } let with_swh_fallback swh_fallback t = { t with swh_fallback } + let with_git_location git_location t = { t with git_location = Some git_location } + let with_git_location_opt git_location t = { t with git_location } let empty = { opam_version = file_format_version; @@ -1528,6 +1532,7 @@ module ConfigSyntax = struct depext_cannot_install = false; depext_bypass = OpamSysPkg.Set.empty; sys_pkg_manager_cmd = OpamStd.String.Map.empty; + git_location = None; swh_fallback = true; } @@ -1632,6 +1637,9 @@ module ConfigSyntax = struct Pp.V.string (Pp.V.string -| Pp.of_module "filename" (module OpamFilename)))) -| Pp.of_pair "Distribution Map" OpamStd.String.Map.(of_list, bindings)); + "git-location", Pp.ppacc_opt + with_git_location git_location + (Pp.V.string -| Pp.of_module "dirname" (module OpamFilename.Dir)); "swh-fallback", Pp.ppacc with_swh_fallback swh_fallback Pp.V.bool; @@ -1707,6 +1715,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; + git_location: dirname option; } let opam_version t = t.opam_version @@ -1727,6 +1736,7 @@ module InitConfigSyntax = struct let init_scripts t = t.init_scripts let criterion kind t = OpamStd.(List.assoc_opt Compare.equal kind t.solver_criteria) + let git_location t = t.git_location let with_opam_version opam_version t = {t with opam_version} let with_repositories repositories t = {t with repositories} @@ -1750,6 +1760,7 @@ module InitConfigSyntax = struct kind t.solver_criteria) in { t with solver_criteria } + let with_git_location git_location t = { t with git_location = Some git_location } let empty = { opam_version = format_version; @@ -1768,6 +1779,7 @@ module InitConfigSyntax = struct recommended_tools = []; required_tools = []; init_scripts = []; + git_location = None; } let pp_repository_def = @@ -1867,6 +1879,9 @@ module InitConfigSyntax = struct (Pp.V.string) (Pp.V.string_tr)) (Pp.opt Pp.V.filter))); + "git-location", Pp.ppacc_opt + with_git_location git_location + (Pp.V.string -| Pp.of_module "dirname" (module OpamFilename.Dir)); ] @ List.map (fun (fld, ppacc) -> fld, Pp.embed with_wrappers wrappers ppacc) @@ -1912,6 +1927,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; + git_location = opt t2.git_location t1.git_location; } end diff --git a/src/format/opamFile.mli b/src/format/opamFile.mli index fb2e10c824a..9d2569158d3 100644 --- a/src/format/opamFile.mli +++ b/src/format/opamFile.mli @@ -172,6 +172,8 @@ module Config: sig val with_sys_pkg_manager_cmd: filename OpamStd.String.Map.t -> t -> t val with_swh_fallback: bool -> t -> t + val with_git_location: dirname -> t -> t + val with_git_location_opt: dirname option -> t -> t (** Return the opam version *) val opam_version: t -> opam_version @@ -233,6 +235,8 @@ module Config: sig sources *) val swh_fallback: t -> bool + val git_location: t -> dirname option + val fields: (string * (t, value) OpamPp.field_parser) list (** All file fields as print-AST, Fields within sections are @@ -265,6 +269,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 git_location: t -> dirname option val with_opam_version: opam_version -> t -> t val with_repositories: diff --git a/tests/reftests/var-option.test b/tests/reftests/var-option.test index 388a5e24e75..477749e0f60 100644 --- a/tests/reftests/var-option.test +++ b/tests/reftests/var-option.test @@ -228,6 +228,7 @@ depext-cannot-install false depext-run-installs true download-command {} download-jobs 3 +git-location {} jobs {} post-build-commands {} post-install-commands {} @@ -525,7 +526,7 @@ Removed variable dolore in global configuration # Return code 2 # ### opam option bar=sit --global [ERROR] There is no option named 'bar'. The allowed options are: -jobs download-command download-jobs archive-mirrors solver-criteria solver-upgrade-criteria solver-fixup-criteria best-effort-prefix-criteria solver global-variables eval-variables repository-validation-command depext depext-run-installs depext-cannot-install depext-bypass sys-pkg-manager-cmd swh-fallback pre-build-commands pre-install-commands pre-remove-commands pre-session-commands wrap-build-commands wrap-install-commands wrap-remove-commands post-build-commands post-install-commands post-remove-commands post-session-commands +jobs download-command download-jobs archive-mirrors solver-criteria solver-upgrade-criteria solver-fixup-criteria best-effort-prefix-criteria solver global-variables eval-variables repository-validation-command depext depext-run-installs depext-cannot-install depext-bypass sys-pkg-manager-cmd git-location swh-fallback pre-build-commands pre-install-commands pre-remove-commands pre-session-commands wrap-build-commands wrap-install-commands wrap-remove-commands post-build-commands post-install-commands post-remove-commands post-session-commands # Return code 2 # ### opam option bar=sit --switch var-option [ERROR] There is no option named 'bar'. The allowed options are: @@ -611,6 +612,7 @@ depext-cannot-install false depext-run-installs true download-command {} download-jobs 1 +git-location {} jobs {} post-build-commands {} post-install-commands {} @@ -642,6 +644,7 @@ depext-cannot-install false depext-run-installs true download-command {} download-jobs 1 +git-location {} jobs {} post-build-commands {} post-install-commands {}