Add extra logging

client_net.ml

@@ -83,6 +83,11 @@ let add_vif { Dao.ClientVif.domid; device_id } ~client_ip ~router ~cleanup_tasks
   let fixed_arp = Client_eth.ARP.create ~net:client_eth iface in
   Netback.listen backend (fun frame ->
     match Ethif_packet.Unmarshal.of_cstruct frame with
+    | exception ex ->
+      Log.err (fun f -> f "Error unmarshalling ethernet frame from client: %s@.%a" (Printexc.to_string ex)
+                  Cstruct.hexdump_pp frame
+              );
+      Lwt.return_unit
     | Error err -> Log.warn (fun f -> f "Invalid Ethernet frame: %s" err); return ()
     | Ok (eth, payload) ->
         match eth.Ethif_packet.ethertype with

firewall.ml

@@ -11,13 +11,23 @@ module Log = (val Logs.src_log src : Logs.LOG)
 (* Transmission *)
 
 let transmit_ipv4 packet iface =
-  let headers, payload = Nat_packet.make_headers_cstruct packet in
   Lwt.catch
-    (fun () -> iface#writev Ethif_wire.IPv4 [headers; payload])
+    (fun () ->
+       let transport = Nat_packet.to_cstruct packet in
+       Lwt.catch
+         (fun () -> iface#writev Ethif_wire.IPv4 transport)
+         (fun ex ->
+            Log.warn (fun f -> f "Failed to write packet to %a: %s"
+                         Ipaddr.V4.pp_hum iface#other_ip
+                         (Printexc.to_string ex));
+            Lwt.return ()
+         )
+    )
     (fun ex ->
-       Log.warn (fun f -> f "Failed to write packet to %a: %s"
-                    Ipaddr.V4.pp_hum iface#other_ip
-                    (Printexc.to_string ex));
+       Log.err (fun f -> f "Exception in transmit_ipv4: %s for:@.%a"
+                   (Printexc.to_string ex)
+                   Nat_packet.pp packet
+               );
        Lwt.return ()
     )
 

my_nat.ml

@@ -27,12 +27,6 @@ let create (type c t) (nat:(module Mirage_nat.S with type config = c and type t
   let table = { current; next } in
   Lwt.return (Nat (nat, c, table))
 
-(* Ideally, mirage-nat wouldn't ask us for an ethernet header, since it only
-   cares about the IP layer anyway. *)
-let fake_ipv4_eth =
-  let dontcare = Macaddr.broadcast in
-  Fw_utils.eth_header Ethif_wire.IPv4 ~src:dontcare ~dst:dontcare
-
 let translate (Nat ((module Nat), _, table)) packet =
   Nat.translate table.current packet >|= function
   | Mirage_nat.Untranslated -> None

uplink.ml

@@ -39,6 +39,11 @@ module Make(Clock : Mirage_clock_lwt.MCLOCK) = struct
           ~arpv4:(Arp.input t.arp)
           ~ipv4:(fun ip ->
               match Nat_packet.of_ipv4_packet ip with
+              | exception ex ->
+                Log.err (fun f -> f "Error unmarshalling ethernet frame from uplink: %s@.%a" (Printexc.to_string ex)
+                            Cstruct.hexdump_pp frame
+                        );
+                Lwt.return_unit
               | Error e ->
                 Log.warn (fun f -> f "Ignored unknown IPv4 message from uplink: %a" Nat_packet.pp_error e);
                 Lwt.return ()