Floodproof

direct/lib/arp.ml

@@ -25,7 +25,6 @@ type entry =
   | Verified of Macaddr.t
 
 type t = {
-  get_etherbuf: unit -> Cstruct.t Lwt.t;
   output: Cstruct.t -> unit Lwt.t;
   get_mac: unit -> Macaddr.t;
   cache: (Ipaddr.V4.t, entry) Hashtbl.t;
@@ -79,7 +78,9 @@ let rec input t frame =
       let tha = Macaddr.of_bytes_exn (copy_arp_sha frame) in
       let spa = Ipaddr.V4.of_int32 (get_arp_tpa frame) in (* the requested address *)
       let tpa = Ipaddr.V4.of_int32 (get_arp_spa frame) in (* the requesting host IPv4 *)
-      output t { op=`Reply; sha; tha; spa; tpa }
+      (* Recycle the frame *)
+      output ~frame t { op=`Reply; sha; tha; spa; tpa } >|= fun () ->
+      OS.Io_page.recycle Cstruct.(frame.buffer)
     end else return ()
   |2 -> (* Reply *)
     let spa = Ipaddr.V4.of_int32 (get_arp_spa frame) in
@@ -98,9 +99,7 @@ let rec input t frame =
     printf "ARP: Unknown message %d ignored\n%!" n;
     return ()
 
-and output t arp =
-  (* Obtain a buffer to write into *)
-  lwt buf = t.get_etherbuf () in
+and output ?(frame=OS.Io_page.(to_cstruct (get 1))) t arp =
   (* Write the ARP packet *)
   let dmac = Macaddr.to_bytes arp.tha in
   let smac = Macaddr.to_bytes arp.sha in
@@ -112,21 +111,21 @@ and output t arp =
     |`Reply -> 2 
     |`Unknown n -> n 
   in
-  set_arp_dst dmac 0 buf;
-  set_arp_src smac 0 buf;
-  set_arp_ethertype buf 0x0806; (* ARP *)
-  set_arp_htype buf 1; 
-  set_arp_ptype buf 0x0800; (* IPv4 *)
-  set_arp_hlen buf 6; (* ethernet mac size *)
-  set_arp_plen buf 4; (* ipv4 size *)
-  set_arp_op buf op;
-  set_arp_sha smac 0 buf;
-  set_arp_spa buf spa;
-  set_arp_tha dmac 0 buf;
-  set_arp_tpa buf tpa;
+  set_arp_dst dmac 0 frame;
+  set_arp_src smac 0 frame;
+  set_arp_ethertype frame 0x0806; (* ARP *)
+  set_arp_htype frame 1; 
+  set_arp_ptype frame 0x0800; (* IPv4 *)
+  set_arp_hlen frame 6; (* ethernet mac size *)
+  set_arp_plen frame 4; (* ipv4 size *)
+  set_arp_op frame op;
+  set_arp_sha smac 0 frame;
+  set_arp_spa frame spa;
+  set_arp_tha dmac 0 frame;
+  set_arp_tpa frame tpa;
   (* Resize buffer to sizeof arp packet *)
-  let buf = Cstruct.sub buf 0 sizeof_arp in
-  t.output buf
+  let frame = Cstruct.sub frame 0 sizeof_arp in
+  t.output frame
 
 (* Send a gratuitous ARP for our IP addresses *)
 let output_garp t =
@@ -186,7 +185,7 @@ let query t ip =
     Lwt_condition.wait cond
   )
 
-let create ~get_etherbuf ~output ~get_mac =
+let create ~output ~get_mac =
   let cache = Hashtbl.create 7 in
   let bound_ips = [] in
-  { output; get_mac; cache; bound_ips; get_etherbuf }
+  { output; get_mac; cache; bound_ips }

direct/lib/arp.mli

@@ -25,10 +25,8 @@ open Printf
     IPv4 -> MAC hashtbl. *)
 type t
 
