From 9dc7d018961b99d05428460033ab03bd6ea81da2 Mon Sep 17 00:00:00 2001 From: Thomas Leonard Date: Wed, 30 Dec 2015 13:48:13 +0000 Subject: [PATCH] Moved client networking to its own module Renamed the old Client_net to Client_eth, as it just handles the Ethernet layer. --- client_eth.ml | 128 ++++++++++++++++++++++++++++++ client_eth.mli | 40 ++++++++++ client_net.ml | 206 +++++++++++++++++++++---------------------------- client_net.mli | 42 ++-------- net.ml | 126 ++---------------------------- router.ml | 24 ++++-- router.mli | 13 ++-- utils.ml | 25 ++++++ 8 files changed, 315 insertions(+), 289 deletions(-) create mode 100644 client_eth.ml create mode 100644 client_eth.mli diff --git a/client_eth.ml b/client_eth.ml new file mode 100644 index 0000000..82b16fc --- /dev/null +++ b/client_eth.ml @@ -0,0 +1,128 @@ +(* Copyright (C) 2015, Thomas Leonard + See the README file for details. *) + +open Utils + +let src = Logs.Src.create "client_eth" ~doc:"Ethernet for NetVM clients" +module Log = (val Logs.src_log src : Logs.LOG) + +type t = { + mutable iface_of_ip : client_link IpMap.t; + prefix : Ipaddr.V4.Prefix.t; + client_gw : Ipaddr.V4.t; (* The IP that clients are given as their default gateway. *) +} + +let create ~prefix ~client_gw = + { iface_of_ip = IpMap.empty; client_gw; prefix } + +let prefix t = t.prefix + +let add_client t iface = + let ip = iface#client_ip in + assert (Ipaddr.V4.Prefix.mem ip t.prefix); + (* TODO: Should probably wait for the previous client to disappear. *) + (* assert (not (IpMap.mem ip t.iface_of_ip)); *) + t.iface_of_ip <- t.iface_of_ip |> IpMap.add ip iface + +let remove_client t iface = + let ip = iface#client_ip in + assert (IpMap.mem ip t.iface_of_ip); + t.iface_of_ip <- t.iface_of_ip |> IpMap.remove ip + +let lookup t ip = IpMap.find ip t.iface_of_ip + +module ARP = struct + type arp = { + net : t; + client_link : client_link; + } + + let lookup t ip = + if ip === t.net.client_gw then Some t.client_link#my_mac + else match IpMap.find ip t.net.iface_of_ip with + | Some client_iface -> Some client_iface#client_mac + | None -> None + + let create ~net client_link = {net; client_link} + + type arp_msg = { + op: [ `Request |`Reply |`Unknown of int ]; + sha: Macaddr.t; + spa: Ipaddr.V4.t; + tha: Macaddr.t; + tpa: Ipaddr.V4.t; + } + + let to_wire arp = + let open Arpv4_wire in + (* Obtain a buffer to write into *) + let buf = Cstruct.create (Wire_structs.sizeof_ethernet + sizeof_arp) in + (* Write the ARP packet *) + let dmac = Macaddr.to_bytes arp.tha in + let smac = Macaddr.to_bytes arp.sha in + let spa = Ipaddr.V4.to_int32 arp.spa in + let tpa = Ipaddr.V4.to_int32 arp.tpa in + let op = + match arp.op with + |`Request -> 1 + |`Reply -> 2 + |`Unknown n -> n + in + Wire_structs.set_ethernet_dst dmac 0 buf; + Wire_structs.set_ethernet_src smac 0 buf; + Wire_structs.set_ethernet_ethertype buf 0x0806; (* ARP *) + let arpbuf = Cstruct.shift buf 14 in + set_arp_htype arpbuf 1; + set_arp_ptype arpbuf 0x0800; (* IPv4 *) + set_arp_hlen arpbuf 6; (* ethernet mac size *) + set_arp_plen arpbuf 4; (* ipv4 size *) + set_arp_op arpbuf op; + set_arp_sha smac 0 arpbuf; + set_arp_spa arpbuf spa; + set_arp_tha dmac 0 arpbuf; + set_arp_tpa arpbuf tpa; + buf + + let input_query t frame = + let open Arpv4_wire in + let req_ipv4 = Ipaddr.V4.of_int32 (get_arp_tpa frame) in + Log.info "who-has %s?" (fun f -> f (Ipaddr.V4.to_string req_ipv4)); + if req_ipv4 === t.client_link#client_ip then ( + Log.info "ignoring request for client's own IP" Logs.unit; + None + ) else match lookup t req_ipv4 with + | None -> + Log.info "unknown address; not responding" Logs.unit; + None + | Some req_mac -> + Log.info "responding to: who-has %s?" (fun f -> f (Ipaddr.V4.to_string req_ipv4)); + Some (to_wire { + op = `Reply; + (* The Target Hardware Address and IP are copied from the request *) + tha = Macaddr.of_bytes_exn (copy_arp_sha frame); + tpa = Ipaddr.V4.of_int32 (get_arp_spa frame); + sha = req_mac; + spa = req_ipv4; + }) + + let input_gratuitous t frame = + let open Arpv4_wire in + let spa = Ipaddr.V4.of_int32 (get_arp_spa frame) in + let sha = Macaddr.of_bytes_exn (copy_arp_sha frame) in + match lookup t spa with + | Some real_mac when Macaddr.compare sha real_mac = 0 -> + Log.info "client suggests updating %s -> %s (as expected)" + (fun f -> f (Ipaddr.V4.to_string spa) (Macaddr.to_string sha)); + | Some other_mac -> + Log.warn "client suggests incorrect update %s -> %s (should be %s)" + (fun f -> f (Ipaddr.V4.to_string spa) (Macaddr.to_string sha) (Macaddr.to_string other_mac)); + | None -> + Log.warn "client suggests incorrect update %s -> %s (unexpected IP)" + (fun f -> f (Ipaddr.V4.to_string spa) (Macaddr.to_string sha)) + + let input t frame = + match Arpv4_wire.get_arp_op frame with + |1 -> input_query t frame + |2 -> input_gratuitous t frame; None + |n -> Log.warn "unknown message %d - ignored" (fun f -> f n); None +end diff --git a/client_eth.mli b/client_eth.mli new file mode 100644 index 0000000..25e281d --- /dev/null +++ b/client_eth.mli @@ -0,0 +1,40 @@ +(* Copyright (C) 2015, Thomas Leonard + See the README file for details. *) + +(** The ethernet network our client AppVMs are on. *) + +open Utils + +type t +(** A network for client AppVMs to join. *) + +val create : prefix:Ipaddr.V4.Prefix.t -> client_gw:Ipaddr.V4.t -> t +(** [create ~prefix ~client_gw] is a network of client machines. + Their IP addresses all start with [prefix] and they are configured to + use [client_gw] as their default gateway. *) + +val add_client : t -> client_link -> unit +val remove_client : t -> client_link -> unit + +val prefix : t -> Ipaddr.V4.Prefix.t + +val lookup : t -> Ipaddr.V4.t -> client_link option + +module ARP : sig + (** We already know the correct mapping of IP addresses to MAC addresses, so we never + allow clients to update it. We log a warning if a client attempts to set incorrect + information. *) + + type arp + (** An ARP-responder for one client. *) + + val create : net:t -> client_link -> arp + (** [create ~net client_link] is an ARP responder for [client_link]. + It answers on behalf of other clients in [net] (but not for the client + itself, since the client might be trying to check that its own address is + free). It also answers for the client's gateway address. *) + + val input : arp -> Cstruct.t -> Cstruct.t option + (** Process one ethernet frame containing an ARP message. + Returns a response frame, if one is needed. *) +end diff --git a/client_net.ml b/client_net.ml index 1c148b2..afc36ca 100644 --- a/client_net.ml +++ b/client_net.ml @@ -1,128 +1,94 @@ (* Copyright (C) 2015, Thomas Leonard See the README file for details. *) +open Lwt.Infix open Utils -let src = Logs.Src.create "client_arp" ~doc:"ARP for NetVM clients" +module Netback = Netchannel.Backend.Make(Netchannel.Xenstore.Make(OS.Xs)) +module ClientEth = Ethif.Make(Netback) + +let src = Logs.Src.create "net" ~doc:"Client networking" module Log = (val Logs.src_log src : Logs.LOG) -type t = { - mutable iface_of_ip : client_link IpMap.t; - prefix : Ipaddr.V4.Prefix.t; - client_gw : Ipaddr.V4.t; (* The IP that clients are given as their default gateway. *) -} - -let create ~prefix ~client_gw = - { iface_of_ip = IpMap.empty; client_gw; prefix } - -let prefix t = t.prefix - -let add_client t iface = - let ip = iface#client_ip in - assert (Ipaddr.V4.Prefix.mem ip t.prefix); - (* TODO: Should probably wait for the previous client to disappear. *) - (* assert (not (IpMap.mem ip t.iface_of_ip)); *) - t.iface_of_ip <- t.iface_of_ip |> IpMap.add ip iface - -let remove_client t iface = - let ip = iface#client_ip in - assert (IpMap.mem ip t.iface_of_ip); - t.iface_of_ip <- t.iface_of_ip |> IpMap.remove ip - -let lookup t ip = IpMap.find ip t.iface_of_ip - -module ARP = struct - type arp = { - net : t; - client_link : client_link; - } - - let lookup t ip = - if ip === t.net.client_gw then Some t.client_link#my_mac - else match IpMap.find ip t.net.iface_of_ip with - | Some client_iface -> Some client_iface#client_mac - | None -> None - - let create ~net client_link = {net; client_link} - - type arp_msg = { - op: [ `Request |`Reply |`Unknown of int ]; - sha: Macaddr.t; - spa: Ipaddr.V4.t; - tha: Macaddr.t; - tpa: Ipaddr.V4.t; - } - - let to_wire arp = - let open Arpv4_wire in - (* Obtain a buffer to write into *) - let buf = Cstruct.create (Wire_structs.sizeof_ethernet + sizeof_arp) in - (* Write the ARP packet *) - let dmac = Macaddr.to_bytes arp.tha in - let smac = Macaddr.to_bytes arp.sha in - let spa = Ipaddr.V4.to_int32 arp.spa in - let tpa = Ipaddr.V4.to_int32 arp.tpa in - let op = - match arp.op with - |`Request -> 1 - |`Reply -> 2 - |`Unknown n -> n - in - Wire_structs.set_ethernet_dst dmac 0 buf; - Wire_structs.set_ethernet_src smac 0 buf; - Wire_structs.set_ethernet_ethertype buf 0x0806; (* ARP *) - let arpbuf = Cstruct.shift buf 14 in - set_arp_htype arpbuf 1; - set_arp_ptype arpbuf 0x0800; (* IPv4 *) - set_arp_hlen arpbuf 6; (* ethernet mac size *) - set_arp_plen arpbuf 4; (* ipv4 size *) - set_arp_op arpbuf op; - set_arp_sha smac 0 arpbuf; - set_arp_spa arpbuf spa; - set_arp_tha dmac 0 arpbuf; - set_arp_tpa arpbuf tpa; - buf - - let input_query t frame = - let open Arpv4_wire in - let req_ipv4 = Ipaddr.V4.of_int32 (get_arp_tpa frame) in - Log.info "who-has %s?" (fun f -> f (Ipaddr.V4.to_string req_ipv4)); - if req_ipv4 === t.client_link#client_ip then ( - Log.info "ignoring request for client's own IP" Logs.unit; - None - ) else match lookup t req_ipv4 with - | None -> - Log.info "unknown address; not responding" Logs.unit; - None - | Some req_mac -> - Log.info "responding to: who-has %s?" (fun f -> f (Ipaddr.V4.to_string req_ipv4)); - Some (to_wire { - op = `Reply; - (* The Target Hardware Address and IP are copied from the request *) - tha = Macaddr.of_bytes_exn (copy_arp_sha frame); - tpa = Ipaddr.V4.of_int32 (get_arp_spa frame); - sha = req_mac; - spa = req_ipv4; - }) - - let input_gratuitous t frame = - let open Arpv4_wire in - let spa = Ipaddr.V4.of_int32 (get_arp_spa frame) in - let sha = Macaddr.of_bytes_exn (copy_arp_sha frame) in - match lookup t spa with - | Some real_mac when Macaddr.compare sha real_mac = 0 -> - Log.info "client suggests updating %s -> %s (as expected)" - (fun f -> f (Ipaddr.V4.to_string spa) (Macaddr.to_string sha)); - | Some other_mac -> - Log.warn "client suggests incorrect update %s -> %s (should be %s)" - (fun f -> f (Ipaddr.V4.to_string spa) (Macaddr.to_string sha) (Macaddr.to_string other_mac)); - | None -> - Log.warn "client suggests incorrect update %s -> %s (unexpected IP)" - (fun f -> f (Ipaddr.V4.to_string spa) (Macaddr.to_string sha)) - - let input t frame = - match Arpv4_wire.get_arp_op frame with - |1 -> input_query t frame - |2 -> input_gratuitous t frame; None - |n -> Log.warn "unknown message %d - ignored" (fun f -> f n); None +class client_iface eth client_ip client_mac : client_link = object + method my_mac = ClientEth.mac eth + method client_mac = client_mac + method client_ip = client_ip + method writev ip = + let eth_hdr = eth_header_ipv4 ~src:(ClientEth.mac eth) ~dst:client_mac in + ClientEth.writev eth (fixup_checksums (Cstruct.concat (eth_hdr :: ip))) end + +let clients : Cleanup.t IntMap.t ref = ref IntMap.empty + +let start_client ~router domid = + let cleanup_tasks = Cleanup.create () in + Log.info "start_client in domain %d" (fun f -> f domid); + Lwt.async (fun () -> + Lwt.catch (fun () -> + Dao.client_vifs domid >>= (function + | [] -> return None + | vif :: others -> + if others <> [] then Log.warn "Client has multiple interfaces; using first" Logs.unit; + let { Dao.domid; device_id; client_ip } = vif in + Netback.make ~domid ~device_id >|= fun backend -> + Some (backend, client_ip) + ) >>= function + | None -> Log.warn "Client has no interfaces" Logs.unit; return () + | Some (backend, client_ip) -> + Log.info "Client %d (IP: %s) ready" (fun f -> + f domid (Ipaddr.V4.to_string client_ip)); + ClientEth.connect backend >>= or_fail "Can't make Ethernet device" >>= fun eth -> + let client_mac = Netback.mac backend in + let iface = new client_iface eth client_ip client_mac in + let fixed_arp = Client_eth.ARP.create ~net:(Router.client_eth router) iface in + Router.add_client router iface; + Cleanup.on_cleanup cleanup_tasks (fun () -> Router.remove_client router iface); + Netback.listen backend ( + ClientEth.input + ~arpv4:(fun buf -> + match Client_eth.ARP.input fixed_arp buf with + | None -> return () + | Some frame -> ClientEth.write eth frame + ) + ~ipv4:(fun packet -> + let src = Wire_structs.Ipv4_wire.get_ipv4_src packet |> Ipaddr.V4.of_int32 in + if src === client_ip then Router.forward_ipv4 router packet + else ( + Log.warn "Incorrect source IP %a in IP packet from %a (dropping)" + (fun f -> f Ipaddr.V4.pp_hum src Ipaddr.V4.pp_hum client_ip); + return () + ) + ) + ~ipv6:(fun _buf -> return ()) + eth + ) + ) + (fun ex -> + Log.warn "Error connecting client domain %d: %s" + (fun f -> f domid (Printexc.to_string ex)); + return () + ) + ); + cleanup_tasks + +let listen router = + let backend_vifs = "backend/vif" in + Log.info "Watching %s" (fun f -> f backend_vifs); + Dao.watch_clients (fun new_set -> + (* Check for removed clients *) + !clients |> IntMap.iter (fun key cleanup -> + if not (IntSet.mem key new_set) then ( + clients := !clients |> IntMap.remove key; + Log.info "stop_client %d" (fun f -> f key); + Cleanup.cleanup cleanup + ) + ); + (* Check for added clients *) + new_set |> IntSet.iter (fun key -> + if not (IntMap.mem key !clients) then ( + let cleanup = start_client ~router key in + clients := !clients |> IntMap.add key cleanup + ) + ) + ) diff --git a/client_net.mli b/client_net.mli index 25e281d..7bc2660 100644 --- a/client_net.mli +++ b/client_net.mli @@ -1,40 +1,10 @@ (* Copyright (C) 2015, Thomas Leonard See the README file for details. *) -(** The ethernet network our client AppVMs are on. *) +(** Handling client VMs. *) -open Utils - -type t -(** A network for client AppVMs to join. *) - -val create : prefix:Ipaddr.V4.Prefix.t -> client_gw:Ipaddr.V4.t -> t -(** [create ~prefix ~client_gw] is a network of client machines. - Their IP addresses all start with [prefix] and they are configured to - use [client_gw] as their default gateway. *) - -val add_client : t -> client_link -> unit -val remove_client : t -> client_link -> unit - -val prefix : t -> Ipaddr.V4.Prefix.t - -val lookup : t -> Ipaddr.V4.t -> client_link option - -module ARP : sig - (** We already know the correct mapping of IP addresses to MAC addresses, so we never - allow clients to update it. We log a warning if a client attempts to set incorrect - information. *) - - type arp - (** An ARP-responder for one client. *) - - val create : net:t -> client_link -> arp - (** [create ~net client_link] is an ARP responder for [client_link]. - It answers on behalf of other clients in [net] (but not for the client - itself, since the client might be trying to check that its own address is - free). It also answers for the client's gateway address. *) - - val input : arp -> Cstruct.t -> Cstruct.t option - (** Process one ethernet frame containing an ARP message. - Returns a response frame, if one is needed. *) -end +val listen : Router.t -> 'a Lwt.t +(** [listen router] is a thread that watches for clients being added to and + removed from XenStore. Clients are connected to the client network and + packets are sent via [router]. We ensure the source IP address is correct + before routing a packet. *) diff --git a/net.ml b/net.ml index e62093e..a3aaf6f 100644 --- a/net.ml +++ b/net.ml @@ -14,137 +14,21 @@ module ClientEth = Ethif.Make(Netback) let src = Logs.Src.create "net" ~doc:"Firewall networking" module Log = (val Logs.src_log src : Logs.LOG) -(* The checksum logic doesn't depend on ARP or Eth, but we can't access - IPv4.checksum without applying the functor. *) -let fixup_checksums frame = - match Nat_rewrite.layers frame with - | None -> raise (Invalid_argument "NAT transformation rendered packet unparseable") - | Some (ether, ip, tx) -> - let (just_headers, higherlevel_data) = - Nat_rewrite.recalculate_transport_checksum (ether, ip, tx) - in - [just_headers; higherlevel_data] - module Make(Clock : V1.CLOCK) = struct module Arp = Arpv4.Make(Eth)(Clock)(OS.Time) module IPv4 = Ipv4.Make(Eth)(Arp) module Xs = OS.Xs - let eth_header ~src ~dst = - let open Wire_structs in - let frame = Cstruct.create sizeof_ethernet in - frame |> set_ethernet_src (Macaddr.to_bytes src) 0; - frame |> set_ethernet_dst (Macaddr.to_bytes dst) 0; - set_ethernet_ethertype frame (ethertype_to_int IPv4); - frame - 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 ~src:(Eth.mac eth) ~dst in + 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 - class client_iface eth client_ip client_mac : client_link = object - method my_mac = ClientEth.mac eth - method client_mac = client_mac - method client_ip = client_ip - method writev ip = - let eth_hdr = eth_header ~src:(ClientEth.mac eth) ~dst:client_mac in - ClientEth.writev eth (fixup_checksums (Cstruct.concat (eth_hdr :: ip))) - end - - let or_fail msg = function - | `Ok x -> return x - | `Error _ -> fail (Failure msg) - - let clients : Cleanup.t IntMap.t ref = ref IntMap.empty - - let forward_ipv4 router buf = - match Memory_pressure.status () with - | `Memory_critical -> (* TODO: should happen before copying and async *) - print_endline "Memory low - dropping packet"; - return () - | `Ok -> - match Router.target router buf with - | Some iface -> iface#writev [buf] - | None -> return () - - let start_client ~router domid = - let cleanup_tasks = Cleanup.create () in - Log.info "start_client in domain %d" (fun f -> f domid); - Lwt.async (fun () -> - Lwt.catch (fun () -> - Dao.client_vifs domid >>= (function - | [] -> return None - | vif :: others -> - if others <> [] then Log.warn "Client has multiple interfaces; using first" Logs.unit; - let { Dao.domid; device_id; client_ip } = vif in - Netback.make ~domid ~device_id >|= fun backend -> - Some (backend, client_ip) - ) >>= function - | None -> Log.warn "Client has no interfaces" Logs.unit; return () - | Some (backend, client_ip) -> - Log.info "Client %d (IP: %s) ready" (fun f -> - f domid (Ipaddr.V4.to_string client_ip)); - ClientEth.connect backend >>= or_fail "Can't make Ethernet device" >>= fun eth -> - let client_mac = Netback.mac backend in - let iface = new client_iface eth client_ip client_mac in - let fixed_arp = Client_net.ARP.create ~net:(Router.client_net router) iface in - Router.add_client router iface; - Cleanup.on_cleanup cleanup_tasks (fun () -> Router.remove_client router iface); - Netback.listen backend ( - ClientEth.input - ~arpv4:(fun buf -> - match Client_net.ARP.input fixed_arp buf with - | None -> return () - | Some frame -> ClientEth.write eth frame - ) - ~ipv4:(fun packet -> - let src = Wire_structs.Ipv4_wire.get_ipv4_src packet |> Ipaddr.V4.of_int32 in - if src === client_ip then forward_ipv4 router packet - else ( - Log.warn "Incorrect source IP %a in IP packet from %a (dropping)" - (fun f -> f Ipaddr.V4.pp_hum src Ipaddr.V4.pp_hum client_ip); - return () - ) - ) - ~ipv6:(fun _buf -> return ()) - eth - ) - ) - (fun ex -> - Log.warn "Error connecting client domain %d: %s" - (fun f -> f domid (Printexc.to_string ex)); - return () - ) - ); - cleanup_tasks - - let watch_clients router = - let backend_vifs = "backend/vif" in - Log.info "Watching %s" (fun f -> f backend_vifs); - Dao.watch_clients (fun new_set -> - (* Check for removed clients *) - !clients |> IntMap.iter (fun key cleanup -> - if not (IntSet.mem key new_set) then ( - clients := !clients |> IntMap.remove key; - Log.info "stop_client %d" (fun f -> f key); - Cleanup.cleanup cleanup - ) - ); - (* Check for added clients *) - new_set |> IntSet.iter (fun key -> - if not (IntMap.mem key !clients) then ( - let cleanup = start_client ~router key in - clients := !clients |> IntMap.add key cleanup - ) - ) - ) - let connect_uplink config = let nat_table = Nat_lookup.empty () in let ip = config.Dao.uplink_our_ip in @@ -169,7 +53,7 @@ module Make(Clock : V1.CLOCK) = struct return () | Some frame -> let frame = fixup_checksums frame |> Cstruct.concat in - forward_ipv4 router (Cstruct.shift frame Wire_structs.sizeof_ethernet) in + Router.forward_ipv4 router (Cstruct.shift frame Wire_structs.sizeof_ethernet) in Netif.listen net0 (fun frame -> Eth.input ~arpv4:(Arp.input arp0) @@ -185,14 +69,14 @@ module Make(Clock : V1.CLOCK) = struct 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_net = Client_net.create + 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_net in + ~client_eth in Lwt.join [ - watch_clients router; + Client_net.listen router; netvm_listen router ] end diff --git a/router.ml b/router.ml index df623a2..6cd11cd 100644 --- a/router.ml +++ b/router.ml @@ -7,20 +7,20 @@ let src = Logs.Src.create "router" ~doc:"Router" module Log = (val Logs.src_log src : Logs.LOG) type t = { - client_net : Client_net.t; + client_eth : Client_eth.t; default_gateway : interface; } -let create ~client_net ~default_gateway = { client_net; default_gateway } +let create ~client_eth ~default_gateway = { client_eth; default_gateway } -let client_net t = t.client_net +let client_eth t = t.client_eth let target t buf = let open Wire_structs.Ipv4_wire in let dst_ip = get_ipv4_dst buf |> Ipaddr.V4.of_int32 in Log.debug "Got IPv4: dst=%s" (fun f -> f (Ipaddr.V4.to_string dst_ip)); - if Ipaddr.V4.Prefix.mem dst_ip (Client_net.prefix t.client_net) then ( - match Client_net.lookup t.client_net dst_ip with + if Ipaddr.V4.Prefix.mem dst_ip (Client_eth.prefix t.client_eth) then ( + match Client_eth.lookup t.client_eth dst_ip with | Some client_link -> Some (client_link :> interface) | None -> Log.warn "Packet to unknown internal client %a - dropping" @@ -28,5 +28,15 @@ let target t buf = None ) else Some t.default_gateway -let add_client t = Client_net.add_client t.client_net -let remove_client t = Client_net.remove_client t.client_net +let add_client t = Client_eth.add_client t.client_eth +let remove_client t = Client_eth.remove_client t.client_eth + +let forward_ipv4 router buf = + match Memory_pressure.status () with + | `Memory_critical -> (* TODO: should happen before copying and async *) + print_endline "Memory low - dropping packet"; + return () + | `Ok -> + match target router buf with + | Some iface -> iface#writev [buf] + | None -> return () diff --git a/router.mli b/router.mli index a1ca8a5..8f561e7 100644 --- a/router.mli +++ b/router.mli @@ -9,19 +9,22 @@ type t (** A routing table. *) val create : - client_net:Client_net.t -> + client_eth:Client_eth.t -> default_gateway:interface -> t -(** [create ~client_net ~default_gateway] is a new routing table that routes packets outside - of [client_net] to [default_gateway]. *) +(** [create ~client_eth ~default_gateway] is a new routing table that routes packets outside + of [client_eth] to [default_gateway]. *) -val client_net : t -> Client_net.t +val client_eth : t -> Client_eth.t val target : t -> Cstruct.t -> interface option (** [target t packet] is the interface to which [packet] (an IP packet) should be routed. *) val add_client : t -> client_link -> unit (** [add_client t iface] adds a rule for routing packets addressed to [iface]. - The client's IP address must be within the [client_net] passed to [create]. *) + The client's IP address must be within the [client_eth] passed to [create]. *) val remove_client : t -> client_link -> unit + +val forward_ipv4 : t -> Cstruct.t -> unit Lwt.t +(** [forward_ipv4 t packet] sends the packet to [target t packet]. *) diff --git a/utils.ml b/utils.ml index e1bcd4b..f0c8339 100644 --- a/utils.ml +++ b/utils.ml @@ -31,6 +31,27 @@ class type client_link = object method client_mac : Macaddr.t end +(** An Ethernet header from [src]'s MAC address to [dst]'s with an IPv4 payload. *) +let eth_header_ipv4 ~src ~dst = + let open Wire_structs in + let frame = Cstruct.create sizeof_ethernet in + frame |> set_ethernet_src (Macaddr.to_bytes src) 0; + frame |> set_ethernet_dst (Macaddr.to_bytes dst) 0; + set_ethernet_ethertype frame (ethertype_to_int IPv4); + frame + +(** Recalculate checksums after modifying packets. + Note that frames often arrive with invalid checksums due to checksum offload. + For now, we always calculate valid checksums for out-bound frames. *) +let fixup_checksums frame = + match Nat_rewrite.layers frame with + | None -> raise (Invalid_argument "NAT transformation rendered packet unparseable") + | Some (ether, ip, tx) -> + let (just_headers, higherlevel_data) = + Nat_rewrite.recalculate_transport_checksum (ether, ip, tx) + in + [just_headers; higherlevel_data] + let (===) a b = (Ipaddr.V4.compare a b = 0) let error fmt = @@ -45,3 +66,7 @@ let set_fixed_string buffer str = let len = String.length str in Cstruct.blit_from_string str 0 buffer 0 len; Cstruct.memset (Cstruct.shift buffer len) 0 + +let or_fail msg = function + | `Ok x -> return x + | `Error _ -> fail (Failure msg)