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