Merge pull request mirage#131 from samoht/channel-read-line

Channel read line

CHANGES

@@ -1,3 +1,7 @@
+2.4.3 (2015-05-05)
+* Fix infinite loop in `Channel.read_line` when the line does not contain a CRLF
+  sequence (#131)
+
 2.4.2 (2015-04-29)
 * Fix a memory leak in `Channel` (#119, by @yomimono)
 * Add basic unit-test for channels (#119, by @yomimono)

_oasis

@@ -1,6 +1,6 @@
 OASISFormat: 0.4
 Name:        tcpip
-Version:     2.4.2
+Version:     2.4.3
 Synopsis:    Ethernet, TCP/IPv4 and DHCPv4 library
 Authors:     Anil Madhavapeddy, Balraj Singh, Richard Mortier,
              Nicolas Ojeda Bar, Thomas Gazagnaire

channel/channel.ml

@@ -94,8 +94,8 @@ module Make(Flow:V1_LWT.FLOW) = struct
       return buf
     end
 
- (* Read up to len characters from the input channel as a
-    stream (and read all available if no length specified *)
+  (* Read up to len characters from the input channel as a
+     stream (and read all available if no length specified *)
   let read_stream ?len t =
     Lwt_stream.from (fun () ->
         Lwt.catch
@@ -106,23 +106,21 @@ module Make(Flow:V1_LWT.FLOW) = struct
   (* Read until a character is found *)
   let read_until t ch =
     Lwt.catch
-       (fun () -> get_ibuf t >>= fun buf ->
-       let len = Cstruct.len buf in
-       let rec scan off =
-         if off = len then None else begin
-           if Cstruct.get_char buf off = ch then
-             Some off else scan (off+1)
-         end
-       in
-       match scan 0 with
-       |None -> (* not found, return what we have until EOF *)
-         t.ibuf <- None; (* basically guaranteeing that next read is EOF *)
-         return (false, buf)
-       |Some off -> (* found, so split the buffer *)
-         let hd = Cstruct.sub buf 0 off in
-         t.ibuf <- Some (Cstruct.shift buf (off+1));
-         return (true, hd)
-       )
+      (fun () ->
+         get_ibuf t >>= fun buf ->
+         let len = Cstruct.len buf in
+         let rec scan off =
+           if off = len then None
+           else if Cstruct.get_char buf off = ch then Some off else scan (off+1)
+         in
+         match scan 0 with
+         | None ->                (* not found, return what we have until EOF *)
+           t.ibuf <- None;    (* basically guaranteeing that next read is EOF *)
+           return (false, buf)
+         | Some off ->                          (* found, so split the buffer *)
+           let hd = Cstruct.sub buf 0 off in
+           t.ibuf <- Some (Cstruct.shift buf (off+1));
+           return (true, hd))
       (function End_of_file -> return (false, Cstruct.create 0) | e -> fail e)
 
   (* This reads a line of input, which is terminated either by a CRLF
@@ -132,7 +130,7 @@ module Make(Flow:V1_LWT.FLOW) = struct
     let rec get acc =
       read_until t '\n' >>= function
       |(false, v) ->
-        get (v :: acc)
+        if Cstruct.len v = 0 then return (v :: acc) else get (v :: acc)
       |(true, v) -> begin
           (* chop the CR if present *)
           let vlen = Cstruct.len v in

lib/META

@@ -1,6 +1,6 @@
 # OASIS_START
-# DO NOT EDIT (digest: 061ba734ed9b1b8aeb13ec8c74bda34a)
-version = "2.4.2"
+# DO NOT EDIT (digest: 8744f03c92c9b635c7a66256a0357ddf)
+version = "2.4.3"
 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.4.2"
+ version = "2.4.3"
  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.4.2"
+ version = "2.4.3"
  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.4.2"
+ version = "2.4.3"
  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.4.2"
+ version = "2.4.3"
  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.4.2"
+ version = "2.4.3"
  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.4.2"
+ version = "2.4.3"
  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.4.2"
+ version = "2.4.3"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
  "tcpip.tcp tcpip.ipv6-unix tcpip.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.4.2"
+ version = "2.4.3"
  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.4.2"
+ version = "2.4.3"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
  "tcpip.tcp tcpip.ipv4-unix tcpip.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.4.2"
+ version = "2.4.3"
  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.4.2"
+ version = "2.4.3"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires =
  "io-page mirage-types ipaddr cstruct lwt tcpip tcpip.ipv4 tcpip.ipv6"
@@ -135,7 +135,7 @@ package "tcp" (
 )
 
 package "stack-unix" (
- version = "2.4.2"
+ version = "2.4.3"
  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.4.2"
+ version = "2.4.3"
  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.4.2"
+ 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"
@@ -171,7 +171,7 @@ package "stack-direct" (
 )
 
 package "ipv6-unix" (
- version = "2.4.2"
+ version = "2.4.3"
  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.4.2"
+ version = "2.4.3"
  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.4.2"
+ version = "2.4.3"
  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.4.2"
+ version = "2.4.3"
  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.4.2"
+ version = "2.4.3"
  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.4.2"
+ version = "2.4.3"
  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.4.2"
+ version = "2.4.3"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires = "io-page bytes mirage-types ipaddr cstruct lwt tcpip.udp"
  archive(byte) = "dhcpv4.cma"
@@ -248,7 +248,7 @@ package "dhcpv4" (
 )
 
 package "channel" (
- version = "2.4.2"
+ version = "2.4.3"
  description = "Ethernet, TCP/IPv4 and DHCPv4 library"
  requires = "io-page mirage-types ipaddr cstruct lwt"
  archive(byte) = "channel.cma"

lib_test/test_channel.ml

@@ -23,10 +23,12 @@ let test_read_char_eof () =
       | End_of_file -> Lwt.return_unit
       | e -> fail "wrong exception: %s" (Printexc.to_string e))
 
+let check a b =
+  OUnit.assert_equal ~printer:(fun a -> a) ~cmp a (Cstruct.to_string b)
+
 let test_read_until_eof () =
-  let check a b = OUnit.assert_equal ~printer:(fun a -> a) ~cmp a
-      (Cstruct.to_string b) in
-  let input = Fflow.input_string "I am the very model of a modern major general"
+  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
@@ -45,7 +47,16 @@ let test_read_until_eof () =
   | 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 ->
+  check input (Cstruct.of_string (Cstruct.copyv buf));
+  Lwt.return_unit
+
 let suite = [
   "read_char + EOF" , test_read_char_eof;
   "read_until + EOF", test_read_until_eof;
+  "read_line"       , test_read_line;
 ]

setup.ml

@@ -1,7 +1,7 @@
 (* setup.ml generated for the first time by OASIS v0.4.5 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: 7ba0036130ff912275101f45fa1af357) *)
+(* DO NOT EDIT (digest: 9e562aeade84671386bb2407954c696f) *)
 (*
    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.4.2";
+          version = "2.4.3";
           license =
             OASISLicense.DEP5License
               (OASISLicense.DEP5Unit
@@ -7902,7 +7902,7 @@ let setup_t =
        };
      oasis_fn = Some "_oasis";
      oasis_version = "0.4.5";
-     oasis_digest = Some "I[\157\184\223Y\223\162\255\219\136K\022\1709\218";
+     oasis_digest = Some "\028ÚØÔÿ\019Î8>;éÀ37)]";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false