summaryrefslogtreecommitdiff
path: root/Presence/XMPPServer.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Presence/XMPPServer.hs')
-rw-r--r--Presence/XMPPServer.hs22
1 files changed, 12 insertions, 10 deletions
diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index 41d60a07..e78e4dd9 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -192,6 +192,7 @@ data XMPPServerParameters =
192 , xmppPeerSubscriptionRequest :: IO () -> ConnectionKey -> Stanza -> TChan Stanza -> IO () 192 , xmppPeerSubscriptionRequest :: IO () -> ConnectionKey -> Stanza -> TChan Stanza -> IO ()
193 , xmppClientInformSubscription :: IO () -> ConnectionKey -> Stanza -> IO () 193 , xmppClientInformSubscription :: IO () -> ConnectionKey -> Stanza -> IO ()
194 , xmppPeerInformSubscription :: IO () -> ConnectionKey -> Stanza -> IO () 194 , xmppPeerInformSubscription :: IO () -> ConnectionKey -> Stanza -> IO ()
195 , xmppVerbosity :: IO Int
195 } 196 }
196 197
197 198
@@ -1253,15 +1254,15 @@ forkConnection sv xmpp k laddr pingflag src snk stanzas = do
1253 msgids <- atomically $ newTVar [] 1254 msgids <- atomically $ newTVar []
1254 forkIO $ do 1255 forkIO $ do
1255 -- mapM_ (atomically . Slotted.push slots Nothing) greetPeer 1256 -- mapM_ (atomically . Slotted.push slots Nothing) greetPeer
1257 verbosity <- xmppVerbosity xmpp
1256 fix $ \loop -> do 1258 fix $ \loop -> do
1257 what <- atomically $ foldr1 orElse 1259 what <- atomically $ foldr1 orElse
1258 [readTChan output >>= \stanza -> return $ do 1260 [readTChan output >>= \stanza -> return $ do
1259#ifndef PINGNOISE 1261 let notping f
1260 let notping f = case stanzaType stanza of Pong -> return () 1262 | (verbosity==1) = case stanzaType stanza of Pong -> return ()
1261 _ -> f 1263 _ -> f
1262#else 1264 | (verbosity>=2) = f
1263 let notping f = f 1265 | otherwise = return ()
1264#endif
1265 -- isempty <- atomically $ isEmptyTChan (stanzaChan stanza) 1266 -- isempty <- atomically $ isEmptyTChan (stanzaChan stanza)
1266 -- kwlog $ "queuing: "++show (isempty, stanzaId stanza) 1267 -- kwlog $ "queuing: "++show (isempty, stanzaId stanza)
1267 notping $ do 1268 notping $ do
@@ -1739,11 +1740,12 @@ monitor sv params xmpp = do
1739 deliver replyto 1740 deliver replyto
1740 _ -> return () 1741 _ -> return ()
1741 -- We need to clone in the case the stanza is passed on as for Message. 1742 -- We need to clone in the case the stanza is passed on as for Message.
1742#ifndef PINGNOISE 1743 verbosity <- xmppVerbosity xmpp
1743 let notping f = case stanzaType stanza of Pong -> return () 1744 let notping f | (verbosity==1) = case stanzaType stanza of Pong -> return ()
1744 _ -> f 1745 _ -> f
1746 | (verbosity>=2) = f
1747 | otherwise = return ()
1745 notping $ do 1748 notping $ do
1746#endif
1747 let typ = Strict8.pack $ c ++ "->"++(concat . take 1 . words $ show (stanzaType stanza))++" " 1749 let typ = Strict8.pack $ c ++ "->"++(concat . take 1 . words $ show (stanzaType stanza))++" "
1748 c = case stanzaOrigin stanza of 1750 c = case stanzaOrigin stanza of
1749 LocalPeer -> "*" 1751 LocalPeer -> "*"