Only split the update value for norewrite

Ensure that lists only ever contain unquoted values - i.e. we de-quote consistently when unzip'ing and re-quote only when re-zipping. It means that the update itself gets / -> \ translated (on Windows) but not quoted until after the update is applied.
ocaml · Apr 24, 2024 · 84d1e54 · 84d1e54
1 parent d7ba7d8
commit 84d1e54
Show file tree

Hide file tree

Showing 2 changed files with 34 additions and 29 deletions.
diff --git a/src/state/opamEnv.ml b/src/state/opamEnv.ml
@@ -49,29 +49,19 @@ let transform_format ~(sepfmt:sep_path_format) =
   match sepfmt with
   | `norewrite -> fun x -> x
   | (`rewrite_default _ | `rewrite _) as sepfmt ->
-    let separator, format =
+    let format =
       match sepfmt with
-      | `rewrite_default var -> default_sep_fmt_str var
-      | `rewrite (sep, fmt) -> sep, fmt
-    in
-    let translate =
-      match format with
-      | Target | Target_quoted ->
-        (match sepfmt with
-         | `rewrite_default _ -> fun x -> x
-         | `rewrite _ ->  OpamSystem.forward_to_back)
-      | Host | Host_quoted ->
-        (* noop on non windows *)
-        (Lazy.force OpamSystem.get_cygpath_path_transform) ~pathlist:false
+      | `rewrite_default var -> snd (default_sep_fmt_str var)
+      | `rewrite (_, fmt) -> fmt
     in
     match format with
-    | Target | Host -> translate
-    | Target_quoted | Host_quoted ->
-      fun arg ->
-        let path = translate arg in
-        let separator = OpamTypesBase.char_of_separator separator in
-        if String.contains path separator then
-          "\""^path^"\"" else path
+    | Target | Target_quoted ->
+      (match sepfmt with
+       | `rewrite_default _ -> fun x -> x
+       | `rewrite _ ->  OpamSystem.forward_to_back)
+    | Host | Host_quoted ->
+      (* noop on non windows *)
+      (Lazy.force OpamSystem.get_cygpath_path_transform) ~pathlist:false
 
 let resolve_separator_and_format :
   type r. (r, 'a) env_update -> (spf_resolved, 'a) env_update =
@@ -156,14 +146,28 @@ let split_var ~(sepfmt:sep_path_format) var value =
       OpamStd.Sys.split_path_variable ~sep value
 
 let join_var ~(sepfmt:sep_path_format) var values =
-  let separator =
+  let (separator, quoting) =
     match sepfmt with
-    | `norewrite -> fst (default_sep_fmt var)
-    | `rewrite_default var -> fst (default_sep_fmt_str var)
-    | `rewrite (sep, _) -> sep
+    | `norewrite -> fst (default_sep_fmt var), Host
+    | `rewrite_default var -> default_sep_fmt_str var
+    | `rewrite spf -> spf
+  in
+  let sep = OpamTypesBase.char_of_separator separator in
+  let values =
+    match quoting with
+    | Host | Target ->
+      values
+    | Host_quoted | Target_quoted ->
+      let f value =
+        if String.contains value sep then
+          "\""^value^"\""
+        else
+          value
+      in
+      List.map f values
   in
   String.concat
-    (String.make 1 (OpamTypesBase.char_of_separator separator))
+    (String.make 1 sep)
     values
 
 
@@ -182,6 +186,7 @@ let unzip_to ~sepfmt var elt current =
     | _ -> None
   in
   match (if String.equal elt "" then [""]
+         else if sepfmt <> `norewrite then [elt]
          else split_var ~sepfmt var elt) with
   | [] -> invalid_arg "OpamEnv.unzip_to"
   | hd::tl ->

diff --git a/tests/reftests/env.win32.test b/tests/reftests/env.win32.test
@@ -381,9 +381,9 @@ The following actions will be performed:
 <><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><>
 Processing  2/3: [semicol-target-quoted: sh env | grep RSTQ_ENV]
 + sh "-c" "env | grep RSTQ_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/semicol-target-quoted.1)
