diff options
Diffstat (limited to 'examples')
-rw-r--r-- | examples/dhtd.hs | 19 |
1 files changed, 18 insertions, 1 deletions
diff --git a/examples/dhtd.hs b/examples/dhtd.hs index 337e7d0d..1790d10a 100644 --- a/examples/dhtd.hs +++ b/examples/dhtd.hs | |||
@@ -7,7 +7,7 @@ | |||
7 | {-# LANGUAGE RecordWildCards #-} | 7 | {-# LANGUAGE RecordWildCards #-} |
8 | {-# LANGUAGE CPP #-} | 8 | {-# LANGUAGE CPP #-} |
9 | 9 | ||
10 | import Control.Arrow; | 10 | import Control.Arrow |
11 | import Control.Monad | 11 | import Control.Monad |
12 | import Control.Monad.Logger | 12 | import Control.Monad.Logger |
13 | import Control.Monad.Reader | 13 | import Control.Monad.Reader |
@@ -27,6 +27,7 @@ import Text.Read | |||
27 | import Control.Monad.Reader.Class | 27 | import Control.Monad.Reader.Class |
28 | import System.Posix.Process (getProcessID) | 28 | import System.Posix.Process (getProcessID) |
29 | 29 | ||
30 | import Data.Torrent (InfoHash) | ||
30 | import Network.BitTorrent.Address | 31 | import Network.BitTorrent.Address |
31 | import Network.BitTorrent.DHT | 32 | import Network.BitTorrent.DHT |
32 | import qualified Network.BitTorrent.DHT.Routing as R | 33 | import qualified Network.BitTorrent.DHT.Routing as R |
@@ -183,6 +184,22 @@ clientSession st signalQuit sock n h = do | |||
183 | let r = map (\PerThread{..} -> (show lbl,show (diffUTCTime tm startTime))) ts | 184 | let r = map (\PerThread{..} -> (show lbl,show (diffUTCTime tm startTime))) ts |
184 | hPutClient h $ showReport r | 185 | hPutClient h $ showReport r |
185 | #endif | 186 | #endif |
187 | ("closest", s) -> cmd $ do | ||
188 | let (ns,hs) = second (dropWhile isSpace) $ break isSpace s | ||
189 | parse | null hs = do | ||
190 | ih <- readEither ns | ||
191 | return (8 :: Int, ih :: InfoHash) | ||
192 | | otherwise = do | ||
193 | n <- readEither ns | ||
194 | ih <- readEither hs | ||
195 | return (n :: Int, ih :: InfoHash) | ||
196 | case parse of | ||
197 | Right (n,ih) -> do | ||
198 | tbl <- getTable | ||
199 | let nodes = R.kclosest n ih tbl | ||
200 | return $ do | ||
201 | hPutClient h $ unlines $ map (showEnry . (flip (,) 0)) nodes | ||
202 | Left er -> return $ hPutClient h er | ||
186 | 203 | ||
187 | _ -> cmd0 $ hPutClient h "error." | 204 | _ -> cmd0 $ hPutClient h "error." |
188 | 205 | ||