Keep track of age of onion routes.

1 files changed, 10 insertions, 7 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 6437e94f..36a9fa68 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -813,7 +813,9 @@ clientSession s@Session{..} sock cnum h = do
                                             Tox.sendChatMsg (Tox.toxCryptoKeys tox) session (B.pack msg)
                                             hPutClient h "sent MESSAGE"
 
-        ("onion", s) -> cmd0 $ join $ atomically $ do
+        ("onion", s) -> cmd0 $ do
+            now <- getPOSIXTime
+            join $ atomically $ do
             rm <- readTVar $ routeMap onionRouter
             ts <- readTVar $ trampolineNodes onionRouter
             tcnt <- readTVar $ trampolineCount onionRouter
@@ -822,16 +824,17 @@ clientSession s@Session{..} sock cnum h = do
             pqs <- readTVar (pendingQueries onionRouter)
             let showRecord :: Int -> Int -> [String]
                 showRecord n wanted_ver
-                    | Just RouteRecord{responseCount,timeoutCount,routeVersion} <- IntMap.lookup n rm
-                                = if routeVersion >= wanted_ver
-                                    then [show n, show responseCount, show timeoutCount, show (routeVersion,wanted_ver) ]
-                                    else [show n, show responseCount, show timeoutCount, show (routeVersion,wanted_ver) ++ "(pending)" ]
-                    | otherwise = [show n, "error!",""]
+                    | Just RouteRecord{responseCount,timeoutCount,routeVersion,routeBirthTime} <- IntMap.lookup n rm
+                                = [ show n, show responseCount, show timeoutCount, show (now-routeBirthTime)
+                                  , if routeVersion >= wanted_ver
+                                     then show routeVersion
+                                     else show routeVersion ++ "(pending)" ]
+                    | otherwise = [show n, "error!","","",""]
                 r = map (uncurry showRecord) $ IntMap.toAscList rs
             return $ do
                 hPutClientChunk h $ unlines [ "trampolines: " ++ show (IntMap.size ts,tcnt,icnt)
                                             , "pending: " ++ show (W64.size pqs) ]
-                hPutClient h $ showColumns $ ["","responses","timeouts", "version"]:r
+                hPutClient h $ showColumns $ ["","responses","timeouts", "age", "version"]:r
 
         -- necrypto <FRIEND-TOXID>
         -- establish a netcrypto session with specified person