diff options
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r-- | src/Network/BitTorrent/Internal.lhs | 28 | ||||
-rw-r--r-- | src/Network/BitTorrent/Peer.hs | 24 |
2 files changed, 14 insertions, 38 deletions
diff --git a/src/Network/BitTorrent/Internal.lhs b/src/Network/BitTorrent/Internal.lhs index e3fe3dac..475c5e32 100644 --- a/src/Network/BitTorrent/Internal.lhs +++ b/src/Network/BitTorrent/Internal.lhs | |||
@@ -257,25 +257,17 @@ so we need to do this on demand: if a peer asks for a block, we | |||
257 | validate corresponding piece and only after read and send the block | 257 | validate corresponding piece and only after read and send the block |
258 | back. | 258 | back. |
259 | 259 | ||
260 | > -- | Used to check torrent location before register torrent. | 260 | > registerTorrent :: TVar TorrentMap -> InfoHash -> TorrentLoc -> IO () |
261 | > validateTorrent :: TorrentLoc -> IO Torrent | 261 | > registerTorrent = error "registerTorrent" |
262 | > validateTorrent TorrentLoc {..} = do | 262 | > {- |
263 | > t <- fromFile metafilePath | ||
264 | > exists <- doesDirectoryExist dataDirPath | ||
265 | > unless exists $ do | ||
266 | > throw undefined | ||
267 | > return t | ||
268 | |||
269 | > registerTorrent :: TVar TorrentMap -> TorrentLoc -> IO (Maybe Torrent) | ||
270 | > registerTorrent ClientSession {..} tl = do | ||
271 | > Torrent {..} <- validateTorrent tl | 263 | > Torrent {..} <- validateTorrent tl |
272 | > atomically $ modifyTVar' torrentMap $ HM.insert tInfoHash tl | 264 | > atomically $ modifyTVar' torrentMap $ HM.insert tInfoHash tl |
273 | > return (Just t) | 265 | > return (Just t) |
274 | > | 266 | > -} |
275 | 267 | ||
276 | > unregisterTorrent :: TVar TorrentMap -> InfoHash -> IO () | 268 | > unregisterTorrent :: TVar TorrentMap -> InfoHash -> IO () |
277 | > unregisterTorrent ClientSession {..} ih = do | 269 | > unregisterTorrent = error "unregisterTorrent" |
278 | > modifyTVar' torrentMap $ HM.delete ih | 270 | > -- modifyTVar' torrentMap $ HM.delete ih |
279 | 271 | ||
280 | Client session | 272 | Client session |
281 | ------------------------------------------------------------------------ | 273 | ------------------------------------------------------------------------ |
@@ -374,7 +366,7 @@ and different enabled extensions at the same time. | |||
374 | > ClientSession | 366 | > ClientSession |
375 | > <$> newPeerId | 367 | > <$> newPeerId |
376 | > <*> pure exts | 368 | > <*> pure exts |
377 | > <*> forkListener (error "listener") | 369 | > <*> pure 10 -- forkListener (error "listener") |
378 | > <*> MSem.new n | 370 | > <*> MSem.new n |
379 | > <*> pure n | 371 | > <*> pure n |
380 | > <*> newTVarIO S.empty | 372 | > <*> newTVarIO S.empty |
@@ -382,6 +374,12 @@ and different enabled extensions at the same time. | |||
382 | > <*> newTVarIO (startProgress 0) | 374 | > <*> newTVarIO (startProgress 0) |
383 | > <*> newTVarIO HM.empty | 375 | > <*> newTVarIO HM.empty |
384 | 376 | ||
377 | data TorrentStatus = Active SwarmSession | ||
378 | | Registered TorrentLoc | ||
379 | | Unknown | ||
380 | lookupTorrent :: ClientSession -> InfoHash -> IO TorrentStatus | ||
381 | lookupTorrent ses ih = | ||
382 | |||
385 | Swarm session | 383 | Swarm session |
386 | ------------------------------------------------------------------------ | 384 | ------------------------------------------------------------------------ |
387 | 385 | ||
diff --git a/src/Network/BitTorrent/Peer.hs b/src/Network/BitTorrent/Peer.hs index 68771052..4615ad3a 100644 --- a/src/Network/BitTorrent/Peer.hs +++ b/src/Network/BitTorrent/Peer.hs | |||
@@ -51,7 +51,7 @@ module Network.BitTorrent.Peer | |||
51 | -- * Peer address | 51 | -- * Peer address |
52 | , PeerAddr(..) | 52 | , PeerAddr(..) |
53 | , peerSockAddr | 53 | , peerSockAddr |
54 | , connectToPeer, forkListener | 54 | , connectToPeer |
55 | , ppPeer | 55 | , ppPeer |
56 | 56 | ||
57 | -- * Client version detection | 57 | -- * Client version detection |
@@ -540,28 +540,6 @@ connectToPeer p = do | |||
540 | connect sock (peerSockAddr p) | 540 | connect sock (peerSockAddr p) |
541 | return sock | 541 | return sock |
542 | 542 | ||
543 | |||
544 | forkListener :: ((PeerAddr, Socket) -> IO ()) -> IO PortNumber | ||
545 | forkListener action = do | ||
546 | sock <- socket AF_INET Stream defaultProtocol | ||
547 | bindSocket sock (SockAddrInet 0 0) | ||
548 | listen sock 1 | ||
549 | addr <- getSocketName sock | ||
550 | case addr of | ||
551 | SockAddrInet port _ -> do | ||
552 | forkIO (loop sock) | ||
553 | return port | ||
554 | _ -> do | ||
555 | throwIO $ userError "listener: impossible happened" | ||
556 | where | ||
557 | loop sock = do | ||
558 | (conn, addr) <- accept sock | ||
559 | case addr of | ||
560 | SockAddrInet port host -> | ||
561 | action (PeerAddr Nothing host port, conn) | ||
562 | _ -> return () | ||
563 | loop sock | ||
564 | |||
565 | -- | Pretty print peer address in human readable form. | 543 | -- | Pretty print peer address in human readable form. |
566 | ppPeer :: PeerAddr -> Doc | 544 | ppPeer :: PeerAddr -> Doc |
567 | ppPeer p @ PeerAddr {..} = case peerID of | 545 | ppPeer p @ PeerAddr {..} = case peerID of |