From 605347124bd39d347058bc3bd5356c184f654b1d Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 3 Sep 2006 03:12:57 +0000 Subject: [PATCH] SSL interaction with client checking server's CN --- openssl/openssl_sml.c | 43 +++++++++++++++++++++++++++++------ openssl/openssl_sml.h | 8 ++++++- src/main.sml | 34 +++------------------------- src/openssl.sig | 4 ++-- src/openssl.sml | 52 +++++++++++++++++++++---------------------- 5 files changed, 73 insertions(+), 68 deletions(-) diff --git a/openssl/openssl_sml.c b/openssl/openssl_sml.c index 201d816..79e6195 100644 --- 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); } -BIO *OpenSSL_SML_new_accept(char *addr) { - return BIO_new_accept(addr); -} - 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); } +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, @@ -94,6 +94,24 @@ BIO *OpenSSL_SML_new_ssl_connect(SSL_CTX *ctx) { 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; @@ -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); + BIO_set_ssl(b1, ssl, BIO_NOCLOSE); } 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; } - } else + } else { + printf("Null entry\n"); return NULL; - } else + } + } else { + printf("Null name\n"); return NULL; - } else + } + } else { + printf("Null certificate\n"); 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 --- 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_accept(char *addr); 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); @@ -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); + +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 --- a/src/main.sml +++ b/src/main.sml @@ -136,34 +136,6 @@ fun eval fname = 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", @@ -193,14 +165,14 @@ fun service () = Config.serverKey, Config.trustStore) - val sock = OpenSSL.listen (Config.dispatcherPort, Config.queueSize) + val sock = OpenSSL.listen (context, Config.dispatcherPort) fun loop () = - case OpenSSL.accept (context, sock) of + case OpenSSL.accept sock of 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 diff --git a/src/openssl.sig b/src/openssl.sig index 750a4fa..3179103 100644 --- 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 listen : int * int -> listener +val listen : context * int -> listener val shutdown : listener -> unit -val accept : context * listener -> bio option +val accept : listener -> bio option val peerCN : bio -> string 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 -- 2.20.1