.

Dockerfile.spamfilter

@@ -1,6 +1,6 @@
 FROM ocaml/opam:ubuntu-20.04-ocaml-4.14
 RUN sudo ln -f /usr/bin/opam-2.1 /usr/bin/opam
-RUN cd ~/opam-repository && git pull origin master && git reset --hard cd449b28e1149a5bafa7f1c6262879ce509b7eea && opam update
+RUN cd ~/opam-repository && git pull origin master && git reset --hard 164c8ecdbe88cb6ee4c0b137997c2e7f3763577e && opam update
 RUN opam depext -ui mirage
 RUN mkdir -p /home/opam/src
 WORKDIR /home/opam/src
@@ -13,4 +13,4 @@ COPY --chown=opam:root unikernel/spamfilter/ /home/opam/src
 RUN opam pin add ptt -ny git+https://github.com/mirage/ptt.git#$BRANCH
 RUN opam depext -ui ptt
 RUN opam config exec -- make depends
-RUN opam config exec -- mirage build
+RUN opam config exec -- make build

unikernel/signer/unikernel.ml

@@ -23,20 +23,20 @@ module K = struct
     Arg.(required & opt (some mailbox) None doc)
 
   let dns_key =
-    let doc = Arg.info ~doc:"nsupdate key" ["dns-key"] in
+    let doc = Arg.info ~doc:"nsupdate key" [ "dns-key" ] in
     let key = Arg.conv ~docv:"HOST:HASH:DATA" Dns.Dnskey.(name_key_of_string, pp_name_key) in
     Arg.(required & opt (some key) None doc)
 
   let dns_server =
-    let doc = Arg.info ~doc:"dns server IP" ["dns-server"] in
+    let doc = Arg.info ~doc:"dns server IP" [ "dns-server" ] in
     Arg.(required & opt (some Mirage_runtime_network.Arg.ip_address) None doc)
 
   let dns_port =
-    let doc = Arg.info ~doc:"dns server port" ["dns-port"] in
+    let doc = Arg.info ~doc:"dns server port" [ "dns-port" ] in
     Arg.(value & opt int 53 doc)
 
   let destination =
-    let doc = Arg.info ~doc:"Next SMTP server IP" ["destination"] in
+    let doc = Arg.info ~doc:"Next SMTP server IP" [ "destination" ] in
     Arg.(required & opt (some Mirage_runtime_network.Arg.ip_address) None doc)
 
   let fields =
@@ -88,8 +88,6 @@ module K = struct
     $ fields $ selector $ timestamp $ expiration $ seed)
 end
 
-
-
 module Make
   (Random : Mirage_random.S)
   (Time : Mirage_time.S)

unikernel/spamfilter/config.ml

@@ -1,38 +1,24 @@
 open Mirage
 
-let domain =
-  let doc = Key.Arg.info ~doc:"SMTP domain-name." [ "domain" ] in
-  Key.(create "domain" Arg.(required string doc))
-
-let destination =
-  let doc = Key.Arg.info ~doc:"SMTP server destination." [ "destination" ] in
-  Key.(create "destination" Arg.(required ip_address doc))
-
-let postmaster =
-  let doc = Key.Arg.info ~doc:"The postmaster of the SMTP service." [ "postmaster" ] in
-  Key.(create "postmaster" Arg.(required string doc))
-
-let keys =
-  Key.[ v domain
-      ; v destination
-      ; v postmaster ]
+let setup = runtime_arg ~pos:__POS__ "Unikernel.K.setup"
 
 let packages =
   [ package "ptt" ~sublibs:[ "spartacus" ]
   ; package "spamtacus-mirage"
   ; package "domain-name"
   ; package "ca-certs-nss" ]
 
+let runtime_args = [ setup ]
+
 let spamfilter =
-  foreign ~keys ~packages "Unikernel.Make" @@
-  random @-> time @-> mclock @-> pclock @-> stackv4v6 @-> job
+  main ~runtime_args ~packages "Unikernel.Make" @@
+  time @-> mclock @-> pclock @-> stackv4v6 @-> job
 
-let random = default_random
 let time = default_time
 let mclock = default_monotonic_clock
 let pclock = default_posix_clock
 let stack = generic_stackv4v6 default_network
 
 let () =
   register "spamfilter"
-    [ spamfilter $ random $ time $ mclock $ pclock $ stack ]
+    [ spamfilter $ time $ mclock $ pclock $ stack ]

unikernel/spamfilter/unikernel.ml

@@ -1,8 +1,39 @@
 open Rresult
 open Lwt.Infix
 
+let ( $ ) f g = fun x -> match f x with Ok x -> g x | Error _ as err -> err
+let ( <.> ) f g = fun x -> f (g x)
+let msgf fmt = Fmt.kstr (fun msg -> `Msg msg) fmt
+
+module K = struct
+  open Cmdliner
+
+  let domain =
+    let doc = Arg.info ~doc:"SMTP domain-name." [ "domain" ] in
+    let domain_name = Arg.conv (Domain_name.(of_string $ host), Domain_name.pp) in
+    Arg.(required & opt (some domain_name) None doc)
+
+  let postmaster =
+    let doc = Arg.info ~doc:"The postmaster of the SMTP service." [ "postmaster" ] in
+    let mailbox = Arg.conv (Result.map_error (msgf "%a" Emile.pp_error) <.> Emile.of_string, Emile.pp_mailbox) in
+    Arg.(required & opt (some mailbox) None doc)
+
+  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)
+
+  type t =
+    { domain : [ `host ] Domain_name.t
+    ; postmaster : Emile.mailbox
+    ; destination : Ipaddr.t }
+
+  let v domain postmaster destination =
+    { domain; postmaster; destination }
+
+  let setup = Term.(const v $ domain $ postmaster $ destination)
+end
+
 module Make
-  (Random : Mirage_random.S)
   (Time : Mirage_time.S)
   (Mclock : Mirage_clock.MCLOCK)
   (Pclock : Mirage_clock.PCLOCK)
@@ -20,21 +51,18 @@ module Make
     let extension ipaddr _ldh _value = Lwt.return_ok ipaddr
   end
 
-  module SpamFilter = Spartacus.Make (Random) (Time) (Mclock) (Pclock) (Resolver) (Stack)
+  module SpamFilter = Spartacus.Make (Time) (Mclock) (Pclock) (Resolver) (Stack)
   module Nss = Ca_certs_nss.Make (Pclock)
 
-  let start _random _time _mclock _pclock stack =
-    let postmaster =
-      let postmaster = Key_gen.postmaster () in
-      R.failwith_error_msg (R.reword_error (fun _ -> R.msgf "Invalid postmaster email: %S" postmaster)
-        (Emile.of_string postmaster)) in
-    let domain = R.failwith_error_msg (Domain_name.of_string (Key_gen.domain ())) in
+  let start _time _mclock _pclock stack { K.domain; postmaster; destination }=
     let authenticator = R.failwith_error_msg (Nss.authenticator ()) in
-    let tls = Tls.Config.client ~authenticator () in
-    let domain = Domain_name.host_exn domain in
-    SpamFilter.fiber ~port:25 ~tls (Stack.tcp stack) (Key_gen.destination ())
+    let tls = R.failwith_error_msg (Tls.Config.client ~authenticator ()) in
+    let ip = Stack.ip stack in
+    let ipaddr = List.hd (Stack.IP.configured_ips ip) in
+    let ipaddr = Ipaddr.Prefix.address ipaddr in
+    SpamFilter.fiber ~port:25 ~tls (Stack.tcp stack) destination
       { Ptt.Logic.domain
-      ; ipaddr= Ipaddr.(V4 (V4.Prefix.address (Key_gen.ipv4 ())))
+      ; ipaddr
       ; tls= None
       ; zone= Mrmime.Date.Zone.GMT (* XXX(dinosaure): any MirageOS use GMT. *)
       ; size= 10_000_000L (* 10M *) }