Add support for the OPAMAUTOANSWER environment variable (for internal use only)

Author: kit-ty-kate

master_changes.md

@@ -16,6 +16,7 @@ users)
 
 ## Global CLI
   * Add cli version 2.5 [#6709 @kit-ty-kate]
+  * Add mechanism for the `OPAMAUTOANSWER` environment variable (for internal use only) [#6709 @kit-ty-kate]
 
 ## Plugins
 
@@ -190,6 +191,7 @@ users)
 
 # API updates
 ## opam-client
+  * `OpamClientConfig.opam_init`: now takes an optional `auto_answer` argument [#6709 @kit-ty-kate]
 
 ## opam-repository
   * `OpamLocal.rsync_*`: Change the return type from `OpamFilename.*` to `unit` [#6658 @kit-ty-kate]
@@ -209,7 +211,10 @@ users)
   * `OpamVariable.variable_contents_equal`: was added [#6644 @kit-ty-kate]
 
 ## opam-core
+  * `OpamConsole.confirm`: now takes an optional `name` argument [#6709 @kit-ty-kate]
   * `OpamConsole.log`: does not keep log messages before initialization if the code is ran through a library [#6487 @kit-ty-kate]
+  * `OpamCoreConfig.auto_answer`: field and arguments were added [#6709 @kit-ty-kate]
+  * `OpamCoreConfig.{answer,anwser_is,answer_is_yes}`: now take a `name` labeled argument [#6709 @kit-ty-kate]
   * `OpamCoreConfig.in_opam`: was added [#6487 @kit-ty-kate]
   * `OpamSystem.cpu_count`: now uses a C binding instead of system utilities to get the number of cores of the current machine [#6634 @kit-ty-kate]
   * `OpamSystem.is_reg_dir`: is now exposed, which returns `true` only if its parameter is a directory, exists and is not a symlink. It returns `false` otherwise [#6450 @kit-ty-kate]
@@ -221,6 +226,7 @@ users)
   * `OpamCompat.String.{starts_with,ends_with,for_all,fold_left}`: were added [#6442 @kit-ty-kate]
   * `OpamHash.check_string`: was added [#6661 @kit-ty-kate]
   * `OpamHash.equal_kind`: was added [#6644 @kit-ty-kate]
+  * `OpamStd.Config.auto_answer`: was added [#6709 @kit-ty-kate]
   * `OpamStd.List.fold_left_map`: was moved to `OpamCompat.List.fold_left_map` [#6442 @kit-ty-kate]
   * `OpamStd.List.{cons,find_opt,filter_map}`: were removed. Use `Stdlib.List` instead. [#6442 @kit-ty-kate]
   * `OpamStd.List.mem`: was added, having as argument the equality function [#6644 @kit-ty-kate]

src/client/opamArg.ml

@@ -87,6 +87,8 @@ let environment_variables =
   let open OpamStd.Config in
   let core =
     let open OpamCoreConfig.E in [
+      "AUTOANSWER", cli_from cli2_5, (fun v -> AUTOANSWER (auto_answer v)),
+      "internal use only.";
       "COLOR", cli_original, (fun v -> COLOR (env_when v)),
       "when set to $(i,always) or $(i,never), sets a default value for the \
        `--color' option.";

src/client/opamClientConfig.mli

@@ -81,7 +81,7 @@ type 'a options_fun =
   ?assume_depexts:bool ->
   ?cli:OpamCLIVersion.t ->
   ?scrubbed_environment_variables:string list ->
-  ?verbose_on:OpamTypes.name_set -> 
+  ?verbose_on:OpamTypes.name_set ->
   'a
   (* constraint 'a = 'b -> 'c *)
 
@@ -153,6 +153,7 @@ val opam_init:
   ?retries:int ->
   ?force_checksums:bool option ->
   ?repo_tarring:bool ->
+  ?auto_answer:(string * OpamStd.Config.answer) list ->
   ?debug_level:int ->
   ?debug_sections:OpamStd.Config.sections ->
   ?verbose_level:OpamStd.Config.level ->

src/client/opamSolution.ml

@@ -1091,7 +1091,7 @@ let dry_run state solution =
 (* Ask confirmation whenever the packages to modify are not exactly
    the packages in the user request *)
 let confirmation ?ask requested solution =
-  OpamCoreConfig.answer_is_yes () ||
+  OpamCoreConfig.answer_is_yes ~name:None () ||
   ask = Some false ||
   let solution_packages =
     OpamPackage.names_of_packages (OpamSolver.all_packages solution)
@@ -1319,7 +1319,7 @@ let install_sys_packages_t ~propagate_st ~map_sysmap ~confirm env config
       "You can retry with '--assume-depexts' to skip this check, or run 'opam \
        option depext=false' to permanently disable handling of system \
        packages.\n%s"
-      (if OpamStd.Sys.tty_in || OpamCoreConfig.answer_is `unsafe_yes then ""
+      (if OpamStd.Sys.tty_in || OpamCoreConfig.answer_is ~name:None `unsafe_yes then ""
        else "Running the system package manager non-interactively requires \
              '--confirm-level=unsafe-yes'.\n")
   and give_up () =

src/core/opamConsole.ml

@@ -786,19 +786,19 @@ let pause fmt =
   else
     Printf.ifprintf () fmt
 
-let confirm ?(require_unsafe_yes=false) ?(default=true) fmt =
+let confirm ?(require_unsafe_yes=false) ?(default=true) ?name fmt =
   Printf.ksprintf (fun s ->
       if OpamCoreConfig.(!r.safe_mode) then false else
       let prompt =
         Printf.ksprintf OpamStd.Format.reformat "%s [%s/%s] " s
           (colorise `blue (if default then "Y" else "y"))
           (colorise `blue (if default then "n" else "N"))
       in
-      if OpamCoreConfig.answer_is `unsafe_yes ||
-         not require_unsafe_yes && OpamCoreConfig.answer_is_yes ()
+      if OpamCoreConfig.answer_is ~name `unsafe_yes ||
+         not require_unsafe_yes && OpamCoreConfig.answer_is_yes ~name ()
       then
         (formatted_msg "%sy\n" prompt; true)
-      else if OpamCoreConfig.answer_is `all_no ||
+      else if OpamCoreConfig.answer_is ~name `all_no ||
               OpamStd.Sys.(not tty_in)
       then
         (formatted_msg "%sn\n" prompt; false)
@@ -814,7 +814,7 @@ let confirm ?(require_unsafe_yes=false) ?(default=true) fmt =
 let read fmt =
   Printf.ksprintf (fun s ->
       formatted_msg "%s " s;
-      if OpamCoreConfig.(answer_is `ask && not !r.safe_mode) then (
+      if OpamCoreConfig.(answer_is ~name:None `ask && not !r.safe_mode) then (
         try match read_line () with
           | "" -> None
           | s  -> Some s
@@ -983,7 +983,7 @@ let menu ?default ?unsafe_yes ?yes ~no ~options fmt =
     let default_s = OpamStd.(List.assoc Compare.equal default options_nums) in
     let no_s = OpamStd.(List.assoc Compare.equal no options_nums) in
     if OpamCoreConfig.(!r.safe_mode) then no else
-    match OpamCoreConfig.answer(), unsafe_yes, yes with
+    match OpamCoreConfig.answer ~name:None (), unsafe_yes, yes with
     | `unsafe_yes, Some a, _ -> print_string prompt; select a
     | #OpamStd.Config.yes_answer, _, Some a -> print_string prompt; select a
     | `all_no, _, _ -> print_string prompt; select no

src/core/opamConsole.mli

@@ -125,7 +125,7 @@ val pause: ('a, unit, string, unit) format4 -> 'a
     prompt and wait user input if it is set [`all_yes] (interactive). Its
     default is false. *)
 val confirm:
-  ?require_unsafe_yes:bool -> ?default:bool ->
+  ?require_unsafe_yes:bool -> ?default:bool -> ?name:string ->
   ('a, unit, string, bool) format4 -> 'a
 
 (** Prompts the user with multiple numbered choices [(answer, message)].

src/core/opamCoreConfig.ml

@@ -11,6 +11,7 @@
 module E = struct
 
   type OpamStd.Config.E.t +=
+    | AUTOANSWER of (string * OpamStd.Config.answer) list option
     | COLOR of OpamStd.Config.when_ option
     | CONFIRMLEVEL of OpamStd.Config.answer option
     | DEBUG of int option
@@ -29,6 +30,7 @@ module E = struct
     | YES of bool option
 
   open OpamStd.Config.E
+  let autoanswer = value (function AUTOANSWER l -> l | _ -> None)
   let color = value (function COLOR c -> c | _ -> None)
   let confirmlevel = value (function CONFIRMLEVEL c -> c | _ -> None)
   let debug = value (function DEBUG i -> i | _ -> None)
@@ -49,6 +51,7 @@ module E = struct
 end
 
 type t = {
+  auto_answer: (string * OpamStd.Config.answer) list;
   debug_level: int;
   debug_sections: OpamStd.Config.sections;
   verbose_level: OpamStd.Config.level;
@@ -71,6 +74,7 @@ type t = {
 }
 
 type 'a options_fun =
+  ?auto_answer:(string * OpamStd.Config.answer) list ->
   ?debug_level:int ->
   ?debug_sections:OpamStd.Config.sections ->
   ?verbose_level:OpamStd.Config.level ->
@@ -90,6 +94,7 @@ type 'a options_fun =
   'a
 
 let default = {
+  auto_answer = [];
   debug_level = 0;
   debug_sections = OpamStd.String.Map.empty;
   verbose_level = 0;
@@ -114,6 +119,7 @@ let default = {
 }
 
 let setk k t
+    ?auto_answer
     ?debug_level
     ?debug_sections
     ?verbose_level
@@ -133,6 +139,7 @@ let setk k t
   =
   let (+) x opt = match opt with Some x -> x | None -> x in
   k {
+    auto_answer = t.auto_answer + auto_answer;
     debug_level = t.debug_level + debug_level;
     debug_sections = t.debug_sections + debug_sections;
     verbose_level = t.verbose_level + verbose_level;
@@ -179,6 +186,7 @@ let initk k =
     | _, _ -> None
   in
   (setk (setk (fun c -> r := c; k)) !r)
+    ?auto_answer:(E.autoanswer ())
     ?debug_level:(E.debug ())
     ?debug_sections:(E.debugsections ())
     ?verbose_level:(E.verbose ())
@@ -198,19 +206,26 @@ let initk k =
 
 let init ?noop:_ = initk (fun () -> ())
 
-let answer () =
-  match !r.confirm_level, !r.yes with
-  | #OpamStd.Config.answer as c, _ -> c
-  | _, Some true -> `all_yes
-  | _, Some false -> `all_no
-  | _ -> `ask
-
-let answer_is =
-  let answer = lazy (answer ()) in
-  fun a -> Lazy.force answer = a
-
-let answer_is_yes () =
-  match answer () with
+let answer ~name () =
+  let fallback () =
+    match !r.confirm_level, !r.yes with
+    | #OpamStd.Config.answer as c, _ -> c
+    | _, Some true -> `all_yes
+    | _, Some false -> `all_no
+    | _ -> `ask
+  in
+  match !r.auto_answer, name with
+  | _::_ as l, Some name ->
+    (match OpamStd.List.assoc_opt String.equal name l with
+     | Some a -> a
+     | None -> fallback ())
+  | [], _ | _, None -> fallback ()
+
+let answer_is ~name a =
+  answer ~name () = a
+
+let answer_is_yes ~name () =
+  match answer ~name () with
   | #OpamStd.Config.yes_answer -> true
   | _ -> false
 

src/core/opamCoreConfig.mli

@@ -13,6 +13,7 @@
 
 module E : sig
   type OpamStd.Config.E.t +=
+    | AUTOANSWER of (string * OpamStd.Config.answer) list option
     | COLOR of OpamStd.Config.when_ option
     | CONFIRMLEVEL of OpamStd.Config.answer option
     | DEBUG of int option
@@ -37,6 +38,11 @@ module E : sig
 end
 
 type t = private {
+  auto_answer : (string * OpamStd.Config.answer) list;
+  (** Controls the answer of specific interactive questions.
+      It maps names to its wanted answer and takes precedence
+      over [yes] and [confirm_level] for the questions linked
+      to the specific names listed. *)
   debug_level : int;
   (** Controls debug messages, 0 to disable *)
   debug_sections : OpamStd.Config.sections;
@@ -83,6 +89,7 @@ type t = private {
 }
 
 type 'a options_fun =
+  ?auto_answer:(string * OpamStd.Config.answer) list ->
   ?debug_level:int ->
   ?debug_sections:OpamStd.Config.sections ->
   ?verbose_level:OpamStd.Config.level ->
@@ -132,9 +139,9 @@ val initk: 'a -> 'a options_fun
     [answer_is] and [answer_is_yes] computes the answer lazily, use [answer] in
     case of config update.
 *)
-val answer_is: OpamStd.Config.answer -> bool
-val answer_is_yes : unit -> bool
-val answer: unit -> OpamStd.Config.answer
+val answer_is: name:string option -> OpamStd.Config.answer -> bool
+val answer_is_yes : name:string option -> unit -> bool
+val answer: name:string option -> unit -> OpamStd.Config.answer
 
 (** [true] if OPAM was compiled in developer mode *)
 val developer : bool

src/core/opamStd.ml

@@ -1752,6 +1752,17 @@ module Config = struct
         try if bool s then `all_yes else `all_no
         with Failure _ -> answer s)
 
+  let auto_answer =
+    env (fun s ->
+        List.filter_map (fun s ->
+            match OpamString.cut_at s '=' with
+            | Some (k, x) ->
+              (match answer x with
+               | x -> Some (k, x)
+               | exception Failure _ -> None)
+            | None -> None)
+        (String.split_on_char ':' s))
+
 
   module E = struct
     type t = ..

src/core/opamStd.mli

@@ -680,6 +680,8 @@ module Config : sig
 
   val env_answer: env_var -> answer option
 
+  val auto_answer: env_var -> (string * answer) list option
+
   module type Sig = sig
 
     (** Read-only record type containing the lib's configuration options *)