summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Tracker
diff options
context:
space:
mode:
authorSam Truzjan <pxqr.sta@gmail.com>2014-03-18 18:34:01 +0400
committerSam Truzjan <pxqr.sta@gmail.com>2014-03-18 18:34:01 +0400
commit207b7593f69d2d3b7e76aa6e68d49f4d1511972d (patch)
tree73021d7020a7e8eef2fcbd6d9353bbf81c16cc18 /src/Network/BitTorrent/Tracker
parentec70fdc102b950a23aad5565a08f10ddb8ef10c7 (diff)
Do not allow to perform regular requests from `notify`
Diffstat (limited to 'src/Network/BitTorrent/Tracker')
-rw-r--r--src/Network/BitTorrent/Tracker/Session.hs75
1 files changed, 32 insertions, 43 deletions
diff --git a/src/Network/BitTorrent/Tracker/Session.hs b/src/Network/BitTorrent/Tracker/Session.hs
index b15075c1..f1b4eae8 100644
--- a/src/Network/BitTorrent/Tracker/Session.hs
+++ b/src/Network/BitTorrent/Tracker/Session.hs
@@ -94,28 +94,22 @@ nullEntry :: URI -> TrackerEntry
94nullEntry uri = TrackerEntry uri Nothing def def 94nullEntry uri = TrackerEntry uri Nothing def def
95 95
96-- | Do we need to notify this /specific/ tracker? 96-- | Do we need to notify this /specific/ tracker?
97needNotify :: Maybe Event -> Maybe Status -> Maybe Bool 97needNotify :: Event -> Maybe Status -> Maybe Bool
98needNotify Nothing Nothing = Just True 98needNotify Started Nothing = Just True
99needNotify (Just Started) Nothing = Just True 99needNotify Stopped Nothing = Just False
100needNotify (Just Stopped) Nothing = Just False 100needNotify Completed Nothing = Just False
101needNotify (Just Completed) Nothing = Just False 101needNotify Started (Just Running) = Nothing
102 102needNotify Stopped (Just Running) = Just True
103needNotify Nothing (Just Running) = Nothing 103needNotify Completed (Just Running) = Just True
104needNotify (Just Started) (Just Running) = Nothing 104needNotify Started (Just Paused ) = Just True
105needNotify (Just Stopped) (Just Running) = Just True 105needNotify Stopped (Just Paused ) = Just False
106needNotify (Just Completed) (Just Running) = Just True 106needNotify Completed (Just Paused ) = Just True
107
108needNotify Nothing (Just Paused ) = Just False
109needNotify (Just Started) (Just Paused ) = Just True
110needNotify (Just Stopped) (Just Paused ) = Just False
111needNotify (Just Completed) (Just Paused ) = Just True
112 107
113-- | Client status after event announce succeed. 108-- | Client status after event announce succeed.
114nextStatus :: Maybe Event -> Status 109nextStatus :: Event -> Status
115nextStatus Nothing = Running 110nextStatus Started = Running
116nextStatus (Just Started ) = Running 111nextStatus Stopped = Paused
117nextStatus (Just Stopped ) = Paused 112nextStatus Completed = Running
118nextStatus (Just Completed) = Running
119 113
120seconds :: Int -> NominalDiffTime 114seconds :: Int -> NominalDiffTime
121seconds n = realToFrac (toEnum n :: Uni) 115seconds n = realToFrac (toEnum n :: Uni)
@@ -136,17 +130,18 @@ cacheScrape AnnounceInfo {..} =
136 } 130 }
137 131
138-- | Make announce request to specific tracker returning new state. 132-- | Make announce request to specific tracker returning new state.
139announceTo :: Manager -> InfoHash -> Maybe Event 133notifyTo :: Manager -> InfoHash -> Event
140 -> TrackerEntry -> IO TrackerEntry 134 -> TrackerEntry -> IO TrackerEntry
141announceTo mgr ih mevent entry @ TrackerEntry {..} = do 135notifyTo mgr ih event entry @ TrackerEntry {..} = do
142 let shouldNotify = needNotify mevent statusSent 136
137 let shouldNotify = needNotify event statusSent
143 mustNotify <- maybe (isExpired peersCache) return shouldNotify 138 mustNotify <- maybe (isExpired peersCache) return shouldNotify
144 if not mustNotify 139 if not mustNotify
145 then return entry 140 then return entry
146 else do 141 else do
147 let q = SAnnounceQuery ih def Nothing mevent 142 let q = SAnnounceQuery ih def Nothing (Just event)
148 res <- RPC.announce mgr trackerURI q 143 res <- RPC.announce mgr trackerURI q
149 TrackerEntry trackerURI (Just (nextStatus mevent)) 144 TrackerEntry trackerURI (Just (nextStatus event))
150 <$> cachePeers res <*> cacheScrape res 145 <$> cachePeers res <*> cacheScrape res
151 146
152{----------------------------------------------------------------------- 147{-----------------------------------------------------------------------
@@ -193,18 +188,17 @@ getStatus Session {..} = readMVar currentStatus
193 188
194-- | Do we need to sent this event to a first working tracker or to 189-- | Do we need to sent this event to a first working tracker or to
195-- the all known good trackers? 190-- the all known good trackers?
196allNotify :: Maybe Event -> Bool 191allNotify :: Event -> Bool
197allNotify Nothing = False 192allNotify Started = False
198allNotify (Just Started) = False 193allNotify Stopped = True
199allNotify (Just Stopped) = True 194allNotify Completed = True
200allNotify (Just Completed) = True 195
201 196notifyAll :: Manager -> Session -> Event -> IO ()
202announceAll :: Manager -> Session -> Maybe Event -> IO () 197notifyAll mgr Session {..} event = do
203announceAll mgr Session {..} mevent = do 198 modifyMVar_ trackers (traversal (notifyTo mgr infohash event))
204 modifyMVar_ trackers (traversal (announceTo mgr infohash mevent))
205 where 199 where
206 traversal 200 traversal
207 | allNotify mevent = traverseAll 201 | allNotify event = traverseAll
208 | otherwise = traverseTiers 202 | otherwise = traverseTiers
209 203
210-- TODO send notifications to tracker periodically. 204-- TODO send notifications to tracker periodically.
@@ -213,14 +207,9 @@ announceAll mgr Session {..} mevent = do
213-- This function /may/ block until tracker query proceed. 207-- This function /may/ block until tracker query proceed.
214notify :: Manager -> Session -> Event -> IO () 208notify :: Manager -> Session -> Event -> IO ()
215notify mgr ses event = do 209notify mgr ses event = do
216 prevStatus <- swapMVar (currentStatus ses) (nextStatus (Just event)) 210 prevStatus <- swapMVar (currentStatus ses) (nextStatus event)
217 when (needNotify (Just event) (Just prevStatus) == Just True) $ do 211 when (needNotify event (Just prevStatus) == Just True) $ do
218 announceAll mgr ses (Just event) 212 notifyAll mgr ses event
219
220-- TODO fork thread for reannounces
221-- |
222announce :: Manager -> Session -> IO ()
223announce mgr ses = announceAll mgr ses Nothing
224 213
225-- TODO run announce if sesion have no peers 214-- TODO run announce if sesion have no peers
226-- | The returned list of peers can have duplicates. 215-- | The returned list of peers can have duplicates.