[vcs] [subst] Correctly call git ls-tree so unicode files are not q…

…uoted

In order to avoid quoting of file names, we need to call `git ls-tree`
with the `-z` option.

This fixes problems with `dune subst` in the presence of unicode
files, in particular fixes #3219

Signed-off-by: Emilio Jesus Gallego Arias <e+git@x80.org>

CHANGES.md

@@ -59,6 +59,10 @@ Unreleased
   makes it possible to use the build info module inside the preprocessor.
   (#3848, fix #3848, @rgrinberg)
 
+- Correctly call `git ls-tree` so unicode files are not quoted, this
+  fixes problems with `dune subst` in the presence of unicode
+  files. Fixes #3219 (#3879, @ejgallego)
+
 2.7.1 (2/09/2020)
 -----------------
 

src/dune_engine/process.ml

@@ -602,6 +602,9 @@ let run_capture = run_capture_gen ~f:Stdune.Io.read_file
 
 let run_capture_lines = run_capture_gen ~f:Stdune.Io.lines_of_file
 
+let run_capture_zero_separated =
+  run_capture_gen ~f:Stdune.Io.zero_strings_of_file
+
 let run_capture_line ?dir ?stderr_to ?stdin_from ?env ?(purpose = Internal_job)
     fail_mode prog args =
   run_capture_gen ?dir ?stderr_to ?stdin_from ?env ~purpose fail_mode prog args

src/dune_engine/process.mli

@@ -98,3 +98,14 @@ val run_capture_lines :
   -> Path.t
   -> string list
   -> 'a Fiber.t
+
+val run_capture_zero_separated :
+     ?dir:Path.t
+  -> ?stderr_to:Io.output Io.t
+  -> ?stdin_from:Io.input Io.t
+  -> ?env:Env.t
+  -> ?purpose:purpose
+  -> (string list, 'a) failure_mode
+  -> Path.t
+  -> string list
+  -> 'a Fiber.t

src/dune_engine/vcs.ml

@@ -78,8 +78,9 @@ let run t args =
   in
   String.trim s
 
-let run_lines t args =
-  Process.run_capture_lines Strict (prog t) args ~dir:t.root ~env:Env.initial
+let run_zero_separated t args =
+  Process.run_capture_zero_separated Strict (prog t) args ~dir:t.root
+    ~env:Env.initial
 
 let hg_describe t =
   let open Fiber.O in
@@ -130,7 +131,7 @@ let commit_id =
 let files =
   let f args t =
     let open Fiber.O in
-    let+ l = run_lines t args in
+    let+ l = run_zero_separated t args in
     List.map l ~f:Path.in_source
   in
   Staged.unstage
@@ -142,5 +143,5 @@ let files =
 
               let to_dyn = Dyn.Encoder.list Path.to_dyn
             end ))
-       ~git:(f [ "ls-tree"; "-r"; "--name-only"; "HEAD" ])
-       ~hg:(f [ "files" ])
+       ~git:(f [ "ls-tree"; "-z"; "-r"; "--name-only"; "HEAD" ])
+       ~hg:(f [ "files"; "-0" ])

src/stdune/io.ml

@@ -17,6 +17,47 @@ let input_lines =
   in
   fun ic -> loop ic []
 
+let input_zero_from_buffer from buf =
+  match String.index_from_opt buf from '\x00' with
+  | None -> (None, from)
+  | Some eos -> (Some (String.sub buf ~pos:from ~len:(eos - from)), eos + 1)
+
+let input_zero_separated =
+  (* Take all the \0-terminated strings from [buf], return the scanned list and
+     the remainder *)
+  let rec scan_inputs_buf from buf acc =
+    match input_zero_from_buffer from buf with
+    | Some istr, from -> scan_inputs_buf from buf (istr :: acc)
+    | None, from ->
+      let total_len = String.length buf in
+      if total_len > from then
+        let rest = String.sub buf ~pos:from ~len:(total_len - from) in
+        (acc, Some rest)
+      else
+        (acc, None)
+  in
+  let ibuf_size = 65536 in
+  let ibuf = Bytes.create ibuf_size in
+  let rec input_loop ic rem acc =
+    let res = input ic ibuf 0 ibuf_size in
+    if res = 0 then
+      (* end of file, check if there is a remainder, and return the results *)
+      match rem with
+      | Some rem -> List.rev (rem :: acc)
+      | None -> List.rev acc
+    else
+      (* new input, append remainder and scan it *)
+      let actual_input = Bytes.sub_string ibuf ~pos:0 ~len:res in
+      let actual_input =
+        match rem with
+        | None -> actual_input
+        | Some rem -> rem ^ actual_input
+      in
+      let acc, rem = scan_inputs_buf 0 actual_input acc in
+      input_loop ic rem acc
+  in
+  fun ic -> input_loop ic None []
+
 let copy_channels =
   let buf_len = 65536 in
   let buf = Bytes.create buf_len in
@@ -137,6 +178,9 @@ struct
 
   let lines_of_file fn = with_file_in fn ~f:input_lines ~binary:false
 
+  let zero_strings_of_file fn =
+    with_file_in fn ~f:input_zero_separated ~binary:true
+
   let write_file ?binary fn data =
     with_file_out ?binary fn ~f:(fun oc -> output_string oc data)
 

src/stdune/io_intf.ml

@@ -15,6 +15,9 @@ module type S = sig
 
   val lines_of_file : path -> string list
 
+  (** Reads zero-separated strings from a file *)
+  val zero_strings_of_file : path -> string list
+
   val read_file : ?binary:bool -> path -> string
 
   val write_file : ?binary:bool -> path -> string -> unit