handlePeerMsgs
) where
-import Prelude hiding (lookup, concat, replicate, splitAt, writeFile, take)
+import Prelude hiding (lookup, concat, replicate, splitAt, take)
-import System.IO (Handle, BufferMode(..), IOMode(..), SeekMode(..), withFile, hSeek, hSetBuffering)
-import Data.ByteString (ByteString, pack, unpack, concat, hGet, hPut, singleton, writeFile, take)
+import System.IO (Handle, BufferMode(..), hSetBuffering)
+import Data.ByteString (ByteString, pack, unpack, concat, hGet, hPut, singleton, take, empty)
import Data.ByteString.Lazy (fromStrict, fromChunks, toStrict)
import qualified Data.ByteString.Char8 as BC (replicate, pack, length)
import Network (connectTo, PortID(..))
import FuncTorrent.Metainfo (Info(..), Metainfo(..))
import FuncTorrent.Utils (splitN, splitNum)
+import FuncTorrent.Fileops (createDummyFile, writeFileAtOffset)
type ID = String
type IP = String
, hash = h
, len = pLen })
| (i, h, pLen) <- zip3 [0..numPieces] hashes pLengths]
- hashes = splitN (fromIntegral numPieces) pieceHash
+ hashes = splitN 20 pieceHash
havePiece :: PieceMap -> Integer -> Bool
havePiece pm index =
in
setBits ++ go bs' (pos + 1)
-createDummyFile :: FilePath -> Int -> IO ()
-createDummyFile path size =
- writeFile path (BC.replicate size '\0')
-
--- write into a file at a specific offet
-writeFileAtOffset :: FilePath -> Integer -> ByteString -> IO ()
-writeFileAtOffset path offset block =
- withFile path WriteMode $ (\h -> do
- _ <- hSeek h AbsoluteSeek offset
- hPut h block)
-
-- recvMsg :: Peer -> Handle -> Msg
msgLoop :: PeerState -> PieceMap -> IO ()
-msgLoop pState pieceStatus | meInterested pState == False &&
- heChoking pState == True = do
- -- if me NOT Interested and she is Choking, tell her that
- -- I am interested.
- let h = handle pState
- sendMsg h InterestedMsg
- putStrLn $ "--> InterestedMsg to peer: " ++ show (peer pState)
- msgLoop (pState { meInterested = True }) pieceStatus
- | meInterested pState == True &&
- heChoking pState == False =
+msgLoop pState pieceStatus | not (meInterested pState) && heChoking pState = do
+ -- if me NOT Interested and she is Choking, tell her that
+ -- I am interested.
+ let h = handle pState
+ sendMsg h InterestedMsg
+ putStrLn $ "--> InterestedMsg to peer: " ++ show (peer pState)
+ msgLoop (pState { meInterested = True }) pieceStatus
+ | meInterested pState && not (heChoking pState) =
-- if me Interested and she not Choking, send her a request
-- for a piece.
case pickPiece pieceStatus of
Nothing -> putStrLn "Nothing to download"
Just workPiece -> do
let pLen = len (pieceStatus ! workPiece)
+ putStrLn $ "piece length = " ++ show pLen
pBS <- downloadPiece (handle pState) workPiece pLen
if not $ verifyHash pBS (hash (pieceStatus ! workPiece))
then
putStrLn $ "Hash mismatch: " ++ show (hash (pieceStatus ! workPiece)) ++ " vs " ++ show (take 20 (SHA1.hash pBS))
- else
+ else do
+ let fileOffset = if workPiece == 0 then 0 else workPiece * len (pieceStatus ! (workPiece - 1))
+ putStrLn $ "Write into file at offset: " ++ show fileOffset
+ writeFileAtOffset "/tmp/download.file" fileOffset pBS
msgLoop pState (adjust (\pieceData -> pieceData { state = Have }) workPiece pieceStatus)
| otherwise = do
msg <- getMsg (handle pState)
BitFieldMsg bss -> do
let pieceList = bitfieldToList (unpack bss)
pieceStatus' = updatePieceAvailability pieceStatus (peer pState) pieceList
- print pieceList
+ putStrLn $ show (length pieceList) ++ " Pieces"
-- 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 pState pieceStatus'
- UnChokeMsg -> do
+ UnChokeMsg ->
msgLoop (pState { heChoking = False }) pieceStatus
- _ -> do
+ _ ->
msgLoop pState pieceStatus
-- simple algorithm to pick piece.
updatePieceAvailability :: PieceMap -> Peer -> [Integer] -> PieceMap
updatePieceAvailability pieceStatus p pieceList =
mapWithKey (\k pd -> if k `elem` pieceList
- then (pd { peers = p : (peers pd) })
+ then (pd { peers = p : peers pd })
else pd) pieceStatus
handlePeerMsgs :: Peer -> Metainfo -> String -> IO ()
pLen = pieceLength (info m)
fileLen = lengthInBytes (info m)
pieceStatus = mkPieceMap numPieces pieceHash (splitNum fileLen pLen)
+ createDummyFile "/tmp/download.file" (fromIntegral fileLen)
msgLoop state pieceStatus
downloadPiece :: Handle -> Integer -> Integer -> IO ByteString
liftM concat $ forM (zip [0..] chunks) (\(i, pLen) -> do
sendMsg h (RequestMsg index (i*pLen) pLen)
putStrLn $ "--> " ++ "RequestMsg for Piece "
- ++ (show index) ++ ", part: " ++ show i ++ " of length: "
+ ++ show index ++ ", part: " ++ show i ++ " of length: "
++ show pLen
- -- TODO: non exhaustive pattern matching. :(
- PieceMsg index begin block <- getMsg h
- putStrLn $ " <-- PieceMsg for Piece: "
- ++ show index
- ++ ", offset: "
- ++ show begin
- return block)
+ msg <- getMsg h
+ case msg of
+ PieceMsg index begin block -> do
+ putStrLn $ " <-- PieceMsg for Piece: "
+ ++ show index
+ ++ ", offset: "
+ ++ show begin
+ return block
+ _ -> do
+ putStrLn "ignoring irrelevant msg"
+ return empty)
verifyHash :: ByteString -> ByteString -> Bool
verifyHash bs pieceHash =