From: Ramakrishnan Muthukrishnan Date: Fri, 24 Jul 2015 07:11:03 +0000 (+0530) Subject: update piece availability list based on the bitmap X-Git-Url: https://git.rkrishnan.org/pf/components/com_hotproperty/cyclelanguage?a=commitdiff_plain;h=a0d180c7ab2c16f3a0f15dba85117dd24ba29660;p=functorrent.git update piece availability list based on the bitmap --- diff --git a/src/FuncTorrent/Peer.hs b/src/FuncTorrent/Peer.hs index 830c1fa..6a47a35 100644 --- a/src/FuncTorrent/Peer.hs +++ b/src/FuncTorrent/Peer.hs @@ -4,7 +4,7 @@ module FuncTorrent.Peer handlePeerMsgs ) where -import Prelude hiding (lookup, concat, replicate, splitAt, empty, writeFile) +import Prelude hiding (lookup, concat, replicate, splitAt, writeFile) import System.IO (Handle, BufferMode(..), hSetBuffering) import Data.ByteString (ByteString, pack, unpack, concat, hGet, hPut, singleton, writeFile) @@ -18,7 +18,7 @@ import Control.Monad (replicateM, liftM, forever) import Control.Applicative ((<$>), liftA3) import Data.Bits import Data.Word (Word8) -import Data.Map (Map(..), fromList, (!)) +import Data.Map (Map(..), fromList, (!), mapWithKey) import FuncTorrent.Metainfo (Info(..), Metainfo(..)) import FuncTorrent.Utils (splitN) @@ -96,7 +96,7 @@ handShake peer@(Peer _ ip port) infoHash peerid = do hSetBuffering h LineBuffering hPut h hs putStrLn $ "--> handhake to peer: " ++ show peer - rlenBS <- hGet h (length (unpack hs)) + _ <- hGet h (length (unpack hs)) putStrLn $ "<-- handshake from peer: " ++ show peer return h @@ -216,17 +216,23 @@ msgLoop state pieceStatus = do msgLoop state pieceStatus BitFieldMsg bss -> do let pieceList = bitfieldToList (unpack bss) + pieceStatus' = updatePieceAvailability pieceStatus (peer state) pieceList print pieceList -- for each pieceIndex in pieceList, make an entry in the pieceStatus -- map with pieceIndex as the key and modify the value to add the peer. -- download each of the piece in order - - msgLoop state pieceStatus + msgLoop state pieceStatus' UnChokeMsg -> do msgLoop (state {heChoking = False}) pieceStatus _ -> do msgLoop state pieceStatus +updatePieceAvailability :: PieceMap -> Peer -> [Integer] -> PieceMap +updatePieceAvailability pieceStatus p pieceList = + mapWithKey (\k pd -> if k `elem` pieceList + then (pd { peers = p : (peers pd) }) + else pd) pieceStatus + handlePeerMsgs :: Peer -> Metainfo -> String -> (String -> IO ()) -> IO () handlePeerMsgs p m peerId logFn = do h <- handShake p (infoHash m) peerId @@ -234,9 +240,9 @@ handlePeerMsgs p m peerId logFn = do let state = PeerState { handle = h , peer = p , heInterested = False - , heChoking = False - , meInterested = True - , meChoking = False } + , heChoking = True + , meInterested = False + , meChoking = True } pieceHash = (pieces (info m)) numPieces = (toInteger . (`quot` 20) . BC.length) pieceHash pieceStatus = mkPieceMap numPieces pieceHash