use extra disks for cache rather than pscp

doc/qemu.md

@@ -54,23 +54,26 @@ obuilder: [INFO] Exec "mv" "/var/lib/docker/test/result-tmp/dce4336e183de81da753
 
 Moving on to the next stage in the build which is the `run` directive.
 First, `qemu-img` creates a snapshot of the current `result` layer into
-`result-tmp`.  Then `qemu-system-x86_64` is started with this snapshot as
-the base image.  `ssh` is used to poll the machine until it is available.
-Next, `scp` runs to copy the cache `opam-archives` over to the target
-directory `/Users/opam/AppData/Local/opam/download-cache`.  Finally,
-the actual commands are sent over `ssh` to install `tar`.  The step
-completes with an `scp` of the cache back to the host followed by an
-ACPI shutdown command sent to the qemu console.
+`result-tmp`.  Then any cache volumes are copied and `qemu-system-x86_64`
+is started with this snapshot as the base image and the cache volumes
+available as extra disks.  `ssh` is used to poll the machine until it is
+available.  Next, `ssh` commands are executed to create a NTFS junction
+point on the directory `c:\Users\opam\AppData\Local\opam\download-cache`.
+Finally, the actual commands are sent over `ssh` to install `tar`.
+The step completes with an `scp` of the cache back to the host followed
+by an ACPI shutdown command sent to the qemu console.
 
 ```
-/: (run (cache (opam-archives (target /Users/opam/AppData/Local/opam/download-cache)))
+/: (run (cache (opam-archives (target "C:\\Users\\opam\\AppData\\Local\\opam\\download-cache")))
         (shell "opam install tar"))
-obuilder: [INFO] Exec "qemu-img" "create" "-f" "qcow2" "-b" "/var/lib/docker/test/result/dce4336e183de81da7537728ed710f2906e9f75431694d9de80b95a9d9ff1101/rootfs/image.qcow2" "-F" "qcow2" "/var/lib/docker/test/result-tmp/8a897f21e54db877fc971c757ef7ffc2e1293e191dc60c3a18f24f0d3f0926f3/rootfs/image.qcow2" "40G"
-obuilder: [INFO] Exec "cp" "-pRduT" "--reflink=auto" "/var/lib/docker/test/cache/c-opam-archives" "/var/lib/docker/test/cache-tmp/0-c-opam-archives"
-obuilder: [INFO] Fork exec "qemu-system-x86_64" "-m" "16G" "-smp" "8" "-machine" "accel=kvm,type=q35" "-cpu" "host" "-nic" "user,hostfwd=tcp::34649-:22" "-display" "none" "-monitor" "stdio" "-drive" "file=/var/lib/docker/test/result-tmp/8a897f21e54db877fc971c757ef7ffc2e1293e191dc60c3a18f24f0d3f0926f3/rootfs/image.qcow2,format=qcow2"
-obuilder: [INFO] Exec "ssh" "opam@localhost" "-p" "34649" "-o" "BatchMode=yes" "-o" "NoHostAuthenticationForLocalhost=yes" "exit"
-obuilder: [INFO] Exec "scp" "-P" "34649" "-o" "NoHostAuthenticationForLocalhost=yes" "-prq" "/var/lib/docker/test/cache-tmp/0-c-opam-archives/md5" "/var/lib/docker/test/cache-tmp/0-c-opam-archives/sha512" "/var/lib/docker/test/cache-tmp/0-c-opam-archives/sha256" "opam@localhost:/Users/opam/AppData/Local/opam/download-cache"
-obuilder: [INFO] Fork exec "ssh" "opam@localhost" "-p" "34649" "-o" "NoHostAuthenticationForLocalhost=yes" "cd" "/" "&&" "opam install tar"
+obuilder: [INFO] Exec "qemu-img" "create" "-f" "qcow2" "-b" "/var/cache/obuilder/test/result/dce4336e183de81da7537728ed710f2906e9f75431694d9de80b95a9d9ff1101/rootfs/image.qcow2" "-F" "qcow2" "/var/cache/obuilder/test/result-tmp/8a897f21e54db877fc971c757ef7ffc2e1293e191dc60c3a18f24f0d3f0926f3/rootfs/image.qcow2" "40G"
+obuilder: [INFO] Exec "cp" "-pRduT" "--reflink=auto" "/var/cache/obuilder/test/cache/c-opam-archives" "/var/cache/obuilder/test/cache-tmp/0-c-opam-archives"
+obuilder: [INFO] Fork exec "qemu-system-x86_64" "-m" "16G" "-smp" "8" "-machine" "accel=kvm,type=q35" "-cpu" "host" "-nic" "user,hostfwd=tcp::56229-:22" "-display" "none" "-monitor" "stdio" "-drive" "file=/var/cache/obuilder/test/result-tmp/8a897f21e54db877fc971c757ef7ffc2e1293e191dc60c3a18f24f0d3f0926f3/rootfs/image.qcow2,format=qcow2" "-drive" "file=/var/cache/obuilder/test/cache-tmp/0-c-opam-archives/rootfs/image.qcow2,format=qcow2"
+obuilder: [INFO] Exec "ssh" "opam@localhost" "-p" "56229" "-o" "NoHostAuthenticationForLocalhost=yes" "exit"
+obuilder: [INFO] Exec "ssh" "opam@localhost" "-p" "56229" "-o" "NoHostAuthenticationForLocalhost=yes" "cmd" "/c" "rmdir /s /q 'C:\Users\opam\AppData\Local\opam\download-cache'"
+obuilder: [INFO] Exec "ssh" "opam@localhost" "-p" "56229" "-o" "NoHostAuthenticationForLocalhost=yes" "cmd" "/c" "mklink /j 'C:\Users\opam\AppData\Local\opam\download-cache' 'd:\'"
+Junction created for C:\Users\opam\AppData\Local\opam\download-cache <<===>> d:\
+obuilder: [INFO] Fork exec "ssh" "opam@localhost" "-p" "56229" "-o" "NoHostAuthenticationForLocalhost=yes" "cd" "/" "&&" "opam install tar"
 The following actions will be performed:
 === install 8 packages
   - install checkseum         0.5.2  [required by decompress]
@@ -100,11 +103,9 @@ The following actions will be performed:
 -> installed tar.3.1.2
 Done.
 # Run eval $(opam env) to update the current shell environment
-obuilder: [INFO] Exec "scp" "-P" "34649" "-o" "NoHostAuthenticationForLocalhost=yes" "-prq" "opam@localhost:/Users/opam/AppData/Local/opam/download-cache/*" "/var/lib/docker/test/cache-tmp/0-c-opam-archives"
-obuilder: [INFO] Sending QEMU an ACPI shutdown event
-obuilder: [INFO] Exec "cp" "-pRduT" "--reflink=auto" "/var/lib/docker/test/cache-tmp/0-c-opam-archives" "/var/lib/docker/test/cache/c-opam-archives"
-obuilder: [INFO] Exec "rm" "-r" "/var/lib/docker/test/cache-tmp/0-c-opam-archives"
-obuilder: [INFO] Exec "mv" "/var/lib/docker/test/result-tmp/8a897f21e54db877fc971c757ef7ffc2e1293e191dc60c3a18f24f0d3f0926f3" "/var/lib/docker/test/result/8a897f21e54db877fc971c757ef7ffc2e1293e191dc60c3a18f24f0d3f0926f3"
+obuilder: [INFO] Exec "cp" "-pRduT" "--reflink=auto" "/var/cache/obuilder/test/cache-tmp/0-c-opam-archives" "/var/cache/obuilder/test/cache/c-opam-archives"
+obuilder: [INFO] Exec "rm" "-r" "/var/cache/obuilder/test/cache-tmp/0-c-opam-archives"
+obuilder: [INFO] Exec "mv" "/var/cache/obuilder/test/result-tmp/8a897f21e54db877fc971c757ef7ffc2e1293e191dc60c3a18f24f0d3f0926f3" "/var/cache/obuilder/test/result/8a897f21e54db877fc971c757ef7ffc2e1293e191dc60c3a18f24f0d3f0926f3"
 ---> saved as "8a897f21e54db877fc971c757ef7ffc2e1293e191dc60c3a18f24f0d3f0926f3"
 Got: "8a897f21e54db877fc971c757ef7ffc2e1293e191dc60c3a18f24f0d3f0926f3"
 ```

