From 07cc384cf2e6e3589f2892026a9b8f9835c8eb2c Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 2 Sep 2006 19:52:07 +0000 Subject: [PATCH] Basic client/server thing going on with unencrypted OpenSSL --- configDefault/domtool.cfg | 5 ++++- configDefault/domtool.cfs | 4 ++++ openssl/openssl_sml.c | 12 +++++++++++ openssl/openssl_sml.h | 11 +++++++++- src/main.sig | 1 + src/main.sml | 45 ++++++++++++++++++++++++++++++++++++++- 6 files changed, 75 insertions(+), 3 deletions(-) diff --git a/configDefault/domtool.cfg b/configDefault/domtool.cfg index 0246f2a..55e6afd 100644 --- a/configDefault/domtool.cfg +++ b/configDefault/domtool.cfg @@ -23,4 +23,7 @@ val testUser = "adamc" val defaultDomain = "hcoop.net" -val dispatcher = "localhost:1234" +val dispatcher = "localhost" +val dispatcherPort = 1234 + +val bufSize = 1024 diff --git a/configDefault/domtool.cfs b/configDefault/domtool.cfs index db536e3..43f9f06 100644 --- a/configDefault/domtool.cfs +++ b/configDefault/domtool.cfs @@ -33,3 +33,7 @@ val testUser : string val defaultDomain : string val dispatcher : string +val dispatcherPort : int + +val bufSize : int + diff --git a/openssl/openssl_sml.c b/openssl/openssl_sml.c index b35262b..b2fbb89 100644 --- a/openssl/openssl_sml.c +++ b/openssl/openssl_sml.c @@ -30,6 +30,10 @@ const char *OpenSSL_SML_reason_error_string(int err) { return ERR_reason_error_string(err); } +int OpenSSL_SML_read(BIO *b, void *data, int len) { + return BIO_read(b, data, len); +} + int OpenSSL_SML_write(BIO *b, const void *data, int len) { return BIO_write(b, data, len); } @@ -38,6 +42,10 @@ 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); } @@ -45,3 +53,7 @@ void OpenSSL_SML_free_all(BIO *b) { int OpenSSL_SML_do_connect(BIO *b) { return BIO_do_connect(b); } + +int OpenSSL_SML_do_accept(BIO *b) { + return BIO_do_accept(b); +} diff --git a/openssl/openssl_sml.h b/openssl/openssl_sml.h index f461c43..5317021 100644 --- a/openssl/openssl_sml.h +++ b/openssl/openssl_sml.h @@ -5,11 +5,20 @@ void OpenSSL_SML_add_all_algorithms(void); void OpenSSL_SML_load_error_strings(void); void OpenSSL_SML_load_BIO_strings(void); + int OpenSSL_SML_get_error(void); const char *OpenSSL_SML_lib_error_string(int err); const char *OpenSSL_SML_func_error_string(int err); const char *OpenSSL_SML_reason_error_string(int err); + +int OpenSSL_SML_read(BIO *b, void *data, int len); int OpenSSL_SML_write(BIO *b, const void *data, int len); + BIO *OpenSSL_SML_new_connect(char *addr); -void OpenSSL_SML_free_all(BIO *b); int OpenSSL_SML_do_connect(BIO *b); + +BIO *OpenSSL_SML_new_accept(char *addr); +int OpenSSL_SML_do_accept(BIO *b); + +void OpenSSL_SML_free_all(BIO *b); + diff --git a/src/main.sig b/src/main.sig index e1d5015..1d084b8 100644 --- a/src/main.sig +++ b/src/main.sig @@ -32,5 +32,6 @@ signature MAIN = sig val eval : string -> unit val request : string -> unit + val serviceOne : unit -> unit end diff --git a/src/main.sml b/src/main.sml index 14eaa4a..bcadb63 100644 --- a/src/main.sml +++ b/src/main.sml @@ -139,7 +139,11 @@ fun eval fname = Eval.exec (SM.map (fn f => f ()) (!defaultV)) body' | NONE => () -val dispatcher : C.rw ZString.zstring' = ZString.dupML' Config.dispatcher +val dispatcher : C.rw ZString.zstring' = + ZString.dupML' (Config.dispatcher ^ ":" ^ Int.toString Config.dispatcherPort) + +val listenOn : C.rw ZString.zstring' = + ZString.dupML' ("localhost:" ^ Int.toString Config.dispatcherPort) fun ssl_err s = let @@ -157,6 +161,23 @@ fun ssl_err s = exception OpenSSL of string +val readBuf : (C.uchar, C.rw) C.obj C.ptr' = C.alloc' C.S.uchar (Word.fromInt Config.bufSize) +val bufSize = Int32.fromInt Config.bufSize + +fun readOne bio = + let + val r = F_OpenSSL_SML_read.f' (bio, C.Ptr.inject' readBuf, bufSize) + in + if r = 0 then + NONE + else if r < 0 then + raise OpenSSL "BIO_read failed" + else + SOME (CharVector.tabulate (Int32.toInt r, + fn i => chr (Word32.toInt (C.Get.uchar' + (C.Ptr.sub' C.S.uchar (readBuf, i)))))) + end + fun writeAll (bio, s) = let val buf = ZString.dupML' s @@ -203,4 +224,26 @@ fun request fname = end end +fun serviceOne () = + let + val bio = F_OpenSSL_SML_new_accept.f' listenOn + in + if C.Ptr.isNull' bio then + (ssl_err "Error initializating listener"; + F_OpenSSL_SML_free_all.f' bio) + else if F_OpenSSL_SML_do_accept.f' bio <= 0 then + (ssl_err "Error accepting connection"; + F_OpenSSL_SML_free_all.f' bio) + else let + fun loop () = + case readOne bio of + NONE => () + | SOME line => (print line; + loop ()) + in + loop (); + F_OpenSSL_SML_free_all.f' bio + end + end + end -- 2.20.1