summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--examples/dhtd.hs2
-rw-r--r--src/Network/Kademlia.hs2
-rw-r--r--src/Network/Tox.hs5
-rw-r--r--src/Network/Tox/Onion/Handlers.hs33
-rw-r--r--todo.txt2
5 files changed, 34 insertions, 10 deletions
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index b845f9df..369650f9 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -1165,7 +1165,7 @@ clientSession s@Session{..} sock cnum h = do
1165 keydb <- atomically $ readTVar toxkeys 1165 keydb <- atomically $ readTVar toxkeys
1166 now <- getPOSIXTime 1166 now <- getPOSIXTime
1167 let entries = map mkentry $ PSQ.toList (Tox.keyByAge keydb) 1167 let entries = map mkentry $ PSQ.toList (Tox.keyByAge keydb)
1168 mkentry (k :-> Down tm) = [ show cnt, show k, show (now - tm) ] 1168 mkentry (k :-> tm) = [ show cnt, show k, show (now - tm) ]
1169 where Just (_,(cnt,_)) = MM.lookup' k (Tox.keyAssoc keydb) 1169 where Just (_,(cnt,_)) = MM.lookup' k (Tox.keyAssoc keydb)
1170 hPutClient h $ showColumns entries 1170 hPutClient h $ showColumns entries
1171 1171
diff --git a/src/Network/Kademlia.hs b/src/Network/Kademlia.hs
index 8956df2c..0ab26e80 100644
--- a/src/Network/Kademlia.hs
+++ b/src/Network/Kademlia.hs
@@ -26,8 +26,6 @@ import Data.IP
26import Data.Monoid 26import Data.Monoid
27import Data.Serialize (Serialize) 27import Data.Serialize (Serialize)
28import Data.Time.Clock.POSIX (POSIXTime) 28import Data.Time.Clock.POSIX (POSIXTime)
29import qualified Data.Wrapper.PSQInt as Int
30 ;import Data.Wrapper.PSQInt (pattern (:->))
31import Network.Address (bucketRange,genBucketSample) 29import Network.Address (bucketRange,genBucketSample)
32import Network.Kademlia.Search 30import Network.Kademlia.Search
33import System.Entropy 31import System.Entropy
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index 634b0db1..3c3bce49 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -19,7 +19,7 @@ import Debug.Trace
19import Control.Exception hiding (Handler) 19import Control.Exception hiding (Handler)
20import Control.Applicative 20import Control.Applicative
21import Control.Arrow 21import Control.Arrow
22import Control.Concurrent (MVar) 22import Control.Concurrent (MVar,killThread)
23import Control.Concurrent.STM 23import Control.Concurrent.STM
24import Control.Monad 24import Control.Monad
25import Control.Monad.Fix 25import Control.Monad.Fix
@@ -485,7 +485,8 @@ forkTox tox = do
485 quit <- forkListener "toxCrypto" (toxCrypto tox) 485 quit <- forkListener "toxCrypto" (toxCrypto tox)
486 forkPollForRefresh (DHT.refresher4 $ toxRouting tox) 486 forkPollForRefresh (DHT.refresher4 $ toxRouting tox)
487 forkPollForRefresh (DHT.refresher6 $ toxRouting tox) 487 forkPollForRefresh (DHT.refresher6 $ toxRouting tox)
488 return ( quit 488 keygc <- Onion.forkAnnouncedKeysGC (toxAnnouncedKeys tox)
489 return ( killThread keygc >> quit
489 , bootstrap (DHT.refresher4 $ toxRouting tox) 490 , bootstrap (DHT.refresher4 $ toxRouting tox)
490 , bootstrap (DHT.refresher6 $ toxRouting tox) 491 , bootstrap (DHT.refresher6 $ toxRouting tox)
491 ) 492 )
diff --git a/src/Network/Tox/Onion/Handlers.hs b/src/Network/Tox/Onion/Handlers.hs
index 99ef3c69..263d60bd 100644
--- a/src/Network/Tox/Onion/Handlers.hs
+++ b/src/Network/Tox/Onion/Handlers.hs
@@ -11,7 +11,7 @@ import Network.QueryResponse as QR hiding (Client)
11import qualified Network.QueryResponse as QR (Client) 11import qualified Network.QueryResponse as QR (Client)
12import Crypto.Tox 12import Crypto.Tox
13import qualified Data.Wrapper.PSQ as PSQ 13import qualified Data.Wrapper.PSQ as PSQ
14 ;import Data.Wrapper.PSQ (PSQ) 14 ;import Data.Wrapper.PSQ (PSQ,pattern (:->))
15#ifdef CRYPTONITE_BACKPORT 15#ifdef CRYPTONITE_BACKPORT
16import Crypto.Error.Types (CryptoFailable (..), 16import Crypto.Error.Types (CryptoFailable (..),
17 throwCryptoError) 17 throwCryptoError)
@@ -35,6 +35,12 @@ import Network.BitTorrent.DHT.Token as Token
35 35
36import Control.Exception hiding (Handler) 36import Control.Exception hiding (Handler)
37import Control.Monad 37import Control.Monad
38#ifdef THREAD_DEBUG
39import Control.Concurrent.Lifted.Instrument
40#else
41import Control.Concurrent
42import GHC.Conc (labelThread)
43#endif
38import Control.Concurrent.STM 44import Control.Concurrent.STM
39import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime) 45import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)
40import Network.Socket 46import Network.Socket
@@ -159,7 +165,7 @@ toOnionDestination (AnnouncedRoute ni rpath) = OnionToOwner ni rpath
159-- structure. 165-- structure.
160-- 166--
161data AnnouncedKeys = AnnouncedKeys 167data AnnouncedKeys = AnnouncedKeys
162 { keyByAge :: !(PSQ NodeId (Down POSIXTime{-Time at which they announced to you-})) -- TODO: timeout of 300 seconds 168 { keyByAge :: !(PSQ NodeId (POSIXTime{-Time at which they announced to you-}))
163 , keyAssoc :: !(MinMaxPSQ' NodeId NodeDistance (Int{-count of route usage-},AnnouncedRoute)) 169 , keyAssoc :: !(MinMaxPSQ' NodeId NodeDistance (Int{-count of route usage-},AnnouncedRoute))
164 -- ^ PSQ using NodeId(user/public key) as Key 170 -- ^ PSQ using NodeId(user/public key) as Key
165 -- and using 'NodeDistance' as priority. 171 -- and using 'NodeDistance' as priority.
@@ -172,12 +178,33 @@ data AnnouncedKeys = AnnouncedKeys
172 178
173insertKey :: POSIXTime -> NodeId -> AnnouncedRoute -> NodeDistance -> AnnouncedKeys -> AnnouncedKeys 179insertKey :: POSIXTime -> NodeId -> AnnouncedRoute -> NodeDistance -> AnnouncedKeys -> AnnouncedKeys
174insertKey tm pub toxpath d keydb = AnnouncedKeys 180insertKey tm pub toxpath d keydb = AnnouncedKeys
175 { keyByAge = PSQ.insert pub (Down tm) (keyByAge keydb) 181 { keyByAge = PSQ.insert pub tm (keyByAge keydb)
176 , keyAssoc = case MinMaxPSQ.lookup' pub (keyAssoc keydb) of 182 , keyAssoc = case MinMaxPSQ.lookup' pub (keyAssoc keydb) of
177 Just (_,(cnt,_)) -> MinMaxPSQ.insert' pub (cnt,toxpath) d (keyAssoc keydb) 183 Just (_,(cnt,_)) -> MinMaxPSQ.insert' pub (cnt,toxpath) d (keyAssoc keydb)
178 Nothing -> MinMaxPSQ.insert' pub (0 ,toxpath) d (keyAssoc keydb) 184 Nothing -> MinMaxPSQ.insert' pub (0 ,toxpath) d (keyAssoc keydb)
179 } 185 }
180 186
187-- | Forks a thread to garbage-collect old key announcements. Keys may be
188-- discarded after 5 minutes.
189forkAnnouncedKeysGC :: TVar AnnouncedKeys -> IO ThreadId
190forkAnnouncedKeysGC db = forkIO $ do
191 myThreadId >>= flip labelThread "gc:toxids"
192 fix $ \loop -> do
193 cutoff <- getPOSIXTime
194 threadDelay 300000000 -- 300 seconds
195 join $ atomically $ do
196 fix $ \gc -> do
197 keys <- readTVar db
198 case PSQ.minView (keyByAge keys) of
199 Nothing -> return loop
200 Just (pub :-> tm,kba')
201 | tm > cutoff -> return loop
202 | otherwise -> do writeTVar db keys
203 { keyByAge = kba'
204 , keyAssoc = MinMaxPSQ.delete pub (keyAssoc keys)
205 }
206 gc
207
181areq :: Message -> Either String AnnounceRequest 208areq :: Message -> Either String AnnounceRequest
182areq (OnionAnnounce asymm) = Right $ fst $ runIdentity $ asymmData asymm 209areq (OnionAnnounce asymm) = Right $ fst $ runIdentity $ asymmData asymm
183areq _ = Left "Unexpected non-announce OnionMessage" 210areq _ = Left "Unexpected non-announce OnionMessage"
diff --git a/todo.txt b/todo.txt
index 5483efbb..d4b2d828 100644
--- a/todo.txt
+++ b/todo.txt
@@ -39,8 +39,6 @@ tox: nat ping
39 39
40tox: cache diffie-helman secrets 40tox: cache diffie-helman secrets
41 41
42tox: Expire ofline Tox announces.
43
44tox: Chat support. 42tox: Chat support.
45 43
46bt: Collect PeerStore garbage: "Note that you should call .put() every hour for 44bt: Collect PeerStore garbage: "Note that you should call .put() every hour for