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

(* HCoop Domtool (http://hcoop.sourceforge.net/)
 * Copyright (c) 2006, Adam Chlipala
 *
 * This program is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License
 * as published by the Free Software Foundation; either version 2
 * of the License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 *)

(* OpenSSL *)

structure OpenSSL :> OPENSSL = struct

val () = (F_OpenSSL_SML_init.f' ();
	  F_OpenSSL_SML_load_error_strings.f' ();
	  F_OpenSSL_SML_load_BIO_strings.f' ())

exception OpenSSL of string

type context = (ST_ssl_ctx_st.tag, C_Int.rw) C_Int.su_obj C_Int.ptr'
type bio = (ST_bio_st.tag, C_Int.rw) C_Int.su_obj C_Int.ptr'
type listener = bio

fun ssl_err s =
    let
	val err = F_OpenSSL_SML_get_error.f ()

	val lib = F_OpenSSL_SML_lib_error_string.f err
	val func = F_OpenSSL_SML_func_error_string.f err
	val reason = F_OpenSSL_SML_reason_error_string.f err
    in
	print s;
	print "\nReason: ";
	if C.Ptr.isNull lib then
	    ()
	else
	    (print (ZString.toML lib);
	     print ":");
	if C.Ptr.isNull func then
	    ()
	else
	    (print (ZString.toML func);
	     print ":");
	if C.Ptr.isNull reason then
	    ()
	else
	    print (ZString.toML reason)
    end

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
val one = Int32.fromInt 1
val four = Int32.fromInt 4

val eight = Word.fromInt 8
val sixteen = Word.fromInt 16
val twentyfour = Word.fromInt 24

val mask1 = Word32.fromInt 255

fun readChar bio =
    let
	val r = F_OpenSSL_SML_read.f' (bio, C.Ptr.inject' readBuf, one)
    in
	if r = 0 then
	    NONE
	else if r < 0 then
	    (ssl_err "BIO_read";
	     raise OpenSSL "BIO_read failed")
	else
	    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)
    in
	if r = 0 then
	    NONE
	else if r < 0 then
	    (ssl_err "BIO_read";
	     raise OpenSSL "BIO_read failed")
	else
	    SOME (Word32.toInt
		      (Word32.+
		       (charToWord (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 0))),
			Word32.+
			(Word32.<< (charToWord (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 1))),
				    eight),
			 Word32.+
			 (Word32.<< (charToWord (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 2))),
				     sixteen),
			  Word32.<< (charToWord (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 3))),
				     twentyfour))))))
    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
		()

	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
	val r = F_OpenSSL_SML_read.f' (bio, C.Ptr.inject' readBuf, bufSize)
    in
	if r = 0 then
	    NONE
	else if r < 0 then
	    (ssl_err "BIO_read";
	     raise OpenSSL "BIO_read failed")
	else
	    SOME (CharVector.tabulate (Int32.toInt r,
				       fn i => chr (Compat.Char.toInt (C.Get.uchar'
									   (C.Ptr.sub' C.S.uchar (readBuf, i))))))
    end

fun readString bio =
    case readInt bio of
	NONE => NONE
      | SOME len => readLen (bio, len)

fun writeChar (bio, ch) =
    let
	val _ = C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 0),
			      Compat.Char.fromInt (ord ch))

	fun trier () =
	    let
		val r = F_OpenSSL_SML_write.f' (bio, C.Ptr.inject' readBuf, one)
	    in
		if r = 0 then
		    trier ()
		else if r < 0 then
		    (ssl_err "BIO_write";
		     raise OpenSSL "BIO_write")
		else
		    ()
	    end
    in
	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),
			       wordToChar (Word32.andb (w, mask1)));
		 C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 1),
			       wordToChar (Word32.andb (Word32.>> (w, eight), mask1)));
		 C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 2),
			       wordToChar (Word32.andb (Word32.>> (w, sixteen), mask1)));
		 C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 3),
			       wordToChar (Word32.andb (Word32.>> (w, twentyfour), mask1))))

	fun trier (buf, count) =
	    let
		val r = F_OpenSSL_SML_write.f' (bio, C.Ptr.inject' buf, count)
	    in
		if r < 0 then
		    (ssl_err "BIO_write";
		     raise OpenSSL "BIO_write")
		else if r = count then
		    ()
		else
		    trier (C.Ptr.|+! C.S.uchar (buf, Int32.toInt r), count - r)
	    end
    in
	trier (readBuf, 4)
    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

