summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent
diff options
context:
space:
mode:
authorSam T <pxqr.sta@gmail.com>2013-05-08 10:52:23 +0400
committerSam T <pxqr.sta@gmail.com>2013-05-08 10:52:23 +0400
commit71980c797f0fa242f544f6bf706999983b0bcf68 (patch)
treecdb71959f3fdbb5e1b5c4eb038d59f3028f57452 /src/Network/BitTorrent
parentd0282172da33bbc58cc40f14d7368726dfde8b37 (diff)
~ Fix handshake.
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r--src/Network/BitTorrent/PeerWire/Handshake.hs27
1 files changed, 14 insertions, 13 deletions
diff --git a/src/Network/BitTorrent/PeerWire/Handshake.hs b/src/Network/BitTorrent/PeerWire/Handshake.hs
index 62d7d7f4..770ca3ce 100644
--- a/src/Network/BitTorrent/PeerWire/Handshake.hs
+++ b/src/Network/BitTorrent/PeerWire/Handshake.hs
@@ -20,6 +20,8 @@ module Network.BitTorrent.PeerWire.Handshake
20 ) where 20 ) where
21 21
22import Control.Applicative 22import Control.Applicative
23import Control.Monad
24import Control.Exception
23import Data.Word 25import Data.Word
24import Data.ByteString (ByteString) 26import Data.ByteString (ByteString)
25import qualified Data.ByteString as B 27import qualified Data.ByteString as B
@@ -74,7 +76,6 @@ instance Serialize Handshake where
74handshakeCaps :: Handshake -> Capabilities 76handshakeCaps :: Handshake -> Capabilities
75handshakeCaps = hsReserved 77handshakeCaps = hsReserved
76 78
77-- TODO add reserved bits info
78-- | Format handshake in human readable form. 79-- | Format handshake in human readable form.
79ppHandshake :: Handshake -> String 80ppHandshake :: Handshake -> String
80ppHandshake hs = BC.unpack (hsProtocol hs) ++ " " 81ppHandshake hs = BC.unpack (hsProtocol hs) ++ " "
@@ -100,23 +101,23 @@ defaultReserved = 0
100defaultHandshake :: InfoHash -> PeerID -> Handshake 101defaultHandshake :: InfoHash -> PeerID -> Handshake
101defaultHandshake = Handshake defaultBTProtocol defaultReserved 102defaultHandshake = Handshake defaultBTProtocol defaultReserved
102 103
103-- TODO exceptions instead of Either
104-- | Handshaking with a peer specified by the second argument. 104-- | Handshaking with a peer specified by the second argument.
105-- 105handshake :: Socket -> Handshake -> IO Handshake
106handshake :: Socket -> Handshake -> IO (Either String Handshake)
107handshake sock hs = do 106handshake sock hs = do
108 sendAll sock (S.encode hs) 107 sendAll sock (S.encode hs)
109 108
110 header <- recv sock 1 109 header <- recv sock 1
111 if B.length header == 0 then 110 when (B.length header == 0) $
112 return $ Left "" 111 throw $ userError "Unable to receive handshake."
113 else do 112
114 let protocolLen = B.head header 113 let protocolLen = B.head header
115 let restLen = handshakeSize protocolLen - 1 114 let restLen = handshakeSize protocolLen - 1
116 body <- recv sock restLen 115 body <- recv sock restLen
117 let resp = B.cons protocolLen body 116 let resp = B.cons protocolLen body
118 117
119 return (checkIH (S.decode resp)) 118 case checkIH (S.decode resp) of
119 Right hs' -> return hs'
120 Left msg -> throw $ userError msg
120 where 121 where
121 checkIH (Right hs') 122 checkIH (Right hs')
122 | hsInfoHash hs /= hsInfoHash hs' = Left "Handshake info hash do not match." 123 | hsInfoHash hs /= hsInfoHash hs' = Left "Handshake info hash do not match."