From 922f1a439e94dd708b808e7d4a858c28d2754937 Mon Sep 17 00:00:00 2001 From: John Millikin Date: Wed, 24 Jun 2009 21:58:02 +0000 Subject: [PATCH] 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. --- Network/Protocol/XMPP/Stream.hs | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/Network/Protocol/XMPP/Stream.hs b/Network/Protocol/XMPP/Stream.hs index 7c8948f..b14c70f 100644 --- a/Network/Protocol/XMPP/Stream.hs +++ b/Network/Protocol/XMPP/Stream.hs @@ -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 -- 2.38.5