summaryrefslogtreecommitdiff
path: root/examples
diff options
context:
space:
mode:
Diffstat (limited to 'examples')
-rw-r--r--examples/dhtd.hs36
1 files changed, 24 insertions, 12 deletions
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 4b5a1fd7..e95fa366 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -351,6 +351,9 @@ clientSession0 s sock cnum h = do
351 else throwIO e 351 else throwIO e
352 352
353 353
354parseDebugTag :: String -> Maybe DebugTag
355parseDebugTag s' = readMaybe ('X':map toUpper (take 1 s') ++ drop 1 s')
356
354clientSession :: Session -> t1 -> t -> ClientHandle -> IO () 357clientSession :: Session -> t1 -> t -> ClientHandle -> IO ()
355clientSession s@Session{..} sock cnum h = do 358clientSession s@Session{..} sock cnum h = do
356 line <- dropWhile isSpace <$> hGetClientLine h 359 line <- dropWhile isSpace <$> hGetClientLine h
@@ -638,7 +641,7 @@ clientSession s@Session{..} sock cnum h = do
638 hPutClient h "" 641 hPutClient h ""
639 642
640 ("quiet",s) | s' <- strp s 643 ("quiet",s) | s' <- strp s
641 , Just (tag::DebugTag) <- readMaybe ('X':map toUpper (take 1 s') ++ drop 1 s') 644 , Just (tag::DebugTag) <- parseDebugTag s'
642 -> cmd0 $ do 645 -> cmd0 $ do
643 setQuiet tag 646 setQuiet tag
644 hPutClient h $ "Suppressing " ++ show tag ++ " messages." 647 hPutClient h $ "Suppressing " ++ show tag ++ " messages."
@@ -658,7 +661,7 @@ clientSession s@Session{..} sock cnum h = do
658 showDebugTags 661 showDebugTags
659 662
660 ("verbose",s) | s' <- strp s 663 ("verbose",s) | s' <- strp s
661 , Just (tag::DebugTag) <- readMaybe ('X':map toUpper (take 1 s') ++ drop 1 s') 664 , Just (tag::DebugTag) <- parseDebugTag s'
662 -> cmd0 $ do 665 -> cmd0 $ do
663 setVerbose tag 666 setVerbose tag
664 hPutClient h $ "Showing " ++ show tag ++ " messages." 667 hPutClient h $ "Showing " ++ show tag ++ " messages."
@@ -1291,19 +1294,21 @@ data Options = Options
1291 -- 1294 --
1292 -- [ 2 ] Log all stanzas, even pings. 1295 -- [ 2 ] Log all stanzas, even pings.
1293 , verbosity :: Int 1296 , verbosity :: Int
1297 , verboseTags :: [DebugTag]
1294 } 1298 }
1295 deriving (Eq,Show) 1299 deriving (Eq,Show)
1296 1300
1297sensibleDefaults :: Options 1301sensibleDefaults :: Options
1298sensibleDefaults = Options 1302sensibleDefaults = Options
1299 { portbt = "6881" 1303 { portbt = "6881"
1300 , porttox = "33445" 1304 , porttox = "33445"
1301 , portxmpp = "5222" 1305 , portxmpp = "5222"
1302 , portxmppS = "5269" 1306 , portxmppS = "5269"
1303 , ip6bt = True 1307 , ip6bt = True
1304 , ip6tox = True 1308 , ip6tox = True
1305 , dhtkey = Nothing 1309 , dhtkey = Nothing
1306 , verbosity = 2 1310 , verbosity = 2
1311 , verboseTags = [XMisc]
1307 } 1312 }
1308 1313
1309-- bt=<port>,tox=<port> 1314-- bt=<port>,tox=<port>
@@ -1317,6 +1322,14 @@ parseArgs ("--dht-key":k:args) opts = parseArgs args opts
1317parseArgs ("-4":args) opts = parseArgs args opts 1322parseArgs ("-4":args) opts = parseArgs args opts
1318 { ip6bt = False 1323 { ip6bt = False
1319 , ip6tox = False } 1324 , ip6tox = False }
1325parseArgs ("-v":tags:args) opts = parseArgs args opts
1326 { verboseTags = let gs = groupBy (const (/= ',')) tags
1327 ss = map (dropWhile (==',')) gs
1328 (ds0,as0) = partition (\s -> last (' ':s) == '-') ss
1329 as = mapMaybe parseDebugTag as0
1330 ds = mapMaybe (parseDebugTag . init) ds0
1331 in (verboseTags opts `union` as) \\ ds
1332 }
1320parseArgs (arg:args) opts = parseArgs args opts 1333parseArgs (arg:args) opts = parseArgs args opts
1321 { portbt = fromMaybe (portbt opts) $ Prelude.lookup "bt" ports 1334 { portbt = fromMaybe (portbt opts) $ Prelude.lookup "bt" ports
1322 , porttox = fromMaybe (porttox opts) $ Prelude.lookup "tox" ports 1335 , porttox = fromMaybe (porttox opts) $ Prelude.lookup "tox" ports
@@ -1434,8 +1447,7 @@ main = do
1434 1447
1435 -- Default: quiet all tags (except XMisc). 1448 -- Default: quiet all tags (except XMisc).
1436 forM [minBound .. maxBound] setQuiet 1449 forM [minBound .. maxBound] setQuiet
1437 -- Default: verbose XMisc 1450 forM (verboseTags opts) setVerbose
1438 setVerbose XMisc
1439 1451
1440 (quitBt,btdhts,btips,baddrs) <- case portbt opts of 1452 (quitBt,btdhts,btips,baddrs) <- case portbt opts of
1441 "" -> return (return (), Map.empty,return [],[]) 1453 "" -> return (return (), Map.empty,return [],[])