use tar and extend the block device

mirage/config.ml

@@ -57,8 +57,9 @@ let mirror =
       package ~min:"3.7.0" "git-paf" ;
       package "opam-file-format" ;
       package ~min:"2.1.0" ~sublibs:[ "gz" ] "tar" ;
+      package "tar-mirage" ;
     ]
-    (kv_ro @-> time @-> pclock @-> stackv4v6 @-> git_client @-> http_client @-> job)
+    (block @-> time @-> pclock @-> stackv4v6 @-> git_client @-> http_client @-> job)
 
 let stack = generic_stackv4v6 default_network
 
@@ -89,6 +90,8 @@ let program_block_size =
   let doc = Key.Arg.info [ "program-block-size" ] in
   Key.(create "program_block_size" Arg.(opt int 16 doc))
 
+let block = block_of_file "tar"
+
 (*
 let kv_rw =
   let block = block_of_file "db" in
@@ -97,9 +100,11 @@ let kv_rw =
 
 (* let kv_rw = direct_kv_rw "/tmp/mirror" *)
 
+(*
 let kv_ro =
   let block = block_of_file "tar" in
   archive block
+*)
 
 let () = register "mirror"
-    [ mirror $ kv_ro $ default_time $ default_posix_clock $ stack $ git_client $ http_client ]
+    [ mirror $ block $ default_time $ default_posix_clock $ stack $ git_client $ http_client ]

mirage/http_mirage_client.ml

@@ -129,7 +129,6 @@ let prepare_http_1_1_headers headers host user_pass body_length =
   add_authentication ~add headers user_pass
 
 let single_http_1_1_request ~sleep ?config flow user_pass host meth path headers body =
-  Logs.info (fun m -> m "http 1.1 request %s path %s" host path);
   let body_length = Option.map String.length body in
   let headers = prepare_http_1_1_headers headers host user_pass body_length in
   let req = Httpaf.Request.create ~headers meth path in
@@ -167,9 +166,7 @@ let single_http_1_1_request ~sleep ?config flow user_pass host meth path headers
   Lwt.async (fun () -> Paf.run (module HTTP_1_1) ~sleep conn flow) ;
   Option.iter (Httpaf.Body.write_string request_body) body ;
   Httpaf.Body.close_writer request_body ;
-  finished >|= fun r ->
+  finished
-  Logs.info (fun m -> m "http 1.1 request %s path %s finished" host path);
-  r
 
 let prepare_h2_headers headers host user_pass body_length =
   let headers = H2.Headers.of_list headers in
@@ -179,7 +176,6 @@ let prepare_h2_headers headers host user_pass body_length =
   add_authentication ~add headers user_pass
 
 let single_h2_request ~sleep ?config ~scheme flow user_pass host meth path headers body =
-  Logs.info (fun m -> m "http2 request %s path %s" host path);
   let body_length = Option.map String.length body in
   let headers = prepare_h2_headers headers host user_pass body_length in
   let req = H2.Request.create ~scheme ~headers meth path in
@@ -225,7 +221,6 @@ let single_h2_request ~sleep ?config ~scheme flow user_pass host meth path heade
   H2.Body.Writer.close request_body ;
   finished >|= fun v ->
   H2.Client_connection.shutdown conn ;
-  Logs.info (fun m -> m "http2 request %s path %s finished" host path);
   v
 
 let decode_uri ~ctx uri =

mirage/unikernel.ml

@@ -3,13 +3,15 @@ open Lwt.Infix
 let argument_error = 64
 
 module Make
-  (KV : Mirage_kv.RO)
+  (BLOCK : Mirage_block.S)
   (Time : Mirage_time.S)
   (Pclock : Mirage_clock.PCLOCK)
   (Stack : Tcpip.Stack.V4V6)
   (_ : sig end)
   (HTTP : Http_mirage_client.S) = struct
 
+  module KV = Tar_mirage.Make_KV_RW(BLOCK)
+
   module Store = Irmin_mirage_git.Mem.KV.Make(Irmin.Contents.String)
   module Sync = Irmin.Sync.Make(Store)
 
@@ -311,9 +313,7 @@ module Make
               false
             end) hm
       then begin
-        Logs.warn (fun m -> m "should set %s" (key_to_string t sha256));
+        KV.set t.dev (Mirage_kv.Key.v sha256) data >|= function
-        Lwt.return_unit
-        (* KV.set t.dev (Mirage_kv.Key.v sha256) data >|= function
         | Ok () ->
           t.md5s <- SM.add md5 sha256 t.md5s;
           t.sha512s <- SM.add sha512 sha256 t.sha512s;
@@ -321,7 +321,7 @@ module Make
                         (String.length data))
         | Error e ->
           Logs.err (fun m -> m "error %a while writing %s (key %s)"
-                       KV.pp_write_error e url (key_to_string t sha256)) *)
+                       KV.pp_write_error e url (key_to_string t sha256))
       end else
         Lwt.return_unit
 
@@ -656,7 +656,7 @@ stamp: %S
           Logs.debug (fun m -> m "ignoring %s (already present)" url);
           Lwt.return_unit
         | false ->
-          Logs.debug (fun m -> m "downloading %s" url);
+          Logs.info (fun m -> m "downloading %s" url);
           Http_mirage_client.one_request
             ~alpn_protocol:HTTP.alpn_protocol
             ~authenticator:HTTP.authenticator
@@ -676,7 +676,8 @@ stamp: %S
 
   module Paf = Paf_mirage.Make(Time)(Stack.TCP)
 
-  let start kv _time _pclock stack git_ctx http_ctx =
+  let start block _time _pclock stack git_ctx http_ctx =
+    KV.connect block >>= fun kv ->
     let key_hex = Key_gen.key_hex () in
     Disk.init ~key_hex kv >>= fun disk ->
     if Key_gen.check () then Lwt.return_unit