From 1e22d4d33ad6b7da93f7fd1fd757f10d74d98309 Mon Sep 17 00:00:00 2001 From: Sam Truzjan Date: Fri, 27 Dec 2013 12:58:17 +0400 Subject: Add naive session tokens implementation --- src/Network/BitTorrent/Core/Node.hs | 8 ++- src/Network/BitTorrent/Core/PeerAddr.hs | 5 ++ src/Network/BitTorrent/DHT/Message.hs | 4 +- src/Network/BitTorrent/DHT/Token.hs | 91 +++++++++++++++++++++++++++++++++ 4 files changed, 104 insertions(+), 4 deletions(-) create mode 100644 src/Network/BitTorrent/DHT/Token.hs (limited to 'src/Network/BitTorrent') diff --git a/src/Network/BitTorrent/Core/Node.hs b/src/Network/BitTorrent/Core/Node.hs index f6ab7d82..f163a895 100644 --- a/src/Network/BitTorrent/Core/Node.hs +++ b/src/Network/BitTorrent/Core/Node.hs @@ -39,6 +39,7 @@ import Data.Bits import Data.ByteString as BS import Data.BEncode as BE import Data.Default +import Data.Hashable import Data.IP import Data.List as L import Data.Ord @@ -126,6 +127,10 @@ instance BEncode a => BEncode (NodeAddr a) where fromBEncode b = uncurry NodeAddr <$> fromBEncode b {-# INLINE fromBEncode #-} +instance Hashable a => Hashable (NodeAddr a) where + hashWithSalt s NodeAddr {..} = hashWithSalt s (nodeHost, nodePort) + {-# INLINE hashWithSalt #-} + -- | Example: -- -- @nodePort \"127.0.0.1:6881\" == 6881@ @@ -160,7 +165,7 @@ instance Eq a => Ord (NodeInfo a) where instance Serialize a => Serialize (NodeInfo a) where get = NodeInfo <$> get <*> get put NodeInfo {..} = put nodeId >> put nodeAddr - +{- type CompactInfo = ByteString data NodeList a = CompactNodeList [NodeInfo a] @@ -176,3 +181,4 @@ encodeCompact = S.runPut . mapM_ put --encodePeerList :: [PeerAddr] -> [BEncode] --encodePeerList = undefined +-} \ No newline at end of file diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs index 261df8d0..9f5c7c5d 100644 --- a/src/Network/BitTorrent/Core/PeerAddr.hs +++ b/src/Network/BitTorrent/Core/PeerAddr.hs @@ -38,6 +38,7 @@ import Data.BEncode.BDict (BKey) import Data.ByteString.Char8 as BS8 import Data.Char import Data.Default +import Data.Hashable import Data.HashMap.Strict as HM import Data.IP import Data.List as L @@ -81,6 +82,10 @@ instance Serialize PortNumber where put = putWord16be . fromIntegral {-# INLINE put #-} +instance Hashable PortNumber where + hashWithSalt s = hashWithSalt s . fromEnum + {-# INLINE hashWithSalt #-} + {----------------------------------------------------------------------- -- IP addr -----------------------------------------------------------------------} diff --git a/src/Network/BitTorrent/DHT/Message.hs b/src/Network/BitTorrent/DHT/Message.hs index 49629755..83413752 100644 --- a/src/Network/BitTorrent/DHT/Message.hs +++ b/src/Network/BitTorrent/DHT/Message.hs @@ -30,7 +30,6 @@ module Network.BitTorrent.DHT.Message import Control.Applicative import Data.BEncode as BE import Data.BEncode.BDict -import Data.ByteString as BS import Data.List as L import Data.Monoid import Data.Serialize as S @@ -40,14 +39,13 @@ import Network.KRPC import Data.Torrent.InfoHash import Network.BitTorrent.Core +import Network.BitTorrent.DHT.Token import Network.KRPC () {----------------------------------------------------------------------- -- envelopes -----------------------------------------------------------------------} -type Token = ByteString - node_id_key :: BKey node_id_key = "id" diff --git a/src/Network/BitTorrent/DHT/Token.hs b/src/Network/BitTorrent/DHT/Token.hs new file mode 100644 index 00000000..6705f932 --- /dev/null +++ b/src/Network/BitTorrent/DHT/Token.hs @@ -0,0 +1,91 @@ +-- | The return value for a query for peers includes an opaque value +-- known as the \"token.\" For a node to announce that its controlling +-- peer is downloading a torrent, it must present the token received +-- from the same queried node in a recent query for peers. When a node +-- attempts to "announce" a torrent, the queried node checks the token +-- against the querying node's IP address. This is to prevent +-- malicious hosts from signing up other hosts for torrents. Since the +-- token is merely returned by the querying node to the same node it +-- received the token from, the implementation is not defined. Tokens +-- must be accepted for a reasonable amount of time after they have +-- been distributed. +-- +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Network.BitTorrent.DHT.Token + ( Token + , TokenMap + , Network.BitTorrent.DHT.Token.tokens + , Network.BitTorrent.DHT.Token.lookup + , Network.BitTorrent.DHT.Token.member + , Network.BitTorrent.DHT.Token.updateInterval + , Network.BitTorrent.DHT.Token.update + ) where + +import Control.Applicative +import Control.Monad.State +import Data.BEncode (BEncode) +import Data.ByteString as BS +import Data.ByteString.Lazy as BL +import Data.ByteString.Lazy.Builder as BS +import Data.Default +import Data.List as L +import Data.Hashable +import Data.String +import Data.Time +import System.Random + +import Network.BitTorrent.Core + + +type Secret = Int + +-- TODO use ShortByteString +newtype Token = Token BS.ByteString + deriving (Show, Eq, BEncode, IsString) + +-- | Meaningless token, for testsing purposes only. +instance Default Token where + def = Token "0xdeadbeef" + +-- The BitTorrent implementation uses the SHA1 hash of the IP address +-- concatenated onto a secret, we use hashable instead. +makeToken :: Hashable a => NodeAddr a -> Secret -> Token +makeToken n s = Token $ toBS $ hashWithSalt s n + where + toBS = toStrict . toLazyByteString . int64BE . fromIntegral + +-- | Constant space token map based on secret. +data TokenMap = TokenMap + { prevSecret :: {-# UNPACK #-} !Secret + , curSecret :: {-# UNPACK #-} !Secret + , generator :: {-# UNPACK #-} !StdGen + } deriving Show + +tokens :: Int -> TokenMap +tokens seed = (`evalState` mkStdGen seed) $ + TokenMap <$> state next + <*> state next + <*> get + +lookup :: Hashable a => NodeAddr a -> TokenMap -> Token +lookup addr TokenMap {..} = makeToken addr curSecret + +-- | If token is not set 'Network.KRPC.ProtocolError' should be sent +-- back. +member :: Hashable a => NodeAddr a -> Token -> TokenMap -> Bool +member addr token TokenMap {..} = token `L.elem` valid + where valid = makeToken addr <$> [curSecret, prevSecret] + +-- Secret changes every five minutes and tokens up to ten minutes old +-- are accepted. +updateInterval :: NominalDiffTime +updateInterval = 5 * 60 + +update :: TokenMap -> TokenMap +update TokenMap {..} = TokenMap + { prevSecret = curSecret + , curSecret = newSecret + , generator = newGen + } + where + (newSecret, newGen) = next generator \ No newline at end of file -- cgit v1.2.3