Fix sector alignment bug in formatting

THIS DESTROYS DATA

mirage/config.ml

@@ -1,8 +1,35 @@
-(* mirage >= 4.8.0 & < 4.9.0 *)
 open Mirage
 
+let setup = runtime_arg ~pos:__POS__ "Unikernel.K.setup"
+
+let ssh_key =
+  Runtime_arg.create ~pos:__POS__
+    {|let open Cmdliner in
+      let doc = Arg.info ~doc:"The private SSH key (rsa:<seed> or ed25519:<b64-key>)." ["ssh-key"] in
+      Arg.(value & opt (some string) None doc)|}
+
+let ssh_authenticator =
+  Runtime_arg.create ~pos:__POS__
+    {|let open Cmdliner in
+      let doc = Arg.info ~doc:"SSH authenticator." ["ssh-auth"] in
+      Arg.(value & opt (some string) None doc)|}
+
+let ssh_password =
+  Runtime_arg.create ~pos:__POS__
+    {|let open Cmdliner in
+      let doc = Arg.info ~doc:"The private SSH password." [ "ssh-password" ] in
+      Arg.(value & opt (some string) None doc)|}
+
+let tls_authenticator =
+  Runtime_arg.create ~pos:__POS__
+    {|let open Cmdliner in
+      let doc = "TLS host authenticator. See git_http in lib/mirage/mirage.mli for a description of the format." in
+      let doc = Arg.info ~doc ["tls-authenticator"] in
+      Arg.(value & opt (some string) None doc)|}
+
 let mirror =
   main "Unikernel.Make"
+    ~runtime_args:[ setup ]
     ~packages:[
       package ~min:"0.3.0" ~sublibs:[ "mirage" ] "paf" ;
       package "h2" ;
@@ -29,9 +56,9 @@ let block = block_of_file "tar"
 
 let git_client, alpn_client =
   let git = mimic_happy_eyeballs stack he dns in
-  merge_git_clients (git_ssh tcp git)
+  merge_git_clients (git_ssh ~key:ssh_key ~authenticator:ssh_authenticator ~password:ssh_password tcp git)
     (merge_git_clients (git_tcp tcp git)
-      (git_http tcp git)),
+      (git_http ~authenticator:tls_authenticator tcp git)),
   paf_client tcp (mimic_happy_eyeballs stack he dns)
 
 let () = register "mirror"

mirage/unikernel.ml

@@ -7,7 +7,7 @@ module K = struct
 
   let check =
     let doc = Arg.info ~doc:"Only check the cache" ["check"] in
-    Mirage_runtime.register_arg Arg.(value & flag doc)
+    Arg.(value & flag doc)
   
   let verify_sha256 =
     let doc = Arg.info
@@ -15,7 +15,7 @@ module K = struct
             re-build the other checksum caches."
       ["verify-sha256"]
     in
-    Mirage_runtime.register_arg Arg.(value & flag doc)
+    Arg.(value & flag doc)
   
   let remote =
     let doc = Arg.info
@@ -23,7 +23,6 @@ module K = struct
             https://github.com/ocaml/opam-repository.git"
       ["remote"]
     in
-    Mirage_runtime.register_arg
     Arg.(value & opt string "https://github.com/ocaml/opam-repository.git#master" doc)
   
   let parallel_downloads =
@@ -31,37 +30,67 @@ module K = struct
         ~doc:"Amount of parallel HTTP downloads"
         ["parallel-downloads"]
     in
-    Mirage_runtime.register_arg Arg.(value & opt int 20 doc)
+    Arg.(value & opt int 20 doc)
   
   let hook_url =
     let doc = Arg.info
         ~doc:"URL to conduct an update of the git repository" ["hook-url"]
     in
-    Mirage_runtime.register_arg Arg.(value & opt string "update" doc)
+    Arg.(value & opt string "update" doc)
   
   let port =
     let doc = Arg.info ~doc:"HTTP listen port." ["port"] in
-    Mirage_runtime.register_arg Arg.(value & opt int 80 doc)
+    Arg.(value & opt int 80 doc)
   
   let sectors_cache =
     let doc = "Number of sectors reserved for each checksum cache (md5, sha512). Only used with --initialize-disk." in
     let doc = Arg.info ~doc ["sectors-cache"] in
-    Mirage_runtime.register_arg Arg.(value & opt int64 Int64.(mul 4L 2048L) doc)
+    Arg.(value & opt int64 Int64.(mul 4L 2048L) doc)
   
   let sectors_git =
     let doc = "Number of sectors reserved for git dump. Only used with --initialize-disk" in
     let doc = Arg.info ~doc ["sectors-git"] in
-    Mirage_runtime.register_arg Arg.(value & opt int64 Int64.(mul 40L (mul 2L 1024L)) doc)
+    Arg.(value & opt int64 Int64.(mul 40L (mul 2L 1024L)) doc)
 
   let initialize_disk =
     let doc = "Initialize the disk with a partition table. THIS IS DESTRUCTIVE!" in
     let doc = Arg.info ~doc ["initialize-disk"] in
