summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Core
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/Core')
-rw-r--r--src/Network/BitTorrent/Core/Fingerprint.hs290
-rw-r--r--src/Network/BitTorrent/Core/NodeInfo.hs219
-rw-r--r--src/Network/BitTorrent/Core/PeerAddr.hs354
-rw-r--r--src/Network/BitTorrent/Core/PeerId.hs364
4 files changed, 0 insertions, 1227 deletions
diff --git a/src/Network/BitTorrent/Core/Fingerprint.hs b/src/Network/BitTorrent/Core/Fingerprint.hs
deleted file mode 100644
index d743acd0..00000000
--- a/src/Network/BitTorrent/Core/Fingerprint.hs
+++ /dev/null
@@ -1,290 +0,0 @@
1-- |
2-- Copyright : (c) Sam Truzjan 2013
3-- License : BSD3
4-- Maintainer : pxqr.sta@gmail.com
5-- Stability : experimental
6-- Portability : portable
7--
8-- 'Fingerprint' is used to identify the client implementation and
9-- version which also contained in 'Peer'. For exsample first 6
10-- bytes of peer id of this this library are @-HS0100-@ while for
11-- mainline we have @M4-3-6--@. We could extract this info and
12-- print in human-friendly form: this is useful for debugging and
13-- logging.
14--
15-- For more information see:
16-- <http://bittorrent.org/beps/bep_0020.html>
17--
18--
19-- NOTE: Do /not/ use this information to control client
20-- capabilities (such as supported enchancements), this should be
21-- done using 'Network.BitTorrent.Extension'!
22--
23{-# OPTIONS -fno-warn-orphans #-}
24module Network.BitTorrent.Core.Fingerprint
25 ( ClientImpl (..)
26 , Fingerprint (..)
27 , libFingerprint
28 , libUserAgent
29 ) where
30
31import Data.Default
32import Data.List as L
33import Data.List.Split as L
34import Data.Monoid
35import Data.String
36import Data.Version
37import Text.PrettyPrint hiding ((<>))
38import Text.PrettyPrint.Class
39import Text.Read (readMaybe)
40-- import Paths_bittorrent (version)
41
42-- TODO FIXME
43version :: Version
44version = Version [0, 0, 0, 3] []
45
46-- | List of registered client versions + 'IlibHSbittorrent' (this
47-- package) + 'IUnknown' (for not recognized software). All names are
48-- prefixed by \"I\" because some of them starts from lowercase letter
49-- but that is not a valid Haskell constructor name.
50--
51data ClientImpl =
52 IUnknown
53
54 | IMainline
55
56 | IABC
57 | IOspreyPermaseed
58 | IBTQueue
59 | ITribler
60 | IShadow
61 | IBitTornado
62
63-- UPnP(!) Bit Torrent !???
64-- 'U' - UPnP NAT Bit Torrent
65 | IBitLord
66 | IOpera
67 | IMLdonkey
68
69 | IAres
70 | IArctic
71 | IAvicora
72 | IBitPump
73 | IAzureus
74 | IBitBuddy
75 | IBitComet
76 | IBitflu
77 | IBTG
78 | IBitRocket
79 | IBTSlave
80 | IBittorrentX
81 | IEnhancedCTorrent
82 | ICTorrent
83 | IDelugeTorrent
84 | IPropagateDataClient
85 | IEBit
86 | IElectricSheep
87 | IFoxTorrent
88 | IGSTorrent
89 | IHalite
90 | IlibHSbittorrent
91 | IHydranode
92 | IKGet
93 | IKTorrent
94 | ILH_ABC
95 | ILphant
96 | ILibtorrent
97 | ILibTorrent
98 | ILimeWire
99 | IMonoTorrent
100 | IMooPolice
101 | IMiro
102 | IMoonlightTorrent
103 | INetTransport
104 | IPando
105 | IqBittorrent
106 | IQQDownload
107 | IQt4TorrentExample
108 | IRetriever
109 | IShareaza
110 | ISwiftbit
111 | ISwarmScope
112 | ISymTorrent
113 | Isharktorrent
114 | ITorrentDotNET
115 | ITransmission
116 | ITorrentstorm
117 | ITuoTu
118 | IuLeecher
119 | IuTorrent
120 | IVagaa
121 | IBitLet
122 | IFireTorrent
123 | IXunlei
124 | IXanTorrent
125 | IXtorrent
126 | IZipTorrent
127 deriving (Show, Eq, Ord, Enum, Bounded)
128
129-- | Used to represent a not recognized implementation
130instance Default ClientImpl where
131 def = IUnknown
132 {-# INLINE def #-}
133
134-- | Example: @\"BitLet\" == 'IBitLet'@
135instance IsString ClientImpl where
136 fromString str
137 | Just impl <- L.lookup str alist = impl
138 | otherwise = error $ "fromString: not recognized " ++ str
139 where
140 alist = L.map mk [minBound..maxBound]
141 mk x = (L.tail $ show x, x)
142
143-- | Example: @pretty 'IBitLet' == \"IBitLet\"@
144instance Pretty ClientImpl where
145 pretty = text . L.tail . show
146
147-- | Just the '0' version.
148instance Default Version where
149 def = Version [0] []
150 {-# INLINE def #-}
151
152-- | For dot delimited version strings.
153-- Example: @fromString \"0.1.0.2\" == Version [0, 1, 0, 2]@
154--
155instance IsString Version where
156 fromString str
157 | Just nums <- chunkNums str = Version nums []
158 | otherwise = error $ "fromString: invalid version string " ++ str
159 where
160 chunkNums = sequence . L.map readMaybe . L.linesBy ('.' ==)
161
162instance Pretty Version where
163 pretty = text . showVersion
164
165-- | The all sensible infomation that can be obtained from a peer
166-- identifier or torrent /createdBy/ field.
167data Fingerprint = Fingerprint
168 { ciImpl :: ClientImpl
169 , ciVersion :: Version
170 } deriving (Show, Eq, Ord)
171
172-- | Unrecognized client implementation.
173instance Default Fingerprint where
174 def = Fingerprint def def
175 {-# INLINE def #-}
176
177-- | Example: @\"BitComet-1.2\" == ClientInfo IBitComet (Version [1, 2] [])@
178instance IsString Fingerprint where
179 fromString str
180 | _ : ver <- _ver = Fingerprint (fromString impl) (fromString ver)
181 | otherwise = error $ "fromString: invalid client info string" ++ str
182 where
183 (impl, _ver) = L.span ((/=) '-') str
184
185instance Pretty Fingerprint where
186 pretty Fingerprint {..} = pretty ciImpl <+> "version" <+> pretty ciVersion
187
188-- | Fingerprint of this (the bittorrent library) package. Normally,
189-- applications should introduce its own fingerprints, otherwise they
190-- can use 'libFingerprint' value.
191--
192libFingerprint :: Fingerprint
193libFingerprint = Fingerprint IlibHSbittorrent version
194
195-- | HTTP user agent of this (the bittorrent library) package. Can be
196-- used in HTTP tracker requests.
197libUserAgent :: String
198libUserAgent = render (pretty IlibHSbittorrent <> "/" <> pretty version)
199
200{-----------------------------------------------------------------------
201-- For torrent file
202-----------------------------------------------------------------------}
203-- TODO collect information about createdBy torrent field
204{-
205renderImpl :: ClientImpl -> Text
206renderImpl = T.pack . L.tail . show
207
208renderVersion :: Version -> Text
209renderVersion = undefined
210
211renderClientInfo :: ClientInfo -> Text
212renderClientInfo ClientInfo {..} = renderImpl ciImpl <> "/" <> renderVersion ciVersion
213
214parseClientInfo :: Text -> ClientImpl
215parseClientInfo t = undefined
216-}
217{-
218-- code used for generation; remove it later on
219
220mkEnumTyDef :: NM -> String
221mkEnumTyDef = unlines . map (" | I" ++) . nub . map snd
222
223mkPars :: NM -> String
224mkPars = unlines . map (\(code, impl) -> " f \"" ++ code ++ "\" = " ++ "I" ++ impl)
225
226type NM = [(String, String)]
227nameMap :: NM
228nameMap =
229 [ ("AG", "Ares")
230 , ("A~", "Ares")
231 , ("AR", "Arctic")
232 , ("AV", "Avicora")
233 , ("AX", "BitPump")
234 , ("AZ", "Azureus")
235 , ("BB", "BitBuddy")
236 , ("BC", "BitComet")
237 , ("BF", "Bitflu")
238 , ("BG", "BTG")
239 , ("BR", "BitRocket")
240 , ("BS", "BTSlave")
241 , ("BX", "BittorrentX")
242 , ("CD", "EnhancedCTorrent")
243 , ("CT", "CTorrent")
244 , ("DE", "DelugeTorrent")
245 , ("DP", "PropagateDataClient")
246 , ("EB", "EBit")
247 , ("ES", "ElectricSheep")
248 , ("FT", "FoxTorrent")
249 , ("GS", "GSTorrent")
250 , ("HL", "Halite")
251 , ("HS", "libHSnetwork_bittorrent")
252 , ("HN", "Hydranode")
253 , ("KG", "KGet")
254 , ("KT", "KTorrent")
255 , ("LH", "LH_ABC")
256 , ("LP", "Lphant")
257 , ("LT", "Libtorrent")
258 , ("lt", "LibTorrent")
259 , ("LW", "LimeWire")
260 , ("MO", "MonoTorrent")
261 , ("MP", "MooPolice")
262 , ("MR", "Miro")
263 , ("MT", "MoonlightTorrent")
264 , ("NX", "NetTransport")
265 , ("PD", "Pando")
266 , ("qB", "qBittorrent")
267 , ("QD", "QQDownload")
268 , ("QT", "Qt4TorrentExample")
269 , ("RT", "Retriever")
270 , ("S~", "Shareaza")
271 , ("SB", "Swiftbit")
272 , ("SS", "SwarmScope")
273 , ("ST", "SymTorrent")
274 , ("st", "sharktorrent")
275 , ("SZ", "Shareaza")
276 , ("TN", "TorrentDotNET")
277 , ("TR", "Transmission")
278 , ("TS", "Torrentstorm")
279 , ("TT", "TuoTu")
280 , ("UL", "uLeecher")
281 , ("UT", "uTorrent")
282 , ("VG", "Vagaa")
283 , ("WT", "BitLet")
284 , ("WY", "FireTorrent")
285 , ("XL", "Xunlei")
286 , ("XT", "XanTorrent")
287 , ("XX", "Xtorrent")
288 , ("ZT", "ZipTorrent")
289 ]
290-}
diff --git a/src/Network/BitTorrent/Core/NodeInfo.hs b/src/Network/BitTorrent/Core/NodeInfo.hs
deleted file mode 100644
index fe17c097..00000000
--- a/src/Network/BitTorrent/Core/NodeInfo.hs
+++ /dev/null
@@ -1,219 +0,0 @@
1-- |
2-- Module : Network.BitTorrent.Core.Node
3-- Copyright : (c) Sam Truzjan 2013
4-- (c) Daniel Gröber 2013
5-- License : BSD3
6-- Maintainer : pxqr.sta@gmail.com
7-- Stability : experimental
8-- Portability : portable
9--
10-- A \"node\" is a client\/server listening on a UDP port
11-- implementing the distributed hash table protocol. The DHT is
12-- composed of nodes and stores the location of peers. BitTorrent
13-- clients include a DHT node, which is used to contact other nodes
14-- in the DHT to get the location of peers to download from using
15-- the BitTorrent protocol.
16--
17{-# LANGUAGE RecordWildCards #-}
18{-# LANGUAGE FlexibleInstances #-}
19{-# LANGUAGE TemplateHaskell #-}
20{-# LANGUAGE GeneralizedNewtypeDeriving #-}
21{-# LANGUAGE DeriveDataTypeable #-}
22{-# LANGUAGE DeriveFunctor #-}
23module Network.BitTorrent.Core.NodeInfo
24 ( -- * Node ID
25 NodeId
26 , testIdBit
27 , genNodeId
28
29 -- ** Node distance
30 , NodeDistance
31 , distance
32
33 -- * Node address
34 , NodeAddr (..)
35
36 -- * Node info
37 , NodeInfo (..)
38 , rank
39 ) where
40
41import Control.Applicative
42import Data.Bits
43import Data.ByteString as BS
44import Data.ByteString.Char8 as BC
45import Data.ByteString.Base16 as Base16
46import Data.BEncode as BE
47import Data.Default
48import Data.Hashable
49import Data.Foldable
50import Data.IP
51import Data.List as L
52import Data.Monoid
53import Data.Ord
54import Data.Serialize as S
55import Data.String
56import Data.Typeable
57import Data.Word
58import Network
59import System.Entropy
60import Text.PrettyPrint as PP hiding ((<>))
61import Text.PrettyPrint.Class
62
63import Network.BitTorrent.Core.PeerAddr (PeerAddr (..))
64
65{-----------------------------------------------------------------------
66-- Node id
67-----------------------------------------------------------------------}
68-- TODO more compact representation ('ShortByteString's?)
69
70-- | Each node has a globally unique identifier known as the \"node
71-- ID.\"
72--
73-- Normally, /this/ node id should be saved between invocations
74-- of the client software.
75newtype NodeId = NodeId ByteString
76 deriving (Show, Eq, Ord, BEncode, Typeable)
77
78nodeIdSize :: Int
79nodeIdSize = 20
80
81-- | Meaningless node id, for testing purposes only.
82instance Default NodeId where
83 def = NodeId (BS.replicate nodeIdSize 0)
84
85instance Serialize NodeId where
86 get = NodeId <$> getByteString nodeIdSize
87 {-# INLINE get #-}
88 put (NodeId bs) = putByteString bs
89 {-# INLINE put #-}
90
91-- | ASCII encoded.
92instance IsString NodeId where
93 fromString str
94 | L.length str == nodeIdSize = NodeId (fromString str)
95 | otherwise = error "fromString: invalid NodeId length"
96 {-# INLINE fromString #-}
97
98-- | base16 encoded.
99instance Pretty NodeId where
100 pretty (NodeId nid) = PP.text $ BC.unpack $ Base16.encode nid
101
102-- | Test if the nth bit is set.
103testIdBit :: NodeId -> Word -> Bool
104testIdBit (NodeId bs) i
105 | fromIntegral i < nodeIdSize * 8
106 , (q, r) <- quotRem (fromIntegral i) 8
107 = testBit (BS.index bs q) r
108 | otherwise = False
109{-# INLINE testIdBit #-}
110
111-- TODO WARN is the 'system' random suitable for this?
112-- | Generate random NodeID used for the entire session.
113-- Distribution of ID's should be as uniform as possible.
114--
115genNodeId :: IO NodeId
116genNodeId = NodeId <$> getEntropy nodeIdSize
117
118{-----------------------------------------------------------------------
119-- Node distance
120-----------------------------------------------------------------------}
121
122-- | In Kademlia, the distance metric is XOR and the result is
123-- interpreted as an unsigned integer.
124newtype NodeDistance = NodeDistance BS.ByteString
125 deriving (Eq, Ord)
126
127instance Pretty NodeDistance where
128 pretty (NodeDistance bs) = foldMap bitseq $ BS.unpack bs
129 where
130 listBits w = L.map (testBit w) (L.reverse [0..bitSize w - 1])
131 bitseq = foldMap (int . fromEnum) . listBits
132
133-- | distance(A,B) = |A xor B| Smaller values are closer.
134distance :: NodeId -> NodeId -> NodeDistance
135distance (NodeId a) (NodeId b) = NodeDistance (BS.pack (BS.zipWith xor a b))
136
137{-----------------------------------------------------------------------
138-- Node address
139-----------------------------------------------------------------------}
140
141data NodeAddr a = NodeAddr
142 { nodeHost :: !a
143 , nodePort :: {-# UNPACK #-} !PortNumber
144 } deriving (Eq, Typeable, Functor)
145
146instance Show a => Show (NodeAddr a) where
147 showsPrec i NodeAddr {..}
148 = showsPrec i nodeHost <> showString ":" <> showsPrec i nodePort
149
150instance Read (NodeAddr IPv4) where
151 readsPrec i x = [ (fromPeerAddr a, s) | (a, s) <- readsPrec i x ]
152
153-- | @127.0.0.1:6882@
154instance Default (NodeAddr IPv4) where
155 def = "127.0.0.1:6882"
156
157-- | KRPC compatible encoding.
158instance Serialize a => Serialize (NodeAddr a) where
159 get = NodeAddr <$> get <*> get
160 {-# INLINE get #-}
161 put NodeAddr {..} = put nodeHost >> put nodePort
162 {-# INLINE put #-}
163
164-- | Torrent file compatible encoding.
165instance BEncode a => BEncode (NodeAddr a) where
166 toBEncode NodeAddr {..} = toBEncode (nodeHost, nodePort)
167 {-# INLINE toBEncode #-}
168 fromBEncode b = uncurry NodeAddr <$> fromBEncode b
169 {-# INLINE fromBEncode #-}
170
171instance Hashable a => Hashable (NodeAddr a) where
172 hashWithSalt s NodeAddr {..} = hashWithSalt s (nodeHost, nodePort)
173 {-# INLINE hashWithSalt #-}
174
175instance Pretty ip => Pretty (NodeAddr ip) where
176 pretty NodeAddr {..} = pretty nodeHost <> ":" <> pretty nodePort
177
178-- | Example:
179--
180-- @nodePort \"127.0.0.1:6881\" == 6881@
181--
182instance IsString (NodeAddr IPv4) where
183 fromString = fromPeerAddr . fromString
184
185fromPeerAddr :: PeerAddr a -> NodeAddr a
186fromPeerAddr PeerAddr {..} = NodeAddr
187 { nodeHost = peerHost
188 , nodePort = peerPort
189 }
190
191{-----------------------------------------------------------------------
192-- Node info
193-----------------------------------------------------------------------}
194
195data NodeInfo a = NodeInfo
196 { nodeId :: !NodeId
197 , nodeAddr :: !(NodeAddr a)
198 } deriving (Show, Eq, Functor)
199
200instance Eq a => Ord (NodeInfo a) where
201 compare = comparing nodeId
202
203-- | KRPC 'compact list' compatible encoding: contact information for
204-- nodes is encoded as a 26-byte string. Also known as "Compact node
205-- info" the 20-byte Node ID in network byte order has the compact
206-- IP-address/port info concatenated to the end.
207instance Serialize a => Serialize (NodeInfo a) where
208 get = NodeInfo <$> get <*> get
209 put NodeInfo {..} = put nodeId >> put nodeAddr
210
211instance Pretty ip => Pretty (NodeInfo ip) where
212 pretty NodeInfo {..} = pretty nodeId <> "@(" <> pretty nodeAddr <> ")"
213
214instance Pretty ip => Pretty [NodeInfo ip] where
215 pretty = PP.vcat . PP.punctuate "," . L.map pretty
216
217-- | Order by closeness: nearest nodes first.
218rank :: Eq ip => NodeId -> [NodeInfo ip] -> [NodeInfo ip]
219rank nid = L.sortBy (comparing (distance nid . nodeId))
diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs
deleted file mode 100644
index 92fb83a7..00000000
--- a/src/Network/BitTorrent/Core/PeerAddr.hs
+++ /dev/null
@@ -1,354 +0,0 @@
1-- |
2-- Module : Network.BitTorrent.Core.PeerAddr
3-- Copyright : (c) Sam Truzjan 2013
4-- (c) Daniel Gröber 2013
5-- License : BSD3
6-- Maintainer : pxqr.sta@gmail.com
7-- Stability : provisional
8-- Portability : portable
9--
10-- 'PeerAddr' is used to represent peer address. Currently it's
11-- just peer IP and peer port but this might change in future.
12--
13{-# LANGUAGE TemplateHaskell #-}
14{-# LANGUAGE StandaloneDeriving #-}
15{-# LANGUAGE GeneralizedNewtypeDeriving #-}
16{-# LANGUAGE DeriveDataTypeable #-}
17{-# LANGUAGE FlexibleInstances #-}
18{-# LANGUAGE DeriveFunctor #-}
19{-# LANGUAGE ViewPatterns #-}
20{-# OPTIONS -fno-warn-orphans #-} -- for PortNumber instances
21module Network.BitTorrent.Core.PeerAddr
22 ( -- * Peer address
23 PeerAddr(..)
24 , defaultPorts
25 , peerSockAddr
26 , peerSocket
27
28 -- * Peer storage
29 , PeerStore
30 , Network.BitTorrent.Core.PeerAddr.lookup
31 , Network.BitTorrent.Core.PeerAddr.insert
32 ) where
33
34import Control.Applicative
35import Control.Monad
36import Data.BEncode as BS
37import Data.BEncode.BDict (BKey)
38import Data.ByteString.Char8 as BS8
39import Data.Char
40import Data.Default
41import Data.Hashable
42import Data.HashMap.Strict as HM
43import Data.IP
44import Data.List as L
45import Data.List.Split
46import Data.Maybe
47import Data.Monoid
48import Data.Serialize as S
49import Data.String
50import Data.Typeable
51import Data.Word
52import Network.Socket
53import Text.PrettyPrint as PP hiding ((<>))
54import Text.PrettyPrint.Class
55import Text.Read (readMaybe)
56import qualified Text.ParserCombinators.ReadP as RP
57
58import Data.Torrent.InfoHash
59import Network.BitTorrent.Core.PeerId
60
61
62{-----------------------------------------------------------------------
63-- Port number
64-----------------------------------------------------------------------}
65
66instance BEncode PortNumber where
67 toBEncode = toBEncode . fromEnum
68 fromBEncode = fromBEncode >=> portNumber
69 where
70 portNumber :: Integer -> BS.Result PortNumber
71 portNumber n
72 | 0 <= n && n <= fromIntegral (maxBound :: Word16)
73 = pure $ fromIntegral n
74 | otherwise = decodingError $ "PortNumber: " ++ show n
75
76instance Serialize PortNumber where
77 get = fromIntegral <$> getWord16be
78 {-# INLINE get #-}
79 put = putWord16be . fromIntegral
80 {-# INLINE put #-}
81
82instance Hashable PortNumber where
83 hashWithSalt s = hashWithSalt s . fromEnum
84 {-# INLINE hashWithSalt #-}
85
86instance Pretty PortNumber where
87 pretty = PP.int . fromEnum
88 {-# INLINE pretty #-}
89
90{-----------------------------------------------------------------------
91-- IP addr
92-----------------------------------------------------------------------}
93
94class IPAddress i where
95 toHostAddr :: i -> Either HostAddress HostAddress6
96
97instance IPAddress IPv4 where
98 toHostAddr = Left . toHostAddress
99 {-# INLINE toHostAddr #-}
100
101instance IPAddress IPv6 where
102 toHostAddr = Right . toHostAddress6
103 {-# INLINE toHostAddr #-}
104
105instance IPAddress IP where
106 toHostAddr (IPv4 ip) = toHostAddr ip
107 toHostAddr (IPv6 ip) = toHostAddr ip
108 {-# INLINE toHostAddr #-}
109
110deriving instance Typeable IP
111deriving instance Typeable IPv4
112deriving instance Typeable IPv6
113
114ipToBEncode :: Show i => i -> BValue
115ipToBEncode ip = BString $ BS8.pack $ show ip
116{-# INLINE ipToBEncode #-}
117
118ipFromBEncode :: Read a => BValue -> BS.Result a
119ipFromBEncode (BString (BS8.unpack -> ipStr))
120 | Just ip <- readMaybe (ipStr) = pure ip
121 | otherwise = decodingError $ "IP: " ++ ipStr
122ipFromBEncode _ = decodingError $ "IP: addr should be a bstring"
123
124instance BEncode IP where
125 toBEncode = ipToBEncode
126 {-# INLINE toBEncode #-}
127 fromBEncode = ipFromBEncode
128 {-# INLINE fromBEncode #-}
129
130instance BEncode IPv4 where
131 toBEncode = ipToBEncode
132 {-# INLINE toBEncode #-}
133 fromBEncode = ipFromBEncode
134 {-# INLINE fromBEncode #-}
135
136instance BEncode IPv6 where
137 toBEncode = ipToBEncode
138 {-# INLINE toBEncode #-}
139 fromBEncode = ipFromBEncode
140 {-# INLINE fromBEncode #-}
141
142-- | When 'get'ing an IP it must be 'isolate'd to the appropriate
143-- number of bytes since we have no other way of telling which
144-- address type we are trying to parse
145instance Serialize IP where
146 put (IPv4 ip) = put ip
147 put (IPv6 ip) = put ip
148
149 get = do
150 n <- remaining
151 case n of
152 4 -> IPv4 <$> get
153 16 -> IPv6 <$> get
154 _ -> fail "Wrong number of bytes remaining to parse IP"
155
156instance Serialize IPv4 where
157 put = putWord32host . toHostAddress
158 get = fromHostAddress <$> getWord32host
159
160instance Serialize IPv6 where
161 put ip = put $ toHostAddress6 ip
162 get = fromHostAddress6 <$> get
163
164instance Pretty IPv4 where
165 pretty = PP.text . show
166 {-# INLINE pretty #-}
167
168instance Pretty IPv6 where
169 pretty = PP.text . show
170 {-# INLINE pretty #-}
171
172instance Pretty IP where
173 pretty = PP.text . show
174 {-# INLINE pretty #-}
175
176instance Hashable IPv4 where
177 hashWithSalt = hashUsing toHostAddress
178 {-# INLINE hashWithSalt #-}
179
180instance Hashable IPv6 where
181 hashWithSalt s a = hashWithSalt s (toHostAddress6 a)
182
183instance Hashable IP where
184 hashWithSalt s (IPv4 h) = hashWithSalt s h
185 hashWithSalt s (IPv6 h) = hashWithSalt s h
186
187{-----------------------------------------------------------------------
188-- Peer addr
189-----------------------------------------------------------------------}
190-- TODO check semantic of ord and eq instances
191
192-- | Peer address info normally extracted from peer list or peer
193-- compact list encoding.
194data PeerAddr a = PeerAddr
195 { peerId :: !(Maybe PeerId)
196
197 -- | This is usually 'IPv4', 'IPv6', 'IP' or unresolved
198 -- 'HostName'.
199 , peerHost :: !a
200
201 -- | The port the peer listenning for incoming P2P sessions.
202 , peerPort :: {-# UNPACK #-} !PortNumber
203 } deriving (Show, Eq, Ord, Typeable, Functor)
204
205peer_ip_key, peer_id_key, peer_port_key :: BKey
206peer_ip_key = "ip"
207peer_id_key = "peer id"
208peer_port_key = "port"
209
210-- | The tracker's 'announce response' compatible encoding.
211instance (Typeable a, BEncode a) => BEncode (PeerAddr a) where
212 toBEncode PeerAddr {..} = toDict $
213 peer_ip_key .=! peerHost
214 .: peer_id_key .=? peerId
215 .: peer_port_key .=! peerPort
216 .: endDict
217
218 fromBEncode = fromDict $ do
219 peerAddr <$>! peer_ip_key
220 <*>? peer_id_key
221 <*>! peer_port_key
222 where
223 peerAddr = flip PeerAddr
224
225-- | The tracker's 'compact peer list' compatible encoding. The
226-- 'peerId' is always 'Nothing'.
227--
228-- For more info see: <http://www.bittorrent.org/beps/bep_0023.html>
229--
230-- TODO: test byte order
231instance (Serialize a) => Serialize (PeerAddr a) where
232 put PeerAddr {..} = put peerHost >> put peerPort
233 get = PeerAddr Nothing <$> get <*> get
234
235-- | @127.0.0.1:6881@
236instance Default (PeerAddr IPv4) where
237 def = "127.0.0.1:6881"
238
239-- | @127.0.0.1:6881@
240instance Default (PeerAddr IP) where
241 def = IPv4 <$> def
242
243-- | Example:
244--
245-- @peerPort \"127.0.0.1:6881\" == 6881@
246--
247instance IsString (PeerAddr IPv4) where
248 fromString str
249 | [hostAddrStr, portStr] <- splitWhen (== ':') str
250 , Just hostAddr <- readMaybe hostAddrStr
251 , Just portNum <- toEnum <$> readMaybe portStr
252 = PeerAddr Nothing hostAddr portNum
253 | otherwise = error $ "fromString: unable to parse (PeerAddr IPv4): " ++ str
254
255instance Read (PeerAddr IPv4) where
256 readsPrec i = RP.readP_to_S $ do
257 ipv4 <- RP.readS_to_P (readsPrec i)
258 _ <- RP.char ':'
259 port <- toEnum <$> RP.readS_to_P (readsPrec i)
260 return $ PeerAddr Nothing ipv4 port
261
262readsIPv6_port :: String -> [((IPv6, PortNumber), String)]
263readsIPv6_port = RP.readP_to_S $ do
264 ip <- RP.char '[' *> (RP.readS_to_P reads) <* RP.char ']'
265 _ <- RP.char ':'
266 port <- toEnum <$> read <$> (RP.many1 $ RP.satisfy isDigit) <* RP.eof
267 return (ip,port)
268
269instance IsString (PeerAddr IPv6) where
270 fromString str
271 | [((ip,port),"")] <- readsIPv6_port str =
272 PeerAddr Nothing ip port
273 | otherwise = error $ "fromString: unable to parse (PeerAddr IPv6): " ++ str
274
275instance IsString (PeerAddr IP) where
276 fromString str
277 | '[' `L.elem` str = IPv6 <$> fromString str
278 | otherwise = IPv4 <$> fromString str
279
280-- | fingerprint + "at" + dotted.host.inet.addr:port
281-- TODO: instances for IPv6, HostName
282instance Pretty a => Pretty (PeerAddr a) where
283 pretty PeerAddr {..}
284 | Just pid <- peerId = pretty (fingerprint pid) <+> "at" <+> paddr
285 | otherwise = paddr
286 where
287 paddr = pretty peerHost <> ":" <> text (show peerPort)
288
289instance Hashable a => Hashable (PeerAddr a) where
290 hashWithSalt s PeerAddr {..} =
291 s `hashWithSalt` peerId `hashWithSalt` peerHost `hashWithSalt` peerPort
292
293-- | Ports typically reserved for bittorrent P2P listener.
294defaultPorts :: [PortNumber]
295defaultPorts = [6881..6889]
296
297_resolvePeerAddr :: (IPAddress i) => PeerAddr HostName -> PeerAddr i
298_resolvePeerAddr = undefined
299
300_peerSockAddr :: PeerAddr IP -> (Family, SockAddr)
301_peerSockAddr PeerAddr {..} =
302 case peerHost of
303 IPv4 ipv4 ->
304 (AF_INET, SockAddrInet peerPort (toHostAddress ipv4))
305 IPv6 ipv6 ->
306 (AF_INET6, SockAddrInet6 peerPort 0 (toHostAddress6 ipv6) 0)
307
308peerSockAddr :: PeerAddr IP -> SockAddr
309peerSockAddr = snd . _peerSockAddr
310
311-- | Create a socket connected to the address specified in a peerAddr
312peerSocket :: SocketType -> PeerAddr IP -> IO Socket
313peerSocket socketType pa = do
314 let (family, addr) = _peerSockAddr pa
315 sock <- socket family socketType defaultProtocol
316 connect sock addr
317 return sock
318
319{-----------------------------------------------------------------------
320-- Peer storage
321-----------------------------------------------------------------------}
322-- TODO use more memory efficient representation
323
324-- | Storage used to keep track a set of known peers in client,
325-- tracker or DHT sessions.
326newtype PeerStore ip = PeerStore (HashMap InfoHash [PeerAddr ip])
327
328-- | Empty store.
329instance Default (PeerStore a) where
330 def = PeerStore HM.empty
331 {-# INLINE def #-}
332
333-- | Monoid under union operation.
334instance Eq a => Monoid (PeerStore a) where
335 mempty = def
336 {-# INLINE mempty #-}
337
338 mappend (PeerStore a) (PeerStore b) =
339 PeerStore (HM.unionWith L.union a b)
340 {-# INLINE mappend #-}
341
342-- | Can be used to store peers between invocations of the client
343-- software.
344instance Serialize (PeerStore a) where
345 get = undefined
346 put = undefined
347
348-- | Used in 'get_peers' DHT queries.
349lookup :: InfoHash -> PeerStore a -> [PeerAddr a]
350lookup ih (PeerStore m) = fromMaybe [] $ HM.lookup ih m
351
352-- | Used in 'announce_peer' DHT queries.
353insert :: Eq a => InfoHash -> PeerAddr a -> PeerStore a -> PeerStore a
354insert ih a (PeerStore m) = PeerStore (HM.insertWith L.union ih [a] m)
diff --git a/src/Network/BitTorrent/Core/PeerId.hs b/src/Network/BitTorrent/Core/PeerId.hs
deleted file mode 100644
index a180ff30..00000000
--- a/src/Network/BitTorrent/Core/PeerId.hs
+++ /dev/null
@@ -1,364 +0,0 @@
1-- |
2-- Copyright : (c) Sam Truzjan 2013
3-- License : BSD3
4-- Maintainer : pxqr.sta@gmail.com
5-- Stability : experimental
6-- Portability : portable
7--
8-- 'PeerID' represent self assigned peer identificator. Ideally each
9-- host in the network should have unique peer id to avoid
10-- collisions, therefore for peer ID generation we use good entropy
11-- source. Peer ID is sent in /tracker request/, sent and received in
12-- /peer handshakes/ and used in DHT queries.
13--
14{-# LANGUAGE GeneralizedNewtypeDeriving #-}
15{-# LANGUAGE MultiParamTypeClasses #-}
16{-# LANGUAGE DeriveDataTypeable #-}
17module Network.BitTorrent.Core.PeerId
18 ( -- * PeerId
19 PeerId
20
21 -- * Generation
22 , genPeerId
23 , timestamp
24 , entropy
25
26 -- * Encoding
27 , azureusStyle
28 , shadowStyle
29 , defaultClientId
30 , defaultVersionNumber
31
32 -- * Decoding
33 , fingerprint
34 ) where
35
36import Control.Applicative
37import Data.BEncode as BE
38import Data.ByteString as BS
39import Data.ByteString.Internal as BS
40import Data.ByteString.Char8 as BC
41import qualified Data.ByteString.Lazy as BL
42import qualified Data.ByteString.Lazy.Builder as BS
43import Data.Convertible
44import Data.Default
45import Data.Foldable (foldMap)
46import Data.List as L
47import Data.List.Split as L
48import Data.Maybe (fromMaybe, catMaybes)
49import Data.Monoid
50import Data.Hashable
51import Data.Serialize as S
52import Data.String
53import Data.Time.Clock (getCurrentTime)
54import Data.Time.Format (formatTime)
55import Data.Typeable
56import Data.Version (Version(Version), versionBranch)
57import Network.HTTP.Types.QueryLike
58import System.Entropy (getEntropy)
59import System.Locale (defaultTimeLocale)
60import Text.PrettyPrint hiding ((<>))
61import Text.PrettyPrint.Class
62import Text.Read (readMaybe)
63
64import Network.BitTorrent.Core.Fingerprint
65
66-- TODO use unpacked Word160 form (length is known statically)
67
68-- | Peer identifier is exactly 20 bytes long bytestring.
69newtype PeerId = PeerId { getPeerId :: ByteString }
70 deriving (Show, Eq, Ord, BEncode, Typeable)
71
72peerIdLen :: Int
73peerIdLen = 20
74
75-- | For testing purposes only.
76instance Default PeerId where
77 def = azureusStyle defaultClientId defaultVersionNumber ""
78
79instance Hashable PeerId where
80 hashWithSalt = hashUsing getPeerId
81 {-# INLINE hashWithSalt #-}
82
83instance Serialize PeerId where
84 put = putByteString . getPeerId
85 get = PeerId <$> getBytes peerIdLen
86
87instance QueryValueLike PeerId where
88 toQueryValue (PeerId pid) = Just pid
89 {-# INLINE toQueryValue #-}
90
91instance IsString PeerId where
92 fromString str
93 | BS.length bs == peerIdLen = PeerId bs
94 | otherwise = error $ "Peer id should be 20 bytes long: " ++ show str
95 where
96 bs = fromString str
97
98instance Pretty PeerId where
99 pretty = text . BC.unpack . getPeerId
100
101instance Convertible BS.ByteString PeerId where
102 safeConvert bs
103 | BS.length bs == peerIdLen = pure (PeerId bs)
104 | otherwise = convError "invalid length" bs
105
106{-----------------------------------------------------------------------
107-- Encoding
108-----------------------------------------------------------------------}
109
110-- | Pad bytestring so it's becomes exactly request length. Conversion
111-- is done like so:
112--
113-- * length < size: Complete bytestring by given charaters.
114--
115-- * length = size: Output bytestring as is.
116--
117-- * length > size: Drop last (length - size) charaters from a
118-- given bytestring.
119--
120byteStringPadded :: ByteString -- ^ bytestring to be padded.
121 -> Int -- ^ size of result builder.
122 -> Char -- ^ character used for padding.
123 -> BS.Builder
124byteStringPadded bs s c =
125 BS.byteString (BS.take s bs) <>
126 BS.byteString (BC.replicate padLen c)
127 where
128 padLen = s - min (BS.length bs) s
129
130-- | Azureus-style encoding have the following layout:
131--
132-- * 1 byte : '-'
133--
134-- * 2 bytes: client id
135--
136-- * 4 bytes: version number
137--
138-- * 1 byte : '-'
139--
140-- * 12 bytes: random number
141--
142azureusStyle :: ByteString -- ^ 2 character client ID, padded with 'H'.
143 -> ByteString -- ^ Version number, padded with 'X'.
144 -> ByteString -- ^ Random number, padded with '0'.
145 -> PeerId -- ^ Azureus-style encoded peer ID.
146azureusStyle cid ver rnd = PeerId $ BL.toStrict $ BS.toLazyByteString $
147 BS.char8 '-' <>
148 byteStringPadded cid 2 'H' <>
149 byteStringPadded ver 4 'X' <>
150 BS.char8 '-' <>
151 byteStringPadded rnd 12 '0'
152
153-- | Shadow-style encoding have the following layout:
154--
155-- * 1 byte : client id.
156--
157-- * 0-4 bytes: version number. If less than 4 then padded with
158-- '-' char.
159--
160-- * 15 bytes : random number. If length is less than 15 then
161-- padded with '0' char.
162--
163shadowStyle :: Char -- ^ Client ID.
164 -> ByteString -- ^ Version number.
165 -> ByteString -- ^ Random number.
166 -> PeerId -- ^ Shadow style encoded peer ID.
167shadowStyle cid ver rnd = PeerId $ BL.toStrict $ BS.toLazyByteString $
168 BS.char8 cid <>
169 byteStringPadded ver 4 '-' <>
170 byteStringPadded rnd 15 '0'
171
172
173-- | 'HS'- 2 bytes long client identifier.
174defaultClientId :: ByteString
175defaultClientId = "HS"
176
177-- | Gives exactly 4 bytes long version number for any version of the
178-- package. Version is taken from .cabal file.
179defaultVersionNumber :: ByteString
180defaultVersionNumber = BS.take 4 $ BC.pack $ foldMap show $
181 versionBranch $ ciVersion libFingerprint
182
183{-----------------------------------------------------------------------
184-- Generation
185-----------------------------------------------------------------------}
186
187-- | Gives 15 characters long decimal timestamp such that:
188--
189-- * 6 bytes : first 6 characters from picoseconds obtained with %q.
190--
191-- * 1 byte : character \'.\' for readability.
192--
193-- * 9..* bytes: number of whole seconds since the Unix epoch
194-- (!)REVERSED.
195--
196-- Can be used both with shadow and azureus style encoding. This
197-- format is used to make the ID's readable for debugging purposes.
198--
199timestamp :: IO ByteString
200timestamp = (BC.pack . format) <$> getCurrentTime
201 where
202 format t = L.take 6 (formatTime defaultTimeLocale "%q" t) ++ "." ++
203 L.take 9 (L.reverse (formatTime defaultTimeLocale "%s" t))
204
205-- | Gives 15 character long random bytestring. This is more robust
206-- method for generation of random part of peer ID than 'timestamp'.
207entropy :: IO ByteString
208entropy = getEntropy 15
209
210-- NOTE: entropy generates incorrrect peer id
211
212-- | Here we use 'azureusStyle' encoding with the following args:
213--
214-- * 'HS' for the client id; ('defaultClientId')
215--
216-- * Version of the package for the version number;
217-- ('defaultVersionNumber')
218--
219-- * UTC time day ++ day time for the random number. ('timestamp')
220--
221genPeerId :: IO PeerId
222genPeerId = azureusStyle defaultClientId defaultVersionNumber <$> timestamp
223
224{-----------------------------------------------------------------------
225-- Decoding
226-----------------------------------------------------------------------}
227
228parseImpl :: ByteString -> ClientImpl
229parseImpl = f . BC.unpack
230 where
231 f "AG" = IAres
232 f "A~" = IAres
233 f "AR" = IArctic
234 f "AV" = IAvicora
235 f "AX" = IBitPump
236 f "AZ" = IAzureus
237 f "BB" = IBitBuddy
238 f "BC" = IBitComet
239 f "BF" = IBitflu
240 f "BG" = IBTG
241 f "BR" = IBitRocket
242 f "BS" = IBTSlave
243 f "BX" = IBittorrentX
244 f "CD" = IEnhancedCTorrent
245 f "CT" = ICTorrent
246 f "DE" = IDelugeTorrent
247 f "DP" = IPropagateDataClient
248 f "EB" = IEBit
249 f "ES" = IElectricSheep
250 f "FT" = IFoxTorrent
251 f "GS" = IGSTorrent
252 f "HL" = IHalite
253 f "HS" = IlibHSbittorrent
254 f "HN" = IHydranode
255 f "KG" = IKGet
256 f "KT" = IKTorrent
257 f "LH" = ILH_ABC
258 f "LP" = ILphant
259 f "LT" = ILibtorrent
260 f "lt" = ILibTorrent
261 f "LW" = ILimeWire
262 f "MO" = IMonoTorrent
263 f "MP" = IMooPolice
264 f "MR" = IMiro
265 f "ML" = IMLdonkey
266 f "MT" = IMoonlightTorrent
267 f "NX" = INetTransport
268 f "PD" = IPando
269 f "qB" = IqBittorrent
270 f "QD" = IQQDownload
271 f "QT" = IQt4TorrentExample
272 f "RT" = IRetriever
273 f "S~" = IShareaza
274 f "SB" = ISwiftbit
275 f "SS" = ISwarmScope
276 f "ST" = ISymTorrent
277 f "st" = Isharktorrent
278 f "SZ" = IShareaza
279 f "TN" = ITorrentDotNET
280 f "TR" = ITransmission
281 f "TS" = ITorrentstorm
282 f "TT" = ITuoTu
283 f "UL" = IuLeecher
284 f "UT" = IuTorrent
285 f "VG" = IVagaa
286 f "WT" = IBitLet
287 f "WY" = IFireTorrent
288 f "XL" = IXunlei
289 f "XT" = IXanTorrent
290 f "XX" = IXtorrent
291 f "ZT" = IZipTorrent
292 f _ = IUnknown
293
294-- TODO use regexps
295
296-- | Tries to extract meaningful information from peer ID bytes. If
297-- peer id uses unknown coding style then client info returned is
298-- 'def'.
299--
300fingerprint :: PeerId -> Fingerprint
301fingerprint pid = either (const def) id $ runGet getCI (getPeerId pid)
302 where
303 getCI = do
304 leading <- BS.w2c <$> getWord8
305 case leading of
306 '-' -> Fingerprint <$> getAzureusImpl <*> getAzureusVersion
307 'M' -> Fingerprint <$> pure IMainline <*> getMainlineVersion
308 'e' -> Fingerprint <$> getBitCometImpl <*> getBitCometVersion
309 'F' -> Fingerprint <$> getBitCometImpl <*> getBitCometVersion
310 c -> do
311 c1 <- w2c <$> S.lookAhead getWord8
312 if c1 == 'P'
313 then do
314 _ <- getWord8
315 Fingerprint <$> pure IOpera <*> getOperaVersion
316 else Fingerprint <$> pure (getShadowImpl c) <*> getShadowVersion
317
318 getMainlineVersion = do
319 str <- BC.unpack <$> getByteString 7
320 let mnums = L.filter (not . L.null) $ L.linesBy ('-' ==) str
321 return $ Version (fromMaybe [] $ sequence $ L.map readMaybe mnums) []
322
323 getAzureusImpl = parseImpl <$> getByteString 2
324 getAzureusVersion = mkVer <$> getByteString 4
325 where
326 mkVer bs = Version [fromMaybe 0 $ readMaybe $ BC.unpack bs] []
327
328 getBitCometImpl = do
329 bs <- getByteString 3
330 S.lookAhead $ do
331 _ <- getByteString 2
332 lr <- getByteString 4
333 return $
334 if lr == "LORD" then IBitLord else
335 if bs == "UTB" then IBitComet else
336 if bs == "xbc" then IBitComet else def
337
338 getBitCometVersion = do
339 x <- getWord8
340 y <- getWord8
341 return $ Version [fromIntegral x, fromIntegral y] []
342
343 getOperaVersion = do
344 str <- BC.unpack <$> getByteString 4
345 return $ Version [fromMaybe 0 $ readMaybe str] []
346
347 getShadowImpl 'A' = IABC
348 getShadowImpl 'O' = IOspreyPermaseed
349 getShadowImpl 'Q' = IBTQueue
350 getShadowImpl 'R' = ITribler
351 getShadowImpl 'S' = IShadow
352 getShadowImpl 'T' = IBitTornado
353 getShadowImpl _ = IUnknown
354
355 decodeShadowVerNr :: Char -> Maybe Int
356 decodeShadowVerNr c
357 | '0' < c && c <= '9' = Just (fromEnum c - fromEnum '0')
358 | 'A' < c && c <= 'Z' = Just ((fromEnum c - fromEnum 'A') + 10)
359 | 'a' < c && c <= 'z' = Just ((fromEnum c - fromEnum 'a') + 36)
360 | otherwise = Nothing
361
362 getShadowVersion = do
363 str <- BC.unpack <$> getByteString 5
364 return $ Version (catMaybes $ L.map decodeShadowVerNr str) []
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 20:05:44 +0000