From c2bdb23d0f691a34e533c8778dbf48e0d3a1a19d Mon Sep 17 00:00:00 2001
From: Antonio Nuno Monteiro <anmonteiro@gmail.com>
Date: Sun, 12 Apr 2020 21:31:36 -0700
Subject: [PATCH] Fix OpenSSL runtime shutdown (#53)

In some cases (especially when receiving a response with a close
delimited body), the peer closes the connection before we attempt to SSL
shutdown, leading to unnecessary reporting of errors such as
`Unix.Unix_error(Unix.EBADF)`
---
 lwt-unix/ssl_io_real.ml | 30 +++++++++++++++++-------------
 lwt-unix/tls_io_real.ml |  2 --
 2 files changed, 17 insertions(+), 15 deletions(-)

diff --git a/lwt-unix/ssl_io_real.ml b/lwt-unix/ssl_io_real.ml
index dc23fbc..94cbf12 100644
--- a/lwt-unix/ssl_io_real.ml
+++ b/lwt-unix/ssl_io_real.ml
@@ -41,21 +41,25 @@ struct
   type addr = Unix.sockaddr
 
   let close ssl =
-    Lwt_ssl.ssl_shutdown ssl >>= fun () ->
+    let fd = Lwt_ssl.get_fd ssl in
+    match Lwt_unix.state fd with
+    | Closed ->
+      Lwt.return_unit
+    | _ ->
+      Lwt_ssl.ssl_shutdown ssl >>= fun () ->
       Lwt.catch
-      (fun () -> Lwt.wrap2 Lwt_ssl.shutdown ssl Unix.SHUTDOWN_ALL)
-      (function
-       | Unix.Unix_error (Unix.ENOTCONN, _, _) ->
-           Lwt.return_unit
-       | exn -> Lwt.fail exn)
+        (fun () -> Lwt.wrap2 Lwt_ssl.shutdown ssl Unix.SHUTDOWN_ALL)
+        (function
+          | Unix.Unix_error (Unix.ENOTCONN, _, _) ->
+            Lwt.return_unit
+          | exn ->
+            Lwt.fail exn)
       >>= fun () ->
-       let fd = Lwt_ssl.get_fd ssl in
-       match Lwt_unix.state fd with
-       | Lwt_unix.Closed -> Lwt.return_unit
-       | _ ->
-         Lwt.catch
-           (fun () -> Lwt_ssl.close ssl)
-           (fun _exn -> Lwt.return_unit)
+      match Lwt_unix.state fd with
+      | Lwt_unix.Closed ->
+        Lwt.return_unit
+      | _ ->
+        Lwt.catch (fun () -> Lwt_ssl.close ssl) (fun _exn -> Lwt.return_unit)
 
   let read ssl bigstring ~off ~len =
     Lwt.catch
diff --git a/lwt-unix/tls_io_real.ml b/lwt-unix/tls_io_real.ml
index ac23014..9230b84 100644
--- a/lwt-unix/tls_io_real.ml
+++ b/lwt-unix/tls_io_real.ml
@@ -80,8 +80,6 @@ module Io :
 
   let shutdown_receive _tls = ()
 
-  let close tls = Tls_lwt.Unix.close tls
-
   let state tls =
     match Tls_lwt.Unix.epoch tls with `Error -> `Error | `Ok _ -> `Open
 end