SSL interaction with client checking server's CN

[hcoop/zz_old/domtool2-proto.git] / src / openssl.sml

diff --git a/src/openssl.sml b/src/openssl.sml
index c0a24d4..627b405 100644 (file)
--- 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