mirror of
https://github.com/mirage/qubes-mirage-firewall.git
synced 2024-10-01 01:05:39 -04:00
Remove unused Clock argument to Uplink
This commit is contained in:
parent
48b38fa992
commit
ab3508a936
@ -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: 6f8f0f19ba62bf5312039f2904ea8696584f8ff49443dec098facf261449ebf2"
|
||||
echo "(hashes should match for released versions)"
|
||||
|
@ -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 *)
|
||||
|
118
uplink.ml
118
uplink.ml
@ -9,66 +9,64 @@ 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 = {
|
||||
net : Netif.t;
|
||||
eth : Eth.t;
|
||||
arp : Arp.t;
|
||||
interface : interface;
|
||||
fragments : Fragments.Cache.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
|
||||
val queue = FrameQ.create (Ipaddr.V4.to_string other_ip)
|
||||
method my_mac = Eth.mac eth
|
||||
method my_ip = my_ip
|
||||
method other_ip = other_ip
|
||||
method writev ethertype fillfn =
|
||||
FrameQ.send queue (fun () ->
|
||||
mac >>= fun dst ->
|
||||
Eth.write eth dst ethertype fillfn >|= or_raise "Write to uplink" Eth.pp_error
|
||||
)
|
||||
end
|
||||
|
||||
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
|
||||
~arpv4:(Arp.input t.arp)
|
||||
~ipv4:(fun ip ->
|
||||
match Nat_packet.of_ipv4_packet t.fragments ~now:(get_ts ()) 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_unit
|
||||
| Ok None -> Lwt.return_unit
|
||||
| Ok (Some packet) ->
|
||||
Firewall.ipv4_from_netvm router packet
|
||||
)
|
||||
~ipv6:(fun _ip -> Lwt.return_unit)
|
||||
frame
|
||||
) >|= or_raise "Uplink listen loop" Netif.pp_error
|
||||
|
||||
let interface t = t.interface
|
||||
|
||||
let connect config =
|
||||
let ip = config.Dao.uplink_our_ip in
|
||||
Netif.connect "0" >>= fun net ->
|
||||
Eth.connect net >>= fun eth ->
|
||||
Arp.connect eth >>= fun arp ->
|
||||
Arp.add_ip arp ip >>= fun () ->
|
||||
let netvm_mac =
|
||||
Arp.query arp config.Dao.uplink_netvm_ip
|
||||
>|= or_raise "Getting MAC of our NetVM" Arp.pp_error in
|
||||
let interface = new netvm_iface eth netvm_mac
|
||||
~my_ip:ip
|
||||
~other_ip:config.Dao.uplink_netvm_ip in
|
||||
let fragments = Fragments.Cache.create (256 * 1024) in
|
||||
Lwt.return { net; eth; arp; interface ; fragments }
|
||||
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
|
||||
method other_ip = other_ip
|
||||
method writev ethertype fillfn =
|
||||
FrameQ.send queue (fun () ->
|
||||
mac >>= fun dst ->
|
||||
Eth.write eth dst ethertype fillfn >|= or_raise "Write to uplink" Eth.pp_error
|
||||
)
|
||||
end
|
||||
|
||||
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
|
||||
~arpv4:(Arp.input t.arp)
|
||||
~ipv4:(fun ip ->
|
||||
match Nat_packet.of_ipv4_packet t.fragments ~now:(get_ts ()) 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_unit
|
||||
| Ok None -> Lwt.return_unit
|
||||
| Ok (Some packet) ->
|
||||
Firewall.ipv4_from_netvm router packet
|
||||
)
|
||||
~ipv6:(fun _ip -> Lwt.return_unit)
|
||||
frame
|
||||
) >|= or_raise "Uplink listen loop" Netif.pp_error
|
||||
|
||||
let interface t = t.interface
|
||||
|
||||
let connect config =
|
||||
let ip = config.Dao.uplink_our_ip in
|
||||
Netif.connect "0" >>= fun net ->
|
||||
Eth.connect net >>= fun eth ->
|
||||
Arp.connect eth >>= fun arp ->
|
||||
Arp.add_ip arp ip >>= fun () ->
|
||||
let netvm_mac =
|
||||
Arp.query arp config.Dao.uplink_netvm_ip
|
||||
>|= or_raise "Getting MAC of our NetVM" Arp.pp_error in
|
||||
let interface = new netvm_iface eth netvm_mac
|
||||
~my_ip:ip
|
||||
~other_ip:config.Dao.uplink_netvm_ip in
|
||||
let fragments = Fragments.Cache.create (256 * 1024) in
|
||||
Lwt.return { net; eth; arp; interface ; fragments }
|
||||
|
16
uplink.mli
16
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. *)
|
||||
|
Loading…
Reference in New Issue
Block a user