From: Ramakrishnan Muthukrishnan Date: Fri, 18 Sep 2015 02:58:51 +0000 (+0530) Subject: handshake for server and client X-Git-Url: https://git.rkrishnan.org/(%5B%5E?a=commitdiff_plain;h=a62ff37228afd1d13cfee8f86e45e33e6b7f2a10;p=functorrent.git handshake for server and client Earlier implementation used a wrong handhake sequence for the server. This commit fixes it. It is untested at the moment. --- diff --git a/src/FuncTorrent/Peer.hs b/src/FuncTorrent/Peer.hs index e4d7a72..2caf377 100644 --- a/src/FuncTorrent/Peer.hs +++ b/src/FuncTorrent/Peer.hs @@ -8,10 +8,10 @@ module FuncTorrent.Peer pieceMapFromFile ) where -import Prelude hiding (lookup, concat, replicate, splitAt, take, filter) +import Prelude hiding (lookup, concat, replicate, splitAt, take, drop, filter) -import System.IO (Handle, BufferMode(..), hSetBuffering) -import Data.ByteString (ByteString, unpack, concat, hGet, hPut, take, empty) +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.Monad.State @@ -83,14 +83,31 @@ connectToPeer (Peer _ ip port) = do hSetBuffering h LineBuffering return h -doHandshake :: Handle -> Peer -> ByteString -> String -> IO () -doHandshake h peer infoHash peerid = do +doHandshake :: Bool -> Handle -> Peer -> ByteString -> String -> IO () +doHandshake isClient h peer infoHash peerid = let hs = genHandshakeMsg infoHash peerid - hPut h hs - putStrLn $ "--> handhake to peer: " ++ show peer - _ <- hGet h (length (unpack hs)) - putStrLn $ "<-- handshake from peer: " ++ show peer - return () + in + if isClient + then do + hPut h hs + putStrLn $ "--> handhake to peer: " ++ show peer + _ <- hGet h (length (unpack hs)) + putStrLn $ "<-- handshake from peer: " ++ show peer + return () + else do + putStrLn $ "waiting for a handshake" + hsMsg <- hGet h (length (unpack hs)) + putStrLn $ "<-- handshake from peer: " ++ show peer + let rxInfoHash = take 20 $ drop 28 hsMsg + if rxInfoHash /= infoHash + then do + putStrLn $ "infoHashes does not match" + hClose h + return () + else do + _ <- hPut h hs + putStrLn $ "--> handhake to peer: " ++ show peer + return () bitfieldToList :: [Word8] -> [Integer] bitfieldToList bs = go bs 0 @@ -132,10 +149,10 @@ updatePieceAvailability pieceStatus p pieceList = then (pd { peers = p : peers pd }) else pd) pieceStatus -handlePeerMsgs :: Peer -> String -> Metainfo -> PieceMap -> IO () -handlePeerMsgs p peerId m pieceMap = do +handlePeerMsgs :: Peer -> String -> Metainfo -> PieceMap -> Bool -> IO () +handlePeerMsgs p peerId m pieceMap isClient = do h <- connectToPeer p - doHandshake h p (infoHash m) peerId + 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 diff --git a/src/FuncTorrent/Server.hs b/src/FuncTorrent/Server.hs index b78be29..766ac4e 100644 --- a/src/FuncTorrent/Server.hs +++ b/src/FuncTorrent/Server.hs @@ -22,4 +22,4 @@ run listenSock peerid m pieceMap = forever $ do (handle, ip, port) <- accept listenSock let peer = Peer "" ip (fromIntegral port) hSetBuffering handle NoBuffering - forkIO $ handlePeerMsgs peer peerid m pieceMap + forkIO $ handlePeerMsgs peer peerid m pieceMap False diff --git a/src/main/Main.hs b/src/main/Main.hs index 79cd9bf..b67b6b2 100644 --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -88,5 +88,5 @@ main = do Right peerList -> do log $ "Peers List : " ++ (show . peers $ peerList) let p1 = head (peers peerList) - handlePeerMsgs p1 peerId m pieceMap + handlePeerMsgs p1 peerId m pieceMap True logStop logR