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.

diff --git a/functorrent.cabal b/functorrent.cabal
index abd77a69ec43a25dabcea8dd8d470caf369a111a..c4da29dc1adce981bf64705131d98cfa3a10275d 100644 (file)
--- a/functorrent.cabal
+++ b/functorrent.cabal
@@ -17,11 +17,13 @@ cabal-version:       >=1.18
 
 library
   exposed-modules:     FuncTorrent.Bencode,
 
 library
   exposed-modules:     FuncTorrent.Bencode,

+                       FuncTorrent.FileSystem,

                        FuncTorrent.Logger,
                        FuncTorrent.Metainfo,
                        FuncTorrent.Network
                        FuncTorrent.Peer,
                        FuncTorrent.PeerMsgs,
                        FuncTorrent.Logger,
                        FuncTorrent.Metainfo,
                        FuncTorrent.Network
                        FuncTorrent.Peer,
                        FuncTorrent.PeerMsgs,

+                       FuncTorrent.PieceManager,

                        FuncTorrent.Server,
                        FuncTorrent.Tracker,
                        FuncTorrent.Utils
                        FuncTorrent.Server,
                        FuncTorrent.Tracker,
                        FuncTorrent.Utils

diff --git a/src/FuncTorrent/FileSystem.hs b/src/FuncTorrent/FileSystem.hs
new file mode 100644 (file)
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 c6629a4c980146a734f3e003d2ef7751506356ad..834c8086032c700f921e7034975156f2b1653e6e 100644 (file)
--- a/src/FuncTorrent/Peer.hs
+++ b/src/FuncTorrent/Peer.hs
@@ -2,27 +2,25 @@
 module FuncTorrent.Peer
     (Peer(..),
      PieceMap,
 module FuncTorrent.Peer
     (Peer(..),
      PieceMap,

-     handlePeerMsgs,
-     bytesDownloaded,
-     initPieceMap,
-     pieceMapFromFile
+     handlePeerMsgs

     ) where
 
     ) 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 Control.Monad.State

+import Data.ByteString (ByteString, unpack, concat, hGet, hPut, take, drop, empty)

 import Data.Bits
 import Data.Word (Word8)
 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.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
 
 data PState = PState { handle :: Handle
                      , peer :: Peer


@@ -31,46 +29,6 @@ data PState = PState { handle :: Handle
                      , heChoking :: Bool
                      , heInterested :: Bool}
 
                      , 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
 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 }
 
          , 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
   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 ()
 
   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
   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 })
       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"
     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
             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)
     _ -> 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)
         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)
         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
           -- 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 })
         UnChokeMsg -> do
           modify (\st' -> st' {heChoking = False })

-          msgLoop pieceStatus file
+          msgLoop pieceStatus msgchannel

         ChokeMsg -> do
           modify (\st' -> st' {heChoking = True })
         ChokeMsg -> do
           modify (\st' -> st' {heChoking = True })

-          msgLoop pieceStatus file
+          msgLoop pieceStatus msgchannel

         InterestedMsg -> do
           modify (\st' -> st' {heInterested = True})
         InterestedMsg -> do
           modify (\st' -> st' {heInterested = True})

-          msgLoop pieceStatus file
+          msgLoop pieceStatus msgchannel

         NotInterestedMsg -> do
           modify (\st' -> st' {heInterested = False})
         NotInterestedMsg -> do
           modify (\st' -> st' {heInterested = False})

-          msgLoop pieceStatus file
+          msgLoop pieceStatus msgchannel

         CancelMsg _ _ _ -> -- check if valid index, begin, length
         CancelMsg _ _ _ -> -- check if valid index, begin, length

-          msgLoop pieceStatus file
+          msgLoop pieceStatus msgchannel

         PortMsg _ ->
         PortMsg _ ->

-          msgLoop pieceStatus file
+          msgLoop pieceStatus msgchannel

         -- handle RequestMsg, HaveMsg. No need to handle PieceMsg here.
         -- also BitFieldMsg
 
         -- 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
                                                     ++ show begin
                                                   return block
                                                 _ -> do

-                                                  putStrLn "ignoring irrelevant msg"
+                                                  putStrLn $ "ignoring irrelevant msg: " ++ show msg

                                                   return empty)
 
                                                   return empty)
 

diff --git a/src/FuncTorrent/PieceManager.hs b/src/FuncTorrent/PieceManager.hs
new file mode 100644 (file)
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 766ac4e77aea22510569ace8598767dc77e294f3..465ef045ac4e45b3f516a2ff8e3bd384aebb2bde 100644 (file)
--- 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 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
 
 -- 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)
 
   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
   (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 125a9269f9b9137fc7e2b25273a3ae4de44d1dd9..b07fd2546f20912c6f7a07c9f9621a6dd5df9d83 100644 (file)
--- a/src/FuncTorrent/Tracker.hs
+++ b/src/FuncTorrent/Tracker.hs
@@ -3,14 +3,16 @@ module FuncTorrent.Tracker
     (TState(..),
      initialTrackerState,
      trackerLoop,
     (TState(..),
      initialTrackerState,
      trackerLoop,

+     udpTrackerLoop

     ) where
 
 import Prelude hiding (lookup, splitAt)
 
     ) 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.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)
 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 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)
 
 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)
 
 import FuncTorrent.Peer (Peer(..))
 import FuncTorrent.Utils (splitN)
 

-

 data TrackerProtocol = Http
                      | Udp
                      | UnknownProtocol
 data TrackerProtocol = Http
                      | Udp
                      | UnknownProtocol


@@ -239,18 +242,33 @@ trackerLoop port peerId m st = do
           trackerLoop port peerId m st
 
 -- udp tracker
           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
   -- 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
 
   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
 
 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 2a2797626527c8bdc7f3f983361bed31f127e129..50478323664a58ca2f6574479c04225201ef1770 100644 (file)
--- 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 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]
 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
     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 =
 
 verifyHash :: ByteString -> ByteString -> Bool
 verifyHash bs pieceHash =

diff --git a/src/main/Main.hs b/src/main/Main.hs
index 4dd4c6867a92f06e0a9fdb69086aa791cfd507de..a75f01c122df050615e645c4ba9f0fb4f55563da 100644 (file)
--- a/src/main/Main.hs
+++ b/src/main/Main.hs
@@ -1,22 +1,24 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Main where
 
 {-# 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 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
 
 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
            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
        log $ "Downloading file : " ++ filePath
        dfe <- doesFileExist filePath
        pieceMap <- if dfe
                    then

-                     pieceMapFromFile filePath defaultPieceMap
+                     FS.pieceMapFromFile handle defaultPieceMap

                    else do
                      -- create a dummy file
                    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"
        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
        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
        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
        logStop logR