Merge pull request #155 from yomimono/separate_arp

Pull arpv4 module out of ipv4.

.travis.yml

@@ -1,5 +1,5 @@
 language: c
 script: bash -ex .travis-ci.sh
 env:
-  - UPDATE_GCC_BINUTILS=1 OCAML_VERSION=4.02 PACKAGE=tcpip MIRAGE_MODE=unix
-  - UPDATE_GCC_BINUTILS=1 OCAML_VERSION=4.01 PACKAGE=tcpip MIRAGE_MODE=xen
+  - OCAML_VERSION=4.02 PACKAGE=tcpip MIRAGE_MODE=unix PINS="mirage-types:https://github.com/yomimono/mirage.git#separate_arp mirage:https://github.com/yomimono/mirage.git#separate_arp"
+  - UPDATE_GCC_BINUTILS=1 OCAML_VERSION=4.01 PACKAGE=tcpip MIRAGE_MODE=xen PINS="mirage-types:https://github.com/yomimono/mirage.git#separate_arp mirage:https://github.com/yomimono/mirage.git#separate_arp"

_oasis

@@ -41,12 +41,20 @@ Library ethif
   Modules:            Ethif
   BuildDepends:       tcpip,io-page,mirage-types,ipaddr,cstruct,lwt
 
+Library arpv4
+  CompiledObject:     best
+  Path:               lib
+  Findlibparent:      tcpip
+  Findlibname:        arpv4
+  Modules:            Arpv4, Arpv4_wire
+  BuildDepends:       tcpip,io-page,mirage-types,ipaddr,cstruct,lwt,cstruct.syntax
+
 Library ipv4
   CompiledObject:     best
   Path:               lib
   Findlibparent:      tcpip
   Findlibname:        ipv4
-  Modules:            Ipv4, Arpv4
+  Modules:            Ipv4
   BuildDepends:       io-page,mirage-types,ipaddr,cstruct,lwt,tcpip
 
 Library ipv6
@@ -109,6 +117,7 @@ Library "tcpip-stack-direct"
                       cstruct,
                       lwt,
                       tcpip.ethif,
+                      tcpip.arpv4,
                       tcpip.udp,
                       tcpip.tcp,
                       tcpip.dhcpv4
@@ -124,6 +133,17 @@ Library "ethif-unix"
                       lwt,
                       lwt.unix
 
+Library "arpv4-unix"
+  CompiledObject:     best
+  Path:               unix
+  Findlibparent:      tcpip
+  Findlibname:        arpv4-unix
+  Modules:            Arpv4_unix
+  BuildDepends:       tcpip.ethif,
+                      mirage-net-unix,
+                      lwt,
+                      lwt.unix
+
 Library "ipv4-unix"
   CompiledObject:     best
   Path:               unix
@@ -297,9 +317,10 @@ Executable test
   install:            false
   Path:               lib_test/
   MainIs:             test.ml
+  Custom:             true
   BuildDepends:       alcotest, oUnit, lwt, lwt.unix, io-page.unix,
                       mirage-profile, mirage-flow, mirage-vnetif,
-                      mirage-console.unix, tcpip.ethif, tcpip.tcp, pcap-format
+                      mirage-console.unix, mirage-clock-unix, tcpip.ethif, tcpip.tcp, pcap-format
 
 Test test
   Run$:               flag(tests)

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 6b9cf3043caf636197595a91784e90f6)
+# DO NOT EDIT (digest: b9afd8f7c25862ce87cac4dd55d2c26b)
 # Ignore VCS directories, you can use the same kind of rule outside
 # OASIS_START/STOP if you want to exclude directories that contains
 # useless stuff for the build process
@@ -32,6 +32,8 @@ true: annot, bin_annot
 <lib/tcpip_xen.{cma,cmxa}>: use_libtcpip_xen_stubs
 # Library ethif
 "lib/ethif.cmxs": use_ethif
+# Library arpv4
+"lib/arpv4.cmxs": use_arpv4
 # Library ipv4
 "lib/ipv4.cmxs": use_ipv4
 # Library ipv6
