diff options
Diffstat (limited to 'src/Network/BitTorrent/Tracker/RPC')
-rw-r--r-- | src/Network/BitTorrent/Tracker/RPC/UDP.hs | 41 |
1 files changed, 26 insertions, 15 deletions
diff --git a/src/Network/BitTorrent/Tracker/RPC/UDP.hs b/src/Network/BitTorrent/Tracker/RPC/UDP.hs index a3927c2c..d7b359ed 100644 --- a/src/Network/BitTorrent/Tracker/RPC/UDP.hs +++ b/src/Network/BitTorrent/Tracker/RPC/UDP.hs | |||
@@ -95,6 +95,28 @@ withManager :: Options -> (Manager -> IO a) -> IO a | |||
95 | withManager opts = bracket (newManager opts) closeManager | 95 | withManager opts = bracket (newManager opts) closeManager |
96 | 96 | ||
97 | {----------------------------------------------------------------------- | 97 | {----------------------------------------------------------------------- |
98 | -- Host Addr resolution | ||
99 | -----------------------------------------------------------------------} | ||
100 | |||
101 | setPort :: PortNumber -> SockAddr -> SockAddr | ||
102 | setPort p (SockAddrInet _ h) = SockAddrInet p h | ||
103 | setPort p (SockAddrInet6 _ f h s) = SockAddrInet6 p f h s | ||
104 | setPort _ addr = addr | ||
105 | |||
106 | resolveURI :: URI -> IO SockAddr | ||
107 | resolveURI URI { uriAuthority = Just (URIAuth {..}) } = do | ||
108 | infos <- getAddrInfo Nothing (Just uriRegName) Nothing | ||
109 | let port = fromMaybe 0 (readMaybe (L.drop 1 uriPort) :: Maybe Int) | ||
110 | case infos of | ||
111 | AddrInfo {..} : _ -> return $ setPort (fromIntegral port) addrAddress | ||
112 | _ -> fail "getTrackerAddr: unable to lookup host addr" | ||
113 | resolveURI _ = fail "getTrackerAddr: hostname unknown" | ||
114 | |||
115 | -- TODO caching? | ||
116 | getTrackerAddr :: Manager -> URI -> IO SockAddr | ||
117 | getTrackerAddr _ = resolveURI | ||
118 | |||
119 | {----------------------------------------------------------------------- | ||
98 | Tokens | 120 | Tokens |
99 | -----------------------------------------------------------------------} | 121 | -----------------------------------------------------------------------} |
100 | 122 | ||
@@ -268,20 +290,6 @@ isExpired Connection {..} = do | |||
268 | maxPacketSize :: Int | 290 | maxPacketSize :: Int |
269 | maxPacketSize = 98 -- announce request packet | 291 | maxPacketSize = 98 -- announce request packet |
270 | 292 | ||
271 | setPort :: PortNumber -> SockAddr -> SockAddr | ||
272 | setPort p (SockAddrInet _ h) = SockAddrInet p h | ||
273 | setPort p (SockAddrInet6 _ f h s) = SockAddrInet6 p f h s | ||
274 | setPort _ addr = addr | ||
275 | |||
276 | getTrackerAddr :: URI -> IO SockAddr | ||
277 | getTrackerAddr URI { uriAuthority = Just (URIAuth {..}) } = do | ||
278 | infos <- getAddrInfo Nothing (Just uriRegName) Nothing | ||
279 | let port = fromMaybe 0 (readMaybe (L.drop 1 uriPort) :: Maybe Int) | ||
280 | case infos of | ||
281 | AddrInfo {..} : _ -> return $ setPort (fromIntegral port) addrAddress | ||
282 | _ -> fail "getTrackerAddr: unable to lookup host addr" | ||
283 | getTrackerAddr _ = fail "getTrackerAddr: hostname unknown" | ||
284 | |||
285 | call :: Manager -> SockAddr -> ByteString -> IO ByteString | 293 | call :: Manager -> SockAddr -> ByteString -> IO ByteString |
286 | call Manager {..} addr arg = do | 294 | call Manager {..} addr arg = do |
287 | BS.sendAllTo sock arg addr | 295 | BS.sendAllTo sock arg addr |
@@ -315,7 +323,7 @@ transaction m tracker @ UDPTracker {..} request = do | |||
315 | tid <- genTransactionId | 323 | tid <- genTransactionId |
316 | let trans = TransactionQ cid tid request | 324 | let trans = TransactionQ cid tid request |
317 | 325 | ||
318 | addr <- getTrackerAddr trackerURI | 326 | addr <- getTrackerAddr m trackerURI |
319 | res <- call m addr (encode trans) | 327 | res <- call m addr (encode trans) |
320 | case decode res of | 328 | case decode res of |
321 | Right (TransactionR {..}) | 329 | Right (TransactionR {..}) |
@@ -346,6 +354,9 @@ freshConnection m tracker @ UDPTracker {..} = do | |||
346 | connId <- connectUDP m tracker | 354 | connId <- connectUDP m tracker |
347 | updateConnection connId tracker | 355 | updateConnection connId tracker |
348 | 356 | ||
357 | getConnection :: Manager -> URI -> IO Connection | ||
358 | getConnection _ = undefined | ||
359 | |||
349 | announce :: Manager -> AnnounceQuery -> UDPTracker -> IO AnnounceInfo | 360 | announce :: Manager -> AnnounceQuery -> UDPTracker -> IO AnnounceInfo |
350 | announce m ann tracker = do | 361 | announce m ann tracker = do |
351 | freshConnection m tracker | 362 | freshConnection m tracker |