From 0852aa0f437848128f7f9b7b4f2589b5f579317c Mon Sep 17 00:00:00 2001 From: Mindy Date: Sun, 17 Mar 2019 16:32:17 -0500 Subject: [PATCH] use tcpip 3.7, ethernet, arp, mirage-nat 1.1.0 --- client_eth.ml | 36 +++++++++++++++++------------------- client_eth.mli | 2 +- client_net.ml | 37 ++++++++++++++++++------------------- config.ml | 8 ++++++-- firewall.ml | 15 ++++++++++++--- fw_utils.ml | 4 ++-- uplink.ml | 15 +++++++-------- 7 files changed, 63 insertions(+), 54 deletions(-) diff --git a/client_eth.ml b/client_eth.ml index e8e20c1..019e459 100644 --- a/client_eth.ml +++ b/client_eth.ml @@ -82,7 +82,7 @@ module ARP = struct let create ~net client_link = {net; client_link} let input_query t arp = - let req_ipv4 = arp.Arpv4_packet.tpa in + let req_ipv4 = arp.Arp_packet.target_ip in Log.info (fun f -> f "who-has %s?" (Ipaddr.V4.to_string req_ipv4)); if req_ipv4 = t.client_link#other_ip then ( Log.info (fun f -> f "ignoring request for client's own IP"); @@ -93,34 +93,32 @@ module ARP = struct None | Some req_mac -> Log.info (fun f -> f "responding to: who-has %s?" (Ipaddr.V4.to_string req_ipv4)); - let req_spa = arp.Arpv4_packet.spa in - let req_sha = arp.Arpv4_packet.sha in - Some { Arpv4_packet. - op = Arpv4_wire.Reply; + Some { Arp_packet. + operation = Arp_packet.Reply; (* The Target Hardware Address and IP are copied from the request *) - tha = req_sha; - tpa = req_spa; - sha = req_mac; - spa = req_ipv4; + target_ip = arp.Arp_packet.source_ip; + target_mac = arp.Arp_packet.source_mac; + source_ip = req_ipv4; + source_mac = req_mac; } let input_gratuitous t arp = - let spa = arp.Arpv4_packet.spa in - let sha = arp.Arpv4_packet.sha in - match lookup t spa with - | Some real_mac when Macaddr.compare sha real_mac = 0 -> + let source_ip = arp.Arp_packet.source_ip in + let source_mac = arp.Arp_packet.source_mac in + match lookup t source_ip with + | Some real_mac when Macaddr.compare source_mac real_mac = 0 -> Log.info (fun f -> f "client suggests updating %s -> %s (as expected)" - (Ipaddr.V4.to_string spa) (Macaddr.to_string sha)); + (Ipaddr.V4.to_string source_ip) (Macaddr.to_string source_mac)); | Some other_mac -> Log.warn (fun f -> f "client suggests incorrect update %s -> %s (should be %s)" - (Ipaddr.V4.to_string spa) (Macaddr.to_string sha) (Macaddr.to_string other_mac)); + (Ipaddr.V4.to_string source_ip) (Macaddr.to_string source_mac) (Macaddr.to_string other_mac)); | None -> Log.warn (fun f -> f "client suggests incorrect update %s -> %s (unexpected IP)" - (Ipaddr.V4.to_string spa) (Macaddr.to_string sha)) + (Ipaddr.V4.to_string source_ip) (Macaddr.to_string source_mac)) let input t arp = - let op = arp.Arpv4_packet.op in + let op = arp.Arp_packet.operation in match op with - | Arpv4_wire.Request -> input_query t arp - | Arpv4_wire.Reply -> input_gratuitous t arp; None + | Arp_packet.Request -> input_query t arp + | Arp_packet.Reply -> input_gratuitous t arp; None end diff --git a/client_eth.mli b/client_eth.mli index 0851913..952e970 100644 --- a/client_eth.mli +++ b/client_eth.mli @@ -47,7 +47,7 @@ module ARP : sig (** [create ~net client_link] is an ARP responder for [client_link]. It answers only for the client's gateway address. *) - val input : arp -> Arpv4_packet.t -> Arpv4_packet.t option + val input : arp -> Arp_packet.t -> Arp_packet.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 4b906e7..01a27f6 100644 --- a/client_net.ml +++ b/client_net.ml @@ -5,24 +5,24 @@ open Lwt.Infix open Fw_utils module Netback = Netchannel.Backend.Make(Netchannel.Xenstore.Make(OS.Xs)) -module ClientEth = Ethif.Make(Netback) +module ClientEth = Ethernet.Make(Netback) let src = Logs.Src.create "client_net" ~doc:"Client networking" module Log = (val Logs.src_log src : Logs.LOG) -let writev eth data = +let writev eth dst proto fillfn = Lwt.catch (fun () -> - ClientEth.writev eth data >|= function + ClientEth.write eth dst proto fillfn >|= function | Ok () -> () | Error e -> - Log.err (fun f -> f "error trying to send to client:@\n@[ %a@]@\nError: @[%a@]" - Cstruct.hexdump_pp (Cstruct.concat data) ClientEth.pp_error e); + Log.err (fun f -> f "error trying to send to client: @[%a@]" + ClientEth.pp_error e); ) (fun ex -> (* Usually Netback_shutdown, because the client disconnected *) - Log.err (fun f -> f "uncaught exception trying to send to client:@\n@[ %a@]@\nException: @[%s@]" - Cstruct.hexdump_pp (Cstruct.concat data) (Printexc.to_string ex)); + Log.err (fun f -> f "uncaught exception trying to send to client: @[%s@]" + (Printexc.to_string ex)); Lwt.return () ) @@ -32,10 +32,9 @@ class client_iface eth ~gateway_ip ~client_ip client_mac : client_link = object method other_mac = client_mac method my_ip = gateway_ip method other_ip = client_ip - method writev proto ip = + method writev proto fillfn = FrameQ.send queue (fun () -> - let eth_hdr = eth_header proto ~src:(ClientEth.mac eth) ~dst:client_mac in - writev eth (eth_hdr :: ip) + writev eth client_mac proto fillfn ) end @@ -43,15 +42,15 @@ let clients : Cleanup.t Dao.VifMap.t ref = ref Dao.VifMap.empty (** Handle an ARP message from the client. *) let input_arp ~fixed_arp ~iface request = - match Arpv4_packet.Unmarshal.of_cstruct request with + match Arp_packet.decode request with | Error e -> - Log.warn (fun f -> f "Ignored unknown ARP message: %a" Arpv4_packet.Unmarshal.pp_error e); + Log.warn (fun f -> f "Ignored unknown ARP message: %a" Arp_packet.pp_error e); Lwt.return () | Ok arp -> match Client_eth.ARP.input fixed_arp arp with | None -> return () | Some response -> - iface#writev Ethif_wire.ARP [Arpv4_packet.Marshal.make_cstruct response] + iface#writev `ARP (fun b -> Arp_packet.encode_into response b; Arp_packet.size) (** Handle an IPv4 packet from the client. *) let input_ipv4 ~client_ip ~router packet = @@ -81,8 +80,8 @@ let add_vif { Dao.ClientVif.domid; device_id } ~client_ip ~router ~cleanup_tasks Router.add_client router iface >>= fun () -> Cleanup.on_cleanup cleanup_tasks (fun () -> Router.remove_client router iface); 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 + Netback.listen backend ~header_size:14 (fun frame -> + match Ethernet_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 @@ -90,10 +89,10 @@ let add_vif { Dao.ClientVif.domid; device_id } ~client_ip ~router ~cleanup_tasks 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 - | Ethif_wire.ARP -> input_arp ~fixed_arp ~iface payload - | Ethif_wire.IPv4 -> input_ipv4 ~client_ip ~router payload - | Ethif_wire.IPv6 -> return () + match eth.Ethernet_packet.ethertype with + | `ARP -> input_arp ~fixed_arp ~iface payload + | `IPv4 -> input_ipv4 ~client_ip ~router payload + | `IPv6 -> return () (* TODO: oh no! *) ) >|= or_raise "Listen on client interface" Netback.pp_error diff --git a/config.ml b/config.ml index c115c1b..d0f702a 100644 --- a/config.ml +++ b/config.ml @@ -21,13 +21,17 @@ let main = package "vchan"; package "cstruct"; package "astring"; - package "tcpip" ~sublibs:["stack-direct"; "xen"; "arpv4"] ~min:"3.1.0"; + package "tcpip" ~min:"3.7.0"; + package "arp"; + package "arp-mirage"; + package "ethernet"; + package "mirage-protocols"; package "shared-memory-ring" ~min:"3.0.0"; package "netchannel" ~min:"1.8.0"; package "mirage-net-xen" ~min:"1.7.1"; package "ipaddr" ~min:"3.0.0"; package "mirage-qubes"; - package "mirage-nat"; + package "mirage-nat" ~min:"1.1.0"; package "mirage-logs"; ] "Unikernel.Main" (mclock @-> job) diff --git a/firewall.ml b/firewall.ml index 98f5b21..39254d3 100644 --- a/firewall.ml +++ b/firewall.ml @@ -13,9 +13,18 @@ module Log = (val Logs.src_log src : Logs.LOG) let transmit_ipv4 packet iface = Lwt.catch (fun () -> - let transport = Nat_packet.to_cstruct packet in Lwt.catch - (fun () -> iface#writev Ethif_wire.IPv4 transport) + (fun () -> + iface#writev `IPv4 (fun b -> + match Nat_packet.into_cstruct packet b with + | Error e -> + Log.warn (fun f -> f "Failed to write packet to %a: %a" + Ipaddr.V4.pp iface#other_ip + Nat_packet.pp_error e); + 0 + | Ok n -> n + ) + ) (fun ex -> Log.warn (fun f -> f "Failed to write packet to %a: %s" Ipaddr.V4.pp iface#other_ip @@ -35,7 +44,7 @@ let forward_ipv4 t packet = let `IPv4 (ip, _) = packet in match Router.target t ip with | Some iface -> transmit_ipv4 packet iface - | None -> return () + | None -> Lwt.return_unit (* Packet classification *) diff --git a/fw_utils.ml b/fw_utils.ml index f4e63e8..65a769f 100644 --- a/fw_utils.ml +++ b/fw_utils.ml @@ -21,7 +21,7 @@ module IntMap = Map.Make(Int) (** An Ethernet interface. *) class type interface = object method my_mac : Macaddr.t - method writev : Ethif_wire.ethertype -> Cstruct.t list -> unit Lwt.t + method writev : Mirage_protocols.Ethernet.proto -> (Cstruct.t -> int) -> unit Lwt.t method my_ip : Ipaddr.V4.t method other_ip : Ipaddr.V4.t end @@ -34,7 +34,7 @@ end (** An Ethernet header from [src]'s MAC address to [dst]'s with an IPv4 payload. *) let eth_header ethertype ~src ~dst = - Ethif_packet.Marshal.make_cstruct { Ethif_packet.source = src; destination = dst; ethertype } + Ethernet_packet.Marshal.make_cstruct { Ethernet_packet.source = src; destination = dst; ethertype } let error fmt = let err s = Failure s in diff --git a/uplink.ml b/uplink.ml index 5735418..7579292 100644 --- a/uplink.ml +++ b/uplink.ml @@ -4,13 +4,13 @@ open Lwt.Infix open Fw_utils -module Eth = Ethif.Make(Netif) +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_lwt.MCLOCK) = struct - module Arp = Arpv4.Make(Eth)(Clock)(OS.Time) + module Arp = Arp.Make(Eth)(OS.Time) type t = { net : Netif.t; @@ -24,16 +24,15 @@ module Make(Clock : Mirage_clock_lwt.MCLOCK) = struct method my_mac = Eth.mac eth method my_ip = my_ip method other_ip = other_ip - method writev ethertype payload = + method writev ethertype fillfn = FrameQ.send queue (fun () -> mac >>= fun dst -> - let eth_hdr = eth_header ethertype ~src:(Eth.mac eth) ~dst in - Eth.writev eth (eth_hdr :: payload) >|= or_raise "Write to uplink" Eth.pp_error + Eth.write eth dst ethertype fillfn >|= or_raise "Write to uplink" Eth.pp_error ) end let listen t router = - Netif.listen t.net (fun frame -> + Netif.listen t.net ~header_size:14 (fun frame -> (* Handle one Ethernet frame from NetVM *) Eth.input t.eth ~arpv4:(Arp.input t.arp) @@ -56,11 +55,11 @@ module Make(Clock : Mirage_clock_lwt.MCLOCK) = struct let interface t = t.interface - let connect ~clock config = + let connect ~clock:_ config = let ip = config.Dao.uplink_our_ip in Netif.connect "0" >>= fun net -> Eth.connect net >>= fun eth -> - Arp.connect eth clock >>= fun arp -> + Arp.connect eth >>= fun arp -> Arp.add_ip arp ip >>= fun () -> let netvm_mac = Arp.query arp config.Dao.uplink_netvm_ip