Git-Mirrors/qubes-mirage-firewall
1
0
Fork 0
mirror of https://github.com/mirage/qubes-mirage-firewall.git synced 2024-12-17 19:44:21 -05:00
Code Issues Packages Projects Releases Wiki Activity

Add extra logging

Browse Source
This commit is contained in:
Thomas Leonard 2017-03-06 14:30:41 +00:00
parent b4079ac861
commit e070044fef
4 changed files with 25 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
client_net.ml
View File

@ -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 let fixed_arp = Client_eth.ARP.create ~net:client_eth iface in
Netback.listen backend (fun frame -> Netback.listen backend (fun frame ->
match Ethif_packet.Unmarshal.of_cstruct frame with 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 () | Error err -> Log.warn (fun f -> f "Invalid Ethernet frame: %s" err); return ()
| Ok (eth, payload) -> | Ok (eth, payload) ->
match eth.Ethif_packet.ethertype with match eth.Ethif_packet.ethertype with

20
firewall.ml
View File

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

6
my_nat.ml
View File

@ -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 let table = { current; next } in
Lwt.return (Nat (nat, c, table)) 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 = let translate (Nat ((module Nat), _, table)) packet =
Nat.translate table.current packet >|= function Nat.translate table.current packet >|= function
| Mirage_nat.Untranslated -> None | Mirage_nat.Untranslated -> None

5
uplink.ml
View File

@ -39,6 +39,11 @@ module Make(Clock : Mirage_clock_lwt.MCLOCK) = struct
~arpv4:(Arp.input t.arp) ~arpv4:(Arp.input t.arp)
~ipv4:(fun ip -> ~ipv4:(fun ip ->
match Nat_packet.of_ipv4_packet ip with 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 -> | Error e ->
Log.warn (fun f -> f "Ignored unknown IPv4 message from uplink: %a" Nat_packet.pp_error e); Log.warn (fun f -> f "Ignored unknown IPv4 message from uplink: %a" Nat_packet.pp_error e);
Lwt.return () Lwt.return ()