fun writeString (bio, s) =
    (writeInt (bio, size s);
     writeString' (bio, s))

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
	    (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
	    (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
	    (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
	    (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
	    context
    end

fun connect (context, hostname) =
    let
	val bio = F_OpenSSL_SML_new_ssl_connect.f' context
    in
	if C.Ptr.isNull' bio then
	    (ssl_err ("Error initializating connection to " ^ hostname);
	     F_OpenSSL_SML_free_all.f' bio;
	     raise OpenSSL "Can't initialize connection")
	else if F_OpenSSL_SML_set_conn_hostname.f' (bio, ZString.dupML' hostname) = 0 then
	    (ssl_err ("Error setting hostname: " ^ hostname);
	     F_OpenSSL_SML_free_all.f' bio;
	     raise OpenSSL "Can't set hostname")
	else if F_OpenSSL_SML_do_connect.f' bio <= 0 then
	    (ssl_err ("Error connecting to " ^ hostname);
	     F_OpenSSL_SML_free_all.f' bio;
	     raise OpenSSL "Can't connect")
	else
	    bio
    end

fun close bio = F_OpenSSL_SML_free_all.f' bio

fun listen (context, port) =
    let
	val port = ZString.dupML' (Int.toString port)
	val listener = F_OpenSSL_SML_new_accept.f' (context, port)
    in
	C.free' port;
	if C.Ptr.isNull' listener then
	    (ssl_err "Null listener";
	     raise OpenSSL "Null listener")
	else if F_OpenSSL_SML_do_accept.f' listener <= 0 then
	    (ssl_err "Error initializing listener";
	     close listener;
	     raise OpenSSL "Can't initialize listener")
	else
	    listener
    end

val shutdown = close

fun accept listener =
    if F_OpenSSL_SML_do_accept.f' listener <= 0 then
	NONE
    else
	let
	    val bio = F_OpenSSL_SML_pop.f' listener
	in
	    if C.Ptr.isNull' bio then
		(ssl_err "Null accepted";
		 raise OpenSSL "Null accepted")
	    else if F_OpenSSL_SML_do_handshake.f' bio <= 0 then
		(ssl_err "Handshake failed";
		 raise OpenSSL "Handshake failed")
	    else
		SOME bio
	end

fun peerCN bio =
    let
	val ssl = F_OpenSSL_SML_get_ssl.f' bio
	val _ = if C.Ptr.isNull' ssl then
		    raise OpenSSL "Null SSL"
		else
		    ()
	val subj = F_OpenSSL_SML_get_peer_name.f' ssl
    in
	if C.Ptr.isNull' subj then
	    raise OpenSSL "Null CN result"
	else
	    ZString.toML' subj
    end

end
Commit	Line	Data
3b267643 AC	1	(* HCoop Domtool (http://hcoop.sourceforge.net/)
	2	* Copyright (c) 2006, Adam Chlipala
	3	*
	4	* This program is free software; you can redistribute it and/or
	5	* modify it under the terms of the GNU General Public License
	6	* as published by the Free Software Foundation; either version 2
	7	* of the License, or (at your option) any later version.
	8	*
	9	* This program is distributed in the hope that it will be useful,
	10	* but WITHOUT ANY WARRANTY; without even the implied warranty of
	11	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	12	* GNU General Public License for more details.
	13	*
	14	* You should have received a copy of the GNU General Public License
	15	* along with this program; if not, write to the Free Software
	16	* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
	17	*)
	18
	19	(* OpenSSL *)
	20
	21	structure OpenSSL :> OPENSSL = struct
	22
	23	val () = (F_OpenSSL_SML_init.f' ();
	24	F_OpenSSL_SML_load_error_strings.f' ();
	25	F_OpenSSL_SML_load_BIO_strings.f' ())
	26
	27	exception OpenSSL of string
	28
	29	type context = (ST_ssl_ctx_st.tag, C_Int.rw) C_Int.su_obj C_Int.ptr'
	30	type bio = (ST_bio_st.tag, C_Int.rw) C_Int.su_obj C_Int.ptr'
60534712	31	type listener = bio
3b267643 AC	32
	33	fun ssl_err s =
	34	let
	35	val err = F_OpenSSL_SML_get_error.f ()
	36
	37	val lib = F_OpenSSL_SML_lib_error_string.f err
	38	val func = F_OpenSSL_SML_func_error_string.f err
	39	val reason = F_OpenSSL_SML_reason_error_string.f err
	40	in
	41	print s;
	42	print "\nReason: ";
	43	if C.Ptr.isNull lib then
	44	()
	45	else
	46	(print (ZString.toML lib);
	47	print ":");
64a44dc0 AC	48	if C.Ptr.isNull func then
	49	()
	50	else
	51	(print (ZString.toML func);
	52	print ":");
	53	if C.Ptr.isNull reason then
	54	()
	55	else
	56	print (ZString.toML reason)
3b267643 AC	57	end
	58
	59	val readBuf : (C.uchar, C.rw) C.obj C.ptr' = C.alloc' C.S.uchar (Word.fromInt Config.bufSize)
	60	val bufSize = Int32.fromInt Config.bufSize
36e42cb8 AC	61	val one = Int32.fromInt 1
36e42cb8 AC	62	val four = Int32.fromInt 4
3b267643	63
36e42cb8 AC	64	val eight = Word.fromInt 8
	65	val sixteen = Word.fromInt 16
	66	val twentyfour = Word.fromInt 24
	67
	68	val mask1 = Word32.fromInt 255
	69
	70	fun readChar bio =
	71	let
	72	val r = F_OpenSSL_SML_read.f' (bio, C.Ptr.inject' readBuf, one)
	73	in
	74	if r = 0 then
	75	NONE
	76	else if r < 0 then
	77	(ssl_err "BIO_read";
	78	raise OpenSSL "BIO_read failed")
	79	else
a49a9bfb AC	80	SOME (chr (Compat.Char.toInt (C.Get.uchar'
a49a9bfb AC	81	(C.Ptr.sub' C.S.uchar (readBuf, 0)))))
36e42cb8 AC	82	end
36e42cb8 AC	83
a49a9bfb AC	84	val charToWord = Word32.fromLargeWord o Compat.Char.toLargeWord
a49a9bfb AC	85
36e42cb8 AC	86	fun readInt bio =
	87	let
	88	val r = F_OpenSSL_SML_read.f' (bio, C.Ptr.inject' readBuf, four)
	89	in
	90	if r = 0 then
	91	NONE
	92	else if r < 0 then
	93	(ssl_err "BIO_read";
	94	raise OpenSSL "BIO_read failed")
	95	else
	96	SOME (Word32.toInt
	97	(Word32.+
a49a9bfb	98	(charToWord (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 0))),
36e42cb8	99	Word32.+
a49a9bfb	100	(Word32.<< (charToWord (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 1))),
36e42cb8 AC	101	eight),
36e42cb8 AC	102	Word32.+
a49a9bfb	103	(Word32.<< (charToWord (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 2))),
36e42cb8	104	sixteen),
a49a9bfb	105	Word32.<< (charToWord (C.Get.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 3))),
36e42cb8 AC	106	twentyfour))))))
	107	end
	108
	109	fun readLen (bio, len) =
	110	let
	111	val buf =
	112	if len > Config.bufSize then
	113	C.alloc' C.S.uchar (Word.fromInt len)
	114	else
	115	readBuf
	116
	117	fun cleanup () =
	118	if len > Config.bufSize then
	119	C.free' buf
	120	else
	121	()
	122
	123	fun loop (buf', needed) =
	124	let
	125	val r = F_OpenSSL_SML_read.f' (bio, C.Ptr.inject' buf, Int32.fromInt len)
	126	in
	127	if r = 0 then
	128	(cleanup (); NONE)
	129	else if r < 0 then
	130	(cleanup ();
	131	ssl_err "BIO_read";
	132	raise OpenSSL "BIO_read failed")
	133	else if r = needed then
	134	SOME (CharVector.tabulate (Int32.toInt needed,
a49a9bfb AC	135	fn i => chr (Compat.Char.toInt (C.Get.uchar'
a49a9bfb AC	136	(C.Ptr.sub' C.S.uchar (buf, i))))))
36e42cb8 AC	137	else
	138	loop (C.Ptr.\|+! C.S.uchar (buf', Int32.toInt r), needed - r)
	139	end
	140	in
	141	loop (buf, Int32.fromInt len)
	142	before cleanup ()
	143	end
	144
	145	fun readChunk bio =
3b267643 AC	146	let
	147	val r = F_OpenSSL_SML_read.f' (bio, C.Ptr.inject' readBuf, bufSize)
	148	in
	149	if r = 0 then
	150	NONE
	151	else if r < 0 then
36e42cb8 AC	152	(ssl_err "BIO_read";
36e42cb8 AC	153	raise OpenSSL "BIO_read failed")
3b267643 AC	154	else
3b267643 AC	155	SOME (CharVector.tabulate (Int32.toInt r,
a49a9bfb AC	156	fn i => chr (Compat.Char.toInt (C.Get.uchar'
a49a9bfb AC	157	(C.Ptr.sub' C.S.uchar (readBuf, i))))))
3b267643 AC	158	end
3b267643 AC	159
36e42cb8 AC	160	fun readString bio =
	161	case readInt bio of
	162	NONE => NONE
	163	\| SOME len => readLen (bio, len)
	164
	165	fun writeChar (bio, ch) =
3b267643	166	let
36e42cb8	167	val _ = C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 0),
a49a9bfb	168	Compat.Char.fromInt (ord ch))
3b267643	169
36e42cb8	170	fun trier () =
3b267643	171	let
36e42cb8	172	val r = F_OpenSSL_SML_write.f' (bio, C.Ptr.inject' readBuf, one)
3b267643	173	in
36e42cb8 AC	174	if r = 0 then
	175	trier ()
	176	else if r < 0 then
	177	(ssl_err "BIO_write";
	178	raise OpenSSL "BIO_write")
	179	else
	180	()
	181	end
	182	in
	183	trier ()
	184	end
	185
a49a9bfb AC	186	val wordToChar = Compat.Char.fromLargeWord o Word32.toLargeWord
a49a9bfb AC	187
36e42cb8 AC	188	fun writeInt (bio, n) =
	189	let
	190	val w = Word32.fromInt n
	191
	192	val _ = (C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 0),
a49a9bfb	193	wordToChar (Word32.andb (w, mask1)));
36e42cb8	194	C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 1),
a49a9bfb	195	wordToChar (Word32.andb (Word32.>> (w, eight), mask1)));
36e42cb8	196	C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 2),
a49a9bfb	197	wordToChar (Word32.andb (Word32.>> (w, sixteen), mask1)));
36e42cb8	198	C.Set.uchar' (C.Ptr.sub' C.S.uchar (readBuf, 3),
a49a9bfb	199	wordToChar (Word32.andb (Word32.>> (w, twentyfour), mask1))))
36e42cb8 AC	200
	201	fun trier (buf, count) =
	202	let
	203	val r = F_OpenSSL_SML_write.f' (bio, C.Ptr.inject' buf, count)
	204	in
	205	if r < 0 then
	206	(ssl_err "BIO_write";
	207	raise OpenSSL "BIO_write")
	208	else if r = count then
