From 552950e6fde25e0deacebf4faa438ae9c741c7a3 Mon Sep 17 00:00:00 2001 From: Ramakrishnan Muthukrishnan Date: Wed, 9 Dec 2015 11:51:53 +0530 Subject: [PATCH] new modules FileSystem and PieceManager FileSystem module abstracts the filesystem operations for the download and upload via a message channel that peers can send messages to. --- functorrent.cabal | 2 + src/FuncTorrent/FileSystem.hs | 77 +++++++++++++++++++++ src/FuncTorrent/Peer.hs | 118 ++++++++------------------------ src/FuncTorrent/PieceManager.hs | 69 +++++++++++++++++++ src/FuncTorrent/Server.hs | 7 +- src/FuncTorrent/Tracker.hs | 36 +++++++--- src/FuncTorrent/Utils.hs | 21 +++--- src/main/Main.hs | 44 +++++++----- 8 files changed, 243 insertions(+), 131 deletions(-) create mode 100644 src/FuncTorrent/FileSystem.hs create mode 100644 src/FuncTorrent/PieceManager.hs diff --git a/functorrent.cabal b/functorrent.cabal index abd77a6..c4da29d 100644 --- a/functorrent.cabal +++ b/functorrent.cabal @@ -17,11 +17,13 @@ cabal-version: >=1.18 library exposed-modules: FuncTorrent.Bencode, + FuncTorrent.FileSystem, FuncTorrent.Logger, FuncTorrent.Metainfo, FuncTorrent.Network FuncTorrent.Peer, FuncTorrent.PeerMsgs, + FuncTorrent.PieceManager, FuncTorrent.Server, FuncTorrent.Tracker, FuncTorrent.Utils diff --git a/src/FuncTorrent/FileSystem.hs b/src/FuncTorrent/FileSystem.hs new file mode 100644 index 0000000..1b190ca --- /dev/null +++ b/src/FuncTorrent/FileSystem.hs @@ -0,0 +1,77 @@ +module FuncTorrent.FileSystem + (startThread, + MsgChannel, + initFS, + Msg(..), + Piece(..), + pieceMapFromFile + ) + where + +import Control.Concurrent (ThreadId, forkIO) +import Control.Concurrent.Chan (Chan, newChan, readChan) +import Control.Concurrent.MVar (MVar, putMVar) +import Control.Monad (forever) +import Data.Map (traverseWithKey) + +import qualified Data.ByteString as BS +import Data.Map ((!)) +import System.IO (Handle, openFile, IOMode (ReadWriteMode)) + +import FuncTorrent.PieceManager (PieceDlState(..), PieceData(..), PieceMap, pieceNumToOffset) +import FuncTorrent.Utils (readFileAtOffset, writeFileAtOffset, verifyHash) + +type PieceNum = Integer +data Piece = Piece PieceNum BS.ByteString + +data Msg = ReadPiece PieceNum Integer (MVar Piece) + | WritePiece Piece + | VerifyPiece PieceNum (MVar Bool) + +type MsgChannel = Chan Msg + +-- init :: FileName -> IO (Handle, MsgChannel) +initFS :: FilePath -> IO (Handle, MsgChannel) +initFS filepath = do + c <- newChan + h <- openFile filepath ReadWriteMode + return (h, c) + +startThread :: Handle -> MsgChannel -> PieceMap -> IO ThreadId +startThread handle c pieceMap = do + forkIO $ forever $ recvMsg >>= sendResponse + where + recvMsg = readChan c + sendResponse msg = + case msg of + ReadPiece n len' var -> do + bs <- readPiece n len' + putMVar var (Piece n bs) + WritePiece (Piece n bs) -> do + writePiece n bs + VerifyPiece n var -> do + isHashValid <- verifyPiece n + putMVar var isHashValid + readPiece n len' = do + let offset = pieceNumToOffset pieceMap n + readFileAtOffset handle offset len' + writePiece n piece = do + let offset = pieceNumToOffset pieceMap n + writeFileAtOffset handle offset piece + verifyPiece n = do + let offset = pieceNumToOffset pieceMap n + hash' = hash (pieceMap ! n) + len' = len (pieceMap ! n) + bs' <- readFileAtOffset handle offset len' + return $ verifyHash bs' hash' + +pieceMapFromFile :: Handle -> PieceMap -> IO PieceMap +pieceMapFromFile handle pieceMap = do + traverseWithKey f pieceMap + where + f k v = do + let offset = pieceNumToOffset pieceMap k + isHashValid <- flip verifyHash (hash v) <$> readFileAtOffset handle offset (len v) + if isHashValid + then return $ v { dlstate = Have } + else return v diff --git a/src/FuncTorrent/Peer.hs b/src/FuncTorrent/Peer.hs index c6629a4..834c808 100644 --- a/src/FuncTorrent/Peer.hs +++ b/src/FuncTorrent/Peer.hs @@ -2,27 +2,25 @@ module FuncTorrent.Peer (Peer(..), PieceMap, - handlePeerMsgs, - bytesDownloaded, - initPieceMap, - pieceMapFromFile + handlePeerMsgs ) where -import Prelude hiding (lookup, concat, replicate, splitAt, take, drop, filter) +import Prelude hiding (lookup, concat, replicate, splitAt, take, drop) -import System.IO (Handle, BufferMode(..), hSetBuffering, hClose) -import Data.ByteString (ByteString, unpack, concat, hGet, hPut, take, drop, empty) -import qualified Data.ByteString.Char8 as BC (length) -import Network (connectTo, PortID(..)) +import Control.Concurrent.Chan (writeChan) import Control.Monad.State +import Data.ByteString (ByteString, unpack, concat, hGet, hPut, take, drop, empty) import Data.Bits import Data.Word (Word8) -import Data.Map (Map, fromList, toList, (!), mapWithKey, traverseWithKey, adjust, filter) -import Safe (headMay) +import Data.Map ((!), adjust) +import Network (connectTo, PortID(..)) +import System.IO (Handle, BufferMode(..), hSetBuffering, hClose) -import FuncTorrent.Metainfo (Info(..), Metainfo(..)) -import FuncTorrent.Utils (splitN, splitNum, writeFileAtOffset, readFileAtOffset, verifyHash) +import FuncTorrent.Metainfo (Metainfo(..)) import FuncTorrent.PeerMsgs (Peer(..), PeerMsg(..), sendMsg, getMsg, genHandshakeMsg) +import FuncTorrent.Utils (splitNum, verifyHash) +import FuncTorrent.PieceManager (PieceDlState(..), PieceData(..), PieceMap, pickPiece, updatePieceAvailability) +import qualified FuncTorrent.FileSystem as FS (MsgChannel, Msg(..), Piece(..)) data PState = PState { handle :: Handle , peer :: Peer @@ -31,46 +29,6 @@ data PState = PState { handle :: Handle , heChoking :: Bool , heInterested :: Bool} -data PieceDlState = Pending - | Downloading - | Have - deriving (Show, Eq) - --- todo - map with index to a new data structure (peers who have that piece and state) -data PieceData = PieceData { peers :: [Peer] -- ^ list of peers who have this piece - , dlstate :: PieceDlState -- ^ state of the piece from download perspective. - , hash :: ByteString -- ^ piece hash - , len :: Integer } -- ^ piece length - --- which piece is with which peers -type PieceMap = Map Integer PieceData - - --- Make the initial Piece map, with the assumption that no peer has the --- piece and that every piece is pending download. -initPieceMap :: ByteString -> Integer -> Integer -> PieceMap -initPieceMap pieceHash fileLen pieceLen = fromList kvs - where - numPieces = (toInteger . (`quot` 20) . BC.length) pieceHash - kvs = [(i, PieceData { peers = [] - , dlstate = Pending - , hash = h - , len = pLen }) - | (i, h, pLen) <- zip3 [0..numPieces] hashes pLengths] - hashes = splitN 20 pieceHash - pLengths = splitNum fileLen pieceLen - -pieceMapFromFile :: FilePath -> PieceMap -> IO PieceMap -pieceMapFromFile filePath pieceMap = - traverseWithKey f pieceMap - where - f k v = do - let offset = if k == 0 then 0 else k * len (pieceMap ! (k - 1)) - isHashValid <- flip verifyHash (hash v) <$> readFileAtOffset filePath offset (len v) - if isHashValid - then return $ v { dlstate = Have } - else return v - havePiece :: PieceMap -> Integer -> Bool havePiece pm index = dlstate (pm ! index) == Have @@ -129,33 +87,16 @@ toPeerState h p meCh meIn heCh heIn = , meChoking = meCh , meInterested = meIn } --- simple algorithm to pick piece. --- pick the first piece from 0 that is not downloaded yet. -pickPiece :: PieceMap -> Maybe Integer -pickPiece = - (fst `liftM`) . headMay . toList . filter (\v -> dlstate v == Pending) - -bytesDownloaded :: PieceMap -> Integer -bytesDownloaded = - sum . map (len . snd) . toList . filter (\v -> dlstate v == Have) - -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 -> String -> Metainfo -> PieceMap -> Bool -> IO () -handlePeerMsgs p peerId m pieceMap isClient = do +handlePeerMsgs :: Peer -> String -> Metainfo -> PieceMap -> Bool -> FS.MsgChannel -> IO () +handlePeerMsgs p peerId m pieceMap isClient c = do h <- connectToPeer p doHandshake isClient h p (infoHash m) peerId let pstate = toPeerState h p False False True True - filePath = name (info m) - _ <- runStateT (msgLoop pieceMap filePath) pstate + _ <- runStateT (msgLoop pieceMap c) pstate return () -msgLoop :: PieceMap -> FilePath -> StateT PState IO () -msgLoop pieceStatus file = do +msgLoop :: PieceMap -> FS.MsgChannel -> StateT PState IO () +msgLoop pieceStatus msgchannel = do h <- gets handle st <- get case st of @@ -163,7 +104,7 @@ msgLoop pieceStatus file = do liftIO $ sendMsg h InterestedMsg gets peer >>= (\p -> liftIO $ putStrLn $ "--> InterestedMsg to peer: " ++ show p) modify (\st' -> st' { meInterested = True }) - msgLoop pieceStatus file + msgLoop pieceStatus msgchannel PState { meInterested = True, heChoking = False } -> case pickPiece pieceStatus of Nothing -> liftIO $ putStrLn "Nothing to download" @@ -175,10 +116,9 @@ msgLoop pieceStatus file = do then liftIO $ putStrLn "Hash mismatch" else do - let fileOffset = if workPiece == 0 then 0 else workPiece * len (pieceStatus ! (workPiece - 1)) - liftIO $ putStrLn $ "Write into file at offset: " ++ show fileOffset - liftIO $ writeFileAtOffset file fileOffset pBS - msgLoop (adjust (\pieceData -> pieceData { dlstate = Have }) workPiece pieceStatus) file + liftIO $ putStrLn $ "Write piece: " ++ show workPiece + liftIO $ writeChan msgchannel $ FS.WritePiece (FS.Piece workPiece pBS) + msgLoop (adjust (\pieceData -> pieceData { dlstate = Have }) workPiece pieceStatus) msgchannel _ -> do msg <- liftIO $ getMsg h gets peer >>= (\p -> liftIO $ putStrLn $ "<-- " ++ show msg ++ "from peer: " ++ show p) @@ -186,7 +126,7 @@ msgLoop pieceStatus file = do KeepAliveMsg -> do liftIO $ sendMsg h KeepAliveMsg gets peer >>= (\p -> liftIO $ putStrLn $ "--> " ++ "KeepAliveMsg to peer: " ++ show p) - msgLoop pieceStatus file + msgLoop pieceStatus msgchannel BitFieldMsg bss -> do p <- gets peer let pieceList = bitfieldToList (unpack bss) @@ -195,23 +135,23 @@ msgLoop pieceStatus file = do -- 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 pieceStatus' file + msgLoop pieceStatus' msgchannel UnChokeMsg -> do modify (\st' -> st' {heChoking = False }) - msgLoop pieceStatus file + msgLoop pieceStatus msgchannel ChokeMsg -> do modify (\st' -> st' {heChoking = True }) - msgLoop pieceStatus file + msgLoop pieceStatus msgchannel InterestedMsg -> do modify (\st' -> st' {heInterested = True}) - msgLoop pieceStatus file + msgLoop pieceStatus msgchannel NotInterestedMsg -> do modify (\st' -> st' {heInterested = False}) - msgLoop pieceStatus file + msgLoop pieceStatus msgchannel CancelMsg _ _ _ -> -- check if valid index, begin, length - msgLoop pieceStatus file + msgLoop pieceStatus msgchannel PortMsg _ -> - msgLoop pieceStatus file + msgLoop pieceStatus msgchannel -- handle RequestMsg, HaveMsg. No need to handle PieceMsg here. -- also BitFieldMsg @@ -233,6 +173,6 @@ downloadPiece h index pieceLength = do ++ show begin return block _ -> do - putStrLn "ignoring irrelevant msg" + putStrLn $ "ignoring irrelevant msg: " ++ show msg return empty) diff --git a/src/FuncTorrent/PieceManager.hs b/src/FuncTorrent/PieceManager.hs new file mode 100644 index 0000000..e65b3fd --- /dev/null +++ b/src/FuncTorrent/PieceManager.hs @@ -0,0 +1,69 @@ +module FuncTorrent.PieceManager + (PieceDlState(..), + PieceData(..), + PieceMap, + pieceNumToOffset, + updatePieceAvailability, + pickPiece, + bytesDownloaded, + initPieceMap, + ) where + +import Prelude hiding (filter) + +import qualified Data.ByteString.Char8 as BC (length) +import Control.Monad (liftM) +import Data.ByteString (ByteString) +import Data.Map (Map, (!), fromList, toList, mapWithKey, filter) +import Safe (headMay) + +import FuncTorrent.PeerMsgs (Peer) +import FuncTorrent.Utils (splitN, splitNum) + +data PieceDlState = Pending + | Downloading + | Have + deriving (Show, Eq) + +-- todo - map with index to a new data structure (peers who have that piece and state) +data PieceData = PieceData { peers :: [Peer] -- ^ list of peers who have this piece + , dlstate :: PieceDlState -- ^ state of the piece from download perspective. + , hash :: ByteString -- ^ piece hash + , len :: Integer } -- ^ piece length + +-- which piece is with which peers +type PieceMap = Map Integer PieceData + +pieceNumToOffset :: PieceMap -> Integer -> Integer +pieceNumToOffset _ 0 = 0 +pieceNumToOffset pieceMap k = k * len (pieceMap ! (k - 1)) + +-- simple algorithm to pick piece. +-- pick the first piece from 0 that is not downloaded yet. +pickPiece :: PieceMap -> Maybe Integer +pickPiece = + (fst `liftM`) . headMay . toList . filter (\v -> dlstate v == Pending) + +bytesDownloaded :: PieceMap -> Integer +bytesDownloaded = + sum . map (len . snd) . toList . filter (\v -> dlstate v == Have) + +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 + +-- Make the initial Piece map, with the assumption that no peer has the +-- piece and that every piece is pending download. +initPieceMap :: ByteString -> Integer -> Integer -> PieceMap +initPieceMap pieceHash fileLen pieceLen = fromList kvs + where + numPieces = (toInteger . (`quot` 20) . BC.length) pieceHash + kvs = [(i, PieceData { peers = [] + , dlstate = Pending + , hash = h + , len = pLen }) + | (i, h, pLen) <- zip3 [0..numPieces] hashes pLengths] + hashes = splitN 20 pieceHash + pLengths = splitNum fileLen pieceLen diff --git a/src/FuncTorrent/Server.hs b/src/FuncTorrent/Server.hs index 766ac4e..465ef04 100644 --- a/src/FuncTorrent/Server.hs +++ b/src/FuncTorrent/Server.hs @@ -8,6 +8,7 @@ import System.IO (hSetBuffering, BufferMode ( NoBuffering )) import FuncTorrent.Metainfo (Metainfo) import FuncTorrent.Peer (handlePeerMsgs, Peer(..), PieceMap) +import qualified FuncTorrent.FileSystem as FS (MsgChannel) -- server is listening on any port from 6881 - 6889 -- return the port number used @@ -17,9 +18,9 @@ start = withSocketsDo $ do sock <- listenOn $ PortNumber $ fromIntegral (head portnums) return (sock, PortNumber $ head portnums) -run :: Socket -> String -> Metainfo -> PieceMap -> IO () -run listenSock peerid m pieceMap = forever $ do +run :: Socket -> String -> Metainfo -> PieceMap -> FS.MsgChannel -> IO () +run listenSock peerid m pieceMap c = forever $ do (handle, ip, port) <- accept listenSock let peer = Peer "" ip (fromIntegral port) hSetBuffering handle NoBuffering - forkIO $ handlePeerMsgs peer peerid m pieceMap False + forkIO $ handlePeerMsgs peer peerid m pieceMap False c diff --git a/src/FuncTorrent/Tracker.hs b/src/FuncTorrent/Tracker.hs index 125a926..b07fd25 100644 --- a/src/FuncTorrent/Tracker.hs +++ b/src/FuncTorrent/Tracker.hs @@ -3,14 +3,16 @@ module FuncTorrent.Tracker (TState(..), initialTrackerState, trackerLoop, + udpTrackerLoop ) where import Prelude hiding (lookup, splitAt) -import System.IO (Handle) + import Control.Applicative (liftA2) import Control.Concurrent (threadDelay) import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, readMVar, putMVar) +import Control.Exception (try) import Data.Binary (Binary(..), encode, decode) import Data.Binary.Put (putWord16be, putWord32be, putWord64be, putByteString) import Data.Binary.Get (Get, isEmpty, getByteString, getWord16be, getWord32be) @@ -20,7 +22,9 @@ import Data.ByteString.Lazy (fromStrict, toStrict) import Data.Char (chr) import Data.List (intercalate, isPrefixOf) import Data.Map as M (lookup) -import Network (PortNumber) +import Network (connectTo, PortID(..), PortNumber, Socket) +import Network.Socket (defaultProtocol, SocketType( Datagram ), Family( AF_INET ), SockAddr( SockAddrInet ), inet_addr, socket) +import Network.Socket.ByteString (sendTo, recv) import Network.HTTP.Base (urlEncode) import qualified Data.ByteString.Base16 as B16 (encode) @@ -31,7 +35,6 @@ import FuncTorrent.Network (sendGetRequest) import FuncTorrent.Peer (Peer(..)) import FuncTorrent.Utils (splitN) - data TrackerProtocol = Http | Udp | UnknownProtocol @@ -239,18 +242,33 @@ trackerLoop port peerId m st = do trackerLoop port peerId m st -- udp tracker -getResponse :: Handle -> IO UDPResponse -getResponse h = do +getResponse :: Socket -> IO UDPResponse +getResponse s = do -- connect packet is 16 bytes long -- announce packet is atleast 20 bytes long - bs <- hGet h (16*1024) + bs <- recv s (16*1024) return $ decode $ fromStrict bs -sendRequest :: Handle -> UDPRequest -> IO () -sendRequest h req = hPut h bsReq - where bsReq = toStrict $ encode req +sendRequest :: Socket -> String -> PortNumber -> UDPRequest -> IO () +sendRequest s ip port req = do + hostaddr <- inet_addr ip + _ <- sendTo s bsReq $ SockAddrInet (fromIntegral port) hostaddr + return () + where bsReq = toStrict $ encode req getTrackerType :: String -> TrackerProtocol getTrackerType url | isPrefixOf "http://" url = Http | isPrefixOf "udp://" url = Udp | otherwise = UnknownProtocol + +udpTrackerLoop :: PortNumber -> String -> Metainfo -> TState -> IO String +udpTrackerLoop port peerId m st = do + -- h <- connectTo "exodus.desync.com" (PortNumber 6969) + s <- socket AF_INET Datagram defaultProtocol + hostAddr <- inet_addr "185.37.101.229" + putStrLn "connected to tracker" + _ <- sendTo s (toStrict $ encode (ConnectReq 42)) (SockAddrInet 2710 hostAddr) + putStrLn "--> sent ConnectReq to tracker" + resp <- recv s 16 + putStrLn "<-- recv ConnectResp from tracker" + return $ show resp diff --git a/src/FuncTorrent/Utils.hs b/src/FuncTorrent/Utils.hs index 2a27976..5047832 100644 --- a/src/FuncTorrent/Utils.hs +++ b/src/FuncTorrent/Utils.hs @@ -14,7 +14,7 @@ import qualified Crypto.Hash.SHA1 as SHA1 (hash) import Control.Exception.Base (IOException, try) import Data.ByteString (ByteString, writeFile, hPut, hGet, take) import qualified Data.ByteString.Char8 as BC -import System.IO (withFile, hSeek, IOMode(..), SeekMode(..)) +import System.IO (Handle, hSeek, SeekMode(..)) import System.Directory (doesFileExist) splitN :: Int -> BC.ByteString -> [BC.ByteString] @@ -36,16 +36,15 @@ createDummyFile path size = do return $ Right () -- write into a file at a specific offet -writeFileAtOffset :: FilePath -> Integer -> ByteString -> IO () -writeFileAtOffset path offset block = - withFile path ReadWriteMode (\h -> do - hSeek h AbsoluteSeek offset - hPut h block) -readFileAtOffset :: FilePath -> Integer -> Integer -> IO ByteString -readFileAtOffset path offset len = - withFile path ReadWriteMode (\h -> do - hSeek h AbsoluteSeek offset - hGet h (fromInteger len)) +writeFileAtOffset :: Handle -> Integer -> ByteString -> IO () +writeFileAtOffset h offset block = do + hSeek h AbsoluteSeek offset + hPut h block + +readFileAtOffset :: Handle -> Integer -> Integer -> IO ByteString +readFileAtOffset h offset len = do + hSeek h AbsoluteSeek offset + hGet h (fromInteger len) verifyHash :: ByteString -> ByteString -> Bool verifyHash bs pieceHash = diff --git a/src/main/Main.hs b/src/main/Main.hs index 4dd4c68..a75f01c 100644 --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -1,22 +1,24 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -import Prelude hiding (log, length, readFile, getContents, replicate, writeFile) +import Prelude hiding (log, length, readFile, getContents) -import Control.Concurrent (forkIO) -import Control.Concurrent.MVar (readMVar) -import Data.ByteString.Char8 (ByteString, getContents, readFile, writeFile, replicate) -import Network (PortID (PortNumber)) -import System.Environment (getArgs) -import System.Exit (exitSuccess) -import System.Directory (doesFileExist) -import System.Random (getStdGen, randomRs) - -import FuncTorrent.Logger (initLogger, logMessage, logStop) -import FuncTorrent.Metainfo (Info(..), Metainfo(..), torrentToMetainfo) -import FuncTorrent.Peer (initPieceMap, handlePeerMsgs, pieceMapFromFile) +import Control.Concurrent (forkIO) +import Control.Concurrent.MVar (readMVar) +import Data.ByteString.Char8 (ByteString, getContents, readFile) +import qualified FuncTorrent.FileSystem as FS (initFS, pieceMapFromFile, startThread) +import FuncTorrent.Logger (initLogger, logMessage, logStop) +import FuncTorrent.Metainfo (Info(..), Metainfo(..), torrentToMetainfo) +import FuncTorrent.Peer (handlePeerMsgs) +import FuncTorrent.PieceManager (initPieceMap) import qualified FuncTorrent.Server as Server -import FuncTorrent.Tracker (connectedPeers, initialTrackerState, trackerLoop) +import FuncTorrent.Tracker (connectedPeers, initialTrackerState, trackerLoop, udpTrackerLoop) +import FuncTorrent.Utils (createDummyFile) +import Network (PortID (PortNumber)) +import System.Directory (doesFileExist) +import System.Environment (getArgs) +import System.Exit (exitSuccess) +import System.Random (getStdGen, randomRs) logError :: String -> (String -> IO ()) -> IO () logError e logMsg = logMsg $ "parse error: \n" ++ e @@ -68,20 +70,24 @@ main = do pieceHash = pieces (info m) pLen = pieceLength (info m) defaultPieceMap = initPieceMap pieceHash fileLen pLen + log $ "create FS msg channel" + (handle, fsMsgChannel) <- FS.initFS filePath log $ "Downloading file : " ++ filePath dfe <- doesFileExist filePath pieceMap <- if dfe then - pieceMapFromFile filePath defaultPieceMap + FS.pieceMapFromFile handle defaultPieceMap else do -- create a dummy file - _ <- writeFile filePath (replicate (fromIntegral fileLen) '\0') - return defaultPieceMap + createDummyFile filePath (fromIntegral fileLen) >> + return defaultPieceMap + log $ "start filesystem manager thread" + FS.startThread handle fsMsgChannel pieceMap log $ "starting server" (serverSock, (PortNumber portnum)) <- Server.start log $ "server started on " ++ show portnum log "Trying to fetch peers" - _ <- forkIO $ Server.run serverSock peerId m pieceMap + _ <- forkIO $ Server.run serverSock peerId m pieceMap fsMsgChannel log $ "Trackers: " ++ head (announceList m) -- (tstate, errstr) <- runTracker portnum peerId m tstate <- initialTrackerState $ lengthInBytes $ info m @@ -89,5 +95,5 @@ main = do ps <- readMVar (connectedPeers tstate) log $ "Peers List : " ++ (show ps) let p1 = head ps - handlePeerMsgs p1 peerId m pieceMap True + handlePeerMsgs p1 peerId m pieceMap True fsMsgChannel logStop logR -- 2.37.2