Remove catchAllAlias in favor of defaultAlias; add better handling of slave servers...

[hcoop/domtool2.git] / src / openssl.sml

diff --git a/src/openssl.sml b/src/openssl.sml
index 7a062f1..d309a61 100644 (file)
--- a/src/openssl.sml
+++ b/src/openssl.sml
@@ -78,10 +78,12 @@ fun readChar bio =
            (ssl_err "BIO_read";
             raise OpenSSL "BIO_read failed")
        else
-           SOME (chr (Word32.toInt (C.Get.uchar'
-                                        (C.Ptr.sub' C.S.uchar (readBuf, 0)))))
+           SOME (chr (Compat.Char.toInt (C.Get.uchar'
+                                             (C.Ptr.sub' C.S.uchar (readBuf, 0)))))
     end
 
+val charToWord = Word32.fromLargeWord o Compat.Char.toLargeWord
+
 fun readInt bio =
     let
        val r = F_OpenSSL_SML_read.f' (bio, C.Ptr.inject' readBuf, four)
@@ -94,14 +96,14 @@ fun readInt bio =
        else
            SOME (Word32.toInt
                      (Word32.+
-                      (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 0)),
+                      (charToWord (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 0))),
                        Word32.+
-                       (Word32.<< (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 1)),
+                       (Word32.<< (charToWord (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 1))),
                                    eight),
                         Word32.+
-                        (Word32.<< (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 2)),
+                        (Word32.<< (charToWord (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 2))),
                                     sixteen),
-                         Word32.<< (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 3)),
+                         Word32.<< (charToWord (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 3))),
                                     twentyfour))))))
     end
 
@@ -131,8 +133,8 @@ fun readLen (bio, len) =
                     raise OpenSSL "BIO_read failed")
                else if r = needed then
                    SOME (CharVector.tabulate (Int32.toInt needed,
-                                           fn i => chr (Word32.toInt (C.Get.uchar'
-                                                                          (C.Ptr.sub' C.S.uchar (buf, i))))))
+                                              fn i => chr (Compat.Char.toInt (C.Get.uchar'
+                                                                                  (C.Ptr.sub' C.S.uchar (buf, i))))))
                else
                    loop (C.Ptr.|+! C.S.uchar (buf', Int32.toInt r), needed - r)
            end
@@ -152,8 +154,8 @@ fun readChunk bio =
             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))))))
+                                      fn i => chr (Compat.Char.toInt (C.Get.uchar'
+                                                                          (C.Ptr.sub' C.S.uchar (readBuf, i))))))
     end
 
 fun readString bio =
@@ -164,7 +166,7 @@ fun readString bio =
 fun writeChar (bio, ch) =
     let
        val _ = C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 0),
-                             Word32.fromInt (ord ch))
+                             Compat.Char.fromInt (ord ch))
 
        fun trier () =
            let
@@ -182,18 +184,20 @@ fun writeChar (bio, ch) =
        trier ()
     end
 
+val wordToChar = Compat.Char.fromLargeWord o Word32.toLargeWord
+
 fun writeInt (bio, n) =
     let
        val w = Word32.fromInt n
 
        val _ = (C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 0),
-                              Word32.andb (w, mask1));
+                              wordToChar (Word32.andb (w, mask1)));
                 C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 1),
-                              Word32.andb (Word32.>> (w, eight), mask1));
+                              wordToChar (Word32.andb (Word32.>> (w, eight), mask1)));
                 C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 2),
-                              Word32.andb (Word32.>> (w, sixteen), mask1));
+                              wordToChar (Word32.andb (Word32.>> (w, sixteen), mask1)));
                 C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 3),
-                              Word32.andb (Word32.>> (w, twentyfour), mask1)))
+                              wordToChar (Word32.andb (Word32.>> (w, twentyfour), mask1))))
 
        fun trier (buf, count) =
            let
@@ -227,29 +231,29 @@ fun writeString (bio, s) =
     (writeInt (bio, size s);
      writeString' (bio, s))
 
-fun context (chain, key, root) =
+fun context printErr (chain, key, root) =
     let
        val context = F_OpenSSL_SML_CTX_new.f' (F_OpenSSL_SML_SSLv23_method.f' ())
     in
        if C.Ptr.isNull' context then
-           (ssl_err "Error creating SSL context";
+           (if printErr then ssl_err "Error creating SSL context" else ();
             raise OpenSSL "Can't create SSL context")
        else if F_OpenSSL_SML_use_certificate_chain_file.f' (context,
                                                             ZString.dupML' chain)
                = 0 then
-           (ssl_err "Error using certificate chain";
+           (if printErr then ssl_err "Error using certificate chain" else ();
             F_OpenSSL_SML_CTX_free.f' context;
             raise OpenSSL "Can't load certificate chain")
        else if F_OpenSSL_SML_use_PrivateKey_file.f' (context,
                                                      ZString.dupML' key)
                = 0 then
-           (ssl_err "Error using private key";
+           (if printErr then ssl_err "Error using private key" else ();
             F_OpenSSL_SML_CTX_free.f' context;
             raise OpenSSL "Can't load private key")
        else if F_OpenSSL_SML_load_verify_locations.f' (context,
                                                        ZString.dupML' root,
                                                        C.Ptr.null') = 0 then
-           (ssl_err "Error loading trust store";
+           (if printErr then ssl_err "Error loading trust store" else ();
             F_OpenSSL_SML_CTX_free.f' context;
             raise OpenSSL "Can't load trust store")
        else