handle exception in flush so that the user can retry in case of non b…

…locking socket
savonet · Apr 6, 2023 · 3d7445d · 3d7445d
1 parent 57014a0
commit 3d7445d
Show file tree

Hide file tree

Showing 3 changed files with 18 additions and 5 deletions.
diff --git a/src/ssl.ml b/src/ssl.ml
@@ -96,6 +96,7 @@ exception Accept_error of ssl_error
 exception Read_error of ssl_error
 exception Write_error of ssl_error
 exception Verify_error of verify_error
+exception Flush_error of bool (* true means retry *)
 
 let () =
   Printexc.register_printer (function
@@ -131,7 +132,8 @@ let () =
   Callback.register_exception "ssl_exn_accept_error" (Accept_error Error_none);
   Callback.register_exception "ssl_exn_read_error" (Read_error Error_none);
   Callback.register_exception "ssl_exn_write_error" (Write_error Error_none);
-  Callback.register_exception "ssl_exn_verify_error" (Verify_error Error_v_application_verification)
+  Callback.register_exception "ssl_exn_verify_error" (Verify_error Error_v_application_verification);
+  Callback.register_exception "ssl_exn_flush_error" (Flush_error true)
 
 let thread_safe = ref false
 

diff --git a/src/ssl.mli b/src/ssl.mli
@@ -96,6 +96,10 @@ exception Read_error of ssl_error
 (** An error occured while writing data. *)
 exception Write_error of ssl_error
 
+(** An error occured while flushing a socket.
+    [Flush_error true],  means that the operation should be retried later. *)
+exception Flush_error of bool
+
 (** Why did the certificate verification fail? *)
 type verify_error =
   | Error_v_unable_to_get_issuer_cert

diff --git a/src/ssl_stubs.c b/src/ssl_stubs.c
@@ -1821,8 +1821,12 @@ CAMLprim value ocaml_ssl_flush(value socket)
   bio = SSL_get_wbio(ssl);
   if(bio)
   {
-    /* TODO: raise an error */
-    assert(BIO_flush(bio) == 1);
+    int ret = BIO_flush(bio);
+    if (ret != 1) {
+      caml_acquire_runtime_system();
+      caml_raise_with_arg(*caml_named_value("ssl_exn_flush_error"),
+			  Val_bool(ret==-1));
+    };
   }
   caml_acquire_runtime_system();
 
@@ -1838,8 +1842,11 @@ CAMLprim value ocaml_ssl_flush_blocking(value socket)
   bio = SSL_get_wbio(ssl);
   if(bio)
   {
-    /* TODO: raise an error */
-    assert(BIO_flush(bio) == 1);
+    int ret = BIO_flush(bio);
+    if (ret != 1) {
+      caml_raise_with_arg(*caml_named_value("ssl_exn_flush_error"),
+			  Val_bool(ret==-1));
+    };
   }
 
   CAMLreturn(Val_unit);