Merge pull request #47 from avsm/master

Adapt the Stack interfaces to the v1.1.1 mirage-types interface

CHANGES

@@ -1,3 +1,9 @@
+1.1.1 (21-February-2013):
+* Catch and ignore top-level socket exceptions (#219).
+* Set `SO_REUSEADDR` on listening sockets for Unix (#218).
+* Adapt the Stack interfaces to the v1.1.1 mirage-types interface
+  (see mirage/mirage#226 for details).
+
 1.1.0 (03-February-2013):
 * Rewrite of the library as a set of functors that parameterize the
   stack across the `V1_LWT` module types from Mirage 1.1.x.  This removes

_oasis

@@ -1,6 +1,6 @@
 OASISFormat: 0.3
 Name:        tcpip
-Version:     1.1.0
+Version:     1.1.1
 Synopsis:    Ethernet, TCP/IPv4 and DHCPv4 library
 Authors:     Anil Madhavapeddy, Balraj Singh, Richard Mortier
 License:     ISC

lib/META

@@ -1,6 +1,6 @@
 # OASIS_START
-# DO NOT EDIT (digest: 5648a170b275da36bda34ae44a9d3978)
-version = "1.1.0"
+# DO NOT EDIT (digest: 9a8b579490349a262ad15856fd512d4e)
+version = "1.1.1"
 description = "Ethernet, TCP/IPv4 and DHCPv4 library"
 requires = "io-page mirage-types ipaddr cstruct"
 archive(byte) = "tcpip.cma"
@@ -9,7 +9,7 @@ archive(native) = "tcpip.cmxa"
 archive(native, plugin) = "tcpip.cmxs"
 exists_if = "tcpip.cma"
 package "udpv4-unix" (
- version = "1.1.0"
+ version = "1.1.1"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
  "tcpip.udpv4 tcpip.ipv4-unix lwt lwt.unix ipaddr.unix cstruct.lwt io-page.unix"
@@ -21,7 +21,7 @@ package "udpv4-unix" (
 )
 
 package "udpv4-socket" (
- version = "1.1.0"
+ version = "1.1.1"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires = "tcpip.udpv4 lwt lwt.unix ipaddr.unix cstruct.lwt io-page.unix"
  archive(byte) = "udpv4-socket.cma"
@@ -32,7 +32,7 @@ package "udpv4-socket" (
 )
 
 package "udpv4" (
- version = "1.1.0"
+ version = "1.1.1"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
  "io-page mirage-types ipaddr cstruct cstruct.syntax lwt.syntax lwt tcpip"
@@ -44,7 +44,7 @@ package "udpv4" (
 )
 
 package "tcpv4-unix" (
- version = "1.1.0"
+ version = "1.1.1"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
  "tcpip.tcpv4 tcpip.ipv4-unix tcpip.channel lwt lwt.unix mirage-unix mirage-clock-unix ipaddr.unix cstruct.lwt io-page.unix"
@@ -56,7 +56,7 @@ package "tcpv4-unix" (
 )
 
 package "tcpv4-socket" (
- version = "1.1.0"
+ version = "1.1.1"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires = "lwt lwt.unix ipaddr.unix cstruct.lwt io-page.unix"
  archive(byte) = "tcpv4-socket.cma"
@@ -67,7 +67,7 @@ package "tcpv4-socket" (
 )
 
 package "tcpv4" (
- version = "1.1.0"
+ version = "1.1.1"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
  "io-page mirage-types ipaddr cstruct cstruct.syntax lwt.syntax lwt tcpip tcpip.ipv4"
@@ -79,7 +79,7 @@ package "tcpv4" (
 )
 
 package "stack-unix" (
- version = "1.1.0"
+ version = "1.1.1"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
  "tcpip.udpv4-unix tcpip.tcpv4-unix tcpip.stack-direct lwt lwt.unix ipaddr.unix mirage-unix mirage-clock-unix mirage-console-unix mirage-types.lwt io-page.unix"
@@ -91,7 +91,7 @@ package "stack-unix" (
 )
 
 package "stack-socket" (
- version = "1.1.0"
+ version = "1.1.1"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
  "tcpip.udpv4-socket tcpip.tcpv4-socket lwt lwt.unix ipaddr.unix io-page.unix"
@@ -103,7 +103,7 @@ package "stack-socket" (
 )
 
 package "stack-direct" (
- version = "1.1.0"
+ version = "1.1.1"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
  "io-page mirage-types ipaddr cstruct cstruct.syntax lwt.syntax lwt tcpip.ethif tcpip.udpv4 tcpip.tcpv4 tcpip.dhcpv4"
@@ -115,7 +115,7 @@ package "stack-direct" (
 )
 
 package "ipv4-unix" (
- version = "1.1.0"
+ version = "1.1.1"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires = "tcpip.ethif-unix tcpip.ipv4 lwt lwt.unix"
  archive(byte) = "ipv4-unix.cma"
@@ -126,7 +126,7 @@ package "ipv4-unix" (
 )
 
 package "ipv4" (
- version = "1.1.0"
+ version = "1.1.1"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
  "io-page mirage-types ipaddr cstruct cstruct.syntax lwt.syntax lwt tcpip"
@@ -138,7 +138,7 @@ package "ipv4" (
 )
 
 package "ethif-unix" (
- version = "1.1.0"
+ version = "1.1.1"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires = "tcpip.ethif mirage-net-unix lwt lwt.unix"
  archive(byte) = "ethif-unix.cma"
@@ -149,7 +149,7 @@ package "ethif-unix" (
 )
 
 package "ethif" (
- version = "1.1.0"
+ version = "1.1.1"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
  "tcpip io-page mirage-types ipaddr cstruct cstruct.syntax lwt.syntax lwt"
@@ -161,7 +161,7 @@ package "ethif" (
 )
 
 package "dhcpv4" (
- version = "1.1.0"
+ version = "1.1.1"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
  "io-page mirage-types ipaddr cstruct cstruct.syntax lwt.syntax lwt tcpip.udpv4"
@@ -173,7 +173,7 @@ package "dhcpv4" (
 )
 
 package "channel" (
- version = "1.1.0"
+ version = "1.1.1"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires = "io-page mirage-types ipaddr cstruct lwt.syntax lwt"
  archive(byte) = "channel.cma"

lib/tcpip_stack_direct.ml

@@ -33,11 +33,6 @@ module Make
     (Udpv4   : UDPV4_DIRECT with type ipv4 = Ipv4.t)
     (Tcpv4   : TCPV4_DIRECT with type ipv4 = Ipv4.t) = struct
 
-  module UDPV4 = Udpv4
-  module TCPV4 = Tcpv4
-
-  module Dhcp = Dhcp_clientv4.Make(Console)(Time)(Random)(Ethif)(Ipv4)(Udpv4)
-
   type +'a io = 'a Lwt.t
   type ('a,'b,'c) config = ('a,'b,'c) V1_LWT.stackv4_config
   type console = Console.t
@@ -46,6 +41,12 @@ module Make
   type id = (console, netif, mode) config
   type buffer = Cstruct.t
   type ipv4addr = Ipaddr.V4.t
+  type tcpv4 = Tcpv4.t
+  type udpv4 = Udpv4.t
+
+  module UDPV4 = Udpv4
+  module TCPV4 = Tcpv4
+  module Dhcp = Dhcp_clientv4.Make(Console)(Time)(Random)(Ethif)(Ipv4)(Udpv4)
 
   type t = {
     id    : id;
@@ -65,6 +66,8 @@ module Make
   ]
 
   let id {id} = id
+  let tcpv4 {tcpv4} = tcpv4
+  let udpv4 {udpv4} = udpv4
 
   let listen_udpv4 t ~port callback =
     Hashtbl.replace t.udpv4_listeners port callback

lib/tcpip_stack_direct.mli

@@ -34,5 +34,7 @@ module Make
       with type console = Console.t
        and type netif   = Netif.t
        and type mode    = V1_LWT.direct_stack_config
+       and type udpv4   = Udpv4.t
+       and type tcpv4   = Tcpv4.t
        and module TCPV4 = Tcpv4
        and module UDPV4 = Udpv4

setup.ml

@@ -1,7 +1,7 @@
 (* setup.ml generated for the first time by OASIS v0.4.1 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: cd9371981b4305b55cb6e9d1813a2034) *)
+(* DO NOT EDIT (digest: 8ef69b601321899837dffe150a680556) *)
 (*
    Regenerated by OASIS v0.4.1
    Visit http://oasis.forge.ocamlcore.org for more information and
@@ -6552,7 +6552,7 @@ let setup_t =
           alpha_features = [];
           beta_features = [];
           name = "tcpip";
-          version = "1.1.0";
+          version = "1.1.1";
           license =
             OASISLicense.DEP5License
               (OASISLicense.DEP5Unit
@@ -7254,7 +7254,7 @@ let setup_t =
        };
      oasis_fn = Some "_oasis";
      oasis_version = "0.4.1";
-     oasis_digest = Some "ÿ8<¦ÕF\027^½\159¹\017D\016 §";
+     oasis_digest = Some "c kNH\026\153öå¬\139òt,TB";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false

tcp/tcptimer.ml

@@ -29,30 +29,30 @@ type t = {
 }
 
 module Make(Time:V1_LWT.TIME) = struct
-let t ~period ~expire =
-  let running = false in
-  {period; expire; running}
+  let t ~period ~expire =
+    let running = false in
+    {period; expire; running}
 
-let rec timerloop t s =
-  Time.sleep t.period >>
-  match t.expire s with
-  | Stoptimer ->
+  let rec timerloop t s =
+    Time.sleep t.period >>
+    match t.expire s with
+    | Stoptimer ->
       t.running <- false;
       return ()
-  | Continue d ->
+    | Continue d ->
       timerloop t d
-  | ContinueSetPeriod (p, d) ->
+    | ContinueSetPeriod (p, d) ->
       t.period <- p;
       timerloop t d
 
-let period t = t.period
+  let period t = t.period
 
-let start t ?(p=(period t)) s =
-  if not t.running then begin
-    t.period <- p;
-    t.running <- true;
-    let _ = timerloop t s in
-    return ()
-  end else 
-    return ()
+  let start t ?(p=(period t)) s =
+    if not t.running then begin
+      t.period <- p;
+      t.running <- true;
+      let _ = timerloop t s in
+      return ()
+    end else 
+      return ()
 end

unix/tcpip_stack_socket.ml

@@ -42,6 +42,9 @@ module Make(Console:V1_LWT.CONSOLE) = struct
   module TCPV4 = Tcpv4_socket
   module UDPV4 = Udpv4_socket
 
+  type udpv4 = Udpv4_socket.t
+  type tcpv4 = Tcpv4_socket.t
+
   type t = {
     id    : id;
     c     : Console.t;
@@ -56,6 +59,8 @@ module Make(Console:V1_LWT.CONSOLE) = struct
   ]
 
   let id {id} = id
+  let udpv4 {udpv4} = udpv4
+  let tcpv4 {tcpv4} = tcpv4
 
   (* List of IP addresses to bind to *)
   let configure t addrs =
@@ -93,14 +98,20 @@ module Make(Console:V1_LWT.CONSOLE) = struct
   let listen_tcpv4 t ~port callback =
     let open Lwt_unix in
     let fd = socket PF_INET SOCK_STREAM 0 in
+    setsockopt fd SO_REUSEADDR true;
     let interface = Ipaddr_unix.V4.to_inet_addr Ipaddr.V4.any in (* TODO *)
     bind fd (ADDR_INET (interface, port));
     listen fd 10;
     let _t = 
       while_lwt true do (* TODO cancellation *)
         Lwt_unix.accept fd
         >>= fun (afd, sa) ->
-        ignore_result (callback afd >>= fun () -> return_unit);
+        ignore_result (
+          try_lwt
+            callback afd
+            >>= fun () -> return_unit
+          with exn -> return_unit
+        );
         return ();
       done
     in

unix/tcpip_stack_socket.mli

@@ -18,5 +18,7 @@ module Make(Console:V1_LWT.CONSOLE) : V1_LWT.STACKV4
   with type console = Console.t
    and type netif   = Ipaddr.V4.t list
    and type mode    = unit
+   and type tcpv4   = Tcpv4_socket.t
+   and type udpv4   = Udpv4_socket.t
    and module UDPV4 = Udpv4_socket
    and module TCPV4 = Tcpv4_socket