Skip to content

Commit

Permalink
Lwt_ssl.*_channel_of_decr now close the socket when the channel is cl…
Browse files Browse the repository at this point in the history
…osed

Ignore-this: a830f5819ec08fb996cc271d03267fce

darcs-hash:20121123194144-c41ad-21f7ce5d97a32f642dec2cc0f421ab6ead727bab
  • Loading branch information
jeremiedimino committed Nov 23, 2012
1 parent 4aaf347 commit b40a307
Showing 1 changed file with 19 additions and 6 deletions.
25 changes: 19 additions & 6 deletions src/ssl/lwt_ssl.ml
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,8 @@
* 02111-1307, USA.
*)

let (>>=) = Lwt.bind

type t =
Plain
| SSL of Ssl.socket
Expand Down Expand Up @@ -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 ()
Expand All @@ -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
Expand Down

0 comments on commit b40a307

Please sign in to comment.