Introduce OpamEnv.Env.Name

OpamEnv.Env.Name.t introduced to defend against comparing environment
variable names as strings. Propagate this change and fix comparison of
environment variables on Windows in the process.

master_changes.md

@@ -88,6 +88,7 @@ users)
 
 ## Config
   * Reset the "jobs" config variable when upgrading from opam 2.0 [#5284 @kit-ty-kate]
+  * Introduce OpamStd.Env.Name to abstract environment variable names [#5356 @dra27]
 
 ## Pin
   * Switch the default version when undefined from ~dev to dev [#4949 @kit-ty-kate]

src/client/opamConfigCommand.ml

@@ -175,6 +175,7 @@ let rec print_fish_env env =
     print_fish_env r
 
 let print_eval_env ~csh ~sexp ~fish ~pwsh ~cmd env =
+  let env = (env : OpamTypes.env :> (string * string * string option) list) in
   if sexp then
     print_sexp_env env
   else if csh then
@@ -283,7 +284,7 @@ let exec gt ~set_opamroot ~set_opamswitch ~inplace_path ~no_switch command =
     if no_switch then
       let revert = OpamEnv.add [] [] in
       List.map (fun ((var, _, _) as base) ->
-          match List.find_opt (fun (v,_,_) -> v = var) revert with
+          match List.find_opt (fun (v,_,_) -> OpamStd.Env.Name.equal v var) revert with
           | Some reverted -> reverted
           | None -> base) base
     else if OpamFile.exists env_file then

src/core/opamStd.ml

@@ -773,6 +773,39 @@ module Env = struct
        https://docs.microsoft.com/en-us/powershell/module/microsoft.powershell.core/about/about_quoting_rules?view=powershell-7.1 *)
     Re.(replace_string (compile (char '\'')) ~by:"''")
 
+  module Name = struct
+    module M = struct
+      include AbstractString
+
+      let compare =
+        if Sys.win32 then
+          fun l r ->
+            String.(compare (lowercase_ascii l) (lowercase_ascii r))
+        else
+          String.compare
+    end
+
+    type t = string
+
+    let of_string = M.of_string
+    let to_string = M.to_string
+    let of_json = M.of_json
+    let to_json = M.to_json
+    let compare = M.compare
+
+    let equal =
+      if Sys.win32 then
+        fun l r ->
+          String.(equal (lowercase_ascii l) (lowercase_ascii r))
+      else
+        String.equal
+
+    let equal_string = equal
+
+    module Set = Set.Make(M)
+    module Map = Map.Make(M)
+  end
+
   let list =
     let lazy_env = lazy (
       let e = Unix.environment () in
@@ -784,15 +817,15 @@ module Env = struct
     ) in
     fun () -> Lazy.force lazy_env
 
-  let get =
-    if Sys.win32 then
-      fun n ->
-        let n = String.uppercase_ascii n in
-        snd (List.find (fun (k,_) -> String.uppercase_ascii k = n) (list ()))
-    else
-      fun n -> OpamList.assoc String.equal n (list ())
+  let get_full n = List.find (fun (k,_) -> Name.equal k n) (list ())
+
+  let get n = snd (get_full n)
+
+  let getopt = Option.of_Not_found get
 
-  let getopt n = try Some (get n) with Not_found -> None
+  let getopt_full n =
+    try let (n, v) = get_full n in (n, Some v)
+    with Not_found -> (n, None)
 end
 
 

src/core/opamStd.mli

@@ -413,11 +413,21 @@ module Env : sig
 
   (** {3 Environment variable handling} *)
 
+  (** Environment variable names *)
+  module Name : sig
+    include ABSTRACT with type t = private string
+
+    val equal_string: t -> string -> bool
+
+  end
+
   val get: string -> string
 
   val getopt: string -> string option
 
-  val list: unit -> (string * string) list
+  val getopt_full: Name.t -> Name.t * string option
+
+  val list: unit -> (Name.t * string) list
 end
 
 (** {2 System query and exit handling} *)

src/core/opamSystem.ml

@@ -353,7 +353,9 @@ let real_path p =
 type command = string list
 
 let default_env () =
-  OpamStd.Env.list () |> List.map (fun (var, v) -> var^"="^v) |> Array.of_list
+  (OpamStd.Env.list () :> (string * string) list)
+    |> List.map (fun (var, v) -> var^"="^v)
+    |> Array.of_list
 
 let env_var env var =
   let len = Array.length env in

src/format/opamTypes.mli

@@ -401,7 +401,7 @@ type stats = {
 }
 
 (** Environement variables: var name, value, optional comment *)
-type env = (string * string * string option) list
+type env = (OpamStd.Env.Name.t * string * string option) list
 
 (** Environment updates *)
 type env_update = string * OpamParserTypes.FullPos.env_update_op_kind * string * string option

src/format/opamTypesBase.ml

@@ -105,12 +105,12 @@ let env_array l =
   (* The env list may contain successive bindings of the same variable, make
      sure to keep only the last *)
   let bindings =
-    List.fold_left (fun acc (k,v,_) -> OpamStd.String.Map.add k v acc)
-      OpamStd.String.Map.empty l
+    List.fold_left (fun acc (k,v,_) -> OpamStd.Env.Name.Map.add k v acc)
+      OpamStd.Env.Name.Map.empty l
   in
-  let a = Array.make (OpamStd.String.Map.cardinal bindings) "" in
-  OpamStd.String.Map.fold
-    (fun k v i -> a.(i) <- String.concat "=" [k;v]; succ i)
+  let a = Array.make (OpamStd.Env.Name.Map.cardinal bindings) "" in
+  OpamStd.Env.Name.Map.fold
+    (fun k v i -> a.(i) <- (k :> string) ^ "=" ^ v; succ i)
     bindings 0
   |> ignore;
   a

src/state/opamEnv.ml

@@ -111,28 +111,56 @@ let reverse_env_update op arg cur_value =
      | Some (rl1, l2) -> Some (List.rev l2, List.rev rl1)
      | None -> None)
 
+let map_update_names env_keys updates =
+  let convert (k, o, a, d) =
+    let k =
+      try
+        let k = OpamStd.Env.Name.of_string k in
+        (OpamStd.Env.Name.(Set.find (equal k) env_keys) :> string)
+      with Not_found -> k
+    in
+    k, o, a, d
+  in
+  List.map convert updates
+
+let global_env_keys = lazy (OpamStd.Env.Name.Set.of_list (List.map fst (OpamStd.Env.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 OpamFile.Environment.read_opt env_file
+    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 expand (updates: env_update list) : env =
+  let updates =
+    if Sys.win32 then
+      (* Preserve the case of updates which are already in env *)
+      map_update_names (Lazy.force global_env_keys) updates
+    else
+      updates
+  in
   (* Reverse all previous updates, in reverse order, on current environment *)
   let reverts =
     match Lazy.force updates_from_previous_instance with
     | None -> []
     | Some updates ->
       List.fold_right (fun (var, op, arg, _) defs0 ->
-          let v_opt, defs = OpamStd.List.pick_assoc String.equal var defs0 in
+          let var = OpamStd.Env.Name.of_string var in
+          let v_opt, defs =
+            OpamStd.List.pick_assoc OpamStd.Env.Name.equal var defs0
+          in
           let v =
-            OpamStd.Option.Op.((v_opt >>| rezip >>+ fun () ->
-                                OpamStd.Env.getopt var >>| split_var) +! [])
+            match Option.map rezip v_opt with
+            | Some v -> v
+            | None ->
+              OpamStd.Option.map_default split_var []
+                (OpamStd.Env.getopt (var :> string))
           in
           match reverse_env_update op arg v with
           | Some v -> (var, v)::defs
@@ -142,19 +170,16 @@ let expand (updates: env_update list) : env =
   (* And apply the new ones *)
   let rec apply_updates reverts acc = function
     | (var, op, arg, doc) :: updates ->
+      let var = OpamStd.Env.Name.of_string var in
       let zip, reverts =
-        let f, var =
-          if Sys.win32 then
-            String.uppercase_ascii, String.uppercase_ascii var
-          else (fun x -> x), var
-        in
-        match OpamStd.List.find_opt (fun (v, _, _) -> f v = var) acc with
+        match OpamStd.List.find_opt (fun (v, _, _) ->
+            OpamStd.Env.Name.equal var v) acc with
         | Some (_, z, _doc) -> z, reverts
         | None ->
-          match OpamStd.List.pick_assoc String.equal var reverts with
+          match OpamStd.List.pick_assoc OpamStd.Env.Name.equal var reverts with
           | Some z, reverts -> z, reverts
           | None, _ ->
-            match OpamStd.Env.getopt var with
+            match OpamStd.Env.getopt (var :> string) with
             | Some s -> ([], split_var s), reverts
             | None -> ([], []), reverts
       in
@@ -177,16 +202,23 @@ let expand (updates: env_update list) : env =
   apply_updates reverts [] updates
 
 let add (env: env) (updates: env_update list) =
-  let env =
+  let updates =
     if Sys.win32 then
-      (*
-       * Environment variable names are case insensitive on Windows
-       *)
-      let updates = List.rev_map (fun (u,_,_,_) -> (String.uppercase_ascii u, "", "", None)) updates in
-      List.filter (fun (k,_,_) -> let k = String.uppercase_ascii k in List.for_all (fun (u,_,_,_) -> u <> k) updates) env
+      (* Preserve the case of updates which are already in env *)
+      map_update_names (OpamStd.Env.Name.Set.of_list
+                          (List.map (fun (k, _, _) -> k) env)) updates
     else
-      List.filter (fun (k,_,_) -> List.for_all (fun (u,_,_,_) -> u <> k) updates)
-        env
+      updates
+  in
+  let update_keys =
+    List.fold_left (fun m (k,_,_,_) ->
+        OpamStd.Env.Name.(Set.add (of_string k) m))
+      OpamStd.Env.Name.Set.empty updates
+  in
+  let env =
+    List.filter (fun (k,_,_) ->
+        not (OpamStd.Env.Name.Set.mem k update_keys))
+      env
   in
   env @ expand updates
 
@@ -272,25 +304,28 @@ let get_opam_raw ~set_opamroot ~set_opamswitch ?(base=[])
     root switch =
   let env_file = OpamPath.Switch.environment root switch in
   let upd = OpamFile.Environment.safe_read env_file in
+  let upd =
+    let remove_OPAM_SWITCH_PREFIX (var, op, _, _) =
+      String.uppercase_ascii var <> "OPAM_SWITCH_PREFIX" || op <> Eq
+    in
+    List.filter remove_OPAM_SWITCH_PREFIX upd
+  in
   let upd =
     ("OPAM_SWITCH_PREFIX", Eq,
      OpamFilename.Dir.to_string (OpamPath.Switch.root root switch),
-     Some "Prefix of the current opam switch") ::
-    List.filter (function ("OPAM_SWITCH_PREFIX", Eq, _, _) -> false | _ -> true)
-      upd
+     Some "Prefix of the current opam switch") :: upd
   in
   let upd =
-    if force_path then
-      List.map (function
-          | "PATH", EqPlusEq, v, doc -> "PATH", PlusEq, v, doc
-          | e -> e)
-        upd
-    else
+    let from_op, to_op =
+      if force_path then
+        EqPlusEq, PlusEq
+      else
+        PlusEq, EqPlusEq
+    in
       List.map (function
-          | "PATH", PlusEq, v, doc -> "PATH", EqPlusEq, v, doc
-          | e -> e)
-        upd
-
+          | var, op, v, doc when String.uppercase_ascii var = "PATH" && op = from_op ->
+            var, to_op, v, doc
+          | e -> e) upd
   in
   add base
     (updates_common ~set_opamroot ~set_opamswitch root switch @
@@ -301,14 +336,13 @@ let get_full
     st =
   let env =
     let env = OpamStd.Env.list () in
-    let map =
-      if Sys.win32 then
-        String.uppercase_ascii
-      else
-        (fun x -> x)
+    let scrub =
+      let add set elt =
+        OpamStd.Env.Name.(Set.add (of_string elt) set)
+      in
+      List.fold_left add OpamStd.Env.Name.Set.empty scrub
     in
-    let scrub = List.rev_map map scrub |> OpamStd.String.Set.of_list in
-    List.filter (fun (name, _) -> not (OpamStd.String.Set.mem (map name) scrub)) env
+    List.filter (fun (name, _) -> not (OpamStd.Env.Name.Set.mem name scrub)) env
   in
   let env0 = List.map (fun (v,va) -> v,va,None) env in
   let updates = u @ updates ~set_opamroot ~set_opamswitch ~force_path st in
@@ -318,11 +352,13 @@ let is_up_to_date_raw ?(skip=OpamStateConfig.(!r.no_env_notice)) updates =
   skip ||
   let not_utd =
     List.fold_left (fun notutd (var, op, arg, _doc as upd) ->
-        match OpamStd.Env.getopt var with
-        | None -> upd::notutd
-        | Some v ->
+        let var = OpamStd.Env.Name.of_string var in
+        match OpamStd.Env.getopt_full var with
+        | _, None -> upd::notutd
+        | var, Some v ->
           if reverse_env_update op arg (split_var v) = None then upd::notutd
-          else List.filter (fun (v, _, _, _) -> v <> var) notutd)
+          else List.filter (fun (v, _, _, _) ->
+              OpamStd.Env.Name.equal_string var v) notutd)
       []
       updates
   in
@@ -356,7 +392,9 @@ let switch_path_update ~force_path root switch =
 
 let path ~force_path root switch =
   let env = expand (switch_path_update ~force_path root switch) in
-  let (_, path_value, _) = List.find (fun (v, _, _) -> v = "PATH") env in
+  let (_, path_value, _) =
+    List.find (fun (v, _, _) -> OpamStd.Env.Name.equal_string v "PATH") env
+  in
   path_value
 
 let full_with_path ~force_path ?(updates=[]) root switch =

src/state/opamSysInteract.ml

@@ -32,12 +32,16 @@ let run_command
     | None -> None
     | Some vars ->
       let env = OpamStd.Env.list () in
+      let vars =
+        List.map (fun (c, (n, v)) -> c, (OpamStd.Env.Name.of_string n, v)) vars
+      in
       let set_vars, kept_vars, env =
         List.fold_left (fun (n,p,e) (op, (name, content as var)) ->
-            match OpamStd.List.assoc_opt String.equal name env, op with
-            | Some c, `add when String.compare c content = 0 -> n, p, e
+            match OpamStd.(List.assoc_opt Env.Name.equal name env), op with
+            | Some c, `add when String.equal c content -> n, p, e
             | Some _, `set ->
-              var::n, p, (OpamStd.List.remove_assoc String.equal name env)
+              var::n, p, (List.filter (fun (k, _) ->
+                  not (OpamStd.Env.Name.equal k name)) env)
             | Some _, _ -> n, var::p, e
             | None, _ -> var::n, p, e
           )
@@ -47,12 +51,12 @@ let run_command
       if set_vars = [] then
         ((if kept_vars <> [] then
             log "Won't override %s"
-              (OpamStd.List.to_string str_var kept_vars));
+              (OpamStd.List.to_string str_var (kept_vars :> (string * string) list)));
          None)
       else
         (log "Adding to env %s"
-           (OpamStd.List.to_string str_var set_vars);
-         Some (set_vars @ env
+           (OpamStd.List.to_string str_var (set_vars :> (string * string) list));
+         Some ((set_vars @ env :> (string * string) list)
                |> List.rev_map str_var
                |> Array.of_list))
   in