X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/3b2676435dc4af39acd77e7fe232902e6651e42d..605347124bd39d347058bc3bd5356c184f654b1d:/src/openssl.sml

diff --git a/src/openssl.sml b/src/openssl.sml
index c0a24d4..627b405 100644
--- a/src/openssl.sml
+++ b/src/openssl.sml
@@ -28,7 +28,7 @@ exception OpenSSL of string
 
 type context = (ST_ssl_ctx_st.tag, C_Int.rw) C_Int.su_obj C_Int.ptr'
 type bio = (ST_bio_st.tag, C_Int.rw) C_Int.su_obj C_Int.ptr'
-type listener = MLRep.Signed.int
+type listener = bio
 
 fun ssl_err s =
     let
@@ -146,32 +146,30 @@ fun connect (context, hostname) =
 
 fun close bio = F_OpenSSL_SML_free_all.f' bio
 
-fun listen (port, qsize) = F_OpenSSL_SML_tcp_listen.f' (Int32.fromInt port, Int32.fromInt qsize)
-fun shutdown sock = F_OpenSSL_SML_shutdown.f' sock
-
-fun accept (context, sock) =
-     let
-	 val sock' = F_OpenSSL_SML_accept.f' sock
-     in
-	 if Int32.< (sock', Int32.fromInt 0) then
-	     NONE
-	 else let
-		 val bio = F_OpenSSL_SML_new_socket.f' sock'
-		 val ssl = F_OpenSSL_SML_SSL_new.f' context
-	     in
-		 if C.Ptr.isNull' bio then
-		     (ssl_err "Error initializating accepter";
-		      F_OpenSSL_SML_free_all.f' bio;
-		      raise OpenSSL "Can't initialize accepter")
-		 else if (F_OpenSSL_SML_SSL_set_bio.f' (ssl, bio, bio);
-			  F_OpenSSL_SML_SSL_accept.f' ssl) <= 0 then
-		     (ssl_err "Error accepting connection";
-		      F_OpenSSL_SML_free_all.f' bio;
-		      raise OpenSSL "Can't accept connection")
-		 else
-		     SOME bio
-	     end
-     end
+fun listen (context, port) =
+    let
+	val port = ZString.dupML' (Int.toString port)
+	val listener = F_OpenSSL_SML_new_accept.f' (context, port)
+    in
+	C.free' port;
+	if C.Ptr.isNull' listener then
+	    (ssl_err "Null listener";
+	     raise OpenSSL "Null listener")
+	else if F_OpenSSL_SML_do_accept.f' listener <= 0 then
+	    (ssl_err "Error initializing listener";
+	     close listener;
+	     raise OpenSSL "Can't initialize listener")
+	else
+	    listener
+    end
+
+val shutdown = close
+
+fun accept listener =
+    if F_OpenSSL_SML_do_accept.f' listener <= 0 then
+	NONE
+    else
+	SOME (F_OpenSSL_SML_pop.f' listener)
 
 fun peerCN bio =
     let