Improve variable interpolation of Windows paths

Windows paths will routinely contain backslash characters, meaning that
opam's variable interpolation (OpamFilter.expand_interpolations_in_file)
will not work if the method is used to generate .config files.

The function now attempts to process the file using opam-file-format. If
this is successful, then variables expansions which occur inside quoted
and triple-quoted strings will have backslash and double-quote
characters escaped.

Thus, if the lib variable is C:\OPAM\system\lib then the following .in
file:

opam-version: "2.0"
variables {
  lib: "%{lib}%/ocaml"
  broken: %{lib}%
}

expands to:

opam-version: "2.0"
variables {
  lib: "C:\\OPAM\\system\\lib/ocaml"
  broken: C:\OPAM\system\lib
}

Signed-off-by: David Allsopp <david.allsopp@metastack.com>

src/core/opamFilename.ml

@@ -186,10 +186,18 @@ let open_in filename =
   try open_in (to_string filename)
   with Sys_error _ -> raise (OpamSystem.File_not_found (to_string filename))
 
+let open_in_bin filename =
+  try open_in_bin (to_string filename)
+  with Sys_error _ -> raise (OpamSystem.File_not_found (to_string filename))
+
 let open_out filename =
   try open_out (to_string filename)
   with Sys_error _ -> raise (OpamSystem.File_not_found (to_string filename))
 
+let open_out_bin filename =
+  try open_out_bin (to_string filename)
+  with Sys_error _ -> raise (OpamSystem.File_not_found (to_string filename))
+
 let write filename raw =
   OpamSystem.write (to_string filename) raw
 

src/core/opamFilename.mli

@@ -136,7 +136,9 @@ val read: t -> string
 
 (** Open a channel from a given file. *)
 val open_in: t -> in_channel
+val open_in_bin: t -> in_channel
 val open_out: t -> out_channel
+val open_out_bin: t -> out_channel
 
 (** Removes everything in [filename] if existed. *)
 val remove: t -> unit

src/format/dune

@@ -10,4 +10,4 @@
                (:include ../ocaml-context-flags.sexp)))
   (wrapped     false))
 
-(ocamllex opamLineLexer)
+(ocamllex opamLineLexer opamInterpLexer)

src/format/opamFilter.ml

@@ -86,6 +86,10 @@ let string_interp_regex =
       seq [str "%{"; group (greedy notclose); opt (group (str "}%"))];
     ])
 
+let escape_value =
+  let rex = Re.(compile @@ set "\\\"") in
+  Re.Pcre.substitute ~rex ~subst:(fun s -> "\\"^s)
+
 let escape_expansions =
   Re.replace_string Re.(compile @@ char '%') ~by:"%%"
 
@@ -214,7 +218,7 @@ let resolve_ident ?no_undef_expand env fident =
   | None -> FUndef (FIdent fident)
 
 (* Resolves ["%{x}%"] string interpolations *)
-let expand_string ?(partial=false) ?default env text =
+let expand_string_aux ?(partial=false) ?(escape_value=fun x -> x) ?default env text =
   let default fident = match default, partial with
     | None, false -> None
     | Some df, false -> Some (df fident)
@@ -237,10 +241,12 @@ let expand_string ?(partial=false) ?default env text =
     else
     let fident = String.sub str 2 (String.length str - 4) in
     resolve_ident ~no_undef_expand:partial env (filter_ident_of_string fident)
-    |> value_string ?default:(default fident)
+    |> value_string ?default:(default fident) |> escape_value
   in
   Re.replace string_interp_regex ~f text
 
