~singpolyma/network-protocol-xmpp

922f1a439e94dd708b808e7d4a858c28d2754937 — John Millikin 13 years ago 23322af
In TLS mode, check for pending data before calling ``tlsRecv``. If no data is pending, wait for some first. By waiting for input in Haskell code, SIGINT will work again.
1 files changed, 13 insertions(+), 6 deletions(-)

M Network/Protocol/XMPP/Stream.hs
M Network/Protocol/XMPP/Stream.hs => Network/Protocol/XMPP/Stream.hs +13 -6
@@ 82,7 82,7 @@ data XMPPVersion = XMPPVersion Int Int

data Handle =
	  PlainHandle IO.Handle
	| SecureHandle (GnuTLS.Session GnuTLS.Client)
	| SecureHandle IO.Handle (GnuTLS.Session GnuTLS.Client)

------------------------------------------------------------------------------



@@ 95,7 95,7 @@ beginStream jid rawHandle = do
	
	plainStream <- beginStream' jid (PlainHandle rawHandle)
	
	putTree plainStream $ mkElement ("", "starttls")
	putTree plainStream $ Util.mkElement ("", "starttls")
		[("", "xmlns", "urn:ietf:params:xml:ns:xmpp-tls")]
		[]
	getTree plainStream


@@ 106,7 106,7 @@ beginStream jid rawHandle = do
		,GnuTLS.credentials GnuTLS.:= GnuTLS.certificateCredentials
		]
	GnuTLS.handshake session
	beginStream' jid (SecureHandle session)
	beginStream' jid (SecureHandle rawHandle session)

beginStream' :: JID -> Handle -> IO Stream
beginStream' jid h = do


@@ 229,11 229,18 @@ readEventsStep done (e:es) depth accum = let

hPutStr :: Handle -> String -> IO ()
hPutStr (PlainHandle h) = IO.hPutStr h
hPutStr (SecureHandle h) = GnuTLS.tlsSendString h
hPutStr (SecureHandle _ session) = GnuTLS.tlsSendString session

hGetChar :: Handle -> IO Char
hGetChar (PlainHandle h) = IO.hGetChar h
hGetChar (SecureHandle h) = allocaBytes 1 $ \ptr -> do
	len <- GnuTLS.tlsRecv h ptr 1
hGetChar (SecureHandle h session) = allocaBytes 1 $ \ptr -> do
	pending <- GnuTLS.tlsCheckPending session
	if pending == 0
		then do
			IO.hWaitForInput h (-1)
			return ()
		else return ()
	
	len <- GnuTLS.tlsRecv session ptr 1
	[char] <- peekCAStringLen (ptr, len)
	return char