Basic infrastructure for Extension messages (BEP 0010)

diff --git a/src/FuncTorrent/PeerMsgs.hs b/src/FuncTorrent/PeerMsgs.hs
index f597ed8c6ee676b3581b25e96a264d7fa35c2fd4..d6bbdcfadefac6d3f7672f090a952492d7299fa2 100644 (file)
--- a/src/FuncTorrent/PeerMsgs.hs
+++ b/src/FuncTorrent/PeerMsgs.hs
@@ -35,7 +35,7 @@ import Data.ByteString (ByteString, pack, unpack, concat, hGet, hPut, singleton)
 import Data.ByteString.Lazy (fromStrict, fromChunks, toStrict)
 import Data.ByteString.Char8 as BC (splitAt)
 import qualified Data.ByteString.Char8 as BC (replicate, pack)
 import Data.ByteString.Lazy (fromStrict, fromChunks, toStrict)
 import Data.ByteString.Char8 as BC (splitAt)
 import qualified Data.ByteString.Char8 as BC (replicate, pack)

-import Control.Monad (replicateM, liftM)
+import Control.Monad (replicateM)

 import Control.Applicative (liftA3)
 
 import Data.Binary (Binary(..), decode, encode)
 import Control.Applicative (liftA3)
 
 import Data.Binary (Binary(..), decode, encode)


@@ -63,6 +63,7 @@ data PeerMsg = KeepAliveMsg
              | PieceMsg Integer Integer ByteString
              | CancelMsg Integer Integer Integer
              | PortMsg Port
              | PieceMsg Integer Integer ByteString
              | CancelMsg Integer Integer Integer
              | PortMsg Port

+             | ExtendedMsg Integer ByteString

              deriving (Show)
 
 instance Binary PeerMsg where
              deriving (Show)
 
 instance Binary PeerMsg where


@@ -100,6 +101,15 @@ instance Binary PeerMsg where
              PortMsg p -> do putWord32be 3
                              putWord8 9
                              putWord16be (fromIntegral p)
              PortMsg p -> do putWord32be 3
                              putWord8 9
                              putWord16be (fromIntegral p)

+             ExtendedHandshakeMsg t b-> do putWord32be msgLen
+                                           putWord8 20
+                                           putWord8 t -- 0 => handshake msg
+                                           -- actual extension msg follows
+                                           mapM_ putWord8 blockList
+                                             where blockList = unpack b
+                                                   blockLen  = length blockList
+
+

     where putIndexOffsetLength i o l = do
             putWord32be (fromIntegral i)
             putWord32be (fromIntegral o)
     where putIndexOffsetLength i o l = do
             putWord32be (fromIntegral i)
             putWord32be (fromIntegral o)


@@ -139,10 +149,12 @@ sendMsg h msg = hPut h bsMsg
   where bsMsg = toStrict $ encode msg
 
 genHandshakeMsg :: ByteString -> String -> ByteString
   where bsMsg = toStrict $ encode msg
 
 genHandshakeMsg :: ByteString -> String -> ByteString

-genHandshakeMsg infoHash peer_id = concat [pstrlen, pstr, reserved, infoHash, peerID]
+genHandshakeMsg infoHash peer_id = concat [pstrlen, pstr, reserved1, reserved2, reserved3, infoHash, peerID]

   where pstrlen = singleton 19
         pstr = BC.pack "BitTorrent protocol"
   where pstrlen = singleton 19
         pstr = BC.pack "BitTorrent protocol"

-        reserved = BC.replicate 8 '\0'
+        reserved1 = BC.replicate 4 '\0'
+        reserved2 = singleton 0x10 -- support extension protocol
+        reserved3 = BC.replicate 3 '\0'

         peerID = BC.pack peer_id
 
 bsToInt :: ByteString -> Int
         peerID = BC.pack peer_id
 
 bsToInt :: ByteString -> Int