+- RSTQ_ENVBUILD_ADD_WITH_COL="a:\nother\gi;ven\path";/a/path/to;t:/his/is/quoted
 - RSTQ_ENVBUILD=\a\given\path
 - RSTQ_ENVBUILD_ADD=\a\given\path;a/path/to
-- RSTQ_ENVBUILD_ADD_WITH_COL="a:\nother\gi;ven\path";/a/path/to;"t:/his/is/quoted"
 - RSTQ_ENVBUILD_STR=something
 - RSTQ_ENVBUILD_WITH_COL=s:mething
 - RSTQ_ENVSET_ADD=a/path/to
@@ -396,7 +396,7 @@ RSTQ_ENVSET='\a\given\path'; export RSTQ_ENVSET;
 RSTQ_ENVSET_STR='something'; export RSTQ_ENVSET_STR;
 RSTQ_ENVSET_WITH_COL='s:mething'; export RSTQ_ENVSET_WITH_COL;
 RSTQ_ENVSET_ADD='\a\given\path;a/path/to'; export RSTQ_ENVSET_ADD;
-RSTQ_ENVSET_ADD_WITH_COL='"a:\nother\gi;ven\path";/a/path/to;"t:/his/is/quoted"'; export RSTQ_ENVSET_ADD_WITH_COL;
+RSTQ_ENVSET_ADD_WITH_COL='"a:\nother\gi;ven\path";/a/path/to;t:/his/is/quoted'; export RSTQ_ENVSET_ADD_WITH_COL;
 ### cat OPAM/rewriting/.opam-switch/environment | grep RSTQ_ENV
 RSTQ_ENVSET	=	/a/given/path	;	target-quoted	Updated\ by\ package\ semicol-target-quoted
 RSTQ_ENVSET_STR	=	something	;	target-quoted	Updated\ by\ package\ semicol-target-quoted
@@ -515,9 +515,9 @@ The following actions will be performed:
 <><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><>
 Processing  2/3: [semicol-host-quoted: sh env | grep RSHQ_ENV]
 + sh "-c" "env | grep RSHQ_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/semicol-host-quoted.1)
+- RSHQ_ENVBUILD_ADD_WITH_COL="/cygdrive/a/nother/gi;ven/path";/a/path/to;t:/his/is/quoted
 - RSHQ_ENVBUILD=/a/given/path
 - RSHQ_ENVBUILD_ADD=/a/given/path;a/path/to
-- RSHQ_ENVBUILD_ADD_WITH_COL="/cygdrive/a/nother/gi;ven/path";/a/path/to;"t:/his/is/quoted"
 - RSHQ_ENVBUILD_STR=something
 - RSHQ_ENVBUILD_WITH_COL=s:mething
 - RSHQ_ENVSET_ADD=a/path/to
@@ -530,7 +530,7 @@ RSHQ_ENVSET='/a/given/path'; export RSHQ_ENVSET;
 RSHQ_ENVSET_STR='something'; export RSHQ_ENVSET_STR;
 RSHQ_ENVSET_WITH_COL='s:mething'; export RSHQ_ENVSET_WITH_COL;
 RSHQ_ENVSET_ADD='/a/given/path;a/path/to'; export RSHQ_ENVSET_ADD;
-RSHQ_ENVSET_ADD_WITH_COL='"/cygdrive/a/nother/gi;ven/path";/a/path/to;"t:/his/is/quoted"'; export RSHQ_ENVSET_ADD_WITH_COL;
+RSHQ_ENVSET_ADD_WITH_COL='"/cygdrive/a/nother/gi;ven/path";/a/path/to;t:/his/is/quoted'; export RSHQ_ENVSET_ADD_WITH_COL;
 ### cat OPAM/rewriting/.opam-switch/environment | grep RSHQ_ENV
 RSHQ_ENVSET	=	/a/given/path	;	host-quoted	Updated\ by\ package\ semicol-host-quoted
 RSHQ_ENVSET_STR	=	something	;	host-quoted	Updated\ by\ package\ semicol-host-quoted