[git] Correctly call git ls-tree so unicode files are not quoted

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 ocaml#3219

Signed-off-by: Emilio Jesus Gallego Arias <[email protected]>

CHANGES.md

@@ -48,6 +48,10 @@ Unreleased
   on UNIX-like systems as a unrelated `gmake` binary might exist on Windows.
   (#3853, @kit-ty-kate)
 
+- 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

@@ -81,6 +81,10 @@ let run t args =
 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
   let* s =
@@ -128,6 +132,11 @@ let commit_id =
        ~hg:(fun t -> run t [ "id"; "-i" ])
 
 let files =
+  let f_zero args t =
+    let open Fiber.O in
+    let+ l = run_zero_separated t args in
+    List.map l ~f:Path.in_source
+  in
   let f args t =
     let open Fiber.O in
     let+ l = run_lines t args in
@@ -142,5 +151,5 @@ let files =
 
               let to_dyn = Dyn.Encoder.list Path.to_dyn
             end ))
-       ~git:(f [ "ls-tree"; "-r"; "--name-only"; "HEAD" ])
+       ~git:(f_zero [ "ls-tree"; "-z"; "-r"; "--name-only"; "HEAD" ])
        ~hg:(f [ "files" ])

src/stdune/io.ml

@@ -17,6 +17,38 @@ let input_lines =
   in
   fun ic -> loop ic []
 
+let input_zero_from_buffer from buf =
+  match Bytes.index_from_opt buf from '\x00' with
+  | None -> (None, from)
+  | Some eos ->
+    (Some (Bytes.sub_string buf ~pos:from ~len:(eos - from)), eos + 1)
+
+let input_zero_separated =
+  let buf_size = 65536 in
+  let buf = Bytes.create buf_size in
+  let rec process_buf buf pos acc =
+    match input_zero_from_buffer pos buf with
+    | Some s, eos -> process_buf buf eos (s :: acc)
+    | None, rest -> (acc, rest)
+  in
+  let rec loop ic pos acc =
+    let res = input ic buf pos (buf_size - pos) in
+    if res = 0 then
+      if pos > 0 then
+        let last = Bytes.sub_string buf ~pos:0 ~len:pos in
+        List.rev (last :: acc)
+      else
+        List.rev acc
+    else
+      let len = res + pos in
+      let act_input = Bytes.sub buf ~pos:0 ~len in
+      let acc, rest = process_buf act_input 0 acc in
+      let rem = len - rest in
+      let () = Bytes.blit ~src:buf ~src_pos:rest ~dst:buf ~dst_pos:0 ~len:rem in
+      loop ic rem acc
+  in
+  fun ic -> loop ic 0 []
+
 let copy_channels =
   let buf_len = 65536 in
   let buf = Bytes.create buf_len in
@@ -137,6 +169,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