summaryrefslogtreecommitdiff
path: root/examples/dhtd.hs
diff options
context:
space:
mode:
authorjim@bo <jim@bo>2018-06-20 22:40:37 -0400
committerjim@bo <jim@bo>2018-06-20 22:43:47 -0400
commit825962518c6ad00279fc23e8e1dec746980e483f (patch)
tree68c135bdffd879835c48cce3d397e8edf99b53f4 /examples/dhtd.hs
parent09aa079fbab069f177e08b5239bf684d312eb00a (diff)
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
Diffstat (limited to 'examples/dhtd.hs')
-rw-r--r--examples/dhtd.hs30
1 files changed, 26 insertions, 4 deletions
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
369 case B.unsnoc x of 369 case B.unsnoc x of
370 Just (str,c) | isSpace c -> (str,False) 370 Just (str,c) | isSpace c -> (str,False)
371 _ -> (x,True) 371 _ -> (x,True)
372 allDebugTags = [XAnnounce .. XMisc]
373 showDebugTags = do
374 vs <- mapM getVerbose allDebugTags
375 let f True = "v"
376 f False = "-"
377 hPutClient h $ showReport (zip (map (drop 1 . show) allDebugTags) (map f vs))
372 let readHex :: (Read n, Integral n) => String -> Maybe n 378 let readHex :: (Read n, Integral n) => String -> Maybe n
373 readHex s = readMaybe ("0x" ++ s) 379 readHex s = readMaybe ("0x" ++ s)
374 strToSession :: String -> IO (Either String Tox.NetCryptoSession) 380 strToSession :: String -> IO (Either String Tox.NetCryptoSession)
@@ -635,6 +641,20 @@ clientSession s@Session{..} sock cnum h = do
635 setQuiet tag 641 setQuiet tag
636 hPutClient h $ "Suppressing " ++ show tag ++ " messages." 642 hPutClient h $ "Suppressing " ++ show tag ++ " messages."
637 643
644 ("quiet",s) | "all" <- strp s
645 -> cmd0 $ do
646 mapM_ setQuiet allDebugTags
647 showDebugTags
648
649 (verbose,s) | "" <- strp s
650 , verbose `elem` ["verbose","quiet"]
651 -> cmd0 $ showDebugTags
652
653 ("verbose",s) | "all" <- strp s
654 -> cmd0 $ do
655 mapM_ setVerbose allDebugTags
656 showDebugTags
657
638 ("verbose",s) | s' <- strp s 658 ("verbose",s) | s' <- strp s
639 , Just (tag::DebugTag) <- readMaybe ('X':map toUpper (take 1 s') ++ drop 1 s') 659 , Just (tag::DebugTag) <- readMaybe ('X':map toUpper (take 1 s') ++ drop 1 s')
640 -> cmd0 $ do 660 -> cmd0 $ do
@@ -1410,8 +1430,10 @@ main = do
1410 1430
1411 announcer <- forkAnnouncer 1431 announcer <- forkAnnouncer
1412 1432
1413 -- Default: quiet all tags. 1433 -- Default: quiet all tags (except XMisc).
1414 forM [minBound .. maxBound] setQuiet 1434 forM [minBound .. maxBound] setQuiet
1435 -- Default: verbose XMisc
1436 setVerbose XMisc
1415 1437
1416 (quitBt,btdhts,btips,baddrs) <- case portbt opts of 1438 (quitBt,btdhts,btips,baddrs) <- case portbt opts of
1417 "" -> return (return (), Map.empty,return [],[]) 1439 "" -> return (return (), Map.empty,return [],[])
@@ -1508,7 +1530,7 @@ main = do
1508 "" -> return (Nothing,return (), Map.empty, return [],[]) 1530 "" -> return (Nothing,return (), Map.empty, return [],[])
1509 toxport -> do 1531 toxport -> do
1510 addrTox <- getBindAddress toxport (ip6tox opts) 1532 addrTox <- getBindAddress toxport (ip6tox opts)
1511 hPutStrLn stderr $ "Supplied key: " ++ show (fmap (Tox.key2id . toPublic) (dhtkey opts)) 1533 dput XMisc $ "Supplied key: " ++ show (fmap (Tox.key2id . toPublic) (dhtkey opts))
1512 tox <- Tox.newTox keysdb 1534 tox <- Tox.newTox keysdb
1513 addrTox 1535 addrTox
1514 (Just _netCryptoSessionsState) 1536 (Just _netCryptoSessionsState)
@@ -1771,7 +1793,7 @@ main = do
1771 installHandler sigINT (CatchOnce (atomically $ writeTVar signalQuit True)) Nothing 1793 installHandler sigINT (CatchOnce (atomically $ writeTVar signalQuit True)) Nothing
1772 let defaultToxData = do 1794 let defaultToxData = do
1773 rster <- Tox.newContactInfo 1795 rster <- Tox.newContactInfo
1774 orouter <- newOnionRouter (hPutStrLn stderr) 1796 orouter <- newOnionRouter (dput XMisc)
1775 return (rster, orouter) 1797 return (rster, orouter)
1776 (rstr,orouter) <- fromMaybe defaultToxData $ do 1798 (rstr,orouter) <- fromMaybe defaultToxData $ do
1777 tox <- mbtox 1799 tox <- mbtox
@@ -1830,7 +1852,7 @@ main = do
1830 (checkQuit >> return (return ())) 1852 (checkQuit >> return (return ()))
1831 what 1853 what
1832 1854
1833 forM msv $ \_ -> hPutStrLn stderr "Started XMPP server." 1855 forM msv $ \_ -> dput XMisc "Started XMPP server."
1834 1856
1835 -- Wait for DHT and XMPP threads to finish. 1857 -- Wait for DHT and XMPP threads to finish.
1836 -- Use ResourceT to clean-up XMPP server. 1858 -- Use ResourceT to clean-up XMPP server.