-all: configDefault/config.sig configDefault/configDefault.sml
+all: configDefault/config.sig configDefault/configDefault.sml \
+ openssl/openssl_sml.so openssl/smlnj/FFI/libssl.h.cm
-.PHONY: all
+.PHONY: all openssl
configDefault/config.sig: src/config.sig.header \
configDefault/*.csg configDefault/*.cfs \
src/configDefault.sml.footer \
>configDefault/configDefault.sml
+openssl/openssl_sml.o: openssl/openssl_sml.c
+ gcc -fPIC -c openssl/openssl_sml.c -o openssl/openssl_sml.o
+
+openssl/openssl_sml.so: openssl/openssl_sml.o
+ gcc -shared -Wl,-soname,openssl_sml.so \
+ -o openssl/openssl_sml.so \
+ openssl/openssl_sml.o -lssl
+
+openssl/smlnj/FFI/libssl.h.cm: openssl/openssl_sml.h
+ cd openssl/smlnj ; ml-nlffigen -d FFI -lh LibsslH.libh -include ../libssl-h.sml \
+ -cm libssl.h.cm -D__builtin_va_list="void*" \
+ ../openssl_sml.h
val testUser = "adamc"
val defaultDomain = "hcoop.net"
+
+val dispatcher = "localhost:1234"
val testUser : string
val defaultDomain : string
+
+val dispatcher : string
--- /dev/null
+#include "openssl/bio.h"
+#include "openssl/ssl.h"
+#include "openssl/err.h"
+
+void OpenSSL_SML_add_all_algorithms() {
+ OpenSSL_add_all_algorithms();
+}
+
+void OpenSSL_SML_load_error_strings() {
+ SSL_load_error_strings();
+}
+
+void OpenSSL_SML_load_BIO_strings() {
+ ERR_load_BIO_strings();
+}
+
+int OpenSSL_SML_get_error() {
+ return ERR_get_error();
+}
+
+const char *OpenSSL_SML_lib_error_string(int err) {
+ return ERR_lib_error_string(err);
+}
+
+const char *OpenSSL_SML_func_error_string(int err) {
+ return ERR_func_error_string(err);
+}
+
+const char *OpenSSL_SML_reason_error_string(int err) {
+ return ERR_reason_error_string(err);
+}
+
+int OpenSSL_SML_write(BIO *b, const void *data, int len) {
+ return BIO_write(b, data, len);
+}
+
+BIO *OpenSSL_SML_new_connect(char *addr) {
+ return BIO_new_connect(addr);
+}
+
+void OpenSSL_SML_free_all(BIO *b) {
+ BIO_free_all(b);
+}
+
+int OpenSSL_SML_do_connect(BIO *b) {
+ return BIO_do_connect(b);
+}
--- /dev/null
+#include "openssl/bio.h"
+#include "openssl/ssl.h"
+#include "openssl/err.h"
+
+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_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);
--- /dev/null
+*.sml
+*.cm
--- /dev/null
+structure LibsslH = struct
+ local
+ val lh = DynLinkage.open_lib
+ { name = "openssl/openssl_sml.so", global = true, lazy = true }
+ handle DynLinkage.DynLinkError s => raise Fail s
+ in
+ fun libh s = let
+ val sh = DynLinkage.lib_symbol (lh, s)
+ in
+ fn () => DynLinkage.addr sh
+ end
+ end
+end
if !ErrorMsg.anyErrors then
()
else
- Slave.handleChanges (map #2 diffs)(*;
+ Slave.handleChanges (map #2 diffs);
ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
- fn cl => "Temp file cleanup failed: " ^ cl))*)
+ fn cl => "Temp file cleanup failed: " ^ cl))
end)
$/smlnj-lib.cm
$/ml-yacc-lib.cm
$/pp-lib.cm
+$c/internals/c-int.cm
+
+../openssl/smlnj/FFI/libssl.h.cm
errormsg.sig
errormsg.sml
val reduce : string -> Ast.exp option
val eval : string -> unit
+ val request : string -> unit
+
end
val dmy = ErrorMsg.dummyLoc
+fun init () = (F_OpenSSL_SML_add_all_algorithms.f' ();
+ F_OpenSSL_SML_load_error_strings.f' ();
+ F_OpenSSL_SML_load_BIO_strings.f' ())
+
+val () = init ()
+
val defaultT : record ref = ref SM.empty
val defaultV : (unit -> exp) SM.map ref = ref SM.empty
Eval.exec (SM.map (fn f => f ()) (!defaultV)) body'
| NONE => ()
+val dispatcher : C.rw ZString.zstring' = ZString.dupML' Config.dispatcher
+
+fun ssl_err s =
+ let
+ val err = F_OpenSSL_SML_get_error.f ()
+ in
+ print s;
+ print "\nReason: ";
+ print (ZString.toML (F_OpenSSL_SML_lib_error_string.f err));
+ print ":";
+ print (ZString.toML (F_OpenSSL_SML_func_error_string.f err));
+ print ":";
+ print (ZString.toML (F_OpenSSL_SML_reason_error_string.f err));
+ print "\n"
+ end
+
+exception OpenSSL of string
+
+fun writeAll (bio, s) =
+ let
+ val buf = ZString.dupML' s
+
+ fun loop (buf, len) =
+ let
+ val r = F_OpenSSL_SML_write.f' (bio, C.Ptr.inject' buf, len)
+ in
+ if r = len then
+ ()
+ else if r <= 0 then
+ (C.free' buf;
+ raise OpenSSL "BIO_write failed")
+ else
+ loop (C.Ptr.|+! C.S.uchar (buf, Int32.toInt r), Int32.- (len, r))
+ end
+ in
+ loop (buf, Int32.fromInt (size s));
+ C.free' buf
+ end
+
+fun request fname =
+ let
+ val bio = F_OpenSSL_SML_new_connect.f' dispatcher
+ in
+ if C.Ptr.isNull' bio then
+ (ssl_err ("Error initializating connection to dispatcher at " ^ Config.dispatcher);
+ F_OpenSSL_SML_free_all.f' bio)
+ else if F_OpenSSL_SML_do_connect.f' bio <= 0 then
+ (ssl_err ("Error connecting to dispatcher at " ^ Config.dispatcher);
+ F_OpenSSL_SML_free_all.f' bio)
+ else let
+ val inf = TextIO.openIn fname
+
+ fun loop () =
+ case TextIO.inputLine inf of
+ NONE => ()
+ | SOME line => (writeAll (bio, line);
+ loop ())
+ in
+ loop ();
+ TextIO.closeIn inf;
+ F_OpenSSL_SML_free_all.f' bio
+ end
+ end
+
end