Remove tar_in function

doc/qemu.md

@@ -115,3 +115,36 @@ Got: "8a897f21e54db877fc971c757ef7ffc2e1293e191dc60c3a18f24f0d3f0926f3"
 While this initial version only runs on x86_64 targetting x86_64
 processors it would be entirely possibly to extend this to other
 architectures.
+
+# Project source
+
+Obuilder uses `tar` to copy the project source into the sandbox.
+Attempts to use `tar -xf - . | ssh opam@localhost -p 60022 tar -xf -`
+fail as the data is corrupted.  This can be show also with `cat test.file
+| ssh opam@localhost -p 60022 sha256sum -` where files of < 1M work most
+of the time, but larger test files give a different hash everytime.
+
+An alternative would be to use `guestfish` as below.  This works, albeit
+the NTFS file permissions aren't clean, but I'm not happy with it as
+it requires knowing the partition number ahead of time - `/dev/sda2` -
+which impacts the ability of this to work more generically.
+
+```
+let tar_in ~cancelled ?stdin ~log:_ _ config result_tmp =
+  let proc =
+    let cmd = ["guestfish";
+               "add-drive"; result_tmp / "rootfs" / "image.qcow2"; ":";
+               "run"; ":";
+               "mount"; "/dev/sda2"; "/"; ":";
+               "tar-in"; "-"; config.Config.cwd; ] in
+    let stdin = Option.map (fun x -> `FD_move_safely x) stdin in
+    let pp f = Os.pp_cmd f ("", config.Config.argv) in
+    Os.sudo_result ?stdin ~pp cmd in
+  proc >>= fun r ->
+  if Lwt.is_sleeping cancelled then Lwt.return (r :> (unit, [`Msg of string | `Cancelled]) result)
+  else Lwt_result.fail `Cancelled
+```
+
+Windows ships with BSD tar in `System32` so we and that does work with an
+`ssh` pipe.
+

lib/build.ml

@@ -161,7 +161,7 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st
               ()
           in
           Os.with_pipe_to_child @@ fun ~r:from_us ~w:to_untar ->
-          let proc = Sandbox.tar_in ~cancelled ~stdin:from_us ~log t.sandbox config result_tmp in
+          let proc = Sandbox.run ~cancelled ~stdin:from_us ~log t.sandbox config result_tmp in
           let send =
             (* If the sending thread finishes (or fails), close the writing socket
                immediately so that the tar process finishes too. *)

lib/docker_sandbox.ml

@@ -155,9 +155,6 @@ let run ~cancelled ?stdin ~log t config (id:S.id) =
   if Lwt.is_sleeping cancelled then (r :> (unit, [`Msg of string | `Cancelled]) result)
   else Error `Cancelled
 
-let tar_in ~cancelled ?stdin ~log t config result_tmp =
-  run ~cancelled ?stdin ~log t config result_tmp
-
 (* Duplicate of Build.hostname. *)
 let hostname = "builder"
 

lib/qemu_sandbox.ml

@@ -83,6 +83,7 @@ let run ~cancelled ?stdin ~log t config result_tmp =
   | "cmd" :: "/S" :: "/C" :: tl
   | "/usr/bin/env" :: "bash" :: "-c" :: tl -> tl
   | "/bin/sh" :: "-c" :: tl -> tl
+  | "tar" :: "-xf" :: "-" :: _ -> ["/cygdrive/c/Windows/System32/tar.exe"; "-xvf"; "-"; "-C"; config.Config.cwd]
   | x -> x in
   let _, proc2 = Os.open_process ~env ?stdin ~stdout ~stderr ~pp (ssh @ sendenv @ ["cd"; config.Config.cwd; "&&"] @ cmd) in
   Lwt.on_termination cancelled (fun () ->
@@ -114,20 +115,6 @@ let run ~cancelled ?stdin ~log t config result_tmp =
   if Lwt.is_sleeping cancelled then Lwt.return (res :> (unit, [`Msg of string | `Cancelled]) result)
   else Lwt_result.fail `Cancelled
 