3b267643	209	()
3b267643	210	else
36e42cb8	211	trier (C.Ptr.\|+! C.S.uchar (buf, Int32.toInt r), count - r)
3b267643 AC	212	end
3b267643 AC	213	in
36e42cb8 AC	214	trier (readBuf, 4)
	215	end
	216
	217	fun writeString' (bio, s) =
	218	let
	219	val buf = ZString.dupML' s
	220	in
	221	if F_OpenSSL_SML_puts.f' (bio, buf) <= 0 then
	222	(C.free' buf;
	223	ssl_err "BIO_puts";
	224	raise OpenSSL "BIO_puts")
	225	else
	226	C.free' buf
3b267643 AC	227	end
3b267643 AC	228
36e42cb8 AC	229	fun writeString (bio, s) =
	230	(writeInt (bio, size s);
	231	writeString' (bio, s))
	232
d22c1f00	233	fun context printErr (chain, key, root) =
3b267643 AC	234	let
	235	val context = F_OpenSSL_SML_CTX_new.f' (F_OpenSSL_SML_SSLv23_method.f' ())
	236	in
	237	if C.Ptr.isNull' context then
d22c1f00	238	(if printErr then ssl_err "Error creating SSL context" else ();
3b267643 AC	239	raise OpenSSL "Can't create SSL context")
	240	else if F_OpenSSL_SML_use_certificate_chain_file.f' (context,
	241	ZString.dupML' chain)
	242	= 0 then
