diff options
Diffstat (limited to 'examples/dhtd.hs')
-rw-r--r-- | examples/dhtd.hs | 30 |
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. |