lib/qemu_sandbox.ml

@@ -36,6 +36,10 @@ let get_free_port () =
 let run ~cancelled ?stdin ~log t config result_tmp =
   let pp f = Os.pp_cmd f ("", config.Config.argv) in
 
+  let extra_mounts = List.map (fun { Config.Mount.src; _ } ->
+    ["-drive"; "file=" ^ src / "rootfs" / "image.qcow2" ^ ",format=qcow2"]
+  ) config.Config.mounts |> List.flatten in
+
   Os.with_pipe_to_child @@ fun ~r:qemu_r ~w:qemu_w ->
   let qemu_stdin = `FD_move_safely qemu_r in
   let qemu_monitor = Lwt_io.(of_fd ~mode:output) qemu_w in
@@ -48,23 +52,25 @@ let run ~cancelled ?stdin ~log t config result_tmp =
               "-nic"; "user,hostfwd=tcp::" ^ port ^ "-:22";
               "-display"; "none";
               "-monitor"; "stdio";
-              "-drive"; "file=" ^ result_tmp / "rootfs" / "image.qcow2" ^ ",format=qcow2" ] in
+              "-drive"; "file=" ^ result_tmp / "rootfs" / "image.qcow2" ^ ",format=qcow2" ]
+              @ extra_mounts in
   let _, proc = Os.open_process ~stdin:qemu_stdin ~stdout:`Dev_null ~pp cmd in
 
