Merge pull request #5356 from dra27/fix-env-again

Fix case-preserving environment updates on Windows

master_changes.md

@@ -342,6 +342,7 @@ users)
   * Support MSYS2: two-phase rsync on MSYS2 to allow MSYS2's behavior of copying rather than symlinking [#4817 @jonahbeckford]
   * Environment: translate PATH from Windows to Unix during opam env. [#4844 @jonahbeckford]
   * Correct invocation of Cygwin binaries when Cygwin bin directory is first in PATH [#5293 @dra27]
+  * [BUG] Fix case insensitive variable handling [#5356 @dra27]
 
 ## Test
   * Update crowbar with compare functions [#4918 @rjbou]
@@ -393,6 +394,7 @@ users)
   * Test opam pin remove <pkg>.<version> [#5325 @kit-ty-kate]
   * Add a test checking that reinstalling a non-installed package is equivalent to installing it [#5228 @kit-ty-kate]
   * Add a test showing that we still get the reason for installing a package when using opam reinstall on non-installed packages [#5229 @kit-ty-kate]
+  * Add a windows test to check case insensitive environment variable handling [#5356 @dra27]
 
 ### Engine
   * Add `opam-cat` to normalise opam file printing [#4763 @rjbou @dra27] [2.1.0~rc2 #4715]
@@ -612,3 +614,4 @@ users)
   * `OpamStd.List`: add comparison function argument to some `OpamList` functions [#5374 @kit-ty-kate @rjbou]
   * `OpamStd.Option`: add `equal` function [#5374 @rjbou]
   * `OpamStd.Compare`: add module to flag polymorphic comparison functions in opam codebase [#5374 @kit-ty-kate @rjbou]
+  * `OpamStd.Env.`: introduce OpamStd.Env.Name to abstract environment variable names [#5356 @dra27]

src/client/opamCommands.ml

@@ -1479,7 +1479,7 @@ let config cli =
               (OpamSwitchState.universe ~test:true ~doc:true ~dev_setup:true
                  ~requested:OpamPackage.Set.empty state Query)
             |> OpamPackage.Set.iter process;
-            if List.mem "." (OpamStd.Sys.split_path_variable (Sys.getenv "PATH"))
+            if not Sys.win32 && List.mem "." (OpamStd.Sys.split_path_variable (Sys.getenv "PATH"))
             then OpamConsole.warning
                 "PATH contains '.' : this is a likely cause of trouble.";
             `Ok ()

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

@@ -762,6 +762,50 @@ module Env = struct
       | curr::after -> aux (curr::before) after
     in aux [] v
 
+  let escape_single_quotes ?(using_backslashes=false) =
+    if using_backslashes then
+      Re.(replace (compile (set "\\\'")) ~f:(fun g -> "\\"^Group.get g 0))
+    else
+      Re.(replace_string (compile (char '\'')) ~by:"'\"'\"'")
+
+  let escape_powershell =
+    (* escape single quotes with two single quotes.
+       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
@@ -773,26 +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 getopt n = try Some (get n) with Not_found -> None
+  let get n = snd (get_full n)
 
-  let escape_single_quotes ?(using_backslashes=false) =
-    if using_backslashes then
-      Re.(replace (compile (set "\\\'")) ~f:(fun g -> "\\"^Group.get g 0))
-    else
-      Re.(replace_string (compile (char '\'')) ~by:"'\"'\"'")
+  let getopt = Option.of_Not_found get
 
-  let escape_powershell =
-    (* escape single quotes with two single quotes.
-       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:"''")
+  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

@@ -386,6 +386,9 @@ end
 (** {2 Manipulation and query of environment variables} *)
 
 module Env : sig
+
+  (** {3 Generic functions} *)
+
   (** Remove from a c-separated list of string the ones with the given prefix *)
   val reset_value: prefix:string -> char -> string -> string list
 
@@ -396,12 +399,6 @@ module Env : sig
   *)
   val cut_value: prefix:string -> char -> string -> string list * string list
 
-  val get: string -> string
-
-  val getopt: string -> string option
-
-  val list: unit -> (string * string) list
-
   (** Utility function for shell single-quoted strings. In most shells,
       backslash escapes are not allowed and a single quote needs to be replaced
       by [quote double-quote quote double-quote quote] (close the single-quoted
@@ -413,6 +410,46 @@ module Env : sig
 
   (** Utility function for PowerShell strings. *)
   val escape_powershell: string -> string
+
+  (** {3 Environment variable handling} *)
+
+  (** Environment variable names. Windows has complicated semantics for
+      environment variables. The retrieval functions are case insensitive, but
+      it's "legal" for the environment block to contain entries which differ
+      only by case. If environment variables are set entirely using CRT or Win32
+      API functions, then there isn't usually a problem, the issue arises when
+      creating a program where the environment block is instead passed. In this
+      model, it's very easy to end up with two bindings in the same block. When
+      dealing with Windows programs, this will mostly be transparent, but it's a
+      problem with Cygwin which actively allows "duplicate" entries which differ
+      by case only and implements Posix semantics on top of this. The problem is
+      constantly with us thanks to the use of PATH on Unix, and Path on Windows!
+      opam tries to ensure that environment variables are looked up according to
+      the OS semantics (so case insensitively on Windows) and OpamEnv goes to
+      some trouble to ensure that updates to environment variables are case
+      preserving (i.e. PATH+=foo gets transformed to Path+=foo if Path exists
+      in the environment block).
+
+      Key to this is not accidentally treating environment variable names as
+      strings, without using the appropriate comparison functions. Name.t
+      represents environment variable names as private strings, providing
+      comparison operators to handle them, and still allowing the possibility
+      to coerce them to strings.
+      *)
+  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 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