Lwt_ssl.*_channel_of_decr now close the socket when the channel is cl…

…osed

Ignore-this: a830f5819ec08fb996cc271d03267fce

darcs-hash:20121123194144-c41ad-21f7ce5d97a32f642dec2cc0f421ab6ead727bab

src/ssl/lwt_ssl.ml

@@ -21,6 +21,8 @@
  * 02111-1307, USA.
  *)
 
+let (>>=) = Lwt.bind
+
 type t =
     Plain
   | SSL of Ssl.socket
@@ -150,12 +152,6 @@ let wait_write (fd, s) =
     Plain -> Lwt_unix.wait_write fd
   | SSL _ -> Lwt_unix.yield ()
 
-let out_channel_of_descr s =
-  Lwt_io.make ~mode:Lwt_io.output (fun buf pos len -> write_bytes s buf pos len)
-
-let in_channel_of_descr s =
-  Lwt_io.make ~mode:Lwt_io.input (fun buf pos len -> read_bytes s buf pos len)
-
 let ssl_shutdown (fd, s) =
   match s with
     Plain -> Lwt.return ()
@@ -167,6 +163,23 @@ let close (fd, _) = Lwt_unix.close fd
 
 let abort (fd, _) = Lwt_unix.abort fd
 
+let shutdown_and_close s =
+  ssl_shutdown s >>= fun () ->
+  Lwt.wrap2 shutdown s Unix.SHUTDOWN_ALL >>= fun () ->
+  close s
+
+let out_channel_of_descr s =
+  Lwt_io.make
+    ~mode:Lwt_io.output
+    ~close:(fun () -> shutdown_and_close s)
+    (fun buf pos len -> write_bytes s buf pos len)
+
+let in_channel_of_descr s =
+  Lwt_io.make
+    ~mode:Lwt_io.input
+    ~close:(fun () -> shutdown_and_close s)
+    (fun buf pos len -> read_bytes s buf pos len)
+
 let get_fd (fd,socket) =
   match socket with
     | Plain -> Lwt_unix.unix_file_descr fd