update to mirage 4.9.0

config.ml

@@ -1,4 +1,4 @@
-(* mirage >= 4.8.0 & < 4.9.0 *)
+(* mirage >= 4.9.0 & < 4.10.0 *)
 (* Copyright (C) 2017, Thomas Leonard <thomas.leonard@unikernel.com>
    See the README file for details. *)
 
@@ -24,7 +24,7 @@ let main =
       package ~min:"6.4.0" "dns-client";
       package "pf-qubes";
     ]
-    "Unikernel.Main" (random @-> mclock @-> time @-> job)
+    "Unikernel" job
 
 let () =
-  register "qubes-firewall" [main $ default_random $ default_monotonic_clock $ default_time]
+  register "qubes-firewall" [main]

dispatcher.ml

@@ -8,14 +8,9 @@ let src = Logs.Src.create "dispatcher" ~doc:"Networking dispatch"
 
 module Log = (val Logs.src_log src : Logs.LOG)
 
-module Make
+  module Arp = Arp.Make (UplinkEth)
-    (R : Mirage_crypto_rng_mirage.S)
+  module I = Static_ipv4.Make (UplinkEth) (Arp)
-    (Clock : Mirage_clock.MCLOCK)
+  module U = Udp.Make (I)
-    (Time : Mirage_time.S) =
-struct
-  module Arp = Arp.Make (UplinkEth) (Time)
-  module I = Static_ipv4.Make (R) (Clock) (UplinkEth) (Arp)
-  module U = Udp.Make (I) (R)
 
   class client_iface eth ~domid ~gateway_ip ~client_ip client_mac : client_link
     =
@@ -632,4 +627,3 @@ struct
       >>= fun () -> aux new_db
     in
     aux Qubes.DB.KeyMap.empty
-end

my_dns.ml

@@ -1,9 +1,7 @@
 open Lwt.Infix
 
-module Transport (R : Mirage_crypto_rng_mirage.S) (C : Mirage_clock.MCLOCK) (Time : Mirage_time.S) = struct
   type +'a io = 'a Lwt.t
   type io_addr = Ipaddr.V4.t * int
-  module Dispatcher = Dispatcher.Make(R)(C)(Time)
   type stack = Dispatcher.t *
                (src_port:int -> dst:Ipaddr.V4.t -> dst_port:int -> string -> (unit, [ `Msg of string ]) result Lwt.t) *
                (Udp_packet.t * string) Lwt_mvar.t
@@ -20,8 +18,8 @@ module Transport (R : Mirage_crypto_rng_mirage.S) (C : Mirage_clock.MCLOCK) (Tim
   type context = t
 
   let nameservers { protocol ; nameserver ; _ } = protocol, [ nameserver ]
-  let rng = R.generate ?g:None
+  let rng = Mirage_crypto_rng.generate ?g:None
-  let clock = C.elapsed_ns
+  let clock = Mirage_mtime.elapsed_ns
 
   let rec read t =
     let _, _, answer = t.stack in
@@ -45,7 +43,7 @@ module Transport (R : Mirage_crypto_rng_mirage.S) (C : Mirage_clock.MCLOCK) (Tim
     t
 
   let with_timeout timeout_ns f =
-    let timeout = Time.sleep_ns timeout_ns >|= fun () -> Error (`Msg "DNS request timeout") in
+    let timeout = Mirage_sleep.ns timeout_ns >|= fun () -> Error (`Msg "DNS request timeout") in
     Lwt.pick [ f ; timeout ]
 
   let connect (t : t) = Lwt.return (Ok (t.protocol, t))
@@ -72,5 +70,3 @@ module Transport (R : Mirage_crypto_rng_mirage.S) (C : Mirage_clock.MCLOCK) (Tim
   let bind = Lwt.bind
 
   let lift = Lwt.return
-end
-

unikernel.ml

@@ -28,10 +28,7 @@ let ipv4_dns2 =
   let doc = Arg.info ~doc:"Manual Second DNS IP setting." [ "ipv4-dns2" ] in
   Mirage_runtime.register_arg Arg.(value & opt string "10.139.1.2" doc)
 
-module Main (R : Mirage_crypto_rng_mirage.S)(Clock : Mirage_clock.MCLOCK)(Time : Mirage_time.S) = struct
+  module Dns_client = Dns_client.Make(My_dns)
-  module Dispatcher = Dispatcher.Make(R)(Clock)(Time)
-  module Dns_transport = My_dns.Transport(R)(Clock)(Time)
-  module Dns_client = Dns_client.Make(Dns_transport)
 
   (* Set up networking and listen for incoming packets. *)
   let network dns_client dns_responses dns_servers qubesDB router =
@@ -39,22 +36,22 @@ module Main (R : Mirage_crypto_rng_mirage.S)(Clock : Mirage_clock.MCLOCK)(Time :
     Dao.set_iptables_error qubesDB "" >>= fun () ->
     (* Handle packets from both networks *)
     Lwt.choose [
-      Dispatcher.wait_clients Clock.elapsed_ns dns_client dns_servers qubesDB router ;
+      Dispatcher.wait_clients Mirage_mtime.elapsed_ns dns_client dns_servers qubesDB router ;
       Dispatcher.uplink_wait_update qubesDB router ;
-      Dispatcher.uplink_listen Clock.elapsed_ns dns_responses router
+      Dispatcher.uplink_listen Mirage_mtime.elapsed_ns dns_responses router
     ]
 
   (* Main unikernel entry point (called from auto-generated main.ml). *)
-  let start _random _clock _time =
+  let start () =
     let open Lwt.Syntax in
-    let start_time = Clock.elapsed_ns () in
+    let start_time = Mirage_mtime.elapsed_ns () in
     (* Start qrexec agent and QubesDB agent in parallel *)
     let* qrexec = RExec.connect ~domid:0 () in
     let agent_listener = RExec.listen qrexec Command.handler in
     let* qubesDB = DB.connect ~domid:0 () in
     let startup_time =
       let (-) = Int64.sub in
-      let time_in_ns = Clock.elapsed_ns () - start_time in
+      let time_in_ns = Mirage_mtime.elapsed_ns () - start_time in
       Int64.to_float time_in_ns /. 1e9
     in
     Log.info (fun f -> f "QubesDB and qrexec agents connected in %.3f s" startup_time);
@@ -113,5 +110,4 @@ module Main (R : Mirage_crypto_rng_mirage.S)(Clock : Mirage_clock.MCLOCK)(Time :
     (* Run until something fails or we get a shutdown request. *)
     Lwt.choose [agent_listener; net_listener; shutdown_rq] >>= fun () ->
     (* Give the console daemon time to show any final log messages. *)
-    Time.sleep_ns (1.0 *. 1e9 |> Int64.of_float)
+    Mirage_sleep.ns (1.0 *. 1e9 |> Int64.of_float)
-end