diff --git a/CHANGES b/CHANGES index 093f58c68..ba1210e0e 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,17 @@ +2.5.1 (2015-07-07) + +* Fix regression introduced in 2.5.0 where packet loss could lead to the + connection to become very slow (#157, MagnusS, @talex5, @yomimono and + @balrajsingh) +* Improve the tests: more logging, more tracing and compile to native code when + available, etc (@MagnusS and @talex5) +* Do not raise `Invalid_argument("Lwt.wakeup_result")` everytime a connection + is closed. Also now pass the raised exceptions to `Lwt.async_exception_hook` + instead of ignoring them transparently, so the user can decide to shutdown + its application if something wrong happens (#153, #156, @yomomino and @talex5) +* The `channel` library now lives in a separate repository and is released + separately (#159, @samoht) + 2.5.0 (2015-06-10) * The test runs now produce `.pcap` files (#141, by @MagnusS) * Strip trailing bytes from network packets (#145, by @talex5) diff --git a/_oasis b/_oasis index 4c33dcccf..139ecb8e3 100644 --- a/_oasis +++ b/_oasis @@ -1,9 +1,10 @@ OASISFormat: 0.4 Name: tcpip -Version: 2.5.0 +Version: 2.5.1 Synopsis: Ethernet, TCP/IPv4 and DHCPv4 library Authors: Anil Madhavapeddy, Balraj Singh, Richard Mortier, - Nicolas Ojeda Bar, Thomas Gazagnaire + Nicolas Ojeda Bar, Thomas Gazagnaire, Vincent Bernardoff, + Magnus Skjegstad, Mindy Preston, Thomas Leonard License: ISC Plugins: META (0.4), DevFiles (0.4) BuildTools: ocamlbuild @@ -291,15 +292,15 @@ Library "tcpip-stack-socket" io-page.unix Executable test - CompiledObject: native - Build$: flag(tests) - Path: lib_test - MainIs: test.ml - ByteOpt: -g - BuildDepends: alcotest, oUnit, lwt, lwt.unix, io-page.unix, channel, mirage-profile, - mirage-flow, mirage-vnetif, mirage-console.unix, tcpip.ethif, - tcpip.tcp, pcap-format + CompiledObject: best + Build$: flag(tests) + install: false + Path: lib_test/ + MainIs: test.ml + BuildDepends: alcotest, oUnit, lwt, lwt.unix, io-page.unix, + mirage-profile, mirage-flow, mirage-vnetif, + mirage-console.unix, tcpip.ethif, tcpip.tcp, pcap-format Test test - Run$: flag(tests) - Command: $test -q + Run$: flag(tests) + Command: $test -q diff --git a/_tags b/_tags index a7de87ec6..c3def1e14 100644 --- a/_tags +++ b/_tags @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: c29853b44d503443994beb236b619204) +# DO NOT EDIT (digest: 6b9cf3043caf636197595a91784e90f6) # 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 @@ -153,32 +153,28 @@ true: annot, bin_annot : use_udpv4-socket : use_udpv6-socket # Executable test -"lib_test/test.native": oasis_executable_test_byte -: oasis_executable_test_byte -"lib_test/test.native": pkg_alcotest -"lib_test/test.native": pkg_bytes -"lib_test/test.native": pkg_channel -"lib_test/test.native": pkg_cstruct -"lib_test/test.native": pkg_io-page -"lib_test/test.native": pkg_io-page.unix -"lib_test/test.native": pkg_ipaddr -"lib_test/test.native": pkg_lwt -"lib_test/test.native": pkg_lwt.unix -"lib_test/test.native": pkg_mirage-console.unix -"lib_test/test.native": pkg_mirage-flow -"lib_test/test.native": pkg_mirage-profile -"lib_test/test.native": pkg_mirage-types -"lib_test/test.native": pkg_mirage-vnetif -"lib_test/test.native": pkg_oUnit -"lib_test/test.native": pkg_pcap-format -"lib_test/test.native": use_ethif -"lib_test/test.native": use_ipv4 -"lib_test/test.native": use_ipv6 -"lib_test/test.native": use_tcp -"lib_test/test.native": use_tcpip +: pkg_alcotest +: pkg_bytes +: pkg_cstruct +: pkg_io-page +: pkg_io-page.unix +: pkg_ipaddr +: pkg_lwt +: pkg_lwt.unix +: pkg_mirage-console.unix +: pkg_mirage-flow +: pkg_mirage-profile +: pkg_mirage-types +: pkg_mirage-vnetif +: pkg_oUnit +: pkg_pcap-format +: use_ethif +: use_ipv4 +: use_ipv6 +: use_tcp +: use_tcpip : pkg_alcotest : pkg_bytes -: pkg_channel : pkg_cstruct : pkg_io-page : pkg_io-page.unix diff --git a/lib/META b/lib/META index 849eb2794..20e0d1d46 100644 --- a/lib/META +++ b/lib/META @@ -1,6 +1,6 @@ # OASIS_START -# DO NOT EDIT (digest: 82241de1434b6baba6806f051e2e5673) -version = "2.5.0" +# DO NOT EDIT (digest: 6aa06eed53e9ce5c406bb78c559f0b39) +version = "2.5.1" description = "Ethernet, TCP/IPv4 and DHCPv4 library" requires = "io-page mirage-types ipaddr cstruct mirage-profile bytes" archive(byte) = "tcpip.cma" @@ -10,7 +10,7 @@ archive(native, plugin) = "tcpip.cmxs" xen_linkopts = "-ltcpip_xen_stubs" exists_if = "tcpip.cma" package "xen" ( - version = "2.5.0" + version = "2.5.1" description = "Ethernet, TCP/IPv4 and DHCPv4 library" archive(byte) = "tcpip_xen.cma" archive(byte, plugin) = "tcpip_xen.cma" @@ -20,7 +20,7 @@ package "xen" ( ) package "udpv6-unix" ( - version = "2.5.0" + version = "2.5.1" description = "Ethernet, TCP/IPv4 and DHCPv4 library" requires = "tcpip.udp tcpip.ipv6-unix lwt lwt.unix ipaddr.unix cstruct.lwt io-page.unix" @@ -32,7 +32,7 @@ package "udpv6-unix" ( ) package "udpv6-socket" ( - version = "2.5.0" + version = "2.5.1" description = "Ethernet, TCP/IPv4 and DHCPv4 library" requires = "tcpip.udp lwt lwt.unix ipaddr.unix cstruct.lwt io-page.unix" archive(byte) = "udpv6-socket.cma" @@ -43,7 +43,7 @@ package "udpv6-socket" ( ) package "udpv4-unix" ( - version = "2.5.0" + version = "2.5.1" description = "Ethernet, TCP/IPv4 and DHCPv4 library" requires = "tcpip.udp tcpip.ipv4-unix lwt lwt.unix ipaddr.unix cstruct.lwt io-page.unix" @@ -55,7 +55,7 @@ package "udpv4-unix" ( ) package "udpv4-socket" ( - version = "2.5.0" + version = "2.5.1" description = "Ethernet, TCP/IPv4 and DHCPv4 library" requires = "tcpip.udp lwt lwt.unix ipaddr.unix cstruct.lwt io-page.unix" archive(byte) = "udpv4-socket.cma" @@ -66,7 +66,7 @@ package "udpv4-socket" ( ) package "udp" ( - version = "2.5.0" + version = "2.5.1" description = "Ethernet, TCP/IPv4 and DHCPv4 library" requires = "io-page mirage-types ipaddr cstruct lwt tcpip" archive(byte) = "udp.cma" @@ -77,7 +77,7 @@ package "udp" ( ) package "tcpv6-unix" ( - version = "2.5.0" + version = "2.5.1" description = "Ethernet, TCP/IPv4 and DHCPv4 library" requires = "tcpip.tcp tcpip.ipv6-unix channel lwt lwt.unix mirage-unix mirage-clock-unix ipaddr.unix cstruct.lwt io-page.unix" @@ -89,7 +89,7 @@ package "tcpv6-unix" ( ) package "tcpv6-socket" ( - version = "2.5.0" + version = "2.5.1" description = "Ethernet, TCP/IPv4 and DHCPv4 library" requires = "lwt lwt.unix ipaddr.unix cstruct.lwt io-page.unix" archive(byte) = "tcpv6-socket.cma" @@ -100,7 +100,7 @@ package "tcpv6-socket" ( ) package "tcpv4-unix" ( - version = "2.5.0" + version = "2.5.1" description = "Ethernet, TCP/IPv4 and DHCPv4 library" requires = "tcpip.tcp tcpip.ipv4-unix channel lwt lwt.unix mirage-unix mirage-clock-unix ipaddr.unix cstruct.lwt io-page.unix" @@ -112,7 +112,7 @@ package "tcpv4-unix" ( ) package "tcpv4-socket" ( - version = "2.5.0" + version = "2.5.1" description = "Ethernet, TCP/IPv4 and DHCPv4 library" requires = "lwt lwt.unix ipaddr.unix cstruct.lwt io-page.unix" archive(byte) = "tcpv4-socket.cma" @@ -123,7 +123,7 @@ package "tcpv4-socket" ( ) package "tcp" ( - version = "2.5.0" + version = "2.5.1" description = "Ethernet, TCP/IPv4 and DHCPv4 library" requires = "io-page mirage-types ipaddr cstruct lwt tcpip tcpip.ipv4 tcpip.ipv6 mirage-profile" @@ -135,7 +135,7 @@ package "tcp" ( ) package "stack-unix" ( - version = "2.5.0" + version = "2.5.1" description = "Ethernet, TCP/IPv4 and DHCPv4 library" requires = "tcpip.udpv4-unix tcpip.tcpv4-unix tcpip.udpv6-unix tcpip.tcpv6-unix tcpip.stack-direct lwt lwt.unix ipaddr.unix mirage-unix mirage-clock-unix mirage-console.unix mirage-types.lwt io-page.unix" @@ -147,7 +147,7 @@ package "stack-unix" ( ) package "stack-socket" ( - version = "2.5.0" + version = "2.5.1" description = "Ethernet, TCP/IPv4 and DHCPv4 library" requires = "tcpip.udpv4-socket tcpip.udpv6-socket tcpip.tcpv4-socket tcpip.tcpv6-socket lwt lwt.unix ipaddr.unix io-page.unix" @@ -159,7 +159,7 @@ package "stack-socket" ( ) package "stack-direct" ( - version = "2.5.0" + 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" @@ -171,7 +171,7 @@ package "stack-direct" ( ) package "ipv6-unix" ( - version = "2.5.0" + version = "2.5.1" description = "Ethernet, TCP/IPv4 and DHCPv4 library" requires = "tcpip.ethif-unix tcpip.ipv6 lwt lwt.unix" archive(byte) = "ipv6-unix.cma" @@ -182,7 +182,7 @@ package "ipv6-unix" ( ) package "ipv6" ( - version = "2.5.0" + version = "2.5.1" description = "Ethernet, TCP/IPv4 and DHCPv4 library" requires = "io-page mirage-types ipaddr cstruct lwt tcpip" archive(byte) = "ipv6.cma" @@ -193,7 +193,7 @@ package "ipv6" ( ) package "ipv4-unix" ( - version = "2.5.0" + version = "2.5.1" description = "Ethernet, TCP/IPv4 and DHCPv4 library" requires = "tcpip.ethif-unix tcpip.ipv4 lwt lwt.unix" archive(byte) = "ipv4-unix.cma" @@ -204,7 +204,7 @@ package "ipv4-unix" ( ) package "ipv4" ( - version = "2.5.0" + version = "2.5.1" description = "Ethernet, TCP/IPv4 and DHCPv4 library" requires = "io-page mirage-types ipaddr cstruct lwt tcpip" archive(byte) = "ipv4.cma" @@ -215,7 +215,7 @@ package "ipv4" ( ) package "ethif-unix" ( - version = "2.5.0" + version = "2.5.1" description = "Ethernet, TCP/IPv4 and DHCPv4 library" requires = "tcpip.ethif mirage-net-unix lwt lwt.unix" archive(byte) = "ethif-unix.cma" @@ -226,7 +226,7 @@ package "ethif-unix" ( ) package "ethif" ( - version = "2.5.0" + version = "2.5.1" description = "Ethernet, TCP/IPv4 and DHCPv4 library" requires = "tcpip io-page mirage-types ipaddr cstruct lwt" archive(byte) = "ethif.cma" @@ -237,7 +237,7 @@ package "ethif" ( ) package "dhcpv4" ( - version = "2.5.0" + version = "2.5.1" description = "Ethernet, TCP/IPv4 and DHCPv4 library" requires = "io-page bytes mirage-types ipaddr cstruct lwt tcpip.udp" archive(byte) = "dhcpv4.cma" diff --git a/lib_test/test.ml b/lib_test/test.ml index 7b6fc810c..dc58787e9 100644 --- a/lib_test/test.ml +++ b/lib_test/test.ml @@ -15,7 +15,6 @@ *) let suite = [ - "channel", Test_channel.suite ; "connect", Test_connect.suite ; "iperf" , Test_iperf.suite ; ] diff --git a/lib_test/test_channel.ml b/lib_test/test_channel.ml deleted file mode 100644 index 013ae872c..000000000 --- a/lib_test/test_channel.ml +++ /dev/null @@ -1,62 +0,0 @@ -open Common - -let (>>=) = Lwt.(>>=) - -(* this is a very small set of tests for the channel interface, - intended to ensure that EOF conditions on the underlying flow are - handled properly *) -module Channel = Channel.Make(Fflow) - -let err_read ch = - fail "character %c was returned from Channel.read_char on an empty flow" ch - -let err_no_exception () = fail "no exception" -let err_wrong_exception e = fail "wrong exception: %s" (Printexc.to_string e) - -let test_read_char_eof () = - let f = Fflow.make () in - let c = Channel.create f in - let try_char_read () = Channel.read_char c >>= err_read in - Lwt.try_bind - (try_char_read) - err_no_exception (* "success" case (no exceptions) *) - (function - | End_of_file -> Lwt.return_unit - | e -> err_wrong_exception e) - -let test_read_until_eof () = - let input = - Fflow.input_string "I am the very model of a modern major general" - in - let f = Fflow.make ~input () in - let c = Channel.create f in - Channel.read_until c 'v' >>= function - | true, buf -> - assert_cstruct "wrong flow prefix" - (Cstruct.of_string "I am the ") buf; - Channel.read_until c '\xff' >>= fun (found, buf) -> - assert_bool "found a char that couldn't have been there in read_until" - false found; - assert_cstruct "wrong flow suffix" - (Cstruct.of_string "ery model of a modern major general") buf; - Channel.read_until c '\n' >>= fun (found, buf) -> - assert_bool "found a char after EOF in read_until" - false found; - assert_int "wrong flow size" 0 (Cstruct.len buf); - Lwt.return_unit - | false, _ -> - OUnit.assert_failure "thought we couldn't find a 'v' in input test" - -let test_read_line () = - let input = "I am the very model of a modern major general" in - let f = Fflow.make ~input:(Fflow.input_string input) () in - let c = Channel.create f in - Channel.read_line c >>= fun buf -> - assert_string "read line" input (Cstruct.copyv buf); - Lwt.return_unit - -let suite = [ - "read_char + EOF" , `Quick, test_read_char_eof; - "read_until + EOF", `Quick, test_read_until_eof; - "read_line" , `Quick, test_read_line; -] diff --git a/myocamlbuild.ml b/myocamlbuild.ml index 2e5f5626a..0af1ac268 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -1,5 +1,5 @@ (* OASIS_START *) -(* DO NOT EDIT (digest: cd4ff85aca2247a2744fd57e017cca2e) *) +(* DO NOT EDIT (digest: 92a049a8f370f29a1a91ed14994a8a3b) *) module OASISGettext = struct (* # 22 "src/oasis/OASISGettext.ml" *) @@ -646,13 +646,7 @@ let package_default = [ (OASISExpr.EBool true, S [A "-ccopt"; A "-O2"; A "-ccopt"; A "${XEN_CFLAGS}"]) - ]); - (["oasis_executable_test_byte"; "ocaml"; "link"; "byte"], - [(OASISExpr.EBool true, S [A "-g"])]); - (["oasis_executable_test_byte"; "ocaml"; "ocamldep"; "byte"], - [(OASISExpr.EBool true, S [A "-g"])]); - (["oasis_executable_test_byte"; "ocaml"; "compile"; "byte"], - [(OASISExpr.EBool true, S [A "-g"])]) + ]) ]; includes = [ @@ -669,7 +663,7 @@ let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false} let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;; -# 673 "myocamlbuild.ml" +# 667 "myocamlbuild.ml" (* OASIS_STOP *) Ocamlbuild_plugin.dispatch dispatch_default;; (* Ocamlbuild_pack.Flags.mark_tag_used "tests";; *) diff --git a/opam b/opam index 74501fed3..6b8e86a01 100644 --- a/opam +++ b/opam @@ -9,6 +9,10 @@ authors: [ "Richard Mortier" "Nicolas Ojeda Bar" "Thomas Gazagnaire" + "Vincent Bernardoff" + "Magnus Skjegstad" + "Mindy Preston" + "Thomas Leonard" ] tags: ["org:mirage"] diff --git a/setup.ml b/setup.ml index 28f79bd7e..c26c3e842 100644 --- a/setup.ml +++ b/setup.ml @@ -1,7 +1,7 @@ (* setup.ml generated for the first time by OASIS v0.4.5 *) (* OASIS_START *) -(* DO NOT EDIT (digest: d477705c240c1631201701944b97f72c) *) +(* DO NOT EDIT (digest: ff98a2365d07a6af3bc823f51066ea76) *) (* Regenerated by OASIS v0.4.5 Visit http://oasis.forge.ocamlcore.org for more information and @@ -6851,7 +6851,7 @@ let setup_t = alpha_features = []; beta_features = []; name = "tcpip"; - version = "2.5.0"; + version = "2.5.1"; license = OASISLicense.DEP5License (OASISLicense.DEP5Unit @@ -6869,7 +6869,11 @@ let setup_t = "Balraj Singh"; "Richard Mortier"; "Nicolas Ojeda Bar"; - "Thomas Gazagnaire" + "Thomas Gazagnaire"; + "Vincent Bernardoff"; + "Magnus Skjegstad"; + "Mindy Preston"; + "Thomas Leonard" ]; homepage = None; synopsis = "Ethernet, TCP/IPv4 and DHCPv4 library"; @@ -7805,9 +7809,9 @@ let setup_t = (OASISExpr.EBool true, false); (OASISExpr.EFlag "tests", true) ]; - bs_install = [(OASISExpr.EBool true, true)]; - bs_path = "lib_test"; - bs_compiled_object = Native; + bs_install = [(OASISExpr.EBool true, false)]; + bs_path = "lib_test/"; + bs_compiled_object = Best; bs_build_depends = [ FindlibPackage ("alcotest", None); @@ -7815,7 +7819,6 @@ let setup_t = FindlibPackage ("lwt", None); FindlibPackage ("lwt.unix", None); FindlibPackage ("io-page.unix", None); - FindlibPackage ("channel", None); FindlibPackage ("mirage-profile", None); FindlibPackage ("mirage-flow", None); FindlibPackage ("mirage-vnetif", None); @@ -7831,7 +7834,7 @@ let setup_t = bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; - bs_byteopt = [(OASISExpr.EBool true, ["-g"])]; + bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "test.ml"}); @@ -7871,7 +7874,7 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.4.5"; - oasis_digest = Some "@xO\231\145LZ\156\178)|\149\149\165\187\140"; + oasis_digest = Some "\137Ðxr¶dòeü\158\015¶Ä\140~I"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -7879,6 +7882,6 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 7883 "setup.ml" +# 7886 "setup.ml" (* OASIS_STOP *) let () = setup ();; diff --git a/tcp/segment.ml b/tcp/segment.ml index c8cc2b573..9c6485c42 100644 --- a/tcp/segment.ml +++ b/tcp/segment.ml @@ -296,7 +296,8 @@ module Tx (Time:V1_LWT.TIME) (Clock:V1.CLOCK) = struct Log.f info (fun fmt -> Log.pf fmt "TCP retransmission on timer seq = %d" (Sequence.to_int rexmit_seg.seq)); - Lwt.async (fun () -> xmit ~flags ~wnd ~options ~seq rexmit_seg.data); + Lwt.async + (fun () -> xmit ~flags ~wnd ~options ~seq rexmit_seg.data); Window.backoff_rto wnd; Log.f debug (fun fmt -> Log.pf fmt "PUSHING TIMER - new time = %f, new seq = %a" @@ -352,7 +353,8 @@ module Tx (Time:V1_LWT.TIME) (Clock:V1.CLOCK) = struct let { wnd; _ } = q in let flags=rexmit_seg.flags in let options=[] in (* TODO: put the right options *) - Lwt.async ( fun () -> q.xmit ~flags ~wnd ~options ~seq rexmit_seg.data ); + Lwt.async + (fun () -> q.xmit ~flags ~wnd ~options ~seq rexmit_seg.data); Lwt.return_unit end else Lwt.return_unit