2 files changed, 20 insertions, 11 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 =
     , xmppPeerSubscriptionRequest :: IO () -> ConnectionKey -> Stanza -> TChan Stanza -> IO () 
     , xmppClientInformSubscription :: IO () -> ConnectionKey -> Stanza -> IO ()
     , xmppPeerInformSubscription :: IO () -> ConnectionKey -> Stanza -> IO ()
+    , xmppVerbosity :: IO Int
     }
 
 
@@ -1253,15 +1254,15 @@ forkConnection sv xmpp k laddr pingflag src snk stanzas = do
     msgids <- atomically $ newTVar []
     forkIO $ do
         -- mapM_ (atomically . Slotted.push slots Nothing) greetPeer
+        verbosity <- xmppVerbosity xmpp
         fix $ \loop -> do
             what <- atomically $ foldr1 orElse
                 [readTChan output >>= \stanza -> return $ do
-#ifndef PINGNOISE
-                    let notping f = case stanzaType stanza of Pong -> return ()
-                                                              _ -> f
-#else
-                    let notping f = f
-#endif
+                    let notping f
+                            | (verbosity==1) = case stanzaType stanza of Pong -> return ()
+                                                                         _ -> f
+                            | (verbosity>=2) = f
+                            | otherwise      = return ()
                     -- isempty <- atomically $ isEmptyTChan (stanzaChan stanza)
                     -- kwlog $ "queuing: "++show (isempty, stanzaId stanza)
                     notping $ do
@@ -1739,11 +1740,12 @@ monitor sv params xmpp = do
                          deliver replyto
                 _ -> return ()
         -- We need to clone in the case the stanza is passed on as for Message.
-#ifndef PINGNOISE
-        let notping f = case stanzaType stanza of Pong -> return ()
-                                                  _ -> f
+        verbosity <- xmppVerbosity xmpp
+        let notping f | (verbosity==1) = case stanzaType stanza of Pong -> return ()
+                                                                   _    -> f
+                      | (verbosity>=2) = f
+                      | otherwise      = return ()
         notping $ do
-#endif
         let typ = Strict8.pack $ c ++ "->"++(concat . take 1 . words $ show (stanzaType stanza))++" "
             c = case stanzaOrigin stanza of
                     LocalPeer -> "*"
diff --git a/xmppServer.hs b/xmppServer.hs
index a406366a..118a16b2 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE LambdaCase #-}
+import System.Environment
 import System.Posix.Signals
 import Control.Concurrent (threadDelay,forkIO,forkOS,killThread,throwTo)
 import Control.Concurrent.STM
@@ -11,7 +13,7 @@ import Network.Socket ( SockAddr(..) )
 import System.Endian (fromBE32)
 import Data.List (nub, (\\), intersect, groupBy, sort, sortBy )
 import Data.Ord (comparing )
-import Data.Monoid ( (<>) )
+import Data.Monoid ( (<>), Sum(..), getSum )
 import qualified Data.Text as Text
 import qualified Data.Text.IO as Text
 import qualified Data.Text.Encoding as Text
@@ -956,6 +958,10 @@ peerInformSubscription state fail k stanza = do
                                chan
 
 main = runResourceT $ do
+    args <- liftIO getArgs
+    let verbosity = getSum $ flip foldMap args $ \case
+            ('-':xs) -> Sum $ length (filter (=='-') xs)
+            _        -> mempty
     cw <- liftIO newConsoleWriter
     state <- liftIO . atomically $ do
         clients <- newTVar Map.empty
@@ -996,6 +1002,7 @@ main = runResourceT $ do
         , xmppPeerSubscriptionRequest = peerSubscriptionRequest state
         , xmppClientInformSubscription = clientInformSubscription state
         , xmppPeerInformSubscription = peerInformSubscription state
+        , xmppVerbosity = return verbosity
         }
     liftIO $ do
     atomically $ putTMVar (server state) sv