d22c1f00	243	(if printErr then ssl_err "Error using certificate chain" else ();
3b267643 AC	244	F_OpenSSL_SML_CTX_free.f' context;
	245	raise OpenSSL "Can't load certificate chain")
	246	else if F_OpenSSL_SML_use_PrivateKey_file.f' (context,
	247	ZString.dupML' key)
	248	= 0 then
d22c1f00	249	(if printErr then ssl_err "Error using private key" else ();
3b267643 AC	250	F_OpenSSL_SML_CTX_free.f' context;
	251	raise OpenSSL "Can't load private key")
	252	else if F_OpenSSL_SML_load_verify_locations.f' (context,
	253	ZString.dupML' root,
	254	C.Ptr.null') = 0 then
d22c1f00	255	(if printErr then ssl_err "Error loading trust store" else ();
3b267643 AC	256	F_OpenSSL_SML_CTX_free.f' context;
	257	raise OpenSSL "Can't load trust store")
	258	else
	259	context
	260	end
	261
	262	fun connect (context, hostname) =
	263	let
	264	val bio = F_OpenSSL_SML_new_ssl_connect.f' context
	265	in
	266	if C.Ptr.isNull' bio then
	267	(ssl_err ("Error initializating connection to " ^ hostname);
	268	F_OpenSSL_SML_free_all.f' bio;
	269	raise OpenSSL "Can't initialize connection")
	270	else if F_OpenSSL_SML_set_conn_hostname.f' (bio, ZString.dupML' hostname) = 0 then
	271	(ssl_err ("Error setting hostname: " ^ hostname);
	272	F_OpenSSL_SML_free_all.f' bio;
	273	raise OpenSSL "Can't set hostname")
	274	else if F_OpenSSL_SML_do_connect.f' bio <= 0 then
	275	(ssl_err ("Error connecting to " ^ hostname);
	276	F_OpenSSL_SML_free_all.f' bio;
	277	raise OpenSSL "Can't connect")
	278	else
	279	bio
	280	end
	281
	282	fun close bio = F_OpenSSL_SML_free_all.f' bio
	283
