Added "peers" command to cli.

3 files changed, 17 insertions, 3 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 96c31dfe..bc5e9eda 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -15,6 +15,7 @@ import Data.Char
 import Data.Default
 import Data.List as L
 import Data.Maybe
+import Data.String
 import qualified Data.ByteString as B (ByteString,writeFile,readFile)
         ; import Data.ByteString (ByteString)
 import System.IO
@@ -140,6 +141,12 @@ clientSession st signalQuit sock n h = do
                     return $ do
                     hPutClient h $ showReport r
 
+        s | "peers " `isPrefixOf` s -> cmd $ do
+                    let ih = fromString (drop 6 s)
+                    ps <- allPeers ih
+                    return $ do
+                    hPutClient h $ showReport $ map (((,) "") . show . pPrint) ps
+
         _    -> cmd0 $ hPutClient h "error."
 
 main :: IO ()
diff --git a/src/Network/BitTorrent/DHT/ContactInfo.hs b/src/Network/BitTorrent/DHT/ContactInfo.hs
index 823982d4..4302288c 100644
--- a/src/Network/BitTorrent/DHT/ContactInfo.hs
+++ b/src/Network/BitTorrent/DHT/ContactInfo.hs
@@ -1,5 +1,6 @@
 module Network.BitTorrent.DHT.ContactInfo
        ( PeerStore
+       , Network.BitTorrent.DHT.ContactInfo.lookup
        , Network.BitTorrent.DHT.ContactInfo.freshPeers
        , Network.BitTorrent.DHT.ContactInfo.insertPeer
        , knownSwarms
@@ -156,9 +157,9 @@ instance Serialize (PeerStore a) where
   get = undefined
   put = undefined
 
--- | Used in 'get_peers' DHT queries.
--- lookup :: Ord a => InfoHash -> PeerStore a -> [PeerAddr a]
--- lookup ih (PeerStore m) = maybe [] (PSQ.keys . peers) $ HM.lookup ih m
+-- | Returns all peers associated with a given info hash.
+lookup :: Ord a => InfoHash -> PeerStore a -> [PeerAddr a]
+lookup ih (PeerStore m) = maybe [] (PSQ.keys . peers) $ HM.lookup ih m
 
 batchSize = 64
 
diff --git a/src/Network/BitTorrent/DHT/Session.hs b/src/Network/BitTorrent/DHT/Session.hs
index 4f861a1e..bc9fda91 100644
--- a/src/Network/BitTorrent/DHT/Session.hs
+++ b/src/Network/BitTorrent/DHT/Session.hs
@@ -55,6 +55,7 @@ module Network.BitTorrent.DHT.Session
        , getTable
        , getClosest
        , getSwarms
+       , allPeers
 
          -- ** Peer storage
        , insertPeer
@@ -408,6 +409,11 @@ getSwarms = do
     store <- asks contactInfo >>= liftIO . atomically . readTVar
     return $ P.knownSwarms store
 
+allPeers :: Ord ip => InfoHash -> DHT ip [ PeerAddr ip ]
+allPeers ih = do
+    store <- asks contactInfo >>= liftIO . atomically . readTVar
+    return $ P.lookup ih store
+
 -- | Find a set of closest nodes from routing table of this node. (in
 -- no particular order)
 --