From 825962518c6ad00279fc23e8e1dec746980e483f Mon Sep 17 00:00:00 2001
From: "jim@bo" <jim@bo>
Date: Wed, 20 Jun 2018 22:40:37 -0400
Subject: More DPut stuff

        * verbose/quiet without args shows report
        * verbose all - sets all tags verbose
        * quiet all - sets all tags quiet
        * XMisc defaults to verbose, everything else quiet
        * new XMan tag for ToxManager related stuff
        * s/hputStrLn stderr/dput XMisc/ in daemon code
---
 examples/dhtd.hs | 30 ++++++++++++++++++++++++++----
 1 file changed, 26 insertions(+), 4 deletions(-)

(limited to 'examples')

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 355450a2..83e8c24f 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -369,6 +369,12 @@ clientSession s@Session{..} sock cnum h = do
                     case B.unsnoc x of
                                  Just (str,c) | isSpace c -> (str,False)
                                  _ -> (x,True)
+        allDebugTags = [XAnnounce .. XMisc]
+        showDebugTags = do
+                vs <- mapM getVerbose allDebugTags
+                let f True = "v"
+                    f False = "-"
+                hPutClient h $ showReport (zip (map (drop 1 . show) allDebugTags) (map f vs))
     let readHex :: (Read n, Integral n) => String -> Maybe n
         readHex s = readMaybe ("0x" ++ s)
         strToSession :: String -> IO (Either String Tox.NetCryptoSession)
@@ -635,6 +641,20 @@ clientSession s@Session{..} sock cnum h = do
                 setQuiet tag
                 hPutClient h $ "Suppressing " ++ show tag ++ " messages."
 
+        ("quiet",s) | "all" <- strp s
+                    -> cmd0 $ do
+                mapM_ setQuiet allDebugTags
+                showDebugTags
+
+        (verbose,s) | "" <- strp s
+                    , verbose `elem` ["verbose","quiet"]
+                    -> cmd0 $ showDebugTags
+
+        ("verbose",s) | "all" <- strp s
+                    -> cmd0 $ do
+                mapM_ setVerbose allDebugTags
+                showDebugTags
+
         ("verbose",s) | s' <- strp s
                     , Just (tag::DebugTag) <- readMaybe ('X':map toUpper (take 1 s') ++ drop 1 s')
                     -> cmd0 $ do
@@ -1410,8 +1430,10 @@ main = do
 
     announcer <- forkAnnouncer
 
-    -- Default: quiet all tags.
+    -- Default: quiet all tags (except XMisc).
     forM [minBound .. maxBound] setQuiet
+    -- Default: verbose XMisc
+    setVerbose XMisc
 
     (quitBt,btdhts,btips,baddrs) <- case portbt opts of
         "" -> return (return (), Map.empty,return [],[])
@@ -1508,7 +1530,7 @@ main = do
         "" -> return (Nothing,return (), Map.empty, return [],[])
         toxport -> do
             addrTox <- getBindAddress toxport (ip6tox opts)
-            hPutStrLn stderr $ "Supplied key: " ++ show (fmap (Tox.key2id . toPublic) (dhtkey opts))
+            dput XMisc $ "Supplied key: " ++ show (fmap (Tox.key2id . toPublic) (dhtkey opts))
             tox <- Tox.newTox keysdb
                               addrTox
                               (Just _netCryptoSessionsState)
@@ -1771,7 +1793,7 @@ main = do
         installHandler sigINT (CatchOnce (atomically $ writeTVar signalQuit True)) Nothing
         let defaultToxData = do
                 rster <- Tox.newContactInfo
-                orouter <- newOnionRouter (hPutStrLn stderr)
+                orouter <- newOnionRouter (dput XMisc)
                 return (rster, orouter)
         (rstr,orouter) <- fromMaybe defaultToxData $ do
             tox <- mbtox
@@ -1830,7 +1852,7 @@ main = do
                      (checkQuit >> return (return ()))
         what
 
-    forM msv $ \_ -> hPutStrLn stderr "Started XMPP server."
+    forM msv $ \_ -> dput XMisc "Started XMPP server."
 
     -- Wait for DHT and XMPP threads to finish.
     -- Use ResourceT to clean-up XMPP server.
-- 
cgit v1.2.3