-let tar_in ~cancelled ?stdin ~log:_ _ config result_tmp =
-  let proc =
-    let cmd = ["guestfish";
-               "add-drive"; result_tmp / "rootfs" / "image.qcow2"; ":";
-               "run"; ":";
-               "mount"; "/dev/sda2"; "/"; ":";
-               "tar-in"; "-"; config.Config.cwd; ] in
-    let stdin = Option.map (fun x -> `FD_move_safely x) stdin in
-    let pp f = Os.pp_cmd f ("", config.Config.argv) in
-    Os.sudo_result ?stdin ~pp cmd in
-  proc >>= fun r ->
-  if Lwt.is_sleeping cancelled then Lwt.return (r :> (unit, [`Msg of string | `Cancelled]) result)
-  else Lwt_result.fail `Cancelled
-
 let create (c : config) =
   let t = { qemu_cpus = c.cpus; qemu_memory = c.memory; qemu_network = c.network } in
   Lwt.return t

lib/s.ml

@@ -89,21 +89,6 @@ module type SANDBOX = sig
       @param log Used for child's stdout and stderr.
   *)
 
-  val tar_in :
-    cancelled:unit Lwt.t ->
-    ?stdin:Os.unix_fd ->
-    log:Build_log.t ->
-    t ->
-    Config.t ->
-    string ->
-    (unit, [`Cancelled | `Msg of string]) Lwt_result.t
-  (** [run ~cancelled t config dir] runs the operation [config] in a sandbox with root
-      filesystem [dir].
-      @param cancelled Resolving this kills the process (and returns [`Cancelled]).
-      @param stdin Passed to child as its standard input.
-      @param log Used for child's stdout and stderr.
-  *)
-
   val finished : unit -> unit Lwt.t
 end
 

lib/sandbox.jail.ml

@@ -159,9 +159,6 @@ let run ~cancelled ?stdin:stdin ~log (t : t) config rootdir =
   else
     Lwt_result.fail `Cancelled
 
-let tar_in ~cancelled ?stdin:stdin ~log (t : t) config rootdir =
-  run ~cancelled ?stdin ~log t config rootdir
-
 let create ~state_dir:_ _c =
   Lwt.return {
     (* Compute a unique (across obuilder instances) name prefix for the jail. *)

lib/sandbox.macos.ml

@@ -101,9 +101,6 @@ let run ~cancelled ?stdin:stdin ~log (t : t) config result_tmp =
       Lwt.return (r :> (unit, [`Msg of string | `Cancelled]) result)
     else Lwt_result.fail `Cancelled)
 
-let tar_in ~cancelled ?stdin:stdin ~log (t : t) config result_tmp =
-  run ~cancelled ?stdin ~log t config result_tmp
-
 let create ~state_dir:_ c =
   Lwt.return {
     uid = c.uid;

lib/sandbox.runc.ml

@@ -318,9 +318,6 @@ let run ~cancelled ?stdin:stdin ~log t config results_dir =
   if Lwt.is_sleeping cancelled then Lwt.return (r :> (unit, [`Msg of string | `Cancelled]) result)
   else Lwt_result.fail `Cancelled
 
-let tar_in ~cancelled ?stdin ~log t config result_tmp =
-  run ~cancelled ?stdin ~log t config result_tmp
-
 let clean_runc dir =
   Sys.readdir dir
   |> Array.to_list

test/mock_sandbox.ml

@@ -21,9 +21,6 @@ let run ~cancelled ?stdin ~log t (config:Obuilder.Config.t) dir =
         | ex -> Lwt_result.fail (`Msg (Printexc.to_string ex))
       )
 
-let tar_in ~cancelled ?stdin ~log t config result_tmp =
-  run ~cancelled ?stdin ~log t config result_tmp
-
 let create () = { expect = Queue.create () }
 
 let finished () = Lwt.return ()