Streaming body is still iterated/generated after connection closes

[wiml]

If the client closes the connection while cohttp is sending a response, cohttp will keep consuming the body stream even though it has nowhere to go.

In the attached example, if you make several requests to the server and cancel them all, you can see in the console that the server process is still generating body text for all of them, apparently forever. The conn_closed callback doesn't seem to be called, either.

In this case the body stream is actually infinite, but even if the stream is simply large-but-finite cohttp should avoid computing the entire body unnecessarily.

open Lwt
open Cohttp
open Cohttp_lwt_unix

let str_of_cn conn = Connection.to_string (snd conn)

let tick_stream conn =
  let num = ref 0 in
  let next_tick () =
    bind ( Lwt_unix.sleep 1. )
     ( fun () ->
       let t = (incr num; string_of_int !num) in
       begin
         print_endline ( "Returning tick: " ^ t ^ " for connection " ^ (str_of_cn conn) ) ;
         return (Some ("\r\nevent: tick\r\ndata: " ^ t ^ "\r\n"))
       end
     )
  in
  Lwt_stream.from next_tick

let route_req conn req body =
  match Request.meth req with
  | `GET ->
     return (
     Response.make ~status:`OK
               ~encoding:Transfer.Unknown
               ~headers:(Header.init_with "Content-Type" "text/event-stream")
               (),
     `Stream (tick_stream conn)
       )
  | _ -> Server.respond_string ~status:`Method_not_allowed ~body:"Unsupported method\n" ()
;;

let _ = Lwt_main.run (Server.create
            ~mode:(`TCP (`Port 8000))
            (Server.make
               ~conn_closed:(fun c -> print_endline ("Connection "^(str_of_cn c)^" closed"))
               ~callback:route_req ()))