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);
}
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,
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;
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) {
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);
}
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);
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);
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",
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
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
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 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