Implemented command to list scheduled announcements.

1 files changed, 14 insertions, 0 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 3e48e4bb..0439ed7e 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -769,6 +769,17 @@ clientSession s@Session{..} sock cnum h = do
         --
         --         a +friend <jid> <text>
         --         a +dhtkey <key>
+        ("a", "") -> cmd0 $ do
+                        now <- getPOSIXTime
+                        rs <- atomically $ do
+                            as <- readTVar (scheduled $ announcer)
+                            forM (PSQ.toList as) $ \(k,ptm,item) -> do
+                                kstr <- unpackAnnounceKey announcer k
+                                return [ show (ptm - now)
+                                       , show (itemStatusNum item)
+                                       , kstr
+                                       ]
+                        hPutClient h $ showColumns rs
         ("a", s) | Just DHT{..} <- Map.lookup netname dhts
                  , not (null s)
                     -> cmd0 $ do
@@ -805,6 +816,7 @@ clientSession s@Session{..} sock cnum h = do
                             reportit target = case op of
                                         '+' -> hPutClient h $ "Announcing at " ++ target ++ "."
                                         '-' -> hPutClient h $ "Canceling " ++ target ++ "."
+                            -- mameth is for typical kademlia announce.
                             mameth = do
                                 DHTAnnouncable { announceSendData
                                                , announceParseData
@@ -824,6 +836,8 @@ clientSession s@Session{..} sock cnum h = do
                                                             announceInterval)
                                             dta
                                     reportit $ show $ announceTarget dta
+                            -- lmeth is for atypical announce messages such as
+                            --   Tox dht-key and friend-request messages.
                             lmeth :: Maybe (IO ())
                             lmeth = do
                                 DHTAnnouncable { announceSendData