60534712 AC	284	fun listen (context, port) =
	285	let
	286	val port = ZString.dupML' (Int.toString port)
	287	val listener = F_OpenSSL_SML_new_accept.f' (context, port)
	288	in
	289	C.free' port;
	290	if C.Ptr.isNull' listener then
	291	(ssl_err "Null listener";
	292	raise OpenSSL "Null listener")
	293	else if F_OpenSSL_SML_do_accept.f' listener <= 0 then
	294	(ssl_err "Error initializing listener";
	295	close listener;
	296	raise OpenSSL "Can't initialize listener")
	297	else
	298	listener
	299	end
	300
	301	val shutdown = close
	302
	303	fun accept listener =
	304	if F_OpenSSL_SML_do_accept.f' listener <= 0 then
	305	NONE
	306	else
7a150fe2 AC	307	let
	308	val bio = F_OpenSSL_SML_pop.f' listener
	309	in
	310	if C.Ptr.isNull' bio then
	311	(ssl_err "Null accepted";
	312	raise OpenSSL "Null accepted")
	313	else if F_OpenSSL_SML_do_handshake.f' bio <= 0 then
	314	(ssl_err "Handshake failed";
	315	raise OpenSSL "Handshake failed")
	316	else
	317	SOME bio
	318	end
3b267643 AC	319
	320	fun peerCN bio =
	321	let
	322	val ssl = F_OpenSSL_SML_get_ssl.f' bio
	323	val _ = if C.Ptr.isNull' ssl then
	324	raise OpenSSL "Null SSL"
	325	else
	326	()
	327	val subj = F_OpenSSL_SML_get_peer_name.f' ssl
	328	in
	329	if C.Ptr.isNull' subj then
	330	raise OpenSSL "Null CN result"
	331	else
	332	ZString.toML' subj
	333	end
	334
	335	end