Merge pull request #5417 from dra27/persisted-reverts

Fully revertible environment updates

master_changes.md

@@ -99,6 +99,9 @@ users)
   * Add `sys-pkg-manager-cmd` field to store specific system package manager command paths [#5433 @rjbou]
   * Regenerate the environment file when a local switch is moved [#5476 @dra27 - fix #3411]
   * Regenerate the environment file in `opam exec` [#5476 @dra27]
+  * Regenerate the environment file when a local switch is moved [#5417 @dra27 - fix #3411]
+  * Regenerate the environment file in `opam exec` [#5417 @dra27]
+  * Store the exact environment in `OPAM_LAST_ENV` [#5417 @dra27 - fix #3411]
 
 ## Pin
   * Switch the default version when undefined from ~dev to dev [#4949 @kit-ty-kate]
@@ -160,6 +163,7 @@ users)
   * Update repository package filename display [#5068 @rjbou]
   * E67: check checksums only for vcs urls [#4960 @rjbou]
   * E57: Enforce synopsis to always be there, restoring behaviour from opam 2.1 [#5442 @kit-ty-kate]
+  * W56: detection removed, since `OPAM_LAST_ENV` allows reliable reverting [#5417 @dra27]
 
 ## Repository
   * When several checksums are specified, instead of adding in the cache only the archive by first checksum, name by best one and link others to this archive [#4696 rjbou]

src/client/opamCommands.ml

@@ -4096,6 +4096,7 @@ let clean cli =
            cleandir (OpamPath.Switch.build_dir root sw);
            cleandir (OpamPath.Switch.remove_dir root sw);
            cleandir (OpamPath.Switch.extra_files_dir root sw);
+           cleandir (OpamPath.Switch.last_env root sw);
            let pinning_overlay_dirs =
              List.map
                (fun nv -> OpamPath.Switch.Overlay.package root sw nv.name)

src/client/opamConfigCommand.ml

@@ -189,7 +189,7 @@ let print_eval_env ~csh ~sexp ~fish ~pwsh ~cmd env =
   else
     print_env env
 
-let regenerate_env ?(base=[]) ~set_opamroot ~set_opamswitch ~force_path
+let regenerate_env ~set_opamroot ~set_opamswitch ~force_path
     gt switch env_file =
   OpamSwitchState.with_ `Lock_none ~switch gt @@ fun st ->
   let upd =
@@ -200,18 +200,20 @@ let regenerate_env ?(base=[]) ~set_opamroot ~set_opamswitch ~force_path
        OpamSwitchState.with_write_lock st @@ fun st ->
        (OpamFile.Environment.write env_file upd), st
      in OpamSwitchState.drop st);
-  OpamEnv.add base upd
+  upd
 
-let load_and_verify_env ?base ~set_opamroot ~set_opamswitch ~force_path
+let load_and_verify_env ~set_opamroot ~set_opamswitch ~force_path
     gt switch env_file =
   let upd =
-    OpamEnv.get_opam_raw ?base ~set_opamroot ~set_opamswitch ~force_path
+    OpamEnv.get_opam_raw_updates ~set_opamroot ~set_opamswitch ~force_path
       gt.root switch
   in
   let environment_opam_switch_prefix =
-    List.find_opt (function "OPAM_SWITCH_PREFIX", _, _ -> true | _ -> false)
-      (upd :> (string * string * string option) list)
-    |> OpamStd.Option.map_default (fun (_, v, _) -> v) ""
+    List.find_opt (function
+        | "OPAM_SWITCH_PREFIX", OpamParserTypes.Eq, _, _ -> true
+        | _ -> false)
+      upd
+    |> OpamStd.Option.map_default (fun (_, _, v, _) -> v) ""
   in
   let actual_opam_switch_prefix =
     OpamFilename.Dir.to_string (OpamPath.Switch.root gt.root switch)
@@ -224,16 +226,64 @@ let load_and_verify_env ?base ~set_opamroot ~set_opamswitch ~force_path
        gt switch env_file)
   else upd
 
-let ensure_env_aux ?base ?(set_opamroot=false) ?(set_opamswitch=false)
+(* Returns [Some file] where [file] contains [updates]. [hash] should be
+   [OpamEnv.hash_env_updates updates] and [n] should initially be [0]. If for
+   whatever reason the file cannot be created, returns [None]. *)
+let  write_last_env_file gt switch updates =
+  let temp_dir = OpamPath.Switch.last_env gt.root switch in
+  let hash = OpamEnv.hash_env_updates updates in
+  let rec aux  n =
+    (* The principal aim here is not to spam /tmp with gazillions of files, but
+       also to be sure that the file present has the correct content. [n] is used
+       to avoid content collisions. If an existing file is used, it is touched as
+       this is used on Windows to allow garbage collection. *)
+    let trial = "env-" ^ hash ^ "-" ^ string_of_int n in
+    let target = OpamFilename.Op.(temp_dir // trial) in
+    if OpamFilename.exists target then
+      (* File already exists - check its content *)
+      let target_hash =
+        OpamFile.make target
+        |> OpamFile.Environment.read_opt
+        |> Option.map OpamEnv.hash_env_updates
+      in
+      if target_hash = Some hash then Some target else
+        (* Content collision/corruption, so try with higher [n] *)
+        aux (succ n)
+    else
+    try
+      (* Environment files are written atomically *)
+      OpamFile.Environment.write (OpamFile.make target) updates;
+      (* File should now exist with the correct content *)
+      aux n
+    with e -> OpamStd.Exn.fatal e; None
+  in
+  aux 0
+
+let ensure_env_aux ?(base=[]) ?(set_opamroot=false) ?(set_opamswitch=false)
     ?(force_path=true) gt switch =
   let env_file = OpamPath.Switch.environment gt.root switch in
-  if OpamFile.exists env_file then
-    load_and_verify_env ?base ~set_opamroot ~set_opamswitch ~force_path
-      gt switch env_file
-  else
-    (log "Missing environment file, regenerate it";
-     regenerate_env ?base ~set_opamroot ~set_opamswitch ~force_path
-       gt switch env_file)
+  let updates =
+    if OpamFile.exists env_file then
+      load_and_verify_env ~set_opamroot ~set_opamswitch ~force_path
+        gt switch env_file
+    else begin
+      log "Missing environment file, regenerate it";
+      regenerate_env ~set_opamroot ~set_opamswitch ~force_path
+        gt switch env_file
+    end
+  in
+  let updates =
+    List.filter (function ("OPAM_LAST_ENV", _, _, _) -> false | _ -> true)
+      updates
+  in
+  let last_env_file = write_last_env_file gt switch updates in
+  let updates =
+    OpamStd.Option.map_default (fun target ->
+        ("OPAM_LAST_ENV", OpamParserTypes.Eq, OpamFilename.to_string target, None)
+        ::updates)
+      updates last_env_file
+  in
+  OpamEnv.add base updates
 
 let ensure_env gt switch =
   ignore (ensure_env_aux gt switch)

src/format/opamFile.ml

@@ -543,7 +543,8 @@ module Pinned_legacy = struct
 end
 
 
-(** Cached environment updates (<switch>/.opam-switch/environment) *)
+(** Cached environment updates (<switch>/.opam-switch/environment
+    <switch>/.opam-switch/last-env/env-* last env files) *)
 
 module Environment = LineFile(struct
 

src/format/opamPath.ml

@@ -140,6 +140,8 @@ module Switch = struct
 
   let environment t a = meta t a /- env_filename
 
+  let last_env t a = meta t a / "last-env"
+
   let env_relative_to_prefix pfx = pfx / meta_dirname /- env_filename
 
   let installed_opams t a = meta t a / "packages"

src/format/opamPath.mli

@@ -174,6 +174,8 @@ module Switch: sig
   (** Cached environment updates. *)
   val environment: t -> switch -> OpamFile.Environment.t OpamFile.t
 
+  val last_env: t -> switch -> dirname
+
   (** Like [environment], but from the switch prefix dir *)
   val env_relative_to_prefix: dirname -> OpamFile.Environment.t OpamFile.t
 

src/state/opamEnv.ml

@@ -123,19 +123,33 @@ let map_update_names env_keys updates =
   in
   List.map convert updates
 
-let global_env_keys = lazy (OpamStd.Env.Name.Set.of_list (List.map fst (OpamStd.Env.list ())))
+let global_env_keys = lazy (
+  OpamStd.Env.list ()
+  |> List.map fst
+  |> OpamStd.Env.Name.Set.of_list)
 
 let updates_from_previous_instance = lazy (
-  match OpamStd.Env.getopt "OPAM_SWITCH_PREFIX" with
-  | None -> None
-  | Some pfx ->
-    let env_file =
-      OpamPath.Switch.env_relative_to_prefix (OpamFilename.Dir.of_string pfx)
-    in
-    try OpamStd.Option.map (map_update_names (Lazy.force global_env_keys))
-                           (OpamFile.Environment.read_opt env_file)
-    with e -> OpamStd.Exn.fatal e; None
-)
+  let get_env env_file =
+    OpamStd.Option.map
+      (map_update_names (Lazy.force global_env_keys))
+      (OpamFile.Environment.read_opt env_file)
+  in
+  let open OpamStd.Option.Op in
+  (OpamStd.Env.getopt "OPAM_LAST_ENV"
+   >>= fun env_file ->
+   try
+     OpamFilename.of_string env_file
+     |> OpamFile.make
+     |> get_env
+   with e -> OpamStd.Exn.fatal e; None)
+  >>+ (fun () ->
+      OpamStd.Env.getopt "OPAM_SWITCH_PREFIX"
+      >>= fun pfx ->
+      let env_file =
+        OpamPath.Switch.env_relative_to_prefix (OpamFilename.Dir.of_string pfx)
+      in
+      try get_env env_file
+      with e -> OpamStd.Exn.fatal e; None))
 
 let expand (updates: env_update list) : env =
   let updates =
@@ -167,6 +181,19 @@ let expand (updates: env_update list) : env =
           | None -> defs0)
         updates []
   in
+  (* OPAM_LAST_ENV and OPAM_SWITCH_PREFIX must be reverted if they were set *)
+  let reverts =
+    if OpamStd.Env.getopt "OPAM_LAST_ENV" <> None then
+      (OpamStd.Env.Name.of_string "OPAM_LAST_ENV", ([], []))::reverts
+    else
+      reverts
+  in
+  let reverts =
+    if OpamStd.Env.getopt "OPAM_SWITCH_PREFIX" <> None then
+      (OpamStd.Env.Name.of_string "OPAM_SWITCH_PREFIX", ([], []))::reverts
+    else
+      reverts
+  in
   (* And apply the new ones *)
   let rec apply_updates reverts acc = function
     | (var, op, arg, doc) :: updates ->
@@ -299,9 +326,7 @@ let get_pure ?(updates=[]) () =
 let get_opam ~set_opamroot ~set_opamswitch ~force_path st =
   add [] (updates ~set_opamroot ~set_opamswitch ~force_path st)
 
-let get_opam_raw ~set_opamroot ~set_opamswitch ?(base=[])
-    ~force_path
-    root switch =
+let get_opam_raw_updates ~set_opamroot ~set_opamswitch ~force_path root switch =
   let env_file = OpamPath.Switch.environment root switch in
   let upd = OpamFile.Environment.safe_read env_file in
   let upd =
@@ -316,9 +341,27 @@ let get_opam_raw ~set_opamroot ~set_opamswitch ?(base=[])
             var, to_op, v, doc
           | e -> e) upd
   in
-  add base
-    (updates_common ~set_opamroot ~set_opamswitch root switch @
-     upd)
+    updates_common ~set_opamroot ~set_opamswitch root switch @ upd
+
+let get_opam_raw ~set_opamroot ~set_opamswitch ?(base=[]) ~force_path
+  root switch =
+  let upd =
+    get_opam_raw_updates ~set_opamroot ~set_opamswitch ~force_path root switch
+  in
+  add base upd
+
+let hash_env_updates upd =
+  (* Should we use OpamFile.Environment.write_to_string ? cons: it contains
+     tabulations *)
+  let to_string (name, op, value, _) =
+    String.escaped name
+    ^ OpamPrinter.FullPos.env_update_op_kind op
+    ^ String.escaped value
+  in
+  List.rev_map to_string upd
+  |> String.concat "\n"
+  |> Digest.string
+  |> Digest.to_hex
 
 let get_full
     ~set_opamroot ~set_opamswitch ~force_path ?updates:(u=[]) ?(scrub=[])

src/state/opamEnv.mli

@@ -43,6 +43,16 @@ val get_opam_raw:
   force_path:bool ->
   dirname -> switch -> env
 
+(** Like [get_opam_raw], but returns the list of updates instead of the new
+    environment. *)
+val get_opam_raw_updates:
+  set_opamroot:bool -> set_opamswitch:bool -> force_path:bool ->
+  dirname -> switch -> env_update list
+
+(** Returns a hash of the given env_update list suitable for use with
+    OPAM_LAST_ENV *)
+val hash_env_updates: env_update list -> string
+
 (** Returns the running environment, with any opam modifications cleaned out,
     and optionally the given updates *)
 val get_pure: ?updates:env_update list -> unit -> env

src/state/opamFileTools.ml

@@ -650,9 +650,13 @@ let t_lint ?check_extra_files ?(check_upstream=false) ?(all=false) t =
                       used norm)
                   bad_os_arch_values)
        (bad_os_arch_values <> []));
+    (* Retired, since `OPAM_LAST_ENV` allows environment updates to be reliably
+       reverted. *)
+(*
     cond 56 `Warning
       "It is discouraged for non-compiler packages to use 'setenv:'"
       (t.env <> [] && not (has_flag Pkgflag_Compiler t));
+*)
     cond 57 `Error
       "Synopsis must not be empty"
       (match t.descr with None -> true | Some d -> String.equal (OpamFile.Descr.synopsis d) "");

tests/reftests/clean.test

@@ -73,6 +73,7 @@ rm -rf "${BASEDIR}/OPAM/clean/.opam-switch/backup"/*
 rm -rf "${BASEDIR}/OPAM/clean/.opam-switch/build"/*
 rm -rf "${BASEDIR}/OPAM/clean/.opam-switch/remove"/*
 rm -rf "${BASEDIR}/OPAM/clean/.opam-switch/extra-files-cache"/*
+rm -rf "${BASEDIR}/OPAM/clean/.opam-switch/last-env"/*
 ### opam clean --untracked
 Cleaning up switch clean
 Remaining directories and files: