Merge pull request #90 from talex5/cleanup

Minor cleanups

Dockerfile

@@ -9,7 +9,7 @@ FROM ocurrent/opam@sha256:3f3ce7e577a94942c7f9c63cbdd1ecbfe0ea793f581f69047f3155
 # latest versions.
 RUN cd ~/opam-repository && git fetch origin master && git reset --hard d205c265cee9a86869259180fd2238da98370430 && opam update
 
-RUN opam depext -i -y mirage.3.7.4 lwt
+RUN opam depext -i -y mirage.3.7.4 lwt.4.5.0
 RUN mkdir /home/opam/qubes-mirage-firewall
 ADD config.ml /home/opam/qubes-mirage-firewall/config.ml
 WORKDIR /home/opam/qubes-mirage-firewall

build-with-docker.sh

@@ -5,5 +5,5 @@ docker build -t qubes-mirage-firewall .
 echo Building Firewall...
 docker run --rm -i -v `pwd`:/home/opam/qubes-mirage-firewall qubes-mirage-firewall
 echo "SHA2 of build:   $(sha256sum qubes_firewall.xen)"
-echo "SHA2 last known: 8a337e61e7d093f7c1f0fa5fe277dace4d606bfa06cfde3f2d61d6bdee6eefbc"
+echo "SHA2 last known: 91c5bf44a85339aaf14e4763a29c2b64537f5bc41cd7dc2571af954ec9dd3cad"
 echo "(hashes should match for released versions)"

firewall.ml

@@ -10,15 +10,13 @@ module Log = (val Logs.src_log src : Logs.LOG)
 (* Transmission *)
 
 let transmit_ipv4 packet iface =
-  Lwt.catch
-    (fun () ->
   Lwt.catch
     (fun () ->
        let fragments = ref [] in
        iface#writev `IPv4 (fun b ->
            match Nat_packet.into_cstruct packet b with
            | Error e ->
-                  Log.warn (fun f -> f "Failed to write packet to %a: %a"
+             Log.warn (fun f -> f "Failed to NAT packet to %a: %a"
                           Ipaddr.V4.pp iface#other_ip
                           Nat_packet.pp_error e);
              0
@@ -33,14 +31,6 @@ let transmit_ipv4 packet iface =
                     (Printexc.to_string ex));
        Lwt.return_unit
     )
-    )
-    (fun ex ->
-       Log.err (fun f -> f "Exception in transmit_ipv4: %s for:@.%a"
-                   (Printexc.to_string ex)
-                   Nat_packet.pp packet
-               );
-       Lwt.return_unit
-    )
 
 let forward_ipv4 t packet =
   let `IPv4 (ip, _) = packet in

unikernel.ml

@@ -8,8 +8,6 @@ let src = Logs.Src.create "unikernel" ~doc:"Main unikernel code"
 module Log = (val Logs.src_log src : Logs.LOG)
 
 module Main (Clock : Mirage_clock.MCLOCK) = struct
-  module Uplink = Uplink.Make(Clock)
-
   (* Set up networking and listen for incoming packets. *)
   let network nat qubesDB =
     (* Read configuration from QubesDB *)

uplink.ml

@@ -9,18 +9,17 @@ module Eth = Ethernet.Make(Netif)
 let src = Logs.Src.create "uplink" ~doc:"Network connection to NetVM"
 module Log = (val Logs.src_log src : Logs.LOG)
 
-module Make(Clock : Mirage_clock.MCLOCK) = struct
-  module Arp = Arp.Make(Eth)(OS.Time)
+module Arp = Arp.Make(Eth)(OS.Time)
 
-  type t = {
+type t = {
   net : Netif.t;
   eth : Eth.t;
   arp : Arp.t;
   interface : interface;
   fragments : Fragments.Cache.t;
-  }
+}
 
-  class netvm_iface eth mac ~my_ip ~other_ip : interface = object
+class netvm_iface eth mac ~my_ip ~other_ip : interface = object
   val queue = FrameQ.create (Ipaddr.V4.to_string other_ip)
   method my_mac = Eth.mac eth
   method my_ip = my_ip
@@ -30,9 +29,9 @@ module Make(Clock : Mirage_clock.MCLOCK) = struct
       mac >>= fun dst ->
       Eth.write eth dst ethertype fillfn >|= or_raise "Write to uplink" Eth.pp_error
     )
-  end
+end
 
-  let listen t get_ts router =
+let listen t get_ts router =
   Netif.listen t.net ~header_size:Ethernet_wire.sizeof_ethernet (fun frame ->
       (* Handle one Ethernet frame from NetVM *)
       Eth.input t.eth
@@ -55,9 +54,9 @@ module Make(Clock : Mirage_clock.MCLOCK) = struct
         frame
     ) >|= or_raise "Uplink listen loop" Netif.pp_error
 
-  let interface t = t.interface
+let interface t = t.interface
 
-  let connect config =
+let connect config =
   let ip = config.Dao.uplink_our_ip in
   Netif.connect "0" >>= fun net ->
   Eth.connect net >>= fun eth ->
@@ -71,4 +70,3 @@ module Make(Clock : Mirage_clock.MCLOCK) = struct
     ~other_ip:config.Dao.uplink_netvm_ip in
   let fragments = Fragments.Cache.create (256 * 1024) in
   Lwt.return { net; eth; arp; interface ; fragments }
-end

uplink.mli

@@ -5,15 +5,13 @@
 
 open Fw_utils
 
-module Make(Clock : Mirage_clock.MCLOCK) : sig
-  type t
+type t
 
-  val connect : Dao.network_config -> t Lwt.t
-  (** Connect to our NetVM (gateway). *)
+val connect : Dao.network_config -> t Lwt.t
+(** Connect to our NetVM (gateway). *)
 
-  val interface : t -> interface
-  (** The network interface to NetVM. *)
+val interface : t -> interface
+(** The network interface to NetVM. *)
 
-  val listen : t -> (unit -> int64) -> Router.t -> unit Lwt.t
-  (** Handle incoming frames from NetVM. *)
-end
+val listen : t -> (unit -> int64) -> Router.t -> unit Lwt.t
+(** Handle incoming frames from NetVM. *)