diff options
Diffstat (limited to 'src/Network/BitTorrent/DHT/Token.hs')
-rw-r--r-- | src/Network/BitTorrent/DHT/Token.hs | 55 |
1 files changed, 43 insertions, 12 deletions
diff --git a/src/Network/BitTorrent/DHT/Token.hs b/src/Network/BitTorrent/DHT/Token.hs index 51ee40d5..a38456fd 100644 --- a/src/Network/BitTorrent/DHT/Token.hs +++ b/src/Network/BitTorrent/DHT/Token.hs | |||
@@ -1,9 +1,16 @@ | |||
1 | -- | The return value for a query for peers includes an opaque value | 1 | -- | |
2 | -- known as the \"token.\" For a node to announce that its controlling | 2 | -- Copyright : (c) Sam Truzjan 2013 |
3 | -- License : BSD3 | ||
4 | -- Maintainer : pxqr.sta@gmail.com | ||
5 | -- Stability : experimental | ||
6 | -- Portability : portable | ||
7 | -- | ||
8 | -- The return value for a query for peers includes an opaque value | ||
9 | -- known as the 'Token'. For a node to announce that its controlling | ||
3 | -- peer is downloading a torrent, it must present the token received | 10 | -- peer is downloading a torrent, it must present the token received |
4 | -- from the same queried node in a recent query for peers. When a node | 11 | -- from the same queried node in a recent query for peers. When a node |
5 | -- attempts to "announce" a torrent, the queried node checks the token | 12 | -- attempts to \"announce\" a torrent, the queried node checks the |
6 | -- against the querying node's IP address. This is to prevent | 13 | -- token against the querying node's 'IP' address. This is to prevent |
7 | -- malicious hosts from signing up other hosts for torrents. Since the | 14 | -- malicious hosts from signing up other hosts for torrents. Since the |
8 | -- token is merely returned by the querying node to the same node it | 15 | -- token is merely returned by the querying node to the same node it |
9 | -- received the token from, the implementation is not defined. Tokens | 16 | -- received the token from, the implementation is not defined. Tokens |
@@ -12,11 +19,20 @@ | |||
12 | -- | 19 | -- |
13 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | 20 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} |
14 | module Network.BitTorrent.DHT.Token | 21 | module Network.BitTorrent.DHT.Token |
15 | ( Token | 22 | ( -- * Token |
23 | Token | ||
24 | |||
25 | -- * Session tokens | ||
16 | , TokenMap | 26 | , TokenMap |
27 | |||
28 | -- ** Construction | ||
17 | , Network.BitTorrent.DHT.Token.tokens | 29 | , Network.BitTorrent.DHT.Token.tokens |
30 | |||
31 | -- ** Query | ||
18 | , Network.BitTorrent.DHT.Token.lookup | 32 | , Network.BitTorrent.DHT.Token.lookup |
19 | , Network.BitTorrent.DHT.Token.member | 33 | , Network.BitTorrent.DHT.Token.member |
34 | |||
35 | -- ** Modification | ||
20 | , Network.BitTorrent.DHT.Token.defaultUpdateInterval | 36 | , Network.BitTorrent.DHT.Token.defaultUpdateInterval |
21 | , Network.BitTorrent.DHT.Token.update | 37 | , Network.BitTorrent.DHT.Token.update |
22 | ) where | 38 | ) where |
@@ -36,10 +52,9 @@ import System.Random | |||
36 | 52 | ||
37 | import Network.BitTorrent.Core | 53 | import Network.BitTorrent.Core |
38 | 54 | ||
39 | |||
40 | type Secret = Int | ||
41 | |||
42 | -- TODO use ShortByteString | 55 | -- TODO use ShortByteString |
56 | |||
57 | -- | An opaque value. | ||
43 | newtype Token = Token BS.ByteString | 58 | newtype Token = Token BS.ByteString |
44 | deriving (Show, Eq, BEncode, IsString) | 59 | deriving (Show, Eq, BEncode, IsString) |
45 | 60 | ||
@@ -47,6 +62,9 @@ newtype Token = Token BS.ByteString | |||
47 | instance Default Token where | 62 | instance Default Token where |
48 | def = Token "0xdeadbeef" | 63 | def = Token "0xdeadbeef" |
49 | 64 | ||
65 | -- | The secret value used as salt. | ||
66 | type Secret = Int | ||
67 | |||
50 | -- The BitTorrent implementation uses the SHA1 hash of the IP address | 68 | -- The BitTorrent implementation uses the SHA1 hash of the IP address |
51 | -- concatenated onto a secret, we use hashable instead. | 69 | -- concatenated onto a secret, we use hashable instead. |
52 | makeToken :: Hashable a => NodeAddr a -> Secret -> Token | 70 | makeToken :: Hashable a => NodeAddr a -> Secret -> Token |
@@ -54,33 +72,46 @@ makeToken n s = Token $ toBS $ hashWithSalt s n | |||
54 | where | 72 | where |
55 | toBS = toStrict . toLazyByteString . int64BE . fromIntegral | 73 | toBS = toStrict . toLazyByteString . int64BE . fromIntegral |
56 | 74 | ||
57 | -- | Constant space token map based on secret. | 75 | -- | Constant space 'Node' to 'Token' map based on the secret value. |
58 | data TokenMap = TokenMap | 76 | data TokenMap = TokenMap |
59 | { prevSecret :: {-# UNPACK #-} !Secret | 77 | { prevSecret :: {-# UNPACK #-} !Secret |
60 | , curSecret :: {-# UNPACK #-} !Secret | 78 | , curSecret :: {-# UNPACK #-} !Secret |
61 | , generator :: {-# UNPACK #-} !StdGen | 79 | , generator :: {-# UNPACK #-} !StdGen |
62 | } deriving Show | 80 | } deriving Show |
63 | 81 | ||
82 | -- | A new token map based on the specified seed value. Returned token | ||
83 | -- map should be periodicatically 'update'd. | ||
84 | -- | ||
85 | -- Normally, the seed value should vary between invocations of the | ||
86 | -- client software. | ||
64 | tokens :: Int -> TokenMap | 87 | tokens :: Int -> TokenMap |
65 | tokens seed = (`evalState` mkStdGen seed) $ | 88 | tokens seed = (`evalState` mkStdGen seed) $ |
66 | TokenMap <$> state next | 89 | TokenMap <$> state next |
67 | <*> state next | 90 | <*> state next |
68 | <*> get | 91 | <*> get |
69 | 92 | ||
93 | -- | Get token for the given node. A token becomes invalid after 2 | ||
94 | -- 'update's. | ||
95 | -- | ||
96 | -- Typically used to handle find_peers query. | ||
70 | lookup :: Hashable a => NodeAddr a -> TokenMap -> Token | 97 | lookup :: Hashable a => NodeAddr a -> TokenMap -> Token |
71 | lookup addr TokenMap {..} = makeToken addr curSecret | 98 | lookup addr TokenMap {..} = makeToken addr curSecret |
72 | 99 | ||
73 | -- | If token is not set 'Network.KRPC.ProtocolError' should be sent | 100 | -- | Check if token is valid. |
74 | -- back. | 101 | -- |
102 | -- Typically used to handle 'Network.BitTorrent.DHT.Message.Announce' | ||
103 | -- query. If token is invalid the 'Network.KRPC.ProtocolError' should | ||
104 | -- be sent back to the malicious node. | ||
75 | member :: Hashable a => NodeAddr a -> Token -> TokenMap -> Bool | 105 | member :: Hashable a => NodeAddr a -> Token -> TokenMap -> Bool |
76 | member addr token TokenMap {..} = token `L.elem` valid | 106 | member addr token TokenMap {..} = token `L.elem` valid |
77 | where valid = makeToken addr <$> [curSecret, prevSecret] | 107 | where valid = makeToken addr <$> [curSecret, prevSecret] |
78 | 108 | ||
79 | -- Secret changes every five minutes and tokens up to ten minutes old | 109 | -- | Secret changes every five minutes and tokens up to ten minutes old |
80 | -- are accepted. | 110 | -- are accepted. |
81 | defaultUpdateInterval :: NominalDiffTime | 111 | defaultUpdateInterval :: NominalDiffTime |
82 | defaultUpdateInterval = 5 * 60 | 112 | defaultUpdateInterval = 5 * 60 |
83 | 113 | ||
114 | -- | Update current tokens. | ||
84 | update :: TokenMap -> TokenMap | 115 | update :: TokenMap -> TokenMap |
85 | update TokenMap {..} = TokenMap | 116 | update TokenMap {..} = TokenMap |
86 | { prevSecret = curSecret | 117 | { prevSecret = curSecret |