diff --git a/CHANGES b/CHANGES index e76539dda..b92f3d07c 100644 --- a/CHANGES +++ b/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 diff --git a/_oasis b/_oasis index 4e11a524f..a45fdc478 100644 --- a/_oasis +++ b/_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 diff --git a/lib/META b/lib/META index c0684ec50..cfe43cd5a 100644 --- a/lib/META +++ b/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" diff --git a/lib/tcpip_stack_direct.ml b/lib/tcpip_stack_direct.ml index 89e8b7d99..6ba3a1faa 100644 --- a/lib/tcpip_stack_direct.ml +++ b/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 diff --git a/lib/tcpip_stack_direct.mli b/lib/tcpip_stack_direct.mli index d7714b06b..1458c905d 100644 --- a/lib/tcpip_stack_direct.mli +++ b/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 diff --git a/setup.ml b/setup.ml index 9bc054a10..000602bb9 100644 --- a/setup.ml +++ b/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 diff --git a/tcp/tcptimer.ml b/tcp/tcptimer.ml index 720a6edf9..c471837c5 100644 --- a/tcp/tcptimer.ml +++ b/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 diff --git a/unix/tcpip_stack_socket.ml b/unix/tcpip_stack_socket.ml index 4719a3262..178865feb 100644 --- a/unix/tcpip_stack_socket.ml +++ b/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,6 +98,7 @@ 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; @@ -100,7 +106,12 @@ module Make(Console:V1_LWT.CONSOLE) = struct 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 diff --git a/unix/tcpip_stack_socket.mli b/unix/tcpip_stack_socket.mli index 91690cd8a..9d47f01d8 100644 --- a/unix/tcpip_stack_socket.mli +++ b/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