SSL interaction with client checking server's CN

diff --git a/openssl/openssl_sml.c b/openssl/openssl_sml.c
index 201d816..79e6195 100644 (file)
--- a/openssl/openssl_sml.c
+++ b/openssl/openssl_sml.c
@@ -48,10 +48,6 @@ BIO *OpenSSL_SML_new_connect(char *addr) {
   return BIO_new_connect(addr);
 }
 
   return BIO_new_connect(addr);
 }
 

-BIO *OpenSSL_SML_new_accept(char *addr) {
-  return BIO_new_accept(addr);
-}
-

 void OpenSSL_SML_free_all(BIO *b) {
   BIO_free_all(b);
 }
 void OpenSSL_SML_free_all(BIO *b) {
   BIO_free_all(b);
 }


@@ -64,6 +60,10 @@ int OpenSSL_SML_do_accept(BIO *b) {
   return BIO_do_accept(b);
 }
 
   return BIO_do_accept(b);
 }
 

+int OpenSSL_SML_do_handshake(BIO *b) {
+  return BIO_do_handshake(b);
+}
+

 SSL_CTX *OpenSSL_SML_CTX_new(SSL_METHOD *meth) {
   SSL_CTX *ctx = SSL_CTX_new(meth);
   SSL_CTX_set_verify(ctx,
 SSL_CTX *OpenSSL_SML_CTX_new(SSL_METHOD *meth) {
   SSL_CTX *ctx = SSL_CTX_new(meth);
   SSL_CTX_set_verify(ctx,


@@ -94,6 +94,24 @@ BIO *OpenSSL_SML_new_ssl_connect(SSL_CTX *ctx) {
   return bio;
 }
 
   return bio;
 }
 

+BIO *OpenSSL_SML_new_ssl(SSL_CTX *ctx) {
+  BIO *bio = BIO_new_ssl_connect(ctx);
+  SSL *ssl;
+
+  BIO_get_ssl(bio, &ssl);
+  SSL_set_mode(ssl, SSL_MODE_AUTO_RETRY);
+
+  return bio;
+}
+
+BIO *OpenSSL_SML_new_accept(SSL_CTX *ctx, char *port) {
+  BIO *sbio = BIO_new_ssl(ctx, 0);
+  BIO *acpt = BIO_new_accept(port);
+
+  BIO_set_accept_bios(acpt, sbio);
+
+  return acpt;
+}

 
 SSL *OpenSSL_SML_get_ssl(BIO *bio) {
   SSL *ssl;
 
 SSL *OpenSSL_SML_get_ssl(BIO *bio) {
   SSL *ssl;


@@ -160,6 +178,7 @@ void OpenSSL_SML_shutdown(int sock) {
 void OpenSSL_SML_SSL_set_bio(SSL *ssl, BIO *b1, BIO *b2) {
   SSL_set_mode(ssl, SSL_MODE_AUTO_RETRY);
   SSL_set_bio(ssl, b1, b2);
 void OpenSSL_SML_SSL_set_bio(SSL *ssl, BIO *b1, BIO *b2) {
   SSL_set_mode(ssl, SSL_MODE_AUTO_RETRY);
   SSL_set_bio(ssl, b1, b2);

+  BIO_set_ssl(b1, ssl, BIO_NOCLOSE);

 }
 
 int OpenSSL_SML_use_PrivateKey_file(SSL_CTX *ctx, char *keyfile) {
 }
 
 int OpenSSL_SML_use_PrivateKey_file(SSL_CTX *ctx, char *keyfile) {


@@ -204,10 +223,20 @@ const char *OpenSSL_SML_get_peer_name(SSL *ssl) {
          ret[M_ASN1_STRING_length(s)] = 0;
          return ret;
        }
          ret[M_ASN1_STRING_length(s)] = 0;
          return ret;
        }

-      } else
+      } else {
+       printf("Null entry\n");

        return NULL;
        return NULL;

-    } else
+      }
+    } else {
+      printf("Null name\n");

       return NULL;
       return NULL;

-  } else
+    }
+  } else {
+    printf("Null certificate\n");

     return NULL;
     return NULL;

+  }
+}
+
+BIO *OpenSSL_SML_pop(BIO *b) {
+  return BIO_pop(b);

 }
 }

diff --git a/openssl/openssl_sml.h b/openssl/openssl_sml.h
index 3eced90..d921bee 100644 (file)
--- a/openssl/openssl_sml.h
+++ b/openssl/openssl_sml.h
@@ -17,9 +17,10 @@ int OpenSSL_SML_write(BIO *b, const void *data, int len);
 BIO *OpenSSL_SML_new_connect(char *addr);
 int OpenSSL_SML_do_connect(BIO *b);
 
 BIO *OpenSSL_SML_new_connect(char *addr);
 int OpenSSL_SML_do_connect(BIO *b);
 

