summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--examples/dhtd.hs24
1 files changed, 12 insertions, 12 deletions
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index e5539036..755a65d7 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -404,6 +404,18 @@ clientSession s@Session{..} sock cnum h = do
404 ] 404 ]
405 case (map toLower c,args) of 405 case (map toLower c,args) of
406 (n, _) | n `elem` Map.keys dhts -> switchNetwork n 406 (n, _) | n `elem` Map.keys dhts -> switchNetwork n
407 -- "ping"
408 -- "cookie"
409 (pinglike, s) | Just DHT{dhtPing} <- Map.lookup netname dhts
410 , Just DHTPing{ pingQuery=ping
411 , pingShowResult=showr } <- Map.lookup pinglike dhtPing
412 , ws@(_:_) <- words s
413 -> cmd0 $ do
414 case readEither $ last ws of
415 Right addr -> do result <- ping (init ws) addr
416 let rs = [" ", maybe "Timeout." showr result]
417 hPutClient h $ unlines rs
418 Left er -> hPutClient h er
407 (x,_) | not (null (strp x)) 419 (x,_) | not (null (strp x))
408 , x `notElem` map head sessionCommands -> cmd0 $ do 420 , x `notElem` map head sessionCommands -> cmd0 $ do
409 hPutClient h $ "error." 421 hPutClient h $ "error."
@@ -473,18 +485,6 @@ clientSession s@Session{..} sock cnum h = do
473 , ("node-id", show $ thisNode bkts) 485 , ("node-id", show $ thisNode bkts)
474 , ("network", netname) ] 486 , ("network", netname) ]
475 487
476 -- "ping"
477 -- "cookie"
478 (pinglike, s) | Just DHT{dhtPing} <- Map.lookup netname dhts
479 , Just DHTPing{ pingQuery=ping
480 , pingShowResult=showr } <- Map.lookup pinglike dhtPing
481 , ws@(_:_) <- words s
482 -> cmd0 $ do
483 case readEither $ last ws of
484 Right addr -> do result <- ping (init ws) addr
485 let rs = [" ", maybe "Timeout." showr result]
486 hPutClient h $ unlines rs
487 Left er -> hPutClient h er
488 ("k", s) | "" <- strp s -> cmd0 $ do 488 ("k", s) | "" <- strp s -> cmd0 $ do
489 ks <- atomically $ readTVar userkeys 489 ks <- atomically $ readTVar userkeys
490 hPutClient h $ unlines $ map (mappend " " . show . Tox.key2id . snd) ks 490 hPutClient h $ unlines $ map (mappend " " . show . Tox.key2id . snd) ks