summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r--src/Network/BitTorrent/Peer.hs532
-rw-r--r--src/Network/BitTorrent/Peer/Addr.hs83
-rw-r--r--src/Network/BitTorrent/Peer/ClientInfo.hs289
-rw-r--r--src/Network/BitTorrent/Peer/ID.hs168
-rw-r--r--src/Network/BitTorrent/PeerWire/Handshake.hs4
-rw-r--r--src/Network/BitTorrent/PeerWire/Status.hs (renamed from src/Network/BitTorrent/Peer/Status.hs)0
6 files changed, 528 insertions, 548 deletions
diff --git a/src/Network/BitTorrent/Peer.hs b/src/Network/BitTorrent/Peer.hs
index 660f146f..f4502f8b 100644
--- a/src/Network/BitTorrent/Peer.hs
+++ b/src/Network/BitTorrent/Peer.hs
@@ -5,13 +5,533 @@
5-- Stability : experimental 5-- Stability : experimental
6-- Portability : non-portable 6-- Portability : non-portable
7-- 7--
8-- Just convenient reexports for peer related modules. 8-- This modules provides three datatypes related to a peer as a host:
9-- 9--
10-- * 'PeerID' represent self assigned peer identificator. Ideally
11-- each host in the network should have unique peer id to avoid
12-- collisions, therefor for peer ID generation we use good entropy
13-- source. (FIX not really) Peer ID is sent in /tracker request/,
14-- sent and received in /peer handshakes/ and used in /distributed
15-- hash table/ queries.
16--
17-- * 'PeerAddr' is used to represent peer location. Currently it's
18-- just peer IP and peer port but this might be changed later.
19--
20-- * 'ClientInfo' is used to identify the client implementation and
21-- version which also contained in 'Peer'. For exsample first
22-- 6 bytes of peer id of this this library are @-HS0100-@ while
23-- for mainline we have @M4-3-6--@.
24-- We could extract this info and print in human frienly form: this
25-- is useful for debugging and logging. For more information see:
26-- <http://bittorrent.org/beps/bep_0020.html>
27-- NOTE: Do _not_ use this information to control client
28-- capabilities (such as supported enchancements), this should be
29-- done using 'Network.BitTorrent.Extension'!
30--
31{-# LANGUAGE OverloadedStrings #-}
32{-# LANGUAGE GeneralizedNewtypeDeriving #-}
33{-# LANGUAGE RecordWildCards #-}
34{-# OPTIONS -fno-warn-orphans #-}
10module Network.BitTorrent.Peer 35module Network.BitTorrent.Peer
11 ( module P 36 ( -- * Peer identificators
37 PeerID (getPeerID), ppPeerID
38
39 -- ** Encoding styles
40 , azureusStyle, shadowStyle
41
42 -- ** Defaults
43 , defaultClientID, defaultVersionNumber
44
45 -- ** Generation
46 , newPeerID, timestampByteString
47 -- ** Extra
48 , byteStringPadded
49
50 -- * Peer address
51 , PeerAddr(..)
52 , peerSockAddr, connectToPeer
53 , ppPeer
54
55 -- * Client version detection
56 -- ** Info
57 , ClientInfo(..), clientInfo, ppClientInfo, unknownClient
58
59 -- ** Version
60 , ClientVersion, ppClientVersion
61
62 -- ** Implementation
63 , ClientImpl(..), ppClientImpl
64
12 ) where 65 ) where
13 66
14import Network.BitTorrent.Peer.Addr as P 67
15import Network.BitTorrent.Peer.ClientInfo as P 68import Control.Applicative
16import Network.BitTorrent.Peer.ID as P 69import Data.BEncode
17import Network.BitTorrent.Peer.Status as P \ No newline at end of file 70import Data.Bits
71import Data.Word
72import Data.ByteString (ByteString)
73import qualified Data.ByteString as B
74import qualified Data.ByteString.Char8 as BC
75import qualified Data.ByteString.Lazy as BL
76import qualified Data.ByteString.Builder as B
77import Data.Foldable (foldMap)
78import Data.Monoid ((<>))
79import Data.Serialize
80import Data.URLEncoded
81import Data.Version (Version(Version), versionBranch)
82import Data.Time.Clock (getCurrentTime)
83import Data.Time.Format (formatTime)
84import Text.PrettyPrint (text, Doc, (<+>))
85import System.Locale (defaultTimeLocale)
86
87import Network
88import Network.Socket
89
90
91
92-- TODO we have linker error here, so manual hardcoded version for a while.
93-- import Paths_network_bittorrent (version)
94version :: Version
95version = Version [0, 10, 0, 0] []
96
97{-----------------------------------------------------------------------
98 Peer identification
99-----------------------------------------------------------------------}
100
101-- | Peer identifier is exactly 20 bytes long bytestring.
102newtype PeerID = PeerID { getPeerID :: ByteString }
103 deriving (Show, Eq, Ord, BEncodable)
104
105instance Serialize PeerID where
106 put = putByteString . getPeerID
107 get = PeerID <$> getBytes 20
108
109instance URLShow PeerID where
110 urlShow = BC.unpack . getPeerID
111
112ppPeerID :: PeerID -> Doc
113ppPeerID = text . BC.unpack . getPeerID
114
115
116-- | Azureus-style encoding have the following layout:
117--
118-- * 1 byte : '-'
119--
120-- * 2 bytes: client id
121--
122-- * 4 bytes: version number
123--
124-- * 1 byte : '-'
125--
126-- * 12 bytes: random number
127--
128azureusStyle :: ByteString -- ^ 2 character client ID, padded with 'H'.
129 -> ByteString -- ^ Version number, padded with 'X'.
130 -> ByteString -- ^ Random number, padded with '0'.
131 -> PeerID -- ^ Azureus-style encoded peer ID.
132azureusStyle cid ver rnd = PeerID $ BL.toStrict $ B.toLazyByteString $
133 B.char8 '-' <>
134 byteStringPadded cid 2 'H' <>
135 byteStringPadded ver 4 'X' <>
136 B.char8 '-' <>
137 byteStringPadded rnd 12 '0'
138
139-- | Shadow-style encoding have the following layout:
140--
141-- * 1 byte : client id.
142--
143-- * 0-4 bytes: version number. If less than 4 then padded with
144-- '-' char.
145--
146-- * 15 bytes : random number. If length is less than 15 then
147-- padded with '0' char.
148--
149shadowStyle :: Char -- ^ Client ID.
150 -> ByteString -- ^ Version number.
151 -> ByteString -- ^ Random number.
152 -> PeerID -- ^ Shadow style encoded peer ID.
153shadowStyle cid ver rnd = PeerID $ BL.toStrict $ B.toLazyByteString $
154 B.char8 cid <>
155 byteStringPadded ver 4 '-' <>
156 byteStringPadded rnd 15 '0'
157
158
159-- | "HS" - 2 bytes long client identifier.
160defaultClientID :: ByteString
161defaultClientID = "HS"
162
163-- | Gives exactly 4 bytes long version number for any version of the
164-- package. Version is taken from .cabal.
165defaultVersionNumber :: ByteString
166defaultVersionNumber = B.take 4 $ BC.pack $ foldMap show $
167 versionBranch version
168
169-- | Gives 15 characters long decimal timestamp such that:
170--
171-- * 6 bytes : first 6 characters from picoseconds obtained with %q.
172--
173-- * 1 bytes : character '.' for readability.
174--
175-- * 9..* bytes: number of whole seconds since the Unix epoch
176-- (!)REVERSED.
177--
178-- Can be used both with shadow and azureus style encoding. This
179-- format is used to make the ID's readable(for debugging) and more
180-- or less random.
181--
182timestampByteString :: IO ByteString
183timestampByteString = (BC.pack . format) <$> getCurrentTime
184 where
185 format t = take 6 (formatTime defaultTimeLocale "%q" t) ++ "." ++
186 take 9 (reverse (formatTime defaultTimeLocale "%s" t))
187
188-- | Here we use Azureus-style encoding with the following args:
189--
190-- * 'HS' for the client id.
191--
192-- * Version of the package for the version number
193--
194-- * UTC time day ++ day time for the random number.
195--
196newPeerID :: IO PeerID
197newPeerID = azureusStyle defaultClientID defaultVersionNumber
198 <$> timestampByteString
199
200-- | Pad bytestring so it's becomes exactly request length. Conversion
201-- is done like so:
202--
203-- * length < size: Complete bytestring by given charaters.
204--
205-- * length = size: Output bytestring as is.
206--
207-- * length > size: Drop last (length - size) charaters from a
208-- given bytestring.
209--
210byteStringPadded :: ByteString -- ^ bytestring to be padded.
211 -> Int -- ^ size of result builder.
212 -> Char -- ^ character used for padding.
213 -> B.Builder
214byteStringPadded bs s c =
215 B.byteString (B.take s bs) <>
216 B.byteString (BC.replicate padLen c)
217 where
218 padLen = s - min (B.length bs) s
219
220
221{-----------------------------------------------------------------------
222 Client detection
223-----------------------------------------------------------------------}
224
225-- | All known client versions.
226data ClientImpl =
227 IUnknown
228 | IAres
229 | IArctic
230 | IAvicora
231 | IBitPump
232 | IAzureus
233 | IBitBuddy
234 | IBitComet
235 | IBitflu
236 | IBTG
237 | IBitRocket
238 | IBTSlave
239 | IBittorrentX
240 | IEnhancedCTorrent
241 | ICTorrent
242 | IDelugeTorrent
243 | IPropagateDataClient
244 | IEBit
245 | IElectricSheep
246 | IFoxTorrent
247 | IGSTorrent
248 | IHalite
249 | IlibHSbittorrent
250 | IHydranode
251 | IKGet
252 | IKTorrent
253 | ILH_ABC
254 | ILphant
255 | ILibtorrent
256 | ILibTorrent
257 | ILimeWire
258 | IMonoTorrent
259 | IMooPolice
260 | IMiro
261 | IMoonlightTorrent
262 | INetTransport
263 | IPando
264 | IqBittorrent
265 | IQQDownload
266 | IQt4TorrentExample
267 | IRetriever
268 | IShareaza
269 | ISwiftbit
270 | ISwarmScope
271 | ISymTorrent
272 | Isharktorrent
273 | ITorrentDotNET
274 | ITransmission
275 | ITorrentstorm
276 | ITuoTu
277 | IuLeecher
278 | IuTorrent
279 | IVagaa
280 | IBitLet
281 | IFireTorrent
282 | IXunlei
283 | IXanTorrent
284 | IXtorrent
285 | IZipTorrent
286 deriving (Show, Eq, Ord)
287
288parseImpl :: ByteString -> ClientImpl
289parseImpl = f . BC.unpack
290 where
291 f "AG" = IAres
292 f "A~" = IAres
293 f "AR" = IArctic
294 f "AV" = IAvicora
295 f "AX" = IBitPump
296 f "AZ" = IAzureus
297 f "BB" = IBitBuddy
298 f "BC" = IBitComet
299 f "BF" = IBitflu
300 f "BG" = IBTG
301 f "BR" = IBitRocket
302 f "BS" = IBTSlave
303 f "BX" = IBittorrentX
304 f "CD" = IEnhancedCTorrent
305 f "CT" = ICTorrent
306 f "DE" = IDelugeTorrent
307 f "DP" = IPropagateDataClient
308 f "EB" = IEBit
309 f "ES" = IElectricSheep
310 f "FT" = IFoxTorrent
311 f "GS" = IGSTorrent
312 f "HL" = IHalite
313 f "HS" = IlibHSbittorrent
314 f "HN" = IHydranode
315 f "KG" = IKGet
316 f "KT" = IKTorrent
317 f "LH" = ILH_ABC
318 f "LP" = ILphant
319 f "LT" = ILibtorrent
320 f "lt" = ILibTorrent
321 f "LW" = ILimeWire
322 f "MO" = IMonoTorrent
323 f "MP" = IMooPolice
324 f "MR" = IMiro
325 f "MT" = IMoonlightTorrent
326 f "NX" = INetTransport
327 f "PD" = IPando
328 f "qB" = IqBittorrent
329 f "QD" = IQQDownload
330 f "QT" = IQt4TorrentExample
331 f "RT" = IRetriever
332 f "S~" = IShareaza
333 f "SB" = ISwiftbit
334 f "SS" = ISwarmScope
335 f "ST" = ISymTorrent
336 f "st" = Isharktorrent
337 f "SZ" = IShareaza
338 f "TN" = ITorrentDotNET
339 f "TR" = ITransmission
340 f "TS" = ITorrentstorm
341 f "TT" = ITuoTu
342 f "UL" = IuLeecher
343 f "UT" = IuTorrent
344 f "VG" = IVagaa
345 f "WT" = IBitLet
346 f "WY" = IFireTorrent
347 f "XL" = IXunlei
348 f "XT" = IXanTorrent
349 f "XX" = IXtorrent
350 f "ZT" = IZipTorrent
351 f _ = IUnknown
352
353-- | Format client implementation info in human readable form.
354ppClientImpl :: ClientImpl -> Doc
355ppClientImpl = text . tail . show
356
357unknownImpl :: ClientImpl
358unknownImpl = IUnknown
359
360
361
362type ClientVersion = ByteString
363
364-- | Format client implementation version in human readable form.
365ppClientVersion :: ClientVersion -> Doc
366ppClientVersion = text . BC.unpack
367
368unknownVersion :: ClientVersion
369unknownVersion = "0000"
370
371
372-- | All useful infomation that can be obtained from a peer
373-- identifier.
374data ClientInfo = ClientInfo {
375 ciImpl :: ClientImpl
376 , ciVersion :: ClientVersion
377 } deriving (Show, Eq, Ord)
378
379-- | Format client implementation in human readable form.
380ppClientInfo :: ClientInfo -> Doc
381ppClientInfo ClientInfo {..} =
382 ppClientImpl ciImpl <+> "version" <+> ppClientVersion ciVersion
383
384
385-- | Unrecognized client implementation.
386unknownClient :: ClientInfo
387unknownClient = ClientInfo unknownImpl unknownVersion
388
389-- | Tries to extract meaningful information from peer ID bytes. If
390-- peer id uses unknown coding style then client info returned is
391-- 'unknownClient'.
392--
393clientInfo :: PeerID -> ClientInfo
394clientInfo pid = either (const unknownClient) id $ runGet getCI (getPeerID pid)
395 where -- TODO other styles
396 getCI = do
397 _ <- getWord8
398 ClientInfo <$> (parseImpl <$> getByteString 2) <*> getByteString 4
399
400
401{-
402-- code used for generation; remove it later on
403
404mkEnumTyDef :: NM -> String
405mkEnumTyDef = unlines . map (" | I" ++) . nub . map snd
406
407mkPars :: NM -> String
408mkPars = unlines . map (\(code, impl) -> " f \"" ++ code ++ "\" = " ++ "I" ++ impl)
409
410type NM = [(String, String)]
411nameMap :: NM
412nameMap =
413 [ ("AG", "Ares")
414 , ("A~", "Ares")
415 , ("AR", "Arctic")
416 , ("AV", "Avicora")
417 , ("AX", "BitPump")
418 , ("AZ", "Azureus")
419 , ("BB", "BitBuddy")
420 , ("BC", "BitComet")
421 , ("BF", "Bitflu")
422 , ("BG", "BTG")
423 , ("BR", "BitRocket")
424 , ("BS", "BTSlave")
425 , ("BX", "BittorrentX")
426 , ("CD", "EnhancedCTorrent")
427 , ("CT", "CTorrent")
428 , ("DE", "DelugeTorrent")
429 , ("DP", "PropagateDataClient")
430 , ("EB", "EBit")
431 , ("ES", "ElectricSheep")
432 , ("FT", "FoxTorrent")
433 , ("GS", "GSTorrent")
434 , ("HL", "Halite")
435 , ("HS", "libHSnetwork_bittorrent")
436 , ("HN", "Hydranode")
437 , ("KG", "KGet")
438 , ("KT", "KTorrent")
439 , ("LH", "LH_ABC")
440 , ("LP", "Lphant")
441 , ("LT", "Libtorrent")
442 , ("lt", "LibTorrent")
443 , ("LW", "LimeWire")
444 , ("MO", "MonoTorrent")
445 , ("MP", "MooPolice")
446 , ("MR", "Miro")
447 , ("MT", "MoonlightTorrent")
448 , ("NX", "NetTransport")
449 , ("PD", "Pando")
450 , ("qB", "qBittorrent")
451 , ("QD", "QQDownload")
452 , ("QT", "Qt4TorrentExample")
453 , ("RT", "Retriever")
454 , ("S~", "Shareaza")
455 , ("SB", "Swiftbit")
456 , ("SS", "SwarmScope")
457 , ("ST", "SymTorrent")
458 , ("st", "sharktorrent")
459 , ("SZ", "Shareaza")
460 , ("TN", "TorrentDotNET")
461 , ("TR", "Transmission")
462 , ("TS", "Torrentstorm")
463 , ("TT", "TuoTu")
464 , ("UL", "uLeecher")
465 , ("UT", "uTorrent")
466 , ("VG", "Vagaa")
467 , ("WT", "BitLet")
468 , ("WY", "FireTorrent")
469 , ("XL", "Xunlei")
470 , ("XT", "XanTorrent")
471 , ("XX", "Xtorrent")
472 , ("ZT", "ZipTorrent")
473 ]
474-}
475
476{-----------------------------------------------------------------------
477 Peer address
478-----------------------------------------------------------------------}
479
480
481data PeerAddr = PeerAddr {
482 peerID :: Maybe PeerID
483 , peerIP :: HostAddress
484 , peerPort :: PortNumber
485 } deriving (Show, Eq)
486
487instance BEncodable PortNumber where
488 toBEncode = toBEncode . fromEnum
489 fromBEncode b = toEnum <$> fromBEncode b
490
491instance BEncodable PeerAddr where
492 toBEncode (PeerAddr pid pip pport) = fromAssocs
493 [ "peer id" -->? pid
494 , "ip" --> pip
495 , "port" --> pport
496 ]
497
498 fromBEncode (BDict d) =
499 PeerAddr <$> d >--? "peer id"
500 <*> d >-- "ip"
501 <*> d >-- "port"
502
503 fromBEncode _ = decodingError "PeerAddr"
504
505
506-- TODO make platform independent, clarify htonl
507
508-- | Convert peer info from tracker response to socket address. Used
509-- for establish connection between peers.
510--
511peerSockAddr :: PeerAddr -> SockAddr
512peerSockAddr = SockAddrInet <$> (g . peerPort) <*> (htonl . peerIP)
513 where
514 htonl :: Word32 -> Word32
515 htonl d =
516 ((d .&. 0xff) `shiftL` 24) .|.
517 (((d `shiftR` 8 ) .&. 0xff) `shiftL` 16) .|.
518 (((d `shiftR` 16) .&. 0xff) `shiftL` 8) .|.
519 ((d `shiftR` 24) .&. 0xff)
520
521 g :: PortNumber -> PortNumber
522 g = id
523
524-- | Tries to connect to peer using reasonable default parameters.
525connectToPeer :: PeerAddr -> IO Socket
526connectToPeer p = do
527 sock <- socket AF_INET Stream Network.Socket.defaultProtocol
528 connect sock (peerSockAddr p)
529 return sock
530
531-- | Pretty print peer address in human readable form.
532ppPeer :: PeerAddr -> Doc
533ppPeer p @ PeerAddr {..} = case peerID of
534 Just pid -> ppClientInfo (clientInfo pid) <+> "at" <+> paddr
535 Nothing -> paddr
536 where
537 paddr = text (show (peerSockAddr p))
diff --git a/src/Network/BitTorrent/Peer/Addr.hs b/src/Network/BitTorrent/Peer/Addr.hs
deleted file mode 100644
index 5c05180a..00000000
--- a/src/Network/BitTorrent/Peer/Addr.hs
+++ /dev/null
@@ -1,83 +0,0 @@
1-- |
2-- Copyright : (c) Sam T. 2013
3-- License : MIT
4-- Maintainer : pxqr.sta@gmail.com
5-- Stability : experimental
6-- Portability : non-portable
7--
8{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE RecordWildCards #-}
10{-# OPTIONS -fno-warn-orphans #-}
11module Network.BitTorrent.Peer.Addr
12 ( PeerAddr(..)
13 , peerSockAddr, connectToPeer
14 , ppPeer
15 ) where
16
17import Control.Applicative
18import Data.BEncode
19import Data.Bits
20import Data.Word
21import Text.PrettyPrint
22import Network
23import Network.Socket
24
25import Network.BitTorrent.Peer.ID
26import Network.BitTorrent.Peer.ClientInfo
27
28
29data PeerAddr = PeerAddr {
30 peerID :: Maybe PeerID
31 , peerIP :: HostAddress
32 , peerPort :: PortNumber
33 } deriving (Show, Eq)
34
35instance BEncodable PortNumber where
36 toBEncode = toBEncode . fromEnum
37 fromBEncode b = toEnum <$> fromBEncode b
38
39instance BEncodable PeerAddr where
40 toBEncode (PeerAddr pid pip pport) = fromAssocs
41 [ "peer id" -->? pid
42 , "ip" --> pip
43 , "port" --> pport
44 ]
45
46 fromBEncode (BDict d) =
47 PeerAddr <$> d >--? "peer id"
48 <*> d >-- "ip"
49 <*> d >-- "port"
50
51 fromBEncode _ = decodingError "PeerAddr"
52
53
54-- TODO make platform independent, clarify htonl
55-- | Convert peer info from tracker response to socket address.
56-- Used for establish connection between peers.
57--
58peerSockAddr :: PeerAddr -> SockAddr
59peerSockAddr = SockAddrInet <$> (g . peerPort) <*> (htonl . peerIP)
60 where
61 htonl :: Word32 -> Word32
62 htonl d =
63 ((d .&. 0xff) `shiftL` 24) .|.
64 (((d `shiftR` 8 ) .&. 0xff) `shiftL` 16) .|.
65 (((d `shiftR` 16) .&. 0xff) `shiftL` 8) .|.
66 ((d `shiftR` 24) .&. 0xff)
67
68 g :: PortNumber -> PortNumber
69 g = id
70
71-- | Tries to connect to peer using reasonable default parameters.
72connectToPeer :: PeerAddr -> IO Socket
73connectToPeer p = do
74 sock <- socket AF_INET Stream Network.Socket.defaultProtocol
75 connect sock (peerSockAddr p)
76 return sock
77
78ppPeer :: PeerAddr -> Doc
79ppPeer p @ PeerAddr {..} = case peerID of
80 Just pid -> ppClientInfo (clientInfo pid) <+> "at" <+> paddr
81 Nothing -> paddr
82 where
83 paddr = text (show (peerSockAddr p))
diff --git a/src/Network/BitTorrent/Peer/ClientInfo.hs b/src/Network/BitTorrent/Peer/ClientInfo.hs
deleted file mode 100644
index 7200471a..00000000
--- a/src/Network/BitTorrent/Peer/ClientInfo.hs
+++ /dev/null
@@ -1,289 +0,0 @@
1-- |
2-- Copyright : (c) Sam T. 2013
3-- License : MIT
4-- Maintainer : pxqr.sta@gmail.com
5-- Stability : experimental
6-- Portability : portable
7--
8-- This module detect client information such as version and
9-- implementation that can be later printed in human frienly
10-- form. Useful for debugging and logging.
11--
12-- See <http://bittorrent.org/beps/bep_0020.html> for more
13-- information.
14--
15{-# LANGUAGE OverloadedStrings #-}
16{-# LANGUAGE RecordWildCards #-}
17module Network.BitTorrent.Peer.ClientInfo
18 ( -- * Info
19 ClientInfo(..), clientInfo, ppClientInfo, unknownClient
20
21 -- * Version
22 , ClientVersion, ppClientVersion
23
24 -- * Implementation
25 , ClientImpl(..), ppClientImpl
26
27-- , mkEnumTyDef, mkPars, nameMap
28 ) where
29
30import Control.Applicative
31--import Data.List
32import Data.ByteString (ByteString)
33import qualified Data.ByteString.Char8 as BC
34import Data.Serialize.Get
35import Text.PrettyPrint
36
37import Network.BitTorrent.Peer.ID
38
39
40-- | All known client versions.
41data ClientImpl =
42 IUnknown
43 | IAres
44 | IArctic
45 | IAvicora
46 | IBitPump
47 | IAzureus
48 | IBitBuddy
49 | IBitComet
50 | IBitflu
51 | IBTG
52 | IBitRocket
53 | IBTSlave
54 | IBittorrentX
55 | IEnhancedCTorrent
56 | ICTorrent
57 | IDelugeTorrent
58 | IPropagateDataClient
59 | IEBit
60 | IElectricSheep
61 | IFoxTorrent
62 | IGSTorrent
63 | IHalite
64 | IlibHSbittorrent
65 | IHydranode
66 | IKGet
67 | IKTorrent
68 | ILH_ABC
69 | ILphant
70 | ILibtorrent
71 | ILibTorrent
72 | ILimeWire
73 | IMonoTorrent
74 | IMooPolice
75 | IMiro
76 | IMoonlightTorrent
77 | INetTransport
78 | IPando
79 | IqBittorrent
80 | IQQDownload
81 | IQt4TorrentExample
82 | IRetriever
83 | IShareaza
84 | ISwiftbit
85 | ISwarmScope
86 | ISymTorrent
87 | Isharktorrent
88 | ITorrentDotNET
89 | ITransmission
90 | ITorrentstorm
91 | ITuoTu
92 | IuLeecher
93 | IuTorrent
94 | IVagaa
95 | IBitLet
96 | IFireTorrent
97 | IXunlei
98 | IXanTorrent
99 | IXtorrent
100 | IZipTorrent
101 deriving (Show, Eq, Ord)
102
103parseImpl :: ByteString -> ClientImpl
104parseImpl = f . BC.unpack
105 where
106 f "AG" = IAres
107 f "A~" = IAres
108 f "AR" = IArctic
109 f "AV" = IAvicora
110 f "AX" = IBitPump
111 f "AZ" = IAzureus
112 f "BB" = IBitBuddy
113 f "BC" = IBitComet
114 f "BF" = IBitflu
115 f "BG" = IBTG
116 f "BR" = IBitRocket
117 f "BS" = IBTSlave
118 f "BX" = IBittorrentX
119 f "CD" = IEnhancedCTorrent
120 f "CT" = ICTorrent
121 f "DE" = IDelugeTorrent
122 f "DP" = IPropagateDataClient
123 f "EB" = IEBit
124 f "ES" = IElectricSheep
125 f "FT" = IFoxTorrent
126 f "GS" = IGSTorrent
127 f "HL" = IHalite
128 f "HS" = IlibHSbittorrent
129 f "HN" = IHydranode
130 f "KG" = IKGet
131 f "KT" = IKTorrent
132 f "LH" = ILH_ABC
133 f "LP" = ILphant
134 f "LT" = ILibtorrent
135 f "lt" = ILibTorrent
136 f "LW" = ILimeWire
137 f "MO" = IMonoTorrent
138 f "MP" = IMooPolice
139 f "MR" = IMiro
140 f "MT" = IMoonlightTorrent
141 f "NX" = INetTransport
142 f "PD" = IPando
143 f "qB" = IqBittorrent
144 f "QD" = IQQDownload
145 f "QT" = IQt4TorrentExample
146 f "RT" = IRetriever
147 f "S~" = IShareaza
148 f "SB" = ISwiftbit
149 f "SS" = ISwarmScope
150 f "ST" = ISymTorrent
151 f "st" = Isharktorrent
152 f "SZ" = IShareaza
153 f "TN" = ITorrentDotNET
154 f "TR" = ITransmission
155 f "TS" = ITorrentstorm
156 f "TT" = ITuoTu
157 f "UL" = IuLeecher
158 f "UT" = IuTorrent
159 f "VG" = IVagaa
160 f "WT" = IBitLet
161 f "WY" = IFireTorrent
162 f "XL" = IXunlei
163 f "XT" = IXanTorrent
164 f "XX" = IXtorrent
165 f "ZT" = IZipTorrent
166 f _ = IUnknown
167
168-- | Format client implementation info in human readable form.
169ppClientImpl :: ClientImpl -> Doc
170ppClientImpl = text . tail . show
171
172unknownImpl :: ClientImpl
173unknownImpl = IUnknown
174
175
176
177type ClientVersion = ByteString
178
179-- | Format client implementation version in human readable form.
180ppClientVersion :: ClientVersion -> Doc
181ppClientVersion = text . BC.unpack
182
183unknownVersion :: ClientVersion
184unknownVersion = "0000"
185
186
187-- | All useful infomation that can be obtained from a peer
188-- identifier.
189data ClientInfo = ClientInfo {
190 ciImpl :: ClientImpl
191 , ciVersion :: ClientVersion
192 } deriving (Show, Eq, Ord)
193
194-- | Format client implementation in human readable form.
195ppClientInfo :: ClientInfo -> Doc
196ppClientInfo ClientInfo {..} =
197 ppClientImpl ciImpl <+> "version" <+> ppClientVersion ciVersion
198
199
200-- | Unrecognized client implementation.
201unknownClient :: ClientInfo
202unknownClient = ClientInfo unknownImpl unknownVersion
203
204-- | Tries to extract meaningful information from peer ID bytes. If
205-- peer id uses unknown coding style then client info returned is
206-- 'unknownClient'.
207--
208clientInfo :: PeerID -> ClientInfo
209clientInfo pid = either (const unknownClient) id $ runGet getCI (getPeerID pid)
210 where -- TODO other styles
211 getCI = do
212 _ <- getWord8
213 ClientInfo <$> (parseImpl <$> getByteString 2) <*> getByteString 4
214
215
216{-
217-- code used for generation; remove it later on
218
219mkEnumTyDef :: NM -> String
220mkEnumTyDef = unlines . map (" | I" ++) . nub . map snd
221
222mkPars :: NM -> String
223mkPars = unlines . map (\(code, impl) -> " f \"" ++ code ++ "\" = " ++ "I" ++ impl)
224
225type NM = [(String, String)]
226nameMap :: NM
227nameMap =
228 [ ("AG", "Ares")
229 , ("A~", "Ares")
230 , ("AR", "Arctic")
231 , ("AV", "Avicora")
232 , ("AX", "BitPump")
233 , ("AZ", "Azureus")
234 , ("BB", "BitBuddy")
235 , ("BC", "BitComet")
236 , ("BF", "Bitflu")
237 , ("BG", "BTG")
238 , ("BR", "BitRocket")
239 , ("BS", "BTSlave")
240 , ("BX", "BittorrentX")
241 , ("CD", "EnhancedCTorrent")
242 , ("CT", "CTorrent")
243 , ("DE", "DelugeTorrent")
244 , ("DP", "PropagateDataClient")
245 , ("EB", "EBit")
246 , ("ES", "ElectricSheep")
247 , ("FT", "FoxTorrent")
248 , ("GS", "GSTorrent")
249 , ("HL", "Halite")
250 , ("HS", "libHSnetwork_bittorrent")
251 , ("HN", "Hydranode")
252 , ("KG", "KGet")
253 , ("KT", "KTorrent")
254 , ("LH", "LH_ABC")
255 , ("LP", "Lphant")
256 , ("LT", "Libtorrent")
257 , ("lt", "LibTorrent")
258 , ("LW", "LimeWire")
259 , ("MO", "MonoTorrent")
260 , ("MP", "MooPolice")
261 , ("MR", "Miro")
262 , ("MT", "MoonlightTorrent")
263 , ("NX", "NetTransport")
264 , ("PD", "Pando")
265 , ("qB", "qBittorrent")
266 , ("QD", "QQDownload")
267 , ("QT", "Qt4TorrentExample")
268 , ("RT", "Retriever")
269 , ("S~", "Shareaza")
270 , ("SB", "Swiftbit")
271 , ("SS", "SwarmScope")
272 , ("ST", "SymTorrent")
273 , ("st", "sharktorrent")
274 , ("SZ", "Shareaza")
275 , ("TN", "TorrentDotNET")
276 , ("TR", "Transmission")
277 , ("TS", "Torrentstorm")
278 , ("TT", "TuoTu")
279 , ("UL", "uLeecher")
280 , ("UT", "uTorrent")
281 , ("VG", "Vagaa")
282 , ("WT", "BitLet")
283 , ("WY", "FireTorrent")
284 , ("XL", "Xunlei")
285 , ("XT", "XanTorrent")
286 , ("XX", "Xtorrent")
287 , ("ZT", "ZipTorrent")
288 ]
289-} \ No newline at end of file
diff --git a/src/Network/BitTorrent/Peer/ID.hs b/src/Network/BitTorrent/Peer/ID.hs
deleted file mode 100644
index 9bf0ae31..00000000
--- a/src/Network/BitTorrent/Peer/ID.hs
+++ /dev/null
@@ -1,168 +0,0 @@
1-- TODO: tests
2-- |
3-- Copyright : (c) Sam T. 2013
4-- License : MIT
5-- Maintainer : pxqr.sta@gmail.com
6-- Stability : experimental
7-- Portability : non-portable
8--
9-- This module provides 'Peer' and 'PeerID' datatypes and all related
10-- operations.
11--
12-- Recommended method for generation of the peer ID's is 'newPeerID',
13-- though this module exports some other goodies for custom generation.
14--
15{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}
16module Network.BitTorrent.Peer.ID
17 ( -- * Peer identification
18 PeerID (getPeerID), ppPeerID
19
20 -- ** Encoding styles
21 , azureusStyle, shadowStyle
22
23 -- ** Defaults
24 , defaultClientID, defaultVersionNumber
25
26 -- ** Generation
27 , newPeerID, timestampByteString
28 -- ** Extra
29
30 , byteStringPadded
31 ) where
32
33import Control.Applicative
34import Data.BEncode
35import Data.ByteString (ByteString)
36import qualified Data.ByteString as B
37import qualified Data.ByteString.Char8 as BC
38import qualified Data.ByteString.Lazy as BL
39import qualified Data.ByteString.Builder as B
40import Data.Foldable (foldMap)
41import Data.Monoid ((<>))
42import Data.Serialize
43import Data.URLEncoded
44import Data.Version (Version(Version), versionBranch)
45import Data.Time.Clock (getCurrentTime)
46import Data.Time.Format (formatTime)
47import Text.PrettyPrint (text, Doc)
48import System.Locale (defaultTimeLocale)
49
50
51-- TODO we have linker error here, so manual hardcoded version for a while.
52-- import Paths_network_bittorrent (version)
53version :: Version
54version = Version [0, 10, 0, 0] []
55
56
57-- | Peer identifier is exactly 20 bytes long bytestring.
58newtype PeerID = PeerID { getPeerID :: ByteString }
59 deriving (Show, Eq, Ord, BEncodable)
60
61instance Serialize PeerID where
62 put = putByteString . getPeerID
63 get = PeerID <$> getBytes 20
64
65instance URLShow PeerID where
66 urlShow = BC.unpack . getPeerID
67
68ppPeerID :: PeerID -> Doc
69ppPeerID = text . BC.unpack . getPeerID
70
71
72-- | Azureus-style encoding have the following layout:
73--
74-- * 1 byte : '-'
75--
76-- * 2 bytes: client id
77--
78-- * 4 bytes: version number
79--
80-- * 1 byte : '-'
81--
82-- * 12 bytes: random number
83--
84azureusStyle :: ByteString -- ^ 2 character client ID, padded with 'H'.
85 -> ByteString -- ^ Version number, padded with 'X'.
86 -> ByteString -- ^ Random number, padded with '0'.
87 -> PeerID -- ^ Azureus-style encoded peer ID.
88azureusStyle cid ver rnd = PeerID $ BL.toStrict $ B.toLazyByteString $
89 B.char8 '-' <>
90 byteStringPadded cid 2 'H' <>
91 byteStringPadded ver 4 'X' <>
92 B.char8 '-' <>
93 byteStringPadded rnd 12 '0'
94
95-- | Shadow-style encoding have the following layout:
96--
97-- * 1 byte : client id.
98--
99-- * 0-4 bytes: version number. If less than 4 then padded with '-' char.
100--
101-- * 15 bytes : random number. If length is less than 15 then padded with '0' char.
102--
103shadowStyle :: Char -- ^ Client ID.
104 -> ByteString -- ^ Version number.
105 -> ByteString -- ^ Random number.
106 -> PeerID -- ^ Shadow style encoded peer ID.
107shadowStyle cid ver rnd = PeerID $ BL.toStrict $ B.toLazyByteString $
108 B.char8 cid <>
109 byteStringPadded ver 4 '-' <>
110 byteStringPadded rnd 15 '0'
111
112
113-- | "HS" - 2 bytes long client identifier.
114defaultClientID :: ByteString
115defaultClientID = "HS"
116
117-- | Gives exactly 4 bytes long version number for any version of the package.
118-- Version is taken from .cabal.
119defaultVersionNumber :: ByteString
120defaultVersionNumber = B.take 4 (BC.pack (foldMap show (versionBranch version)))
121
122-- | Gives 15 characters long decimal timestamp such that:
123--
124-- * 6 bytes : first 6 characters from picoseconds obtained with %q.
125--
126-- * 1 bytes : character '.' for readability.
127--
128-- * 9..* bytes: number of whole seconds since the Unix epoch (!)REVERSED.
129--
130-- Can be used both with shadow and azureus style encoding. This format is
131-- used to make the ID's readable(for debugging) and more or less random.
132--
133timestampByteString :: IO ByteString
134timestampByteString = (BC.pack . format) <$> getCurrentTime
135 where
136 format t = take 6 (formatTime defaultTimeLocale "%q" t) ++ "." ++
137 take 9 (reverse (formatTime defaultTimeLocale "%s" t))
138
139-- | Here we use Azureus-style encoding with the following args:
140--
141-- * 'HS' for the client id.
142--
143-- * Version of the package for the version number
144--
145-- * UTC time day ++ day time for the random number.
146--
147newPeerID :: IO PeerID
148newPeerID = azureusStyle defaultClientID defaultVersionNumber
149 <$> timestampByteString
150
151-- | Pad bytestring so it's becomes exactly request length. Conversion is done
152-- like so:
153--
154-- * length < size: Complete bytestring by given charaters.
155--
156-- * length = size: Output bytestring as is.
157--
158-- * length > size: Drop last (length - size) charaters from a given bytestring.
159--
160byteStringPadded :: ByteString -- ^ bytestring to be padded.
161 -> Int -- ^ size of result builder.
162 -> Char -- ^ character used for padding.
163 -> B.Builder
164byteStringPadded bs s c =
165 B.byteString (B.take s bs) <>
166 B.byteString (BC.replicate padLen c)
167 where
168 padLen = s - min (B.length bs) s \ No newline at end of file
diff --git a/src/Network/BitTorrent/PeerWire/Handshake.hs b/src/Network/BitTorrent/PeerWire/Handshake.hs
index ff768cae..d5ee0b5b 100644
--- a/src/Network/BitTorrent/PeerWire/Handshake.hs
+++ b/src/Network/BitTorrent/PeerWire/Handshake.hs
@@ -35,8 +35,8 @@ import Network.Socket.ByteString
35 35
36import Data.Torrent 36import Data.Torrent
37import Network.BitTorrent.Extension 37import Network.BitTorrent.Extension
38import Network.BitTorrent.Peer.ID 38import Network.BitTorrent.Peer
39import Network.BitTorrent.Peer.ClientInfo 39
40 40
41 41
42data Handshake = Handshake { 42data Handshake = Handshake {
diff --git a/src/Network/BitTorrent/Peer/Status.hs b/src/Network/BitTorrent/PeerWire/Status.hs
index 806ba77d..806ba77d 100644
--- a/src/Network/BitTorrent/Peer/Status.hs
+++ b/src/Network/BitTorrent/PeerWire/Status.hs
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 20:05:35 +0000