diff options
-rw-r--r-- | bittorrent.cabal | 2 | ||||
-rw-r--r-- | src/Network/BitTorrent/DHT.hs | 7 | ||||
-rw-r--r-- | src/Network/BitTorrent/Peer.hs | 24 |
3 files changed, 19 insertions, 14 deletions
diff --git a/bittorrent.cabal b/bittorrent.cabal index 345e8018..22c2794a 100644 --- a/bittorrent.cabal +++ b/bittorrent.cabal | |||
@@ -43,6 +43,7 @@ library | |||
43 | , Network.BitTorrent.Peer | 43 | , Network.BitTorrent.Peer |
44 | , Network.BitTorrent.Tracker | 44 | , Network.BitTorrent.Tracker |
45 | , Network.BitTorrent.Exchange | 45 | , Network.BitTorrent.Exchange |
46 | , Network.BitTorrent.DHT | ||
46 | , System.Torrent.Storage | 47 | , System.Torrent.Storage |
47 | Network.BitTorrent.Internal | 48 | Network.BitTorrent.Internal |
48 | other-modules: | 49 | other-modules: |
@@ -108,6 +109,7 @@ library | |||
108 | , filepath >= 1 | 109 | , filepath >= 1 |
109 | , directory >= 1 | 110 | , directory >= 1 |
110 | , mmap >= 0.5.2 | 111 | , mmap >= 0.5.2 |
112 | , entropy | ||
111 | 113 | ||
112 | -- Hash | 114 | -- Hash |
113 | , cryptohash | 115 | , cryptohash |
diff --git a/src/Network/BitTorrent/DHT.hs b/src/Network/BitTorrent/DHT.hs index 3be7cfa0..2e8164bd 100644 --- a/src/Network/BitTorrent/DHT.hs +++ b/src/Network/BitTorrent/DHT.hs | |||
@@ -23,14 +23,13 @@ import Data.Maybe | |||
23 | import Data.List as L | 23 | import Data.List as L |
24 | import Data.Map as M | 24 | import Data.Map as M |
25 | import Data.HashMap.Strict as HM | 25 | import Data.HashMap.Strict as HM |
26 | |||
27 | import Network | 26 | import Network |
28 | import Network.Socket | 27 | import Network.Socket |
29 | import Remote.KRPC | 28 | import System.Entropy |
30 | 29 | ||
30 | import Remote.KRPC | ||
31 | import Data.BEncode | 31 | import Data.BEncode |
32 | import Data.Torrent | 32 | import Data.Torrent |
33 | import Data.Kademlia.Routing.Table | ||
34 | import Network.BitTorrent.Peer | 33 | import Network.BitTorrent.Peer |
35 | 34 | ||
36 | {----------------------------------------------------------------------- | 35 | {----------------------------------------------------------------------- |
@@ -44,7 +43,7 @@ type NodeId = ByteString | |||
44 | -- Distribution of ID's should be as uniform as possible. | 43 | -- Distribution of ID's should be as uniform as possible. |
45 | -- | 44 | -- |
46 | genNodeID :: IO NodeId | 45 | genNodeID :: IO NodeId |
47 | genNodeID = undefined -- randomIO | 46 | genNodeID = getEntropy 20 |
48 | 47 | ||
49 | instance Serialize PortNumber where | 48 | instance Serialize PortNumber where |
50 | get = fromIntegral <$> getWord16be | 49 | get = fromIntegral <$> getWord16be |
diff --git a/src/Network/BitTorrent/Peer.hs b/src/Network/BitTorrent/Peer.hs index 97c9f57f..cdcd65ea 100644 --- a/src/Network/BitTorrent/Peer.hs +++ b/src/Network/BitTorrent/Peer.hs | |||
@@ -43,7 +43,8 @@ module Network.BitTorrent.Peer | |||
43 | , defaultClientId, defaultVersionNumber | 43 | , defaultClientId, defaultVersionNumber |
44 | 44 | ||
45 | -- ** Generation | 45 | -- ** Generation |
46 | , genPeerId, timestampByteString | 46 | , genPeerId |
47 | , timestamp, entropy | ||
47 | 48 | ||
48 | -- ** Extra | 49 | -- ** Extra |
49 | , byteStringPadded | 50 | , byteStringPadded |
@@ -68,8 +69,6 @@ module Network.BitTorrent.Peer | |||
68 | 69 | ||
69 | 70 | ||
70 | import Control.Applicative | 71 | import Control.Applicative |
71 | import Control.Concurrent | ||
72 | import Control.Exception | ||
73 | import Data.BEncode | 72 | import Data.BEncode |
74 | import Data.Bits | 73 | import Data.Bits |
75 | import Data.Word | 74 | import Data.Word |
@@ -87,15 +86,16 @@ import Data.Time.Clock (getCurrentTime) | |||
87 | import Data.Time.Format (formatTime) | 86 | import Data.Time.Format (formatTime) |
88 | import Text.PrettyPrint (text, Doc, (<+>)) | 87 | import Text.PrettyPrint (text, Doc, (<+>)) |
89 | import System.Locale (defaultTimeLocale) | 88 | import System.Locale (defaultTimeLocale) |
90 | 89 | import System.Entropy (getEntropy) | |
91 | import Network hiding (accept) | 90 | import Network hiding (accept) |
92 | import Network.Socket | 91 | import Network.Socket |
93 | 92 | ||
94 | 93 | ||
95 | 94 | -- TODO we have linker error here, so manually hardcoded version for a | |
96 | -- TODO we have linker error here, so manual hardcoded version for a | ||
97 | -- while. | 95 | -- while. |
96 | |||
98 | -- import Paths_network_bittorrent (version) | 97 | -- import Paths_network_bittorrent (version) |
98 | |||
99 | version :: Version | 99 | version :: Version |
100 | version = Version [0, 10, 0, 0] [] | 100 | version = Version [0, 10, 0, 0] [] |
101 | 101 | ||
@@ -185,12 +185,17 @@ defaultVersionNumber = B.take 4 $ BC.pack $ foldMap show $ | |||
185 | -- format is used to make the ID's readable(for debugging) and more | 185 | -- format is used to make the ID's readable(for debugging) and more |
186 | -- or less random. | 186 | -- or less random. |
187 | -- | 187 | -- |
188 | timestampByteString :: IO ByteString | 188 | timestamp :: IO ByteString |
189 | timestampByteString = (BC.pack . format) <$> getCurrentTime | 189 | timestamp = (BC.pack . format) <$> getCurrentTime |
190 | where | 190 | where |
191 | format t = take 6 (formatTime defaultTimeLocale "%q" t) ++ "." ++ | 191 | format t = take 6 (formatTime defaultTimeLocale "%q" t) ++ "." ++ |
192 | take 9 (reverse (formatTime defaultTimeLocale "%s" t)) | 192 | take 9 (reverse (formatTime defaultTimeLocale "%s" t)) |
193 | 193 | ||
194 | -- | Gives 15 character long random bytestring. This is more robust | ||
195 | -- method for generation of random part of peer ID than timestamp. | ||
196 | entropy :: IO ByteString | ||
197 | entropy = getEntropy 15 | ||
198 | |||
194 | -- | Here we use Azureus-style encoding with the following args: | 199 | -- | Here we use Azureus-style encoding with the following args: |
195 | -- | 200 | -- |
196 | -- * 'HS' for the client id. | 201 | -- * 'HS' for the client id. |
@@ -200,8 +205,7 @@ timestampByteString = (BC.pack . format) <$> getCurrentTime | |||
200 | -- * UTC time day ++ day time for the random number. | 205 | -- * UTC time day ++ day time for the random number. |
201 | -- | 206 | -- |
202 | genPeerId :: IO PeerId | 207 | genPeerId :: IO PeerId |
203 | genPeerId = azureusStyle defaultClientId defaultVersionNumber | 208 | genPeerId = azureusStyle defaultClientId defaultVersionNumber <$> entropy |
204 | <$> timestampByteString | ||
205 | 209 | ||
206 | -- | Pad bytestring so it's becomes exactly request length. Conversion | 210 | -- | Pad bytestring so it's becomes exactly request length. Conversion |
207 | -- is done like so: | 211 | -- is done like so: |