X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/16465a9ab10d41506006aa27499513a42d2b7de6..9b8c6dc8df86d6ba1c7512cb12445912a9035a89:/src/openssl.sml

diff --git a/src/openssl.sml b/src/openssl.sml
index d309a61..26001cc 100644
--- a/src/openssl.sml
+++ b/src/openssl.sml
@@ -108,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
@@ -216,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);
@@ -260,9 +266,15 @@ fun context printErr (chain, key, root) =
 	    context
     end
 
-fun connect (context, hostname) =
+fun connect printErr (context, hostname) =
     let
 	val bio = F_OpenSSL_SML_new_ssl_connect.f' context
+
+	val ssl_err =
+	    if printErr then
+		ssl_err
+	    else
+		(fn _ => ())
     in
 	if C.Ptr.isNull' bio then
 	    (ssl_err ("Error initializating connection to " ^ hostname);