2 files changed, 25 insertions, 18 deletions

diff --git a/OnionRouter.hs b/OnionRouter.hs
index 1d43d05f..f8271239 100644
--- a/OnionRouter.hs
+++ b/OnionRouter.hs
@@ -25,6 +25,7 @@ import qualified Data.IntMap         as IntMap
          ;import Data.IntMap         (IntMap)
 import Data.Maybe
 import qualified Data.Serialize      as S
+import Data.Time.Clock.POSIX
 import Data.Typeable
 import Data.Word
 import qualified Data.Word64Map      as W64
@@ -87,10 +88,11 @@ data PendingQuery = PendingQuery
  deriving Show
 
 data RouteRecord = RouteRecord
-    { storedRoute   :: OnionRoute
-    , responseCount :: !Int
-    , timeoutCount  :: !Int
-    , routeVersion  :: !Int
+    { storedRoute    :: OnionRoute
+    , responseCount  :: !Int
+    , timeoutCount   :: !Int
+    , routeVersion   :: !Int
+    , routeBirthTime :: !POSIXTime
     }
 
 -- Onion paths have different timeouts depending on whether the path is
@@ -107,12 +109,13 @@ timeoutForRoute :: RouteRecord -> Int
 timeoutForRoute RouteRecord{ responseCount = 0 } = 4000000
 timeoutForRoute RouteRecord{ responseCount = _ } = 10000000
 
-freshRoute :: OnionRoute -> Maybe RouteRecord -> Maybe RouteRecord
-freshRoute r mrec = Just $ RouteRecord
-    { storedRoute = r
-    , responseCount = 0
-    , timeoutCount = 0
-    , routeVersion = maybe 0 succ $ routeVersion <$> mrec
+freshRoute :: POSIXTime -> OnionRoute -> Maybe RouteRecord -> Maybe RouteRecord
+freshRoute birthday r mrec = Just $ RouteRecord
+    { storedRoute    = r
+    , responseCount  = 0
+    , timeoutCount   = 0
+    , routeVersion   = maybe 0 succ $ routeVersion <$> mrec
+    , routeBirthTime = birthday
     }
 
 gotResponse :: RouteRecord -> RouteRecord
@@ -333,9 +336,10 @@ handleEvent getnodes or e@(BuildRoute (RouteId rid)) = do
                         _ -> return Nothing
         writeTVar (onionDRG or) drg'
         return $ getr
+    now <- getPOSIXTime
     atomically $ maybe (return ()) -- writeTVar (pendingRoutes or IntMap.! rid) True)
                        (\r -> do modifyTVar' (routeMap or)
-                                             (IntMap.alter (freshRoute r) rid)
+                                             (IntMap.alter (freshRoute now r) rid)
                                  v <- routeVersion . (IntMap.! rid) <$> readTVar (routeMap or)
                                  writeTVar (pendingRoutes or IntMap.! rid) v
                                  )
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