@@ -78,11 +80,13 @@ true: annot, bin_annot
 "lib/tcpip-stack-direct.cmxs": use_tcpip-stack-direct
 <lib/*.ml{,i,y}>: pkg_bytes
 <lib/*.ml{,i,y}>: pkg_cstruct
+<lib/*.ml{,i,y}>: pkg_cstruct.syntax
 <lib/*.ml{,i,y}>: pkg_io-page
 <lib/*.ml{,i,y}>: pkg_ipaddr
 <lib/*.ml{,i,y}>: pkg_lwt
 <lib/*.ml{,i,y}>: pkg_mirage-profile
 <lib/*.ml{,i,y}>: pkg_mirage-types
+<lib/*.ml{,i,y}>: use_arpv4
 <lib/*.ml{,i,y}>: use_dhcpv4
 <lib/*.ml{,i,y}>: use_ethif
 <lib/*.ml{,i,y}>: use_ipv4
@@ -92,6 +96,8 @@ true: annot, bin_annot
 <lib/*.ml{,i,y}>: use_udp
 # Library ethif-unix
 "unix/ethif-unix.cmxs": use_ethif-unix
+# Library arpv4-unix
+"unix/arpv4-unix.cmxs": use_arpv4-unix
 # Library ipv4-unix
 "unix/ipv4-unix.cmxs": use_ipv4-unix
 # Library ipv6-unix
@@ -115,11 +121,13 @@ true: annot, bin_annot
 # Library tcpip-stack-unix
 "unix/tcpip-stack-unix.cmxs": use_tcpip-stack-unix
 <unix/*.ml{,i,y}>: pkg_channel
+<unix/*.ml{,i,y}>: pkg_cstruct.syntax
 <unix/*.ml{,i,y}>: pkg_mirage-clock-unix
 <unix/*.ml{,i,y}>: pkg_mirage-console.unix
 <unix/*.ml{,i,y}>: pkg_mirage-net-unix
 <unix/*.ml{,i,y}>: pkg_mirage-types.lwt
 <unix/*.ml{,i,y}>: pkg_mirage-unix
+<unix/*.ml{,i,y}>: use_arpv4
 <unix/*.ml{,i,y}>: use_dhcpv4
 <unix/*.ml{,i,y}>: use_ethif
 <unix/*.ml{,i,y}>: use_ethif-unix
@@ -161,6 +169,7 @@ true: annot, bin_annot
 <lib_test/test.{native,byte}>: pkg_ipaddr
 <lib_test/test.{native,byte}>: pkg_lwt
 <lib_test/test.{native,byte}>: pkg_lwt.unix
+<lib_test/test.{native,byte}>: pkg_mirage-clock-unix
 <lib_test/test.{native,byte}>: pkg_mirage-console.unix
 <lib_test/test.{native,byte}>: pkg_mirage-flow
 <lib_test/test.{native,byte}>: pkg_mirage-profile
@@ -181,6 +190,7 @@ true: annot, bin_annot
 <lib_test/*.ml{,i,y}>: pkg_ipaddr
 <lib_test/*.ml{,i,y}>: pkg_lwt
 <lib_test/*.ml{,i,y}>: pkg_lwt.unix
+<lib_test/*.ml{,i,y}>: pkg_mirage-clock-unix
 <lib_test/*.ml{,i,y}>: pkg_mirage-console.unix
 <lib_test/*.ml{,i,y}>: pkg_mirage-flow
 <lib_test/*.ml{,i,y}>: pkg_mirage-profile
@@ -193,6 +203,7 @@ true: annot, bin_annot
 <lib_test/*.ml{,i,y}>: use_ipv6
 <lib_test/*.ml{,i,y}>: use_tcp
 <lib_test/*.ml{,i,y}>: use_tcpip
+<lib_test/test.{native,byte}>: custom
 # OASIS_STOP
 true: annot, bin_annot, principal, strict_sequence, debug
 <tcp/pcb.ml>: pkg_cstruct.syntax

lib/META

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 6aa06eed53e9ce5c406bb78c559f0b39)
+# DO NOT EDIT (digest: b312e78e8475ee39ff695adf9eb35d35)
 version = "2.5.1"
 description = "Ethernet, TCP/IPv4 and DHCPv4 library"
 requires = "io-page mirage-types ipaddr cstruct mirage-profile bytes"
@@ -162,7 +162,7 @@ package "stack-direct" (
  version = "2.5.1"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
- "io-page mirage-types ipaddr cstruct lwt tcpip.ethif tcpip.udp tcpip.tcp tcpip.dhcpv4"
+ "io-page mirage-types ipaddr cstruct lwt tcpip.ethif tcpip.arpv4 tcpip.udp tcpip.tcp tcpip.dhcpv4"
  archive(byte) = "tcpip-stack-direct.cma"
  archive(byte, plugin) = "tcpip-stack-direct.cma"
  archive(native) = "tcpip-stack-direct.cmxa"
@@ -246,5 +246,27 @@ package "dhcpv4" (
  archive(native, plugin) = "dhcpv4.cmxs"
  exists_if = "dhcpv4.cma"
 )
+
+package "arpv4-unix" (
+ version = "2.5.1"
+ description = "Ethernet, TCP/IPv4 and DHCPv4 library"
+ requires = "tcpip.ethif mirage-net-unix lwt lwt.unix"
+ archive(byte) = "arpv4-unix.cma"
+ archive(byte, plugin) = "arpv4-unix.cma"
+ archive(native) = "arpv4-unix.cmxa"
+ archive(native, plugin) = "arpv4-unix.cmxs"
+ exists_if = "arpv4-unix.cma"
+)
+
+package "arpv4" (
+ version = "2.5.1"
+ description = "Ethernet, TCP/IPv4 and DHCPv4 library"
+ requires = "tcpip io-page mirage-types ipaddr cstruct lwt cstruct.syntax"
+ archive(byte) = "arpv4.cma"
+ archive(byte, plugin) = "arpv4.cma"
+ archive(native) = "arpv4.cmxa"
+ archive(native, plugin) = "arpv4.cmxs"
+ exists_if = "arpv4.cma"
+)
 # OASIS_STOP
 

lib/arpv4.ml

@@ -28,8 +28,6 @@ module Make (Ethif : V1_LWT.ETHIF) (Clock : V1.CLOCK) (Time : V1_LWT.TIME) = str
     tpa: Ipaddr.V4.t;
   }
 
-  (* TODO implement the full ARP state machine (pending, failed, timer thread, etc) *)
-
   type result = [ `Ok of Macaddr.t | `Timeout ]
 
   type entry =
@@ -42,25 +40,14 @@ module Make (Ethif : V1_LWT.ETHIF) (Clock : V1.CLOCK) (Time : V1_LWT.TIME) = str
     mutable bound_ips: Ipaddr.V4.t list;
   }
 
-  cstruct arp {
-    uint8_t dst[6];
-    uint8_t src[6];
-    uint16_t ethertype;
-    uint16_t htype;
-    uint16_t ptype;
-    uint8_t hlen;
-    uint8_t plen;
-    uint16_t op;
-    uint8_t sha[6];
-    uint32_t spa;
-    uint8_t tha[6];
-    uint32_t tpa
-  } as big_endian
-
-  cenum op {
-    Op_request = 1;
-    Op_reply
-  } as uint16_t
+  type 'a io = 'a Lwt.t
+  type buffer = Cstruct.t
+  type ipaddr = Ipaddr.V4.t
+  type macaddr = Macaddr.t
+  type ethif = Ethif.t
+  type repr = string
+  type id = t
+  type error
 
   let arp_timeout = 60. (* age entries out of cache after this many seconds *)
   let probe_repeat_delay = 1.5 (* per rfc5227, 2s >= probe_repeat_delay >= 1s *)
@@ -77,17 +64,18 @@ module Make (Ethif : V1_LWT.ETHIF) (Clock : V1.CLOCK) (Time : V1_LWT.TIME) = str
     List.iter (Hashtbl.remove t.cache) expired;
     Time.sleep arp_timeout >>= tick t
 
-  (* Prettyprint cache contents *)
-  let prettyprint t =
-    printf "ARP info:\n";
-    Hashtbl.iter (fun ip entry ->
-        printf "%s -> %s\n%!"
-          (Ipaddr.V4.to_string ip)
-          (match entry with
-           | Pending _ -> "I"
-           | Confirmed (_, mac) -> sprintf "V(%s)" (Macaddr.to_string mac)
-          )
-      ) t.cache
+  let to_repr t =
+    let print ip entry acc =
+      let key = Ipaddr.V4.to_string ip in
+      match entry with
+       | Pending _ -> acc ^ "\n" ^ key ^ " -> " ^ "Pending" 
+       | Confirmed (time, mac) -> Printf.sprintf "%s\n%s -> Confirmed (%s) (expires %f)\n%!" 
+                                    acc key (Macaddr.to_string mac) time
+    in
+    Lwt.return (Hashtbl.fold print t.cache "")
+
+  let pp fmt repr =
+    Format.fprintf fmt "%s" repr
 
   let notify t ip mac =
     let now = Clock.time () in
@@ -105,6 +93,7 @@ module Make (Ethif : V1_LWT.ETHIF) (Clock : V1.CLOCK) (Time : V1_LWT.TIME) = str
 
   (* Input handler for an ARP packet, registered through attach() *)
   let rec input t frame =
+    let open Arpv4_wire in
     MProf.Trace.label "arpv4.input";
     match get_arp_op frame with
     |1 -> (* Request *)
@@ -134,6 +123,7 @@ module Make (Ethif : V1_LWT.ETHIF) (Clock : V1.CLOCK) (Time : V1_LWT.TIME) = str
       Lwt.return_unit
 
   and output t arp =
+    let open Arpv4_wire in
     (* Obtain a buffer to write into *)
     let buf = Io_page.to_cstruct (Io_page.get 1) in
     (* Write the ARP packet *)
@@ -233,10 +223,12 @@ module Make (Ethif : V1_LWT.ETHIF) (Clock : V1.CLOCK) (Time : V1_LWT.TIME) = str
       Lwt.async (retry 0);
       response
 
-  let create ethif =
+  let connect ethif =
     let cache = Hashtbl.create 7 in
     let bound_ips = [] in
     let t = { ethif; cache; bound_ips } in
     Lwt.async (tick t);
-    t
+    Lwt.return (`Ok t)
+
+  let disconnect t = Lwt.return_unit (* TODO: should kill tick *)
 end

lib/arpv4.mldylib

@@ -0,0 +1,5 @@
+# OASIS_START
+# DO NOT EDIT (digest: 5194760ef3cd01243f8b4b4dc5e5d3b9)
+Arpv4
+Arpv4_wire
+# OASIS_STOP

lib/arpv4.mli

@@ -15,45 +15,11 @@
  *
  *)
 
-(** INTERNAL: ARP protocol. *)
-
 module Make (Ethif : V1_LWT.ETHIF) (Clock : V1.CLOCK) (Time : V1_LWT.TIME) : sig
+  include V1_LWT.ARP
 
-  (** Type of an ARP record. ARP records are included in Ethif.t
-      values. They contain, among other bits, a list of bound IPs, and a
-      IPv4 -> MAC hashtbl. *)
-  type t
-
-  (** [create ~get_etherbuf ~output ~get_mac] creates a value of type
-      [t]. *)
-  val create: Ethif.t -> t
-
-  (** [set_ips arp] sets the bound IP address list, which will xmit a
-      GARP packet also. *)
-  val set_ips: t -> Ipaddr.V4.t list -> unit Lwt.t
-
-  (** [get_ips arp] gets the bound IP address list in the [arp]
-      value. *)
-  val get_ips: t -> Ipaddr.V4.t list
-
-  (** [add_ip arp ip] adds [ip] to the bound IP address list in the
-      [arp] value, which will xmit a GARP packet also. *)
-  val add_ip: t -> Ipaddr.V4.t -> unit Lwt.t
-
-  (** [remove_ip arp ip] removes [ip] to the bound IP address list in
-      the [arp] value, which will xmit a GARP packet also. *)
-  val remove_ip: t -> Ipaddr.V4.t -> unit Lwt.t
-
-  (** [input arp frame] will handle an ethernet frame containing an ARP
-      packet. If it is a response, it will update its cache, otherwise
-      will try to satisfy the request. *)
-  val input: t -> Cstruct.t -> unit Lwt.t
-
-  (** [query arp ip] queries the cache in [arp] for an ARP entry
-      corresponding to [ip], which may result in the sender sleeping
-      waiting for a response. *)
-  val query: t -> Ipaddr.V4.t -> [ `Ok of Macaddr.t | `Timeout ] Lwt.t
+  type ethif = Ethif.t
 
-  (** Prettyprint cache contents *)
-  val prettyprint: t -> unit
+  (** [connect] creates a value of type [t]. *)
+  val connect : ethif -> [> `Ok of t | `Error of error ] Lwt.t
 end

lib/arpv4.mllib

@@ -0,0 +1,5 @@
+# OASIS_START
+# DO NOT EDIT (digest: 5194760ef3cd01243f8b4b4dc5e5d3b9)
+Arpv4
+Arpv4_wire
+# OASIS_STOP

lib/arpv4_wire.ml

@@ -0,0 +1,19 @@
+cstruct arp {
+  uint8_t dst[6];
+  uint8_t src[6];
+  uint16_t ethertype;
+  uint16_t htype;
+  uint16_t ptype;
+  uint8_t hlen;
+  uint8_t plen;
+  uint16_t op;
+  uint8_t sha[6];
+  uint32_t spa;
+  uint8_t tha[6];
+  uint32_t tpa
+} as big_endian
+
+cenum op {
+  Op_request = 1;
+  Op_reply
+} as uint16_t