1 files changed, 43 insertions, 0 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 67888eb4..2abaecdd 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -132,6 +132,26 @@ reportTable bkts = map (show *** show . fst)
                  $ R.toList
                  $ bkts
 
+reportResult :: Show ni =>
+    String
+    -> (r -> String)
+    -> (tok -> Maybe String)
+    -> Handle
+    -> Either String ([ni],[r],tok)
+    -> IO ()
+reportResult meth showR showTok h (Left e)            = hPutClient h e
+reportResult meth showR showTok h (Right (ns,rs,tok)) = do
+    hPutClient h $ showReport report
+ where
+    report = intercalate [("","")] [ tok_r , node_r , result_r ]
+
+    tok_r = maybe [] (pure . ("token:",)) $ showTok tok
+
+    node_r = map ( ("n",) . show ) ns
+
+    result_r | (meth=="node") = []
+             | otherwise      = map ( (take 1 meth,) . showR ) rs
+
 data Session = Session
     { netname           :: String
     , dhts              :: Map.Map String DHT
@@ -215,6 +235,29 @@ clientSession s@Session{..} sock cnum h = do
                                            let rs = [" ", show result]
                                            hPutClient h $ unlines rs
                           Left er -> hPutClient h er
+        ("g", s) | Just DHT{..} <- Map.lookup netname dhts
+                    -> cmd0 $ do
+                        -- arguments: method
+                        --            nid
+                        --            (optional dest-ni)
+                        self <- atomically $ thisNode <$> readTVar dhtBuckets
+                        let (method,xs) = break isSpace $ dropWhile isSpace s
+                            (nidstr,ys) = break isSpace $ dropWhile isSpace xs
+                            destination = dropWhile isSpace ys
+                            goQuery qry = either (hPutClient h . ("Bad search target: "++))
+                                                 (goTarget qry)
+                                                 $ dhtParseId nidstr
+                            goTarget DHTQuery{..} nid =
+                                go nid >>= reportResult method qshowR qshowTok h
+                              where
+                                go | null destination = fmap Right . qhandler self
+                                   | otherwise        = case readEither destination of
+                                        Right ni -> fmap (maybe (Left "Timeout.") Right)
+                                                    . flip (searchQuery qsearch) ni
+                                        Left  e  -> const $ return $ Left ("Bad destination: "++e)
+                        maybe (hPutClient h ("Unsupported method: "++method))
+                              goQuery
+                              $ Map.lookup method dhtQuery
 
         ("save", _) | Just dht <- Map.lookup netname dhts
                     -> cmd0 $ do