Adding domain description

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

diff --git a/src/openssl.sml b/src/openssl.sml
index df63276..aad3925 100644 (file)
--- a/src/openssl.sml
+++ b/src/openssl.sml
@@ -53,7 +53,8 @@ fun ssl_err s =
        if C.Ptr.isNull reason then
            ()
        else
-           print (ZString.toML reason)
+           print (ZString.toML reason);
+       print "\n"
     end
 
 val readBuf : (C.uchar, C.rw) C.obj C.ptr' = C.alloc' C.S.uchar (Word.fromInt Config.bufSize)
@@ -107,40 +108,43 @@ fun readInt bio =
     end
 
 fun readLen (bio, len) =
-    let
-       val buf =
-           if len > Config.bufSize then
-               C.alloc' C.S.uchar (Word.fromInt len)
-           else
-               readBuf
-
-       fun cleanup () =
-           if len > Config.bufSize then
-               C.free' buf
-           else
-               ()
+    if len = 0 then
+       SOME ""
+    else
+       let
+           val buf =
+               if len > Config.bufSize then
+                   C.alloc' C.S.uchar (Word.fromInt len)
+               else
+                   readBuf
 
-       fun loop (buf', needed) =
-           let
-               val r = F_OpenSSL_SML_read.f' (bio, C.Ptr.inject' buf, Int32.fromInt len)
-           in
-               if r = 0 then
-                   (cleanup (); NONE)
-               else if r < 0 then
-                   (cleanup ();
-                    ssl_err "BIO_read";
-                    raise OpenSSL "BIO_read failed")
-               else if r = needed then
-                   SOME (CharVector.tabulate (Int32.toInt needed,
-                                              fn i => chr (Compat.Char.toInt (C.Get.uchar'
-                                                                                  (C.Ptr.sub' C.S.uchar (buf, i))))))
+           fun cleanup () =
+               if len > Config.bufSize then
+                   C.free' buf
                else
-                   loop (C.Ptr.|+! C.S.uchar (buf', Int32.toInt r), needed - r)
-           end
-    in
-       loop (buf, Int32.fromInt len)
-       before cleanup ()
-    end        
+                   ()
+
+           fun loop (buf', needed) =
+               let
+                   val r = F_OpenSSL_SML_read.f' (bio, C.Ptr.inject' buf, Int32.fromInt len)
+               in
+                   if r = 0 then
+                       (cleanup (); NONE)
+                   else if r < 0 then
+                       (cleanup ();
+                        ssl_err "BIO_read";
+                        raise OpenSSL "BIO_read failed")
+                   else if r = needed then
+                       SOME (CharVector.tabulate (Int32.toInt needed,
+                                               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
+       in
+           loop (buf, Int32.fromInt len)
+           before cleanup ()
+       end
 
 fun readChunk bio =
     let
@@ -215,16 +219,19 @@ fun writeInt (bio, n) =
     end        
 
 fun writeString' (bio, s) =
-    let
-       val buf = ZString.dupML' s
-    in
-       if F_OpenSSL_SML_puts.f' (bio, buf) <= 0 then
-           (C.free' buf;
-            ssl_err "BIO_puts";
-            raise OpenSSL "BIO_puts")
-       else
-           C.free' buf
-    end
+    if size s = 0 then
+       ()
+    else
+       let
+           val buf = ZString.dupML' s
+       in
+           if F_OpenSSL_SML_puts.f' (bio, buf) <= 0 then
+               (C.free' buf;
+                ssl_err "BIO_puts";
+                raise OpenSSL "BIO_puts")
+           else
+               C.free' buf
+       end
 
 fun writeString (bio, s) =
     (writeInt (bio, size s);