+let expand_string = expand_string_aux ?escape_value:None
+
 let unclosed_expansions text =
   let re =
     Re.(
@@ -400,17 +406,37 @@ let ident_bool ?default env id = value_bool ?default (resolve_ident env id)
 let expand_interpolations_in_file env file =
   let f = OpamFilename.of_basename file in
   let src = OpamFilename.add_extension f "in" in
-  let ic = OpamFilename.open_in src in
-  let oc = OpamFilename.open_out f in
-  let rec aux () =
-    match try Some (input_line ic) with End_of_file -> None with
-    | Some s ->
-      output_string oc (expand_string ~default:(fun _ -> "") env s);
-      output_char oc '\n';
-      aux ()
-    | None -> ()
+  let ic = OpamFilename.open_in_bin src in
+  let oc = OpamFilename.open_out_bin f in
+  (* Determine if the input file parses in opam-file-format *)
+  let is_opam_format =
+    try
+      let _ =
+        OpamParser.channel ic (OpamFilename.to_string src)
+      in
+      true
+    with e ->
+      OpamStd.Exn.fatal e;
+      false
+  in
+  (* Reset the input for processing *)
+  seek_in ic 0;
+  let default _ = "" in
+  let write = output_string oc in
+  let unquoted s = write @@ expand_string ~default env s in
+  let quoted s = write @@ expand_string_aux ~escape_value ~default env s in
+  let process =
+    if is_opam_format then
+      fun () -> OpamInterpLexer.main unquoted quoted (Lexing.from_channel ic)
+    else
+      let rec aux () =
+        match input_line ic with
+        | s -> unquoted s; output_char oc '\n'; aux ()
+        | exception End_of_file -> ()
+      in
+        aux
   in
-  aux ();
+  process ();
   close_in ic;
   close_out oc
 

src/format/opamFilter.mli

@@ -123,7 +123,11 @@ val ident_string: ?default:string -> env -> fident -> string
 (** Like [ident_value], but casts the result to a bool *)
 val ident_bool: ?default:bool -> env -> fident -> bool
 
-(** Rewrites [basename].in to [basename], expanding interpolations *)
+(** Rewrites [basename].in to [basename], expanding interpolations.
+    If the first line begins ["opam-version:"], assumes that expansion of
+    variables within strings should be properly escaped. In particular, this
+    means that Windows paths should expand correctly when generating .config
+    files. *)
 val expand_interpolations_in_file: env -> basename -> unit
 
 

src/format/opamInterpLexer.mli

@@ -0,0 +1,18 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright 2016 MetaStack Solutions Ltd.                             *)
+(*                                                                        *)
+(*  All rights reserved. This file is distributed under the terms of the  *)
+(*  GNU Lesser General Public License version 2.1, with the special       *)
+(*  exception on linking described in the file LICENSE.                   *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** OPAM format variable interpolation processor *)
+
+val main: (string -> unit) -> (string -> unit) -> Lexing.lexbuf -> unit
+(** [main unquoted quoted lexbuf] fully processes the given lexbuf. Strings are
+    applied to [unquoted] until a ["] or ["""] sequence is encountered when the
+    content within the single or triple-quoted string is applied to [quoted]
+    (note that the quote marks themselves are passed to [unquoted]). Within
+    either string type, backslash is the escape character. *)

src/format/opamInterpLexer.mll

@@ -0,0 +1,42 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright 2016 MetaStack Solutions Ltd.                             *)
+(*                                                                        *)
+(*  All rights reserved. This file is distributed under the terms of the  *)
+(*  GNU Lesser General Public License version 2.1, with the special       *)
+(*  exception on linking described in the file LICENSE.                   *)
+(*                                                                        *)
+(**************************************************************************)
+
+rule main unquoted quoted = parse
+| [^ '"' '\n' ]+
+               { unquoted @@ Lexing.lexeme lexbuf;
+                 main unquoted quoted lexbuf }
+| ("\"\"\"" | '"') as quote
+               { unquoted quote;
+                 let triple = String.length quote = 3 in
+                 string triple unquoted quoted lexbuf }
+| '\n'         { Lexing.new_line lexbuf;
+                 unquoted "\n";
+                 main unquoted quoted lexbuf }
+| eof          { () }
+
+
+and string triple unquoted quoted = parse
+| ( [^ '"' '\\' '\n' ]+ | '\\' [^ '\n' ]? )+
+               { quoted @@ Lexing.lexeme lexbuf;
+                 string triple unquoted quoted lexbuf }
+| "\"\"\""
+               { unquoted "\"\"\"";
+                 main unquoted quoted lexbuf }
+| '"'          { if triple then begin
+                   quoted "\"";
+                   string triple unquoted quoted lexbuf
+                 end else begin
+                   unquoted "\"";
+                   main unquoted quoted lexbuf
+                 end }
+| '\n'         { Lexing.new_line lexbuf;
+                 unquoted "\n";
+                 string triple unquoted quoted lexbuf}
+| eof          { () }