Expose Arpv4.Make functor; require arp argument for Ipv4.connect

.travis.yml

@@ -1,5 +1,5 @@
 language: c
 script: bash -ex .travis-ci.sh
 env:
-  - OCAML_VERSION=4.02 PACKAGE=tcpip MIRAGE_MODE=unix
-  - 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"
+  - 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

@@ -40,12 +40,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
@@ -118,6 +126,7 @@ Library "tcpip-stack-direct"
                       cstruct,
                       lwt,
                       tcpip.ethif,
+                      tcpip.arpv4,
                       tcpip.udp,
                       tcpip.tcp,
                       tcpip.dhcpv4
@@ -133,6 +142,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

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: ff3f3aaffeb9a8ae52f69f7e1b8a25ee)
+# DO NOT EDIT (digest: 5eda5b7653b9bd749a0150b351c8c7d1)
 # 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
@@ -83,11 +85,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
@@ -97,6 +101,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
@@ -119,11 +125,13 @@ true: annot, bin_annot
 "unix/tcpv6-socket.cmxs": use_tcpv6-socket
 # Library tcpip-stack-unix
 "unix/tcpip-stack-unix.cmxs": use_tcpip-stack-unix
+<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_channel
 <unix/*.ml{,i,y}>: use_dhcpv4
 <unix/*.ml{,i,y}>: use_ethif

lib/META

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 8744f03c92c9b635c7a66256a0357ddf)
+# DO NOT EDIT (digest: 85b6059fe7bf288561afaa7f08ec8a15)
 version = "2.4.3"
 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.4.3"
  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"
@@ -257,5 +257,27 @@ package "channel" (
  archive(native, plugin) = "channel.cmxs"
  exists_if = "channel.cma"
 )
+
+package "arpv4-unix" (
+ version = "2.4.3"
+ 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.4.3"
+ 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,12 @@ 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 ethif = Ethif.t
+  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 *)
@@ -80,14 +65,14 @@ module Make (Ethif : V1_LWT.ETHIF) (Clock : V1.CLOCK) (Time : V1_LWT.TIME) = str
   (* Prettyprint cache contents *)
   let prettyprint t =
     printf "ARP info:\n";
-    Hashtbl.iter (fun ip entry ->
-        printf "%s -> %s\n%!"
+    Hashtbl.fold (fun ip entry existing -> existing ^
+        sprintf "%s -> %s\n%!"
           (Ipaddr.V4.to_string ip)
           (match entry with
            | Pending _ -> "I"
            | Confirmed (_, mac) -> sprintf "V(%s)" (Macaddr.to_string mac)
           )
-      ) t.cache
+      ) t.cache ""
 
   let notify t ip mac =
     let now = Clock.time () in
@@ -105,6 +90,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 +120,7 @@ module Make (Ethif : V1_LWT.ETHIF) (Clock : V1.CLOCK) (Time : V1_LWT.TIME) = str
       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 *)
@@ -193,12 +180,12 @@ module Make (Ethif : V1_LWT.ETHIF) (Clock : V1.CLOCK) (Time : V1_LWT.TIME) = str
   let add_ip t ip =
     if not (List.mem ip t.bound_ips) then
       set_ips t (ip :: t.bound_ips)
-    else return_unit
+    else Lwt.return_unit
 
   let remove_ip t ip =
     if List.mem ip t.bound_ips then
       set_ips t (List.filter ((<>) ip) t.bound_ips)
-    else return_unit
+    else Lwt.return_unit
 
   (* Query the cache for an ARP entry, which may result in the sender sleeping
      waiting for a response *)
@@ -233,10 +220,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

lib/ipv4.ml

@@ -17,9 +17,7 @@
 open Lwt
 open Printf
 
-module Make(Ethif : V1_LWT.ETHIF) (Clock : V1.CLOCK) (Time : V1_LWT.TIME) = struct
-
-  module Arpv4 = Arpv4.Make (Ethif) (Clock) (Time)
+module Make(Ethif: V1_LWT.ETHIF) (Arpv4 : V1_LWT.ARP) = struct
 
   (** IO operation errors *)
   type error = [
@@ -36,7 +34,7 @@ module Make(Ethif : V1_LWT.ETHIF) (Clock : V1.CLOCK) (Time : V1_LWT.TIME) = stru
   type macaddr = Ethif.macaddr
 
   type t = {
-    ethif: Ethif.t;
+    ethif : Ethif.t;
     arp : Arpv4.t;
     mutable ip: Ipaddr.V4.t;
     mutable netmask: Ipaddr.V4.t;
@@ -195,11 +193,10 @@ module Make(Ethif : V1_LWT.ETHIF) (Clock : V1.CLOCK) (Time : V1_LWT.TIME) = stru
       | None       -> default ~proto ~src ~dst data
     end else return_unit
 
-  let connect ethif =
+  let connect ethif arp =
     let ip = Ipaddr.V4.any in
     let netmask = Ipaddr.V4.any in
     let gateways = [] in
-    let arp = Arpv4.create ethif in
     let t = { ethif; arp; ip; netmask; gateways } in
     return (`Ok t)
 

lib/ipv4.mldylib

@@ -1,5 +1,4 @@
 # OASIS_START
-# DO NOT EDIT (digest: cb71e7ddbe984c8104a4a6c58420a5a6)
+# DO NOT EDIT (digest: e53211788365c0a2b1be74b682c19983)
 Ipv4
-Arpv4
 # OASIS_STOP

lib/ipv4.mli

@@ -14,7 +14,7 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
-module Make ( N:V1_LWT.ETHIF ) ( C:V1.CLOCK ) ( T:V1_LWT.TIME ) : sig
+module Make (N:V1_LWT.ETHIF) (A: V1_LWT.ARP) : sig
   include V1_LWT.IPV4 with type ethif = N.t
-  val connect : ethif -> [> `Ok of t | `Error of error ] Lwt.t
+  val connect : ethif -> A.t -> [> `Ok of t | `Error of error ] Lwt.t
 end

lib/ipv4.mllib

@@ -1,5 +1,4 @@
 # OASIS_START
-# DO NOT EDIT (digest: cb71e7ddbe984c8104a4a6c58420a5a6)
+# DO NOT EDIT (digest: e53211788365c0a2b1be74b682c19983)
 Ipv4
-Arpv4
 # OASIS_STOP