-BIO *OpenSSL_SML_new_accept(char *addr);

 int OpenSSL_SML_do_accept(BIO *b);
 
 int OpenSSL_SML_do_accept(BIO *b);
 

+int OpenSSL_SML_do_handshake(BIO *b);
+

 void OpenSSL_SML_free_all(BIO *b);
 
 SSL_METHOD *OpenSSL_SML_SSLv23_method(void);
 void OpenSSL_SML_free_all(BIO *b);
 
 SSL_METHOD *OpenSSL_SML_SSLv23_method(void);


@@ -51,3 +52,8 @@ int OpenSSL_SML_SSL_accept(SSL *ssl);
 int OpenSSL_SML_use_certificate_chain_file(SSL_CTX *ctx, char *keyfile);
 
 const char *OpenSSL_SML_get_peer_name(SSL *ssl);
 int OpenSSL_SML_use_certificate_chain_file(SSL_CTX *ctx, char *keyfile);
 
 const char *OpenSSL_SML_get_peer_name(SSL *ssl);

+
+BIO *OpenSSL_SML_new_ssl(SSL_CTX *ctx);
+BIO *OpenSSL_SML_new_accept(SSL_CTX *ctx, char *port);
+
+BIO *OpenSSL_SML_pop(BIO *b);

diff --git a/src/main.sml b/src/main.sml
index cc5b5b5..58b9768 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -136,34 +136,6 @@ fun eval fname =
 val dispatcher =
     Config.dispatcher ^ ":" ^ Int.toString Config.dispatcherPort
 
 val dispatcher =
     Config.dispatcher ^ ":" ^ Int.toString Config.dispatcherPort
 

-fun ssl_err s =
-    let
-       val err = F_OpenSSL_SML_get_error.f ()
-
-       val lib = F_OpenSSL_SML_lib_error_string.f err
-       val func = F_OpenSSL_SML_func_error_string.f err
-       val reason = F_OpenSSL_SML_reason_error_string.f err
-    in
-       print s;
-       print "\nReason: ";
-       if C.Ptr.isNull lib then
-           ()
-       else
-           (print (ZString.toML lib);
-            print ":");
-       if C.Ptr.isNull func then
-           ()
-       else
-           (print (ZString.toML func);
-            print ":");
-       if C.Ptr.isNull reason then
-           ()
-       else
-           print (ZString.toML reason);
-       print "\n"
-    end
-
-

 fun request fname =
     let
        val context = OpenSSL.context ("/home/adamc/fake/clientcert.pem",
 fun request fname =
     let
        val context = OpenSSL.context ("/home/adamc/fake/clientcert.pem",


@@ -193,14 +165,14 @@ fun service () =
                                       Config.serverKey,
                                       Config.trustStore)
 
                                       Config.serverKey,
                                       Config.trustStore)
 

-       val sock = OpenSSL.listen (Config.dispatcherPort, Config.queueSize)
+       val sock = OpenSSL.listen (context, Config.dispatcherPort)

 
        fun loop () =
 
        fun loop () =

-           case OpenSSL.accept (context, sock) of
+           case OpenSSL.accept sock of

                NONE => ()
              | SOME bio =>
                let
                NONE => ()
              | SOME bio =>
                let

-                   val _ = print ("Subject: " ^ OpenSSL.peerCN bio ^ "\n")
+                   (*val _ = print ("Subject: " ^ OpenSSL.peerCN bio ^ "\n")*)

 
                    fun loop' () =
                        case OpenSSL.readOne bio of
 
                    fun loop' () =
                        case OpenSSL.readOne bio of

diff --git a/src/openssl.sig b/src/openssl.sig
index 750a4fa..3179103 100644 (file)
--- a/src/openssl.sig
+++ b/src/openssl.sig
@@ -36,10 +36,10 @@ val context : string * string * string -> context
 val connect : context * string -> bio
 val close : bio -> unit
 
 val connect : context * string -> bio
 val close : bio -> unit
 

-val listen : int * int -> listener
+val listen : context * int -> listener

 val shutdown : listener -> unit
 
 val shutdown : listener -> unit
 

-val accept : context * listener -> bio option
+val accept : listener -> bio option

 
 val peerCN : bio -> string
 
 
 val peerCN : bio -> string
 

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 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
 
 fun ssl_err s =
     let


@@ -146,32 +146,30 @@ fun connect (context, hostname) =
 
 fun close bio = F_OpenSSL_SML_free_all.f' bio
 
 
 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
 
 fun peerCN bio =
     let