New "closest" command, find nearby routing nodes to an info hash.

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 @@
 {-# LANGUAGE RecordWildCards       #-}
 {-# LANGUAGE CPP #-}
 
-import Control.Arrow;
+import Control.Arrow
 import Control.Monad
 import Control.Monad.Logger
 import Control.Monad.Reader
@@ -27,6 +27,7 @@ import Text.Read
 import Control.Monad.Reader.Class
 import System.Posix.Process (getProcessID)
 
+import Data.Torrent (InfoHash)
 import Network.BitTorrent.Address
 import Network.BitTorrent.DHT
 import qualified Network.BitTorrent.DHT.Routing as R
@@ -183,6 +184,22 @@ clientSession st signalQuit sock n h = do
                     let r = map (\PerThread{..} -> (show lbl,show (diffUTCTime tm startTime))) ts
                     hPutClient h $ showReport r
 #endif
+        ("closest", s) -> cmd $ do
+                        let (ns,hs) = second (dropWhile isSpace) $ break isSpace s
+                            parse | null hs = do
+                                       ih <- readEither ns
+                                       return (8 :: Int, ih :: InfoHash)
+                                  | otherwise = do
+                                       n <- readEither ns
+                                       ih <- readEither hs
+                                       return (n :: Int, ih :: InfoHash)
+                        case parse of
+                            Right (n,ih) -> do
+                                tbl <- getTable
+                                let nodes = R.kclosest n ih tbl
+                                return $ do
+                                hPutClient h $ unlines $ map (showEnry . (flip (,) 0)) nodes
+                            Left er -> return $ hPutClient h er
 
         _    -> cmd0 $ hPutClient h "error."