diff --git a/unikernel/relay/config.ml b/unikernel/relay/config.ml index 68f8ee5..82e145f 100644 --- a/unikernel/relay/config.ml +++ b/unikernel/relay/config.ml @@ -1,24 +1,7 @@ -open Mirage - -let ssh_key = - Runtime_arg.create ~pos:__POS__ - {|let open Cmdliner in - let doc = Arg.info ~doc:"The private SSH key (rsa: or ed25519:)." ["ssh-key"] in - Arg.(value & opt (some string) None doc)|} +(* mirage >= 4.8.0 & < 4.9.0 *) -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)|} +open Mirage -let nameservers = Runtime_arg.create ~pos:__POS__ "Unikernel.K.nameservers" let setup = runtime_arg ~pos:__POS__ "Unikernel.K.setup" let packages = @@ -39,11 +22,11 @@ let mclock = default_monotonic_clock let pclock = default_posix_clock let stack = generic_stackv4v6 default_network let he = generic_happy_eyeballs stack -let dns = generic_dns_client ~nameservers stack he +let dns = generic_dns_client stack he let tcp = tcpv4v6_of_stackv4v6 stack let git_client = let git = mimic_happy_eyeballs stack he dns in - git_ssh ~password:ssh_password ~key:ssh_key ~authenticator:ssh_authenticator tcp git + git_ssh tcp git let () = register "relay" diff --git a/unikernel/signer/config.ml b/unikernel/signer/config.ml index 1366e1e..db07847 100644 --- a/unikernel/signer/config.ml +++ b/unikernel/signer/config.ml @@ -1,9 +1,11 @@ +(* mirage >= 4.8.0 & < 4.9.0 *) + open Mirage (* NOTE(dinosaure): it's like a DNS client but it uses the primary DNS server to get the possible DKIM public key if it exists (like a client) or [nsupdate] the primary DNS server with what we got from the command-line. *) -let generic_dns_client timeout dns_server dns_port = +let generic_dns_client timeout = let open Functoria.DSL in let pp_label name ppf = function | None -> () @@ -17,7 +19,9 @@ let generic_dns_client timeout dns_server dns_port = | _, None -> (None, rest) | _ -> err () in let packages = [ package "dns-client-mirage" ~min:"9.0.0" ~max:"10.0.0" ] in - let runtime_args = [ Runtime_arg.v dns_server; Runtime_arg.v dns_port; ] in + let dns_server = Runtime_arg.create ~pos:__POS__ "Unikernel.K.dns_server" in + let dns_port = Runtime_arg.create ~pos:__POS__ "Unikernel.K.dns_port" in + let runtime_args = Runtime_arg.[ v dns_server; v dns_port; ] in let runtime_args = match timeout with | Some timeout -> runtime_args @ [ Runtime_arg.v timeout ] | None -> runtime_args in @@ -25,7 +29,7 @@ let generic_dns_client timeout dns_server dns_port = let nameserver = Fmt.str "[\"tcp:%s:%s\"]" dns_server dns_port in pp_label "nameservers" ppf (Some nameserver) in - let err () = connect_err "generic_dns_client" 6 ~max:9 in + let err () = connect_err "generic_dns_client" 6 in let connect _info modname = function | _random :: _time @@ -54,8 +58,8 @@ let generic_dns_client timeout dns_server dns_port = let generic_dns_client ?timeout ?(random = default_random) ?(time = default_time) ?(mclock = default_monotonic_clock) - ?(pclock = default_posix_clock) ~dns_server ~dns_port stackv4v6 happy_eyeballs = - generic_dns_client timeout dns_server dns_port + ?(pclock = default_posix_clock) stackv4v6 happy_eyeballs = + generic_dns_client timeout $ random $ time $ mclock @@ -63,8 +67,6 @@ let generic_dns_client ?timeout ?(random = default_random) $ stackv4v6 $ happy_eyeballs -let dns_server : Ipaddr.t Runtime_arg.arg = Runtime_arg.create ~pos:__POS__ "Unikernel.K.dns_server" -let dns_port : int Runtime_arg.arg = Runtime_arg.create ~pos:__POS__ "Unikernel.K.dns_port" let setup = runtime_arg ~pos:__POS__ "Unikernel.K.setup" let packages = @@ -90,7 +92,7 @@ let mclock = default_monotonic_clock let pclock = default_posix_clock let stack = generic_stackv4v6 default_network let he = generic_happy_eyeballs stack -let dns = generic_dns_client ~dns_server ~dns_port stack he +let dns = generic_dns_client stack he let () = register "signer" diff --git a/unikernel/signer/unikernel.ml b/unikernel/signer/unikernel.ml index b6cf31c..21e7179 100644 --- a/unikernel/signer/unikernel.ml +++ b/unikernel/signer/unikernel.ml @@ -37,7 +37,7 @@ module K = struct let destination = let doc = Arg.info ~doc:"Next SMTP server IP" [ "destination" ] in - Arg.(required & opt (some Mirage_runtime_network.Arg.ip_address) None doc) + Mirage_runtime.register_arg Arg.(required & opt (some Mirage_runtime_network.Arg.ip_address) None doc) let fields = let doc = Arg.info [ "fields" ] ~doc:"List of fields to sign" in @@ -67,7 +67,6 @@ module K = struct type t = { domain : [ `host ] Domain_name.t ; postmaster : Emile.mailbox - ; destination : Ipaddr.t ; dns_key : [ `raw ] Domain_name.t * Dns.Dnskey.t ; dns_server : Ipaddr.t ; dns_port : int @@ -77,15 +76,31 @@ module K = struct ; expiration : int64 option ; seed : string } - let v domain postmaster destination - dns_key dns_server dns_port - fields selector timestamp expiration seed = - { domain; postmaster; destination; dns_key; dns_server; dns_port; fields; selector; timestamp; expiration; seed } + let v domain postmaster dns_key dns_server dns_port fields selector timestamp expiration seed = + { domain + ; postmaster + ; dns_key + ; dns_server + ; dns_port + ; fields + ; selector + ; timestamp + ; expiration + ; seed } let setup = - Term.(const v $ domain $ postmaster $ destination - $ dns_key $ dns_server $ dns_port - $ fields $ selector $ timestamp $ expiration $ seed) + let open Term in + const v + $ domain + $ postmaster + $ dns_key + $ dns_server + $ dns_port + $ fields + $ selector + $ timestamp + $ expiration + $ seed end module Make @@ -158,8 +173,11 @@ module Make | Error _ -> assert false end @@ fun res -> Stack.TCP.close flow >>= fun () -> Lwt.return res + module Fake_dns = Ptt_fake_dns.Make (struct let ipaddr = K.destination () end) + module Nec = Nec.Make (Time) (Mclock) (Pclock) (Stack) (Fake_dns) (Happy_eyeballs) + let start _random _time _mclock _pclock stack dns he - ({ K.domain; postmaster; destination; dns_key; fields; selector; seed; timestamp; expiration; _ } as cfg) = + ({ K.domain; postmaster; dns_key; fields; selector; seed; timestamp; expiration; _ } as cfg) = let dkim = Dkim.v ~version:1 ?fields ~selector ~algorithm:`RSA @@ -176,8 +194,6 @@ module Make let ipaddr = List.hd (Stack.IP.configured_ips ip) in let ipaddr = Ipaddr.Prefix.address ipaddr in let locals = Ptt_map.empty ~postmaster in - let module Fake_dns = Ptt_fake_dns.Make (struct let ipaddr = destination end) in - let module Nec = Nec.Make (Time) (Mclock) (Pclock) (Stack) (Fake_dns) (Happy_eyeballs) in let info = { Ptt_common.domain= Colombe.Domain.Domain (Domain_name.to_strings domain) ; ipaddr diff --git a/unikernel/spamfilter/config.ml b/unikernel/spamfilter/config.ml index a885be6..94b811d 100644 --- a/unikernel/spamfilter/config.ml +++ b/unikernel/spamfilter/config.ml @@ -1,3 +1,5 @@ +(* mirage >= 4.8.0 & < 4.9.0 *) + open Mirage let setup = runtime_arg ~pos:__POS__ "Unikernel.K.setup" diff --git a/unikernel/spamfilter/unikernel.ml b/unikernel/spamfilter/unikernel.ml index 00e420e..ec5aa53 100644 --- a/unikernel/spamfilter/unikernel.ml +++ b/unikernel/spamfilter/unikernel.ml @@ -20,17 +20,16 @@ module K = struct let destination = let doc = Arg.info ~doc:"Next SMTP server IP" [ "destination" ] in - Arg.(required & opt (some Mirage_runtime_network.Arg.ip_address) None doc) + Mirage_runtime.register_arg Arg.(required & opt (some Mirage_runtime_network.Arg.ip_address) None doc) type t = { domain : Colombe.Domain.t - ; postmaster : Emile.mailbox - ; destination : Ipaddr.t } + ; postmaster : Emile.mailbox } - let v domain postmaster destination = - { domain; postmaster; destination } + let v domain postmaster = + { domain; postmaster } - let setup = Term.(const v $ domain $ postmaster $ destination) + let setup = Term.(const v $ domain $ postmaster) end module Make @@ -42,8 +41,10 @@ module Make = struct module Nss = Ca_certs_nss.Make (Pclock) + module Fake_dns = Ptt_fake_dns.Make (struct let ipaddr = K.destination () end) + module Spam_filter = Spartacus.Make (Time) (Mclock) (Pclock) (Stack) (Fake_dns) (Happy_eyeballs) - let start _time _mclock _pclock stack he { K.domain; postmaster; destination }= + let start _time _mclock _pclock stack he { K.domain; postmaster }= let authenticator = R.failwith_error_msg (Nss.authenticator ()) in let tls = R.failwith_error_msg (Tls.Config.client ~authenticator ()) in let ip = Stack.ip stack in @@ -56,8 +57,6 @@ module Make ; zone= Mrmime.Date.Zone.GMT ; size= 10_000_000L (* 10M *) } in let locals = Ptt_map.empty ~postmaster in - let module Fake_dns = Ptt_fake_dns.Make (struct let ipaddr = destination end) in - let module Spam_filter = Spartacus.Make (Time) (Mclock) (Pclock) (Stack) (Fake_dns) (Happy_eyeballs) in Fake_dns.connect () >>= fun dns -> Spam_filter.job ~locals ~port:25 ~tls ~info (Stack.tcp stack) dns he end diff --git a/unikernel/submission/config.ml b/unikernel/submission/config.ml index 793831f..a63be98 100644 --- a/unikernel/submission/config.ml +++ b/unikernel/submission/config.ml @@ -1,24 +1,7 @@ -open Mirage - -let ssh_key = - Runtime_arg.create ~pos:__POS__ - {|let open Cmdliner in - let doc = Arg.info ~doc:"The private SSH key (rsa: or ed25519:)." ["ssh-key"] in - Arg.(value & opt (some string) None doc)|} +(* mirage >= 4.8.0 & < 4.9.0 *) -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)|} +open Mirage -let nameservers = Runtime_arg.create ~pos:__POS__ "Unikernel.K.nameservers" let setup = runtime_arg ~pos:__POS__ "Unikernel.K.setup" let packages = @@ -43,11 +26,11 @@ let mclock = default_monotonic_clock let pclock = default_posix_clock let stack = generic_stackv4v6 default_network let he = generic_happy_eyeballs stack -let dns = generic_dns_client ~nameservers stack he +let dns = generic_dns_client stack he let tcp = tcpv4v6_of_stackv4v6 stack let git_client = let git = mimic_happy_eyeballs stack he dns in - git_ssh ~password:ssh_password ~key:ssh_key ~authenticator:ssh_authenticator tcp git + git_ssh tcp git let () = register "submission" diff --git a/unikernel/submission/unikernel.ml b/unikernel/submission/unikernel.ml index f0ddda1..840425d 100644 --- a/unikernel/submission/unikernel.ml +++ b/unikernel/submission/unikernel.ml @@ -42,7 +42,7 @@ module K = struct let destination = let doc = Arg.info ~doc:"Next SMTP server IP" ["destination"] in - Arg.(required & opt (some Mirage_runtime_network.Arg.ip_address) None doc) + Mirage_runtime.register_arg Arg.(required & opt (some Mirage_runtime_network.Arg.ip_address) None doc) let key_seed = let doc = Arg.info ~doc:"certificate key seed" ["key-seed"] in @@ -57,15 +57,14 @@ module K = struct ; domain : Colombe.Domain.t ; hostname : [ `host ] Domain_name.t ; postmaster : Emile.mailbox - ; destination : Ipaddr.t ; dns_key : [ `raw ] Domain_name.t * Dns.Dnskey.t ; dns_server : Ipaddr.t ; key_seed : string } - let v remote domain hostname postmaster destination dns_key dns_server key_seed = - { remote; domain; hostname; postmaster; destination; dns_key; dns_server; key_seed } + let v remote domain hostname postmaster dns_key dns_server key_seed = + { remote; domain; hostname; postmaster; dns_key; dns_server; key_seed } - let setup = Term.(const v $ remote $ domain $ hostname $ postmaster $ destination $ dns_key $ dns_server $ key_seed) + let setup = Term.(const v $ remote $ domain $ hostname $ postmaster $ dns_key $ dns_server $ key_seed) end module Make @@ -136,7 +135,10 @@ module Make (Duration.of_day (max 0 (next_expire - 7))) in Lwt.return (`Single certificates, seven_days_before_expire) - let start _random _time _mclock _pclock stack he ctx ({ K.remote; domain; postmaster; destination; _ } as cfg) = + module Fake_dns = Ptt_fake_dns.Make (struct let ipaddr = K.destination () end) + module Lipap = Lipap.Make (Time) (Mclock) (Pclock) (Stack) (Fake_dns) (Happy_eyeballs) + + let start _random _time _mclock _pclock stack he ctx ({ K.remote; domain; postmaster; _ } as cfg) = let authenticator = R.failwith_error_msg (Nss.authenticator ()) in let tls = R.failwith_error_msg (Tls.Config.client ~authenticator ()) in let ip = Stack.ip stack in @@ -144,8 +146,6 @@ module Make let ipaddr = Ipaddr.Prefix.address ipaddr in let locals = Ptt_map.empty ~postmaster in authentication ctx remote >>= fun authentication -> - let module Fake_dns = Ptt_fake_dns.Make (struct let ipaddr = destination end) in - let module Lipap = Lipap.Make (Time) (Mclock) (Pclock) (Stack) (Fake_dns) (Happy_eyeballs) in Fake_dns.connect () >>= fun dns -> let rec loop (certificates, expiration) = let info = diff --git a/unikernel/verifier/config.ml b/unikernel/verifier/config.ml index fb5e88f..732cc62 100644 --- a/unikernel/verifier/config.ml +++ b/unikernel/verifier/config.ml @@ -1,3 +1,5 @@ +(* mirage >= 4.8.0 & < 4.9.0 *) + open Mirage let setup = runtime_arg ~pos:__POS__ "Unikernel.K.setup"