+  let ssh = ["ssh"; "opam@localhost"; "-p"; port; "-o"; "NoHostAuthenticationForLocalhost=yes"] in
+
   let rec loop = function
     | 0 -> Lwt_result.fail (`Msg "No connection")
     | n ->
-      Os.exec_result ~pp ["ssh"; "opam@localhost"; "-p"; port; "-o"; "BatchMode=yes"; "-o"; "NoHostAuthenticationForLocalhost=yes"; "exit"] >>= function
+      Os.exec_result ~pp (ssh @ ["exit"]) >>= function
       | Ok _ -> Lwt_result.ok (Lwt.return ())
-      | _ -> Lwt_unix.sleep 2. >>= fun _ -> loop (n - 1) in
-  Lwt_unix.sleep 2. >>= fun _ ->
+      | _ -> Lwt_unix.sleep 1. >>= fun _ -> loop (n - 1) in
+  Lwt_unix.sleep 5. >>= fun _ ->
   loop 30 >>= fun _ ->
 
-  Lwt_list.iter_s (fun { Config.Mount.src; dst; _ } ->
-    let folders = Sys.readdir src |> Array.to_list |> List.map (fun f -> src / f) in
-    if List.length folders > 0 then
-      Os.exec (["scp"; "-P"; port; "-o"; "NoHostAuthenticationForLocalhost=yes"; "-prq"] @ folders @ ["opam@localhost:" ^ dst ])
-    else Lwt.return ()) config.Config.mounts >>= fun () ->
+  Lwt_list.iteri_s (fun i { Config.Mount.dst; _ } ->
+    Os.exec (ssh @ ["cmd"; "/c"; "rmdir /s /q '" ^ dst ^ "'"]) >>= fun () ->
+    let drive_letter = String.init 1 (fun _ -> Char.chr (Char.code 'd' + i)) in
+    Os.exec (ssh @ ["cmd"; "/c"; "mklink /j '" ^ dst ^ "' '" ^ drive_letter ^ ":\\'"])) config.Config.mounts >>= fun () ->
 
   Os.with_pipe_from_child @@ fun ~r:out_r ~w:out_w ->
   let stdin = Option.map (fun x -> `FD_move_safely x) stdin in
@@ -78,7 +84,7 @@ let run ~cancelled ?stdin ~log t config result_tmp =
   | "/usr/bin/env" :: "bash" :: "-c" :: tl -> tl
   | "/bin/sh" :: "-c" :: tl -> tl
   | x -> x in
-  let _, proc2 = Os.open_process ~env ?stdin ~stdout ~stderr ~pp (["ssh"; "opam@localhost"; "-p"; port; "-o"; "NoHostAuthenticationForLocalhost=yes"] @ sendenv @ ["cd"; config.Config.cwd; "&&"] @ cmd) in
+  let _, proc2 = Os.open_process ~env ?stdin ~stdout ~stderr ~pp (ssh @ sendenv @ ["cd"; config.Config.cwd; "&&"] @ cmd) in
   Lwt.on_termination cancelled (fun () ->
     let aux () =
       if Lwt.is_sleeping proc then
@@ -90,9 +96,6 @@ let run ~cancelled ?stdin ~log t config result_tmp =
   Os.process_result ~pp proc2 >>= fun res ->
   copy_log >>= fun () ->
 
-  Lwt_list.iter_s (fun { Config.Mount.src; dst; _ } ->
-    Os.exec ["scp"; "-P"; port; "-o"; "NoHostAuthenticationForLocalhost=yes"; "-prq"; "opam@localhost:" ^ dst ^ "/*"; src ]) config.Config.mounts >>= fun () ->
-
   Log.info (fun f -> f "Sending QEMU an ACPI shutdown event");
   Lwt_io.write qemu_monitor "system_powerdown\n" >>= fun () ->
   let rec loop = function

lib/qemu_store.ml

@@ -139,9 +139,14 @@ let cache ~user:_ t name : (string * (unit -> unit Lwt.t)) Lwt.t =
   Os.cp ~src:master tmp >>= fun () ->
   let release () =
     Lwt_mutex.with_lock cache.lock @@ fun () ->
-      cache.children <- cache.children - 1;
-      Os.cp ~src:tmp master >>= fun () ->
-      Os.rm ~directory:tmp
+    cache.children <- cache.children - 1;
+    let cache_stat = Unix.stat master in
+    let tmp_stat = Unix.stat tmp in
+    (if tmp_stat.st_size > cache_stat.st_size then
+      Os.cp ~src:tmp master
+    else
+      Lwt.return ()) >>= fun () ->
+    Os.rm ~directory:tmp
   in
   Lwt.return (tmp, release)