-    Mirage_runtime.register_arg Arg.(value & flag doc)
+    Arg.(value & flag doc)
   
   let ignore_local_git =
     let doc = "Ignore restoring locally saved git repository." in
     let doc = Arg.info ~doc ["ignore-local-git"] in
-    Mirage_runtime.register_arg Arg.(value & flag doc)
+    Arg.(value & flag doc)
+
+  type t =
+    { check : bool
+    ; verify_sha256 : bool
+    ; remote : string
+    ; parallel_downloads : int
+    ; hook_url : string
+    ; port : int
+    ; sectors_cache : int64
+    ; sectors_git : int64
+    ; initialize_disk : bool
+    ; ignore_local_git : bool }
+
+  let v check verify_sha256 remote parallel_downloads hook_url port
+    sectors_cache sectors_git initialize_disk ignore_local_git =
+    { check; verify_sha256; remote; parallel_downloads; hook_url; port
+    ; sectors_cache; sectors_git; initialize_disk; ignore_local_git }
+
+  let setup =
+    Term.(const v
+          $ check
+          $ verify_sha256
+          $ remote
+          $ parallel_downloads
+          $ hook_url
+          $ port
+          $ sectors_cache
+          $ sectors_git
+          $ initialize_disk
+          $ ignore_local_git)
 end
 
 module Make
@@ -989,20 +1018,21 @@ stamp: %S
 
   module Paf = Paf_mirage.Make(Stack.TCP)
 
-  let start_mirror { Part.tar; git_dump; md5s; sha512s } stack git_ctx http_ctx =
+  let start_mirror { Part.tar; git_dump; md5s; sha512s } stack git_ctx http_ctx
+      check verify_sha256 remote parallel_downloads hook_url port
+      ignore_local_git =
     KV.connect tar >>= fun kv ->
     Cache.connect git_dump >>= fun git_dump ->
     Cache.connect md5s >>= fun md5s ->
     Cache.connect sha512s >>= fun sha512s ->
     Logs.info (fun m -> m "Available bytes in tar storage: %Ld" (KV.free kv));
-    Disk.init ~verify_sha256:(K.verify_sha256 ()) kv md5s sha512s >>= fun disk ->
-    let remote = K.remote () in
-    if K.check () then
+    Disk.init ~verify_sha256 kv md5s sha512s >>= fun disk ->
+    if check then
       Lwt.return_unit
     else
       begin
         Logs.info (fun m -> m "Initializing git state. This may take a while...");
-        (if K.ignore_local_git () then
+        (if ignore_local_git then
            Lwt.return (Error ())
          else
            restore_git ~remote git_dump git_ctx) >>= function
@@ -1016,21 +1046,21 @@ stamp: %S
       Serve.commit_id git_kv >>= fun commit_id ->
       Logs.info (fun m -> m "git: %s" commit_id);
       Serve.create remote git_kv >>= fun serve ->
-      Paf.init ~port:(K.port ()) (Stack.tcp stack) >>= fun t ->
+      Paf.init ~port (Stack.tcp stack) >>= fun t ->
       let update () =
         Serve.update_git ~remote serve git_kv >>= function
         | None | Some [] -> Lwt.return_unit
         | Some _changes ->
           dump_git git_dump git_kv >>= fun () ->
-          download_archives (K.parallel_downloads ()) disk http_ctx git_kv
+          download_archives parallel_downloads disk http_ctx git_kv
       in
       let service =
         Paf.http_service
           ~error_handler:(fun _ ?request:_ _ _ -> ())
-          (Serve.dispatch serve disk (K.hook_url ()) update)
+          (Serve.dispatch serve disk hook_url update)
       in
       let `Initialized th = Paf.serve service t in
-      Logs.info (fun f -> f "listening on %d/HTTP" (K.port ()));
+      Logs.info (fun f -> f "listening on %d/HTTP" port);
       Lwt.async (fun () ->
           let rec go () =
             Time.sleep_ns (Duration.of_hour 1) >>= fun () ->
@@ -1038,13 +1068,12 @@ stamp: %S
             go ()
           in
           go ());
-      download_archives (K.parallel_downloads ()) disk http_ctx git_kv >>= fun () ->
+      download_archives parallel_downloads disk http_ctx git_kv >>= fun () ->
       (th >|= fun _v -> ())
 
-  let start block _time _pclock stack git_ctx http_ctx =
-    let initialize_disk = K.initialize_disk ()
-    and sectors_cache = K.sectors_cache ()
-    and sectors_git = K.sectors_git () in
+  let start block _time _pclock stack git_ctx http_ctx
+    { K.check; verify_sha256; remote; parallel_downloads; hook_url
+    ; port; sectors_cache; sectors_git; initialize_disk; ignore_local_git } =
     if initialize_disk then
       Part.format block ~sectors_cache ~sectors_git >>= function
       | Ok () -> Lwt.return_unit
@@ -1056,5 +1085,6 @@ stamp: %S
         exit 2
     else
       Part.connect block >>= fun parts ->
-      start_mirror parts stack git_ctx http_ctx
+      start_mirror parts stack git_ctx http_ctx check verify_sha256 remote
+        parallel_downloads hook_url port ignore_local_git
 end