-(** [create ~get_etherbuf ~output ~get_mac] creates a value of type
-    [t]. *)
-val create: get_etherbuf:(unit -> Cstruct.t Lwt.t) ->
-  output:(Cstruct.t -> unit Lwt.t) -> get_mac:(unit -> Macaddr.t) -> t
+(** [create ~output ~get_mac] creates a value of type [t]. *)
+val create: output:(Cstruct.t -> unit Lwt.t) -> get_mac:(unit -> Macaddr.t) -> t
 
 (** [set_ips arp] sets the bound IP address list, which will xmit a
     GARP packet also. *)

direct/lib/ethif.ml

@@ -40,11 +40,9 @@ cstruct ethernet {
 let default_process t frame =
   match get_ethernet_ethertype frame with
   | 0x0806 -> Arp.input t.arp frame (* ARP *)
-  | 0x0800 -> (* IPv4 *)
-    let payload = Cstruct.shift frame sizeof_ethernet in
-    t.ipv4 payload
-  | 0x86dd -> return () (* IPv6 *) (*printf "Ethif: discarding ipv6\n%!"*)
-  | etype  -> return () (*printf "Ethif: unknown frame %x\n%!" etype*)
+  | 0x0800 -> t.ipv4 frame          (* IPv4 *)
+  | 0x86dd -> return ()             (* IPv6 *)
+  | etype  -> return ()
 
 (* Handle a single input frame *)
 let input t frame =
@@ -62,9 +60,6 @@ let disable_promiscuous t =
 let rec listen t =
   OS.Netif.listen t.netif (input t)
 
-let get_frame t =
-  OS.Netif.get_writebuf t.netif
-
 let write t frame =
   match t.promiscuous with
   |Some f -> f (Output [frame]) >>= fun () -> OS.Netif.write t.netif frame
@@ -81,9 +76,8 @@ let create netif =
   let mac = OS.Netif.mac netif in
   let arp =
     let get_mac () = mac in
-    let get_etherbuf () = OS.Netif.get_writebuf netif in
     let output buf = OS.Netif.write netif buf in
-    Arp.create ~output ~get_mac ~get_etherbuf in
+    Arp.create ~output ~get_mac in
   let t = { netif; ipv4; mac; arp; promiscuous=None; } in
   let listen = listen t in
   (t, listen)

direct/lib/ethif.mli

@@ -86,7 +86,6 @@ val query_arp : t -> Ipaddr.V4.t -> Macaddr.t Lwt.t
     embedded into [t]. Please refer to the documentation of module
     [OS.Netif] for more information. *)
 
-val get_frame : t -> Cstruct.t Lwt.t
 val write : t -> Cstruct.t -> unit Lwt.t
 val writev : t -> Cstruct.t list -> unit Lwt.t
 

direct/lib/icmp.ml

@@ -30,22 +30,24 @@ type t = {
   ip: Ipv4.t;
 }
 
-let input t src hdr buf =
-  match get_icmpv4_ty buf with
+let input t src frame ipv4_hdr ipv4_payload =
+  match get_icmpv4_ty ipv4_payload with
   |0 -> (* echo reply *)
     return (printf "ICMP: discarding echo reply\n%!")
   |8 -> (* echo request *)
     (* convert the echo request into an echo reply *)
     let csum =
-      let orig_csum = get_icmpv4_csum buf in
+      let orig_csum = get_icmpv4_csum ipv4_payload in
       let shift = if orig_csum > 0xffff -0x0800 then 0x0801 else 0x0800 in
       (orig_csum + shift) land 0xffff in
-    set_icmpv4_ty buf 0;
-    set_icmpv4_csum buf csum;
+    set_icmpv4_ty ipv4_payload 0;
+    set_icmpv4_csum ipv4_payload csum;
     (* stick an IPv4 header on the front and transmit *)
-    lwt (ipv4_frame, ipv4_len) = Ipv4.get_header ~proto:`ICMP ~dest_ip:src t.ip in
+    lwt (ipv4_frame, ipv4_len) =
+      Ipv4.get_header ~frame ~proto:`ICMP ~dest_ip:src t.ip in
     let ipv4_frame = Cstruct.set_len ipv4_frame ipv4_len in
-    Ipv4.write t.ip ipv4_frame buf
+    Ipv4.write t.ip ipv4_frame ipv4_payload >|= fun () ->
+    OS.Io_page.recycle Cstruct.(frame.buffer)
   |ty ->
     printf "ICMP unknown ty %d\n" ty; 
     return ()

direct/lib/ipv4.ml

@@ -36,7 +36,7 @@ type t = {
   mutable ip: Ipaddr.V4.t;
   mutable netmask: Ipaddr.V4.t;
   mutable gateways: Ipaddr.V4.t list;
-  mutable icmp: Ipaddr.V4.t -> Cstruct.t -> Cstruct.t -> unit Lwt.t;
+  mutable icmp: Ipaddr.V4.t -> Cstruct.t -> Cstruct.t -> Cstruct.t -> unit Lwt.t;
   mutable udp: src:Ipaddr.V4.t -> dst:Ipaddr.V4.t -> Cstruct.t -> unit Lwt.t;
   mutable tcp: src:Ipaddr.V4.t -> dst:Ipaddr.V4.t -> Cstruct.t -> unit Lwt.t;
 }
@@ -69,15 +69,18 @@ module Routing = struct
     end
 end
 
-let get_header ~proto ~dest_ip t =
-  lwt ethernet_frame = Ethif.get_frame t.ethif in
+let get_header
+    ?(frame=OS.Io_page.(to_cstruct (get 1)))
+    ~proto
+    ~dest_ip
+    t =
   (* Something of a layer violation here, but ARP is awkward *)
   lwt dmac = Routing.destination_mac t dest_ip >|= Macaddr.to_bytes in
   let smac = Macaddr.to_bytes (Ethif.mac t.ethif) in
-  Ethif.set_ethernet_dst dmac 0 ethernet_frame; 
-  Ethif.set_ethernet_src smac 0 ethernet_frame;
-  Ethif.set_ethernet_ethertype ethernet_frame 0x0800;
-  let buf = Cstruct.shift ethernet_frame Ethif.sizeof_ethernet in
+  Ethif.set_ethernet_dst dmac 0 frame; 
+  Ethif.set_ethernet_src smac 0 frame;
+  Ethif.set_ethernet_ethertype frame 0x0800;
+  let buf = Cstruct.shift frame Ethif.sizeof_ethernet in
   (* Write the constant IPv4 header fields *)
   set_ipv4_hlen_version buf ((4 lsl 4) + (5)); (* TODO options *)
   set_ipv4_tos buf 0;
@@ -88,7 +91,7 @@ let get_header ~proto ~dest_ip t =
   set_ipv4_src buf (Ipaddr.V4.to_int32 t.ip);
   set_ipv4_dst buf (Ipaddr.V4.to_int32 dest_ip);
   let len = Ethif.sizeof_ethernet + sizeof_ipv4 in
-  return (ethernet_frame, len)
+  return (frame, len)
 
 let adjust_output_header ~tlen frame =
   let buf = Cstruct.sub frame Ethif.sizeof_ethernet sizeof_ipv4 in
@@ -108,30 +111,31 @@ let write t frame data =
   adjust_output_header ~tlen frame;
   Ethif.writev t.ethif [frame;data]
 
-let writev t ethernet_frame bufs =
-  let tlen = Cstruct.len ethernet_frame - Ethif.sizeof_ethernet + (Cstruct.lenv bufs) in
-  adjust_output_header ~tlen ethernet_frame;
-  Ethif.writev t.ethif (ethernet_frame::bufs)
-
-let input t buf =
-  (* buf pointers to to start of IPv4 header here *)
-  let ihl = (get_ipv4_hlen_version buf land 0xf) * 4 in
-  let src = Ipaddr.V4.of_int32 (get_ipv4_src buf) in
-  let dst = Ipaddr.V4.of_int32 (get_ipv4_dst buf) in
-  let payload_len = get_ipv4_len buf - ihl in
+let writev t frame bufs =
+  let tlen = Cstruct.len frame - Ethif.sizeof_ethernet + (Cstruct.lenv bufs) in
+  adjust_output_header ~tlen frame;
+  Ethif.writev t.ethif (frame::bufs)
+
+let input t frame =
+  (* buf pointers to start of the ethernet header here *)
+  let ipv4_packet = Cstruct.shift frame Ethif.sizeof_ethernet in
+  let ihl = (get_ipv4_hlen_version ipv4_packet land 0xf) * 4 in
+  let src = Ipaddr.V4.of_int32 (get_ipv4_src ipv4_packet) in
+  let dst = Ipaddr.V4.of_int32 (get_ipv4_dst ipv4_packet) in
+  let payload_len = get_ipv4_len ipv4_packet - ihl in
   (* XXX this will raise exception for 0-length payload *)
-  let hdr = Cstruct.sub buf 0 ihl in
-  let data = Cstruct.sub buf ihl payload_len in
-  match get_ipv4_proto buf with
+  let hdr = Cstruct.sub ipv4_packet 0 ihl in
+  let data = Cstruct.sub ipv4_packet ihl payload_len in
+  match get_ipv4_proto ipv4_packet with
   |1 -> (* ICMP *)
-    t.icmp src hdr data
+    t.icmp src frame hdr data
   |6 -> (* TCP *)
     t.tcp ~src ~dst data
   |17 -> (* UDP *)
     t.udp ~src ~dst data
   |proto -> return ( (* printf "IPv4: dropping proto %d\n%!" proto *) )
 
-let default_icmp = fun _ _ _ -> return ()
+let default_icmp = fun _ _ _ _ -> return ()
 let default_udp = fun ~src ~dst _ -> return ()
 let default_tcp = fun ~src ~dst _ -> return ()
 

direct/lib/ipv4.mli

@@ -21,7 +21,16 @@ open Nettypes
 type t
 (** Type of a IPv4 *)
 
-val get_header: proto:[< `ICMP | `TCP | `UDP ] -> dest_ip:Ipaddr.V4.t -> t -> (Cstruct.t * int) Lwt.t
+val get_header:
+  ?frame:Cstruct.t ->
+  proto:[< `ICMP | `TCP | `UDP ] ->
+  dest_ip:Ipaddr.V4.t ->
+  t ->
+  (Cstruct.t * int) Lwt.t
+(** [get_header ?ethernet_frame ~proto ~dest_ip ipv4] allocates a page
+    (or recycle one if [?ethernet_frame <> None] and write an IPv4
+    header on it. It returns the page and the combined size of the
+    ethernet header + IPv4 header. *)
 
 val write: t -> Cstruct.t -> Cstruct.t -> unit Lwt.t
 val writev: t -> Cstruct.t -> Cstruct.t list -> unit Lwt.t
@@ -34,7 +43,7 @@ val set_gateways: t -> Ipaddr.V4.t list -> unit Lwt.t
 val create : Ethif.t -> t * unit Lwt.t
 
 val attach : t ->
-  [<  `ICMP of Ipaddr.V4.t -> Cstruct.t -> Cstruct.t -> unit Lwt.t
+  [<  `ICMP of Ipaddr.V4.t -> Cstruct.t -> Cstruct.t -> Cstruct.t -> unit Lwt.t
     | `UDP of src:Ipaddr.V4.t -> dst:Ipaddr.V4.t -> Cstruct.t -> unit Lwt.t 
     | `TCP of src:Ipaddr.V4.t -> dst:Ipaddr.V4.t -> Cstruct.t -> unit Lwt.t ] -> unit
 val detach : t -> [< `ICMP | `UDP | `TCP ] -> unit