From 42736131ad609c3e3e7530244c0da7dd04b32c0d Mon Sep 17 00:00:00 2001
From: Christopher Zimmermann <madroach@gmerlin.de>
Date: Sun, 21 Jun 2020 16:15:30 +0200
Subject: [PATCH] add close_notify as raw SSL_shutdown

this is needed for sending EOF, aka one-way shutdown.
---
 src/ssl.ml      |  8 +++++++-
 src/ssl.mli     |  8 +++++++-
 src/ssl_stubs.c | 14 +++++++++-----
 3 files changed, 23 insertions(+), 7 deletions(-)

diff --git a/src/ssl.ml b/src/ssl.ml
index 01990bd..b39ccb6 100644
--- a/src/ssl.ml
+++ b/src/ssl.ml
@@ -276,7 +276,7 @@ external accept : socket -> unit = "ocaml_ssl_accept"
 
 external flush : socket -> unit = "ocaml_ssl_flush"
 
-external shutdown : socket -> unit = "ocaml_ssl_shutdown"
+external shutdown : socket -> bool = "ocaml_ssl_shutdown"
 
 let open_connection_with_context context sockaddr =
   let domain = Unix.domain_of_sockaddr sockaddr in
@@ -292,6 +292,12 @@ let open_connection_with_context context sockaddr =
 let open_connection ssl_method sockaddr =
   open_connection_with_context (create_context ssl_method Client_context) sockaddr
 
+let close_notify = shutdown
+
+let rec shutdown sock =
+  if not (close_notify sock)
+  then shutdown sock
+
 let shutdown_connection = shutdown
 
 let output_string ssl s =
diff --git a/src/ssl.mli b/src/ssl.mli
index 8463f29..1611786 100644
--- a/src/ssl.mli
+++ b/src/ssl.mli
@@ -421,7 +421,13 @@ val accept : socket -> unit
 (** Flush an SSL connection. *)
 val flush : socket -> unit
 
-(** Close an SSL connection. *)
+(** Send close notify to the peer. This is SSL_shutdown(3).
+ *  returns [true] if shutdown is finished, [false] in case [close_notify]
+ *  needs to be called a second time. *)
+val close_notify : socket -> bool
+
+(** Close a SSL connection.
+  * Send close notify to the peer and wait for close notify from peer. *)
 val shutdown : socket -> unit
 
 
diff --git a/src/ssl_stubs.c b/src/ssl_stubs.c
index 2822d81..8abc16c 100644
--- a/src/ssl_stubs.c
+++ b/src/ssl_stubs.c
@@ -1660,12 +1660,16 @@ CAMLprim value ocaml_ssl_shutdown(value socket)
 
   caml_enter_blocking_section();
   ret = SSL_shutdown(ssl);
-  if (!ret)
-    SSL_shutdown(ssl);
   caml_leave_blocking_section();
-  /* close(SSL_get_fd(SSL_val(socket))); */
-
-  CAMLreturn(Val_unit);
+  switch (ret) {
+    case 0:
+    case 1:
+      /* close(SSL_get_fd(SSL_val(socket))); */
+      CAMLreturn(Val_int(ret));
+    default:
+      ret = SSL_get_error(ssl, ret);
+      caml_raise_with_arg(*caml_named_value("ssl_exn_connection_error"), Val_int(ret));
+  }
 }
 
 /* ======================================================== */