mirror of
https://github.com/mirage/qubes-mirage-firewall.git
synced 2024-10-01 01:05:39 -04:00
Moved uplink code to its own module
This commit is contained in:
Thomas Leonard
parent
9dc7d01896
commit
11e18c0b83
82
net.ml
82
net.ml
@ -1,82 +0,0 @@
|
||||
(* Copyright (C) 2015, Thomas Leonard <thomas.leonard@unikernel.com>
|
||||
See the README file for details. *)
|
||||
|
||||
(** General network stuff (needs reorganising). *)
|
||||
|
||||
open Lwt.Infix
|
||||
open Utils
|
||||
|
||||
module Eth = Ethif.Make(Netif)
|
||||
|
||||
module Netback = Netchannel.Backend.Make(Netchannel.Xenstore.Make(OS.Xs))
|
||||
module ClientEth = Ethif.Make(Netback)
|
||||
|
||||
let src = Logs.Src.create "net" ~doc:"Firewall networking"
|
||||
module Log = (val Logs.src_log src : Logs.LOG)
|
||||
|
||||
module Make(Clock : V1.CLOCK) = struct
|
||||
module Arp = Arpv4.Make(Eth)(Clock)(OS.Time)
|
||||
module IPv4 = Ipv4.Make(Eth)(Arp)
|
||||
module Xs = OS.Xs
|
||||
|
||||
class netvm_iface eth my_ip mac nat_table : interface = object
|
||||
method my_mac = Eth.mac eth
|
||||
method writev ip =
|
||||
mac >>= fun dst ->
|
||||
let eth_hdr = eth_header_ipv4 ~src:(Eth.mac eth) ~dst in
|
||||
match Nat_rules.nat my_ip nat_table Nat_rewrite.Source (Cstruct.concat (eth_hdr :: ip)) with
|
||||
| None -> return ()
|
||||
| Some frame -> Eth.writev eth (fixup_checksums frame)
|
||||
end
|
||||
|
||||
let connect_uplink config =
|
||||
let nat_table = Nat_lookup.empty () in
|
||||
let ip = config.Dao.uplink_our_ip in
|
||||
Netif.connect "tap0" >>= function
|
||||
| `Error (`Unknown msg) -> failwith msg
|
||||
| `Error `Disconnected -> failwith "Disconnected"
|
||||
| `Error `Unimplemented -> failwith "Unimplemented"
|
||||
| `Ok net0 ->
|
||||
Eth.connect net0 >>= or_fail "Can't make Ethernet device for tap" >>= fun eth0 ->
|
||||
Arp.connect eth0 >>= or_fail "Can't add ARP" >>= fun arp0 ->
|
||||
Arp.add_ip arp0 ip >>= fun () ->
|
||||
let netvm_mac = Arp.query arp0 config.Dao.uplink_netvm_ip >|= function
|
||||
| `Timeout -> failwith "ARP timeout getting MAC of our NetVM"
|
||||
| `Ok netvm_mac -> netvm_mac in
|
||||
let ip46 = Ipaddr.V4 ip in
|
||||
let iface = new netvm_iface eth0 ip46 netvm_mac nat_table in
|
||||
let listen router =
|
||||
let unnat frame _ip =
|
||||
match Nat_rules.nat ip46 nat_table Nat_rewrite.Destination frame with
|
||||
| None ->
|
||||
Log.debug "Discarding unexpected frame" Logs.unit;
|
||||
return ()
|
||||
| Some frame ->
|
||||
let frame = fixup_checksums frame |> Cstruct.concat in
|
||||
Router.forward_ipv4 router (Cstruct.shift frame Wire_structs.sizeof_ethernet) in
|
||||
Netif.listen net0 (fun frame ->
|
||||
Eth.input
|
||||
~arpv4:(Arp.input arp0)
|
||||
~ipv4:(unnat frame)
|
||||
~ipv6:(fun _buf -> return ())
|
||||
eth0 frame
|
||||
) in
|
||||
return (iface, listen)
|
||||
|
||||
let connect qubesDB =
|
||||
let config = Dao.read_network_config qubesDB in
|
||||
connect_uplink config >>= fun (netvm_iface, netvm_listen) ->
|
||||
Dao.set_iptables_error qubesDB "" >>= fun () ->
|
||||
Logs.info "Client (internal) network is %a"
|
||||
(fun f -> f Ipaddr.V4.Prefix.pp_hum config.Dao.clients_prefix);
|
||||
let client_eth = Client_eth.create
|
||||
~client_gw:config.Dao.clients_our_ip
|
||||
~prefix:config.Dao.clients_prefix in
|
||||
let router = Router.create
|
||||
~default_gateway:netvm_iface
|
||||
~client_eth in
|
||||
Lwt.join [
|
||||
Client_net.listen router;
|
||||
netvm_listen router
|
||||
]
|
||||
end
|
||||
32
unikernel.ml
32
unikernel.ml
@ -7,6 +7,7 @@ open Qubes
|
||||
let src = Logs.Src.create "unikernel" ~doc:"Main unikernel code"
|
||||
module Log = (val Logs.src_log src : Logs.LOG)
|
||||
|
||||
(* Configure logging *)
|
||||
let () =
|
||||
let open Logs in
|
||||
(* Set default log level *)
|
||||
@ -16,9 +17,34 @@ let () =
|
||||
Src.set_level xs (Some Debug)
|
||||
|
||||
module Main (Clock : V1.CLOCK) = struct
|
||||
module N = Net.Make(Clock)
|
||||
module Log_reporter = Mirage_logs.Make(Clock)
|
||||
module Uplink = Uplink.Make(Clock)
|
||||
|
||||
(* Set up networking and listen for incoming packets. *)
|
||||
let network qubesDB =
|
||||
(* Read configuration from QubesDB *)
|
||||
let config = Dao.read_network_config qubesDB in
|
||||
Logs.info "Client (internal) network is %a"
|
||||
(fun f -> f Ipaddr.V4.Prefix.pp_hum config.Dao.clients_prefix);
|
||||
(* Initialise connection to NetVM *)
|
||||
Uplink.connect config >>= fun uplink ->
|
||||
(* Report success *)
|
||||
Dao.set_iptables_error qubesDB "" >>= fun () ->
|
||||
(* Set up client-side networking *)
|
||||
let client_eth = Client_eth.create
|
||||
~client_gw:config.Dao.clients_our_ip
|
||||
~prefix:config.Dao.clients_prefix in
|
||||
(* Set up routing between networks and hosts *)
|
||||
let router = Router.create
|
||||
~client_eth
|
||||
~default_gateway:(Uplink.interface uplink) in
|
||||
(* Handle packets from both networks *)
|
||||
Lwt.join [
|
||||
Client_net.listen router;
|
||||
Uplink.listen uplink router
|
||||
]
|
||||
|
||||
(* Main unikernel entry point (called from auto-generated main.ml). *)
|
||||
let start () =
|
||||
let start_time = Clock.time () in
|
||||
Log_reporter.init_logging ();
|
||||
@ -37,9 +63,9 @@ module Main (Clock : V1.CLOCK) = struct
|
||||
(* Watch for shutdown requests from Qubes *)
|
||||
let shutdown_rq = OS.Lifecycle.await_shutdown () >|= function `Poweroff | `Reboot -> () in
|
||||
(* Set up networking *)
|
||||
let net = N.connect qubesDB in
|
||||
let net_listener = network qubesDB in
|
||||
(* Run until something fails or we get a shutdown request. *)
|
||||
Lwt.choose [agent_listener; net; shutdown_rq] >>= fun () ->
|
||||
Lwt.choose [agent_listener; net_listener; shutdown_rq] >>= fun () ->
|
||||
(* Give the console daemon time to show any final log messages. *)
|
||||
OS.Time.sleep 1.0
|
||||
end
|
||||
|
||||
72
uplink.ml
Normal file
72
uplink.ml
Normal file
@ -0,0 +1,72 @@
|
||||
(* Copyright (C) 2015, Thomas Leonard <thomas.leonard@unikernel.com>
|
||||
See the README file for details. *)
|
||||
|
||||
open Lwt.Infix
|
||||
open Utils
|
||||
|
||||
module Eth = Ethif.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 : V1.CLOCK) = struct
|
||||
module Arp = Arpv4.Make(Eth)(Clock)(OS.Time)
|
||||
module IPv4 = Ipv4.Make(Eth)(Arp)
|
||||
|
||||
type t = {
|
||||
net : Netif.t;
|
||||
eth : Eth.t;
|
||||
arp : Arp.t;
|
||||
interface : interface;
|
||||
my_ip : Ipaddr.t;
|
||||
nat_table : Nat_lookup.t;
|
||||
}
|
||||
|
||||
class netvm_iface eth my_ip mac nat_table = object
|
||||
method my_mac = Eth.mac eth
|
||||
method writev ip =
|
||||
mac >>= fun dst ->
|
||||
let eth_hdr = eth_header_ipv4 ~src:(Eth.mac eth) ~dst in
|
||||
match Nat_rules.nat my_ip nat_table Nat_rewrite.Source (Cstruct.concat (eth_hdr :: ip)) with
|
||||
| None -> return ()
|
||||
| Some frame -> Eth.writev eth (fixup_checksums frame)
|
||||
end
|
||||
|
||||
let unnat t router frame _ip =
|
||||
match Nat_rules.nat t.my_ip t.nat_table Nat_rewrite.Destination frame with
|
||||
| None ->
|
||||
Log.debug "Discarding unexpected frame" Logs.unit;
|
||||
return ()
|
||||
| Some frame ->
|
||||
let frame = fixup_checksums frame |> Cstruct.concat in
|
||||
Router.forward_ipv4 router (Cstruct.shift frame Wire_structs.sizeof_ethernet)
|
||||
|
||||
let listen t router =
|
||||
Netif.listen t.net (fun frame ->
|
||||
Eth.input
|
||||
~arpv4:(Arp.input t.arp)
|
||||
~ipv4:(unnat t router frame)
|
||||
~ipv6:(fun _buf -> return ())
|
||||
t.eth frame
|
||||
)
|
||||
|
||||
let interface t = t.interface
|
||||
|
||||
let connect config =
|
||||
let ip = config.Dao.uplink_our_ip in
|
||||
Netif.connect "tap0" >>= function
|
||||
| `Error (`Unknown msg) -> failwith msg
|
||||
| `Error `Disconnected -> failwith "Disconnected"
|
||||
| `Error `Unimplemented -> failwith "Unimplemented"
|
||||
| `Ok net ->
|
||||
Eth.connect net >>= or_fail "Can't make Ethernet device for tap" >>= fun eth ->
|
||||
Arp.connect eth >>= or_fail "Can't add ARP" >>= fun arp ->
|
||||
Arp.add_ip arp ip >>= fun () ->
|
||||
let netvm_mac = Arp.query arp config.Dao.uplink_netvm_ip >|= function
|
||||
| `Timeout -> failwith "ARP timeout getting MAC of our NetVM"
|
||||
| `Ok netvm_mac -> netvm_mac in
|
||||
let my_ip = Ipaddr.V4 ip in
|
||||
let nat_table = Nat_lookup.empty () in
|
||||
let interface = new netvm_iface eth my_ip netvm_mac nat_table in
|
||||
return { net; eth; arp; interface; my_ip; nat_table }
|
||||
end
|
||||
19
uplink.mli
Normal file
19
uplink.mli
Normal file
@ -0,0 +1,19 @@
|
||||
(* Copyright (C) 2015, Thomas Leonard <thomas.leonard@unikernel.com>
|
||||
See the README file for details. *)
|
||||
|
||||
(** The link from us to NetVM (and, through that, to the outside world). *)
|
||||
|
||||
open Utils
|
||||
|
||||
module Make(Clock : V1.CLOCK) : sig
|
||||
type t
|
||||
|
||||
val connect : Dao.network_config -> t Lwt.t
|
||||
(** Connect to our NetVM (gateway). *)
|
||||
|
||||
val interface : t -> interface
|
||||
(** The network interface to NetVM. *)
|
||||
|
||||
val listen : t -> Router.t -> unit Lwt.t
|
||||
(** Handle incoming frames from NetVM. *)
|
||||
end
|
||||
Loading…
Reference in New Issue
Block a user