robur/opam-mirror
4
0
Fork 0
Code Issues 6 Pull requests 2 Projects Releases Packages Wiki Activity Actions

update to mirage 4.8 #4

Merged
hannes merged 1 commit from mirage-48 into main 2024-10-16 08:40:11 +00:00
Conversation 1 Commits 1 Files changed 2 +36 -91
2 changed files with 36 additions and 91 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
mirage/config.ml
View file

@ -1,35 +1,8 @@
(* mirage >= 4.8.0 & < 4.9.0 *)
open Mirage 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)|}
dinosaure commented 2024-10-15 09:15:28 +00:00
Review
Copy link

How you can pass ssh-key and ssh-password then to the unikernel? I actually needs git_ssh for my usage.

How you can pass `ssh-key` and `ssh-password` then to the unikernel? I actually needs `git_ssh` for my usage.
hannes commented 2024-10-15 10:31:04 +00:00
Review
Copy link

In general, you don't and shouldn't ;) the command line arguments are private to the ssh/git device -- why would you need them elsewhere?

As a hack, you can inspect the value of Mirage_runtime.runtime_args () and take a look inside. But I really encourage that we disentangle / find a path on how you don't need to have ssh-key and ssh-password in your unikernel.

Another option is to have functions providing these values in the Git_mirage.

In general, you don't and shouldn't ;) the command line arguments are private to the ssh/git device -- why would you need them elsewhere? As a hack, you can inspect the value of `Mirage_runtime.runtime_args ()` and take a look inside. But I really encourage that we disentangle / find a path on how you don't need to have `ssh-key` and `ssh-password` in your unikernel. Another option is to have functions providing these values in the Git_mirage.
dinosaure commented 2024-10-15 11:54:13 +00:00
Review
Copy link

Hmmhmm, I need to test the unikernel if I'm still able to synchronize the repo from a Git repository via SSH. As far as I understand, I should be able to do that.

Hmmhmm, I need to test the unikernel if I'm still able to synchronize the repo from a Git repository via SSH. As far as I understand, I should be able to do that.
hannes commented 2024-10-15 13:08:42 +00:00
Review
Copy link

Maybe not the best thing right now (let's fix that), but we have:

NETWORK OPTIONS
...
       --ssh-authenticator=SSH-AUTHENTICATOR
           SSH authenticator.

       --ssh-key=KEY
           Private SSH key (rsa:<seed> or ed25519:<b64-key>).

       --ssh-password=PASSWORD
           Private SSH password.

       --tls-authenticator=TLS-AUTHENTICATOR
           TLS authenticator.

We may move the DNS into a custom section, the HE into a custom section, and also the higher level (SSH/TLS/GIT) options into a custom section, and leave NETWORK for everything up to IPv4/IPv6.

Maybe not the best thing right now (let's fix that), but we have: ``` NETWORK OPTIONS ... --ssh-authenticator=SSH-AUTHENTICATOR SSH authenticator. --ssh-key=KEY Private SSH key (rsa:<seed> or ed25519:<b64-key>). --ssh-password=PASSWORD Private SSH password. --tls-authenticator=TLS-AUTHENTICATOR TLS authenticator. ``` We may move the DNS into a custom section, the HE into a custom section, and also the higher level (SSH/TLS/GIT) options into a custom section, and leave NETWORK for everything up to IPv4/IPv6.
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 = let mirror =
main "Unikernel.Make" main "Unikernel.Make"
~runtime_args:[ setup ]
~packages:[ ~packages:[
package ~min:"0.3.0" ~sublibs:[ "mirage" ] "paf" ; package ~min:"0.3.0" ~sublibs:[ "mirage" ] "paf" ;
package "h2" ; package "h2" ;
@ -54,9 +27,9 @@ let block = block_of_file "tar"
let git_client, alpn_client = let git_client, alpn_client =
let git = mimic_happy_eyeballs stack he dns in let git = mimic_happy_eyeballs stack he dns in
merge_git_clients (git_ssh ~key:ssh_key ~authenticator:ssh_authenticator ~password:ssh_password tcp git) merge_git_clients (git_ssh tcp git)
(merge_git_clients (git_tcp tcp git) (merge_git_clients (git_tcp tcp git)
(git_http ~authenticator:tls_authenticator tcp git)), (git_http tcp git)),
paf_client tcp (mimic_happy_eyeballs stack he dns) paf_client tcp (mimic_happy_eyeballs stack he dns)
let () = register "mirror" let () = register "mirror"

76
mirage/unikernel.ml
View file

@ -7,7 +7,7 @@ module K = struct
let check = let check =
let doc = Arg.info ~doc:"Only check the cache" ["check"] in let doc = Arg.info ~doc:"Only check the cache" ["check"] in
Arg.(value & flag doc) Mirage_runtime.register_arg Arg.(value & flag doc)
let verify_sha256 = let verify_sha256 =
let doc = Arg.info let doc = Arg.info
@ -15,7 +15,7 @@ module K = struct
re-build the other checksum caches." re-build the other checksum caches."
["verify-sha256"] ["verify-sha256"]
in in
Arg.(value & flag doc) Mirage_runtime.register_arg Arg.(value & flag doc)
let remote = let remote =
let doc = Arg.info let doc = Arg.info
@ -23,67 +23,40 @@ module K = struct
https://github.com/ocaml/opam-repository.git" https://github.com/ocaml/opam-repository.git"
["remote"] ["remote"]
in in
Arg.(value & opt string "https://github.com/ocaml/opam-repository.git#master" doc) Mirage_runtime.register_arg
Arg.(value & opt string "https://github.com/ocaml/opam-repository.git#master" doc)
let parallel_downloads = let parallel_downloads =
let doc = Arg.info let doc = Arg.info
~doc:"Amount of parallel HTTP downloads" ~doc:"Amount of parallel HTTP downloads"
["parallel-downloads"] ["parallel-downloads"]
in in
Arg.(value & opt int 20 doc) Mirage_runtime.register_arg Arg.(value & opt int 20 doc)
let hook_url = let hook_url =
let doc = Arg.info let doc = Arg.info
~doc:"URL to conduct an update of the git repository" ["hook-url"] ~doc:"URL to conduct an update of the git repository" ["hook-url"]
in in
Arg.(value & opt string "update" doc) Mirage_runtime.register_arg Arg.(value & opt string "update" doc)
let port = let port =
let doc = Arg.info ~doc:"HTTP listen port." ["port"] in let doc = Arg.info ~doc:"HTTP listen port." ["port"] in
Arg.(value & opt int 80 doc) Mirage_runtime.register_arg Arg.(value & opt int 80 doc)
let sectors_cache = let sectors_cache =
let doc = "Number of sectors reserved for each checksum cache (md5, sha512)." in let doc = "Number of sectors reserved for each checksum cache (md5, sha512)." in
let doc = Arg.info ~doc ["sectors-cache"] in let doc = Arg.info ~doc ["sectors-cache"] in
Arg.(value & opt int64 Int64.(mul 4L 2048L) doc) Mirage_runtime.register_arg Arg.(value & opt int64 Int64.(mul 4L 2048L) doc)
let sectors_git = let sectors_git =
let doc = "Number of sectors reserved for git dump." in let doc = "Number of sectors reserved for git dump." in
let doc = Arg.info ~doc ["sectors-git"] in let doc = Arg.info ~doc ["sectors-git"] in
Arg.(value & opt int64 Int64.(mul 40L (mul 2L 1024L)) doc) Mirage_runtime.register_arg Arg.(value & opt int64 Int64.(mul 40L (mul 2L 1024L)) doc)
let ignore_local_git = let ignore_local_git =
let doc = "Ignore restoring locally saved git repository." in let doc = "Ignore restoring locally saved git repository." in
let doc = Arg.info ~doc ["ignore-local-git"] in let doc = Arg.info ~doc ["ignore-local-git"] in
Arg.(value & flag doc) Mirage_runtime.register_arg 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
; ignore_local_git : bool }
let v check verify_sha256 remote parallel_downloads hook_url port
sectors_cache sectors_git ignore_local_git =
{ check; verify_sha256; remote; parallel_downloads; hook_url; port
; sectors_cache; sectors_git; ignore_local_git }
let setup =
Term.(const v
$ check
$ verify_sha256
$ remote
$ parallel_downloads
$ hook_url
$ port
$ sectors_cache
$ sectors_git
$ ignore_local_git)
end end
module Make module Make
@ -1011,29 +984,28 @@ stamp: %S
module Paf = Paf_mirage.Make(Stack.TCP) module Paf = Paf_mirage.Make(Stack.TCP)
let start block _time _pclock stack git_ctx http_ctx let start block _time _pclock stack git_ctx http_ctx =
{ K.check; verify_sha256; remote; parallel_downloads; hook_url
; port; sectors_cache; sectors_git; ignore_local_git } =
BLOCK.get_info block >>= fun info -> BLOCK.get_info block >>= fun info ->
let git_start = let git_start =
let cache_size = Int64.(mul 2L sectors_cache) in let cache_size = Int64.(mul 2L (K.sectors_cache ())) in
Int64.(sub info.size_sectors (add cache_size sectors_git)) Int64.(sub info.size_sectors (add cache_size (K.sectors_git ())))
in in
Part.connect git_start block >>= fun (kv, rest) -> Part.connect git_start block >>= fun (kv, rest) ->
let git_dump, rest = Part.subpartition sectors_git rest in let git_dump, rest = Part.subpartition (K.sectors_git ()) rest in
let md5s, sha512s = Part.subpartition sectors_cache rest in let md5s, sha512s = Part.subpartition (K.sectors_cache ()) rest in
KV.connect kv >>= fun kv -> KV.connect kv >>= fun kv ->
Cache.connect md5s >>= fun md5s -> Cache.connect md5s >>= fun md5s ->
Cache.connect sha512s >>= fun sha512s -> Cache.connect sha512s >>= fun sha512s ->
Cache.connect git_dump >>= fun git_dump -> Cache.connect git_dump >>= fun git_dump ->
Logs.info (fun m -> m "Available bytes in tar storage: %Ld" (KV.free kv)); Logs.info (fun m -> m "Available bytes in tar storage: %Ld" (KV.free kv));
Disk.init ~verify_sha256 kv md5s sha512s >>= fun disk -> Disk.init ~verify_sha256:(K.verify_sha256 ()) kv md5s sha512s >>= fun disk ->
if check then let remote = K.remote () in
if K.check () then
Lwt.return_unit Lwt.return_unit
else else
begin begin
Logs.info (fun m -> m "Initializing git state. This may take a while..."); Logs.info (fun m -> m "Initializing git state. This may take a while...");
(if ignore_local_git then (if K.ignore_local_git () then
Lwt.return (Error ()) Lwt.return (Error ())
else else
restore_git ~remote git_dump git_ctx) >>= function restore_git ~remote git_dump git_ctx) >>= function
@ -1047,21 +1019,21 @@ stamp: %S
Serve.commit_id git_kv >>= fun commit_id -> Serve.commit_id git_kv >>= fun commit_id ->
Logs.info (fun m -> m "git: %s" commit_id); Logs.info (fun m -> m "git: %s" commit_id);
Serve.create remote git_kv >>= fun serve -> Serve.create remote git_kv >>= fun serve ->
Paf.init ~port (Stack.tcp stack) >>= fun t -> Paf.init ~port:(K.port ()) (Stack.tcp stack) >>= fun t ->
let update () = let update () =
Serve.update_git ~remote serve git_kv >>= function Serve.update_git ~remote serve git_kv >>= function
| None | Some [] -> Lwt.return_unit | None | Some [] -> Lwt.return_unit
| Some _changes -> | Some _changes ->
dump_git git_dump git_kv >>= fun () -> dump_git git_dump git_kv >>= fun () ->
download_archives parallel_downloads disk http_ctx git_kv download_archives (K.parallel_downloads ()) disk http_ctx git_kv
in in
let service = let service =
Paf.http_service Paf.http_service
~error_handler:(fun _ ?request:_ _ _ -> ()) ~error_handler:(fun _ ?request:_ _ _ -> ())
(Serve.dispatch serve disk hook_url update) (Serve.dispatch serve disk (K.hook_url ()) update)
in in
let `Initialized th = Paf.serve service t in let `Initialized th = Paf.serve service t in
Logs.info (fun f -> f "listening on %d/HTTP" port); Logs.info (fun f -> f "listening on %d/HTTP" (K.port ()));
Lwt.async (fun () -> Lwt.async (fun () ->
let rec go () = let rec go () =
Time.sleep_ns (Duration.of_hour 1) >>= fun () -> Time.sleep_ns (Duration.of_hour 1) >>= fun () ->
@ -1069,6 +1041,6 @@ stamp: %S
go () go ()
in in
go ()); go ());
download_archives parallel_downloads disk http_ctx git_kv >>= fun () -> download_archives (K.parallel_downloads ()) disk http_ctx git_kv >>= fun () ->
(th >|= fun _v -> ()) (th >|= fun _v -> ())
end end