summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Address.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/Address.hs')
-rw-r--r--src/Network/BitTorrent/Address.hs1052
1 files changed, 0 insertions, 1052 deletions
diff --git a/src/Network/BitTorrent/Address.hs b/src/Network/BitTorrent/Address.hs
deleted file mode 100644
index e75066b1..00000000
--- a/src/Network/BitTorrent/Address.hs
+++ /dev/null
@@ -1,1052 +0,0 @@
1-- |
2-- Module : Network.BitTorrent.Address
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-- Peer and Node addresses.
11--
12{-# LANGUAGE CPP #-}
13{-# LANGUAGE FlexibleInstances #-}
14{-# LANGUAGE FlexibleContexts #-}
15{-# LANGUAGE RecordWildCards #-}
16{-# LANGUAGE ScopedTypeVariables #-}
17{-# LANGUAGE StandaloneDeriving #-}
18{-# LANGUAGE ViewPatterns #-}
19{-# LANGUAGE GeneralizedNewtypeDeriving #-}
20{-# LANGUAGE MultiParamTypeClasses #-}
21{-# LANGUAGE DeriveDataTypeable #-}
22{-# LANGUAGE DeriveFunctor #-}
23{-# LANGUAGE DeriveFoldable #-}
24{-# LANGUAGE DeriveTraversable #-}
25{-# LANGUAGE TemplateHaskell #-}
26{-# OPTIONS -fno-warn-orphans #-}
27module Network.BitTorrent.Address
28 ( -- * Address
29 Address (..)
30 , fromAddr
31 , PortNumber
32 , SockAddr
33
34 -- ** IP
35 , IPv4
36 , IPv6
37 , IP (..)
38
39 -- * PeerId
40 -- $peer-id
41 , PeerId
42
43 -- ** Generation
44 , genPeerId
45 , timestamp
46 , entropy
47
48 -- ** Encoding
49 , azureusStyle
50 , shadowStyle
51 , defaultClientId
52 , defaultVersionNumber
53
54 -- * PeerAddr
55 -- $peer-addr
56 , PeerAddr(..)
57 , defaultPorts
58 , peerSockAddr
59 , peerSocket
60
61 -- * Node
62 -- ** Id
63 , NodeId
64 , testIdBit
65 , genNodeId
66 , bucketRange
67 , genBucketSample
68
69 -- ** Info
70 , NodeAddr (..)
71 , NodeInfo (..)
72 , mapAddress
73 , traverseAddress
74 , rank
75
76 -- * Fingerprint
77 -- $fingerprint
78 , Software (..)
79 , Fingerprint (..)
80 , libFingerprint
81 , fingerprint
82
83 -- * Utils
84 , libUserAgent
85 , sockAddrPort
86 , getBindAddress
87 ) where
88
89import Control.Applicative
90import Control.Monad
91import Control.Exception (onException)
92#ifdef VERSION_bencoding
93import Data.BEncode as BE
94import Data.BEncode.BDict (BKey)
95#endif
96import Data.Bits
97import qualified Data.ByteString as BS
98import qualified Data.ByteString.Internal as BS
99import Data.ByteString.Char8 as BC
100import Data.ByteString.Char8 as BS8
101import qualified Data.ByteString.Lazy as BL
102import qualified Data.ByteString.Lazy.Builder as BS
103import Data.Char
104import Data.Convertible
105import Data.Default
106import Data.IP
107import Data.List as L
108import Data.List.Split as L
109import Data.Maybe (fromMaybe, catMaybes, mapMaybe)
110import Data.Monoid
111import Data.Hashable
112import Data.Ord
113import Data.Serialize as S
114import Data.String
115import Data.Time
116import Data.Typeable
117import Data.Version
118import Data.Word
119import qualified Text.ParserCombinators.ReadP as RP
120import Text.Read (readMaybe)
121import Network.HTTP.Types.QueryLike
122import Network.Socket
123import Text.PrettyPrint as PP hiding ((<>))
124import Text.PrettyPrint.HughesPJClass hiding ((<>),($$))
125#if !MIN_VERSION_time(1,5,0)
126import System.Locale (defaultTimeLocale)
127#endif
128import System.Entropy
129import Data.Digest.CRC32C
130import Network.DatagramServer.Types as RPC
131import Network.DatagramServer.Mainline (KMessageOf)
132-- import Network.DHT.Mainline
133
134-- import Paths_bittorrent (version)
135
136instance Pretty UTCTime where
137 pPrint = PP.text . show
138
139setPort :: PortNumber -> SockAddr -> SockAddr
140setPort port (SockAddrInet _ h ) = SockAddrInet port h
141setPort port (SockAddrInet6 _ f h s) = SockAddrInet6 port f h s
142setPort _ addr = addr
143{-# INLINE setPort #-}
144
145-- | Obtains the port associated with a socket address
146-- if one is associated with it.
147sockAddrPort :: SockAddr -> Maybe PortNumber
148sockAddrPort (SockAddrInet p _ ) = Just p
149sockAddrPort (SockAddrInet6 p _ _ _) = Just p
150sockAddrPort _ = Nothing
151{-# INLINE sockAddrPort #-}
152
153instance Address a => Address (NodeAddr a) where
154 toSockAddr NodeAddr {..} = setPort nodePort $ toSockAddr nodeHost
155 fromSockAddr sa = NodeAddr <$> fromSockAddr sa <*> sockAddrPort sa
156
157instance Address a => Address (PeerAddr a) where
158 toSockAddr PeerAddr {..} = setPort peerPort $ toSockAddr peerHost
159 fromSockAddr sa = PeerAddr Nothing <$> fromSockAddr sa <*> sockAddrPort sa
160
161{-----------------------------------------------------------------------
162-- Peer id
163-----------------------------------------------------------------------}
164-- $peer-id
165--
166-- 'PeerID' represent self assigned peer identificator. Ideally each
167-- host in the network should have unique peer id to avoid
168-- collisions, therefore for peer ID generation we use good entropy
169-- source. Peer ID is sent in /tracker request/, sent and received in
170-- /peer handshakes/ and used in DHT queries.
171--
172
173-- TODO use unpacked Word160 form (length is known statically)
174
175-- | Peer identifier is exactly 20 bytes long bytestring.
176newtype PeerId = PeerId { getPeerId :: ByteString }
177 deriving ( Show, Eq, Ord, Typeable
178#ifdef VERSION_bencoding
179 , BEncode
180#endif
181 )
182
183peerIdLen :: Int
184peerIdLen = 20
185
186-- | For testing purposes only.
187instance Default PeerId where
188 def = azureusStyle defaultClientId defaultVersionNumber ""
189
190instance Hashable PeerId where
191 hashWithSalt = hashUsing getPeerId
192 {-# INLINE hashWithSalt #-}
193
194instance Serialize PeerId where
195 put = putByteString . getPeerId
196 get = PeerId <$> getBytes peerIdLen
197
198instance QueryValueLike PeerId where
199 toQueryValue (PeerId pid) = Just pid
200 {-# INLINE toQueryValue #-}
201
202instance IsString PeerId where
203 fromString str
204 | BS.length bs == peerIdLen = PeerId bs
205 | otherwise = error $ "Peer id should be 20 bytes long: " ++ show str
206 where
207 bs = fromString str
208
209instance Pretty PeerId where
210 pPrint = text . BC.unpack . getPeerId
211
212instance Convertible BS.ByteString PeerId where
213 safeConvert bs
214 | BS.length bs == peerIdLen = pure (PeerId bs)
215 | otherwise = convError "invalid length" bs
216
217------------------------------------------------------------------------
218
219-- | Pad bytestring so it's becomes exactly request length. Conversion
220-- is done like so:
221--
222-- * length < size: Complete bytestring by given charaters.
223--
224-- * length = size: Output bytestring as is.
225--
226-- * length > size: Drop last (length - size) charaters from a
227-- given bytestring.
228--
229byteStringPadded :: ByteString -- ^ bytestring to be padded.
230 -> Int -- ^ size of result builder.
231 -> Char -- ^ character used for padding.
232 -> BS.Builder
233byteStringPadded bs s c =
234 BS.byteString (BS.take s bs) <>
235 BS.byteString (BC.replicate padLen c)
236 where
237 padLen = s - min (BS.length bs) s
238
239-- | Azureus-style encoding have the following layout:
240--
241-- * 1 byte : '-'
242--
243-- * 2 bytes: client id
244--
245-- * 4 bytes: version number
246--
247-- * 1 byte : '-'
248--
249-- * 12 bytes: random number
250--
251azureusStyle :: ByteString -- ^ 2 character client ID, padded with 'H'.
252 -> ByteString -- ^ Version number, padded with 'X'.
253 -> ByteString -- ^ Random number, padded with '0'.
254 -> PeerId -- ^ Azureus-style encoded peer ID.
255azureusStyle cid ver rnd = PeerId $ BL.toStrict $ BS.toLazyByteString $
256 BS.char8 '-' <>
257 byteStringPadded cid 2 'H' <>
258 byteStringPadded ver 4 'X' <>
259 BS.char8 '-' <>
260 byteStringPadded rnd 12 '0'
261
262-- | Shadow-style encoding have the following layout:
263--
264-- * 1 byte : client id.
265--
266-- * 0-4 bytes: version number. If less than 4 then padded with
267-- '-' char.
268--
269-- * 15 bytes : random number. If length is less than 15 then
270-- padded with '0' char.
271--
272shadowStyle :: Char -- ^ Client ID.
273 -> ByteString -- ^ Version number.
274 -> ByteString -- ^ Random number.
275 -> PeerId -- ^ Shadow style encoded peer ID.
276shadowStyle cid ver rnd = PeerId $ BL.toStrict $ BS.toLazyByteString $
277 BS.char8 cid <>
278 byteStringPadded ver 4 '-' <>
279 byteStringPadded rnd 15 '0'
280
281
282-- | 'HS'- 2 bytes long client identifier.
283defaultClientId :: ByteString
284defaultClientId = "HS"
285
286-- | Gives exactly 4 bytes long version number for any version of the
287-- package. Version is taken from .cabal file.
288defaultVersionNumber :: ByteString
289defaultVersionNumber = BS.take 4 $ BC.pack $ foldMap show $
290 versionBranch myVersion
291 where
292 Fingerprint _ myVersion = libFingerprint
293
294------------------------------------------------------------------------
295
296-- | Gives 15 characters long decimal timestamp such that:
297--
298-- * 6 bytes : first 6 characters from picoseconds obtained with %q.
299--
300-- * 1 byte : character \'.\' for readability.
301--
302-- * 9..* bytes: number of whole seconds since the Unix epoch
303-- (!)REVERSED.
304--
305-- Can be used both with shadow and azureus style encoding. This
306-- format is used to make the ID's readable for debugging purposes.
307--
308timestamp :: IO ByteString
309timestamp = (BC.pack . format) <$> getCurrentTime
310 where
311 format t = L.take 6 (formatTime defaultTimeLocale "%q" t) ++ "." ++
312 L.take 9 (L.reverse (formatTime defaultTimeLocale "%s" t))
313
314-- | Gives 15 character long random bytestring. This is more robust
315-- method for generation of random part of peer ID than 'timestamp'.
316entropy :: IO ByteString
317entropy = getEntropy 15
318
319-- NOTE: entropy generates incorrrect peer id
320
321-- | Here we use 'azureusStyle' encoding with the following args:
322--
323-- * 'HS' for the client id; ('defaultClientId')
324--
325-- * Version of the package for the version number;
326-- ('defaultVersionNumber')
327--
328-- * UTC time day ++ day time for the random number. ('timestamp')
329--
330genPeerId :: IO PeerId
331genPeerId = azureusStyle defaultClientId defaultVersionNumber <$> timestamp
332
333{-----------------------------------------------------------------------
334-- Peer Addr
335-----------------------------------------------------------------------}
336-- $peer-addr
337--
338-- 'PeerAddr' is used to represent peer address. Currently it's
339-- just peer IP and peer port but this might change in future.
340--
341
342{-----------------------------------------------------------------------
343-- Port number
344-----------------------------------------------------------------------}
345
346#ifdef VERSION_bencoding
347instance BEncode PortNumber where
348 toBEncode = toBEncode . fromEnum
349 fromBEncode = fromBEncode >=> portNumber
350 where
351 portNumber :: Integer -> BE.Result PortNumber
352 portNumber n
353 | 0 <= n && n <= fromIntegral (maxBound :: Word16)
354 = pure $ fromIntegral n
355 | otherwise = decodingError $ "PortNumber: " ++ show n
356#endif
357{-----------------------------------------------------------------------
358-- IP addr
359-----------------------------------------------------------------------}
360
361class IPAddress i where
362 toHostAddr :: i -> Either HostAddress HostAddress6
363
364instance IPAddress IPv4 where
365 toHostAddr = Left . toHostAddress
366 {-# INLINE toHostAddr #-}
367
368instance IPAddress IPv6 where
369 toHostAddr = Right . toHostAddress6
370 {-# INLINE toHostAddr #-}
371
372instance IPAddress IP where
373 toHostAddr (IPv4 ip) = toHostAddr ip
374 toHostAddr (IPv6 ip) = toHostAddr ip
375 {-# INLINE toHostAddr #-}
376
377deriving instance Typeable IP
378deriving instance Typeable IPv4
379deriving instance Typeable IPv6
380
381#ifdef VERSION_bencoding
382ipToBEncode :: Show i => i -> BValue
383ipToBEncode ip = BString $ BS8.pack $ show ip
384{-# INLINE ipToBEncode #-}
385
386ipFromBEncode :: Read a => BValue -> BE.Result a
387ipFromBEncode (BString (BS8.unpack -> ipStr))
388 | Just ip <- readMaybe (ipStr) = pure ip
389 | otherwise = decodingError $ "IP: " ++ ipStr
390ipFromBEncode _ = decodingError $ "IP: addr should be a bstring"
391
392instance BEncode IP where
393 toBEncode = ipToBEncode
394 {-# INLINE toBEncode #-}
395 fromBEncode = ipFromBEncode
396 {-# INLINE fromBEncode #-}
397
398instance BEncode IPv4 where
399 toBEncode = ipToBEncode
400 {-# INLINE toBEncode #-}
401 fromBEncode = ipFromBEncode
402 {-# INLINE fromBEncode #-}
403
404instance BEncode IPv6 where
405 toBEncode = ipToBEncode
406 {-# INLINE toBEncode #-}
407 fromBEncode = ipFromBEncode
408 {-# INLINE fromBEncode #-}
409#endif
410
411{-----------------------------------------------------------------------
412-- Peer addr
413-----------------------------------------------------------------------}
414-- TODO check semantic of ord and eq instances
415
416-- | Peer address info normally extracted from peer list or peer
417-- compact list encoding.
418data PeerAddr a = PeerAddr
419 { peerId :: !(Maybe PeerId)
420
421 -- | This is usually 'IPv4', 'IPv6', 'IP' or unresolved
422 -- 'HostName'.
423 , peerHost :: !a
424
425 -- | The port the peer listenning for incoming P2P sessions.
426 , peerPort :: {-# UNPACK #-} !PortNumber
427 } deriving (Show, Eq, Ord, Typeable, Functor)
428
429#ifdef VERSION_bencoding
430peer_ip_key, peer_id_key, peer_port_key :: BKey
431peer_ip_key = "ip"
432peer_id_key = "peer id"
433peer_port_key = "port"
434
435-- | The tracker's 'announce response' compatible encoding.
436instance (Typeable a, BEncode a) => BEncode (PeerAddr a) where
437 toBEncode PeerAddr {..} = toDict $
438 peer_ip_key .=! peerHost
439 .: peer_id_key .=? peerId
440 .: peer_port_key .=! peerPort
441 .: endDict
442
443 fromBEncode = fromDict $ do
444 peerAddr <$>! peer_ip_key
445 <*>? peer_id_key
446 <*>! peer_port_key
447 where
448 peerAddr = flip PeerAddr
449#endif
450
451-- | The tracker's 'compact peer list' compatible encoding. The
452-- 'peerId' is always 'Nothing'.
453--
454-- For more info see: <http://www.bittorrent.org/beps/bep_0023.html>
455--
456-- TODO: test byte order
457instance (Serialize a) => Serialize (PeerAddr a) where
458 put PeerAddr {..} = put peerHost >> put peerPort
459 get = PeerAddr Nothing <$> get <*> get
460
461-- | @127.0.0.1:6881@
462instance Default (PeerAddr IPv4) where
463 def = "127.0.0.1:6881"
464
465-- | @127.0.0.1:6881@
466instance Default (PeerAddr IP) where
467 def = IPv4 <$> def
468
469-- | Example:
470--
471-- @peerPort \"127.0.0.1:6881\" == 6881@
472--
473instance IsString (PeerAddr IPv4) where
474 fromString str
475 | [hostAddrStr, portStr] <- splitWhen (== ':') str
476 , Just hostAddr <- readMaybe hostAddrStr
477 , Just portNum <- toEnum <$> readMaybe portStr
478 = PeerAddr Nothing hostAddr portNum
479 | otherwise = error $ "fromString: unable to parse (PeerAddr IPv4): " ++ str
480
481instance Read (PeerAddr IPv4) where
482 readsPrec i = RP.readP_to_S $ do
483 ipv4 <- RP.readS_to_P (readsPrec i)
484 _ <- RP.char ':'
485 port <- toEnum <$> RP.readS_to_P (readsPrec i)
486 return $ PeerAddr Nothing ipv4 port
487
488readsIPv6_port :: String -> [((IPv6, PortNumber), String)]
489readsIPv6_port = RP.readP_to_S $ do
490 ip <- RP.char '[' *> (RP.readS_to_P reads) <* RP.char ']'
491 _ <- RP.char ':'
492 port <- toEnum <$> read <$> (RP.many1 $ RP.satisfy isDigit) <* RP.eof
493 return (ip,port)
494
495instance IsString (PeerAddr IPv6) where
496 fromString str
497 | [((ip,port),"")] <- readsIPv6_port str =
498 PeerAddr Nothing ip port
499 | otherwise = error $ "fromString: unable to parse (PeerAddr IPv6): " ++ str
500
501instance IsString (PeerAddr IP) where
502 fromString str
503 | '[' `L.elem` str = IPv6 <$> fromString str
504 | otherwise = IPv4 <$> fromString str
505
506-- | fingerprint + "at" + dotted.host.inet.addr:port
507-- TODO: instances for IPv6, HostName
508instance Pretty a => Pretty (PeerAddr a) where
509 pPrint PeerAddr {..}
510 | Just pid <- peerId = pPrint (fingerprint pid) <+> "at" <+> paddr
511 | otherwise = paddr
512 where
513 paddr = pPrint peerHost <> ":" <> text (show peerPort)
514
515instance Hashable a => Hashable (PeerAddr a) where
516 hashWithSalt s PeerAddr {..} =
517 s `hashWithSalt` peerId `hashWithSalt` peerHost `hashWithSalt` peerPort
518
519-- | Ports typically reserved for bittorrent P2P listener.
520defaultPorts :: [PortNumber]
521defaultPorts = [6881..6889]
522
523_resolvePeerAddr :: (IPAddress i) => PeerAddr HostName -> PeerAddr i
524_resolvePeerAddr = undefined
525
526_peerSockAddr :: PeerAddr IP -> (Family, SockAddr)
527_peerSockAddr PeerAddr {..} =
528 case peerHost of
529 IPv4 ipv4 ->
530 (AF_INET, SockAddrInet peerPort (toHostAddress ipv4))
531 IPv6 ipv6 ->
532 (AF_INET6, SockAddrInet6 peerPort 0 (toHostAddress6 ipv6) 0)
533
534peerSockAddr :: PeerAddr IP -> SockAddr
535peerSockAddr = snd . _peerSockAddr
536
537-- | Create a socket connected to the address specified in a peerAddr
538peerSocket :: SocketType -> PeerAddr IP -> IO Socket
539peerSocket socketType pa = do
540 let (family, addr) = _peerSockAddr pa
541 sock <- socket family socketType defaultProtocol
542 connect sock addr
543 return sock
544
545{-----------------------------------------------------------------------
546-- Node info
547-----------------------------------------------------------------------}
548-- $node-info
549--
550-- A \"node\" is a client\/server listening on a UDP port
551-- implementing the distributed hash table protocol. The DHT is
552-- composed of nodes and stores the location of peers. BitTorrent
553-- clients include a DHT node, which is used to contact other nodes
554-- in the DHT to get the location of peers to download from using
555-- the BitTorrent protocol.
556
557-- asNodeId :: ByteString -> NodeId
558-- asNodeId bs = NodeId $ BS.take nodeIdSize bs
559
560{-
561
562-- | Test if the nth bit is set.
563testIdBit :: NodeId -> Word -> Bool
564testIdBit (NodeId bs) i
565 | fromIntegral i < nodeIdSize * 8
566 , (q, r) <- quotRem (fromIntegral i) 8
567 = testBit (BS.index bs q) (7 - r)
568 | otherwise = False
569-}
570
571testIdBit :: FiniteBits bs => bs -> Word -> Bool
572testIdBit bs i = testBit bs (fromIntegral (finiteBitSize bs - fromIntegral i))
573{-# INLINE testIdBit #-}
574
575------------------------------------------------------------------------
576
577-- | Accepts a depth/index of a bucket and whether or not it is the last one,
578-- yields:
579--
580-- count of leading bytes to be copied from your node id.
581--
582-- mask to clear the extra bits of the last copied byte
583--
584-- mask to toggle the last copied bit if it is not the last bucket
585--
586-- Normally this is used with 'genBucketSample' to obtain a random id suitable
587-- for refreshing a particular bucket.
588bucketRange :: Int -> Bool -> (Int, Word8, Word8)
589bucketRange depth is_last = (q,m,b)
590 where
591 (q,r) = divMod ((if is_last then (+7) else (+8)) depth) 8
592 m = 2^(7-r) - 1
593 b = if is_last then 0 else 2^(7-r)
594
595------------------------------------------------------------------------
596
597#ifdef VERSION_bencoding
598-- | Torrent file compatible encoding.
599instance BEncode a => BEncode (NodeAddr a) where
600 toBEncode NodeAddr {..} = toBEncode (nodeHost, nodePort)
601 {-# INLINE toBEncode #-}
602 fromBEncode b = uncurry NodeAddr <$> fromBEncode b
603 {-# INLINE fromBEncode #-}
604#endif
605
606fromPeerAddr :: PeerAddr a -> NodeAddr a
607fromPeerAddr PeerAddr {..} = NodeAddr
608 { nodeHost = peerHost
609 , nodePort = peerPort
610 }
611
612------------------------------------------------------------------------
613
614-- | Order by closeness: nearest nodes first.
615rank :: ( Ord (NodeId dht)
616 , Bits (NodeId dht)
617 ) => (x -> NodeId dht) -> NodeId dht -> [x] -> [x]
618rank f nid = L.sortBy (comparing (RPC.distance nid . f))
619
620{-----------------------------------------------------------------------
621-- Fingerprint
622-----------------------------------------------------------------------}
623-- $fingerprint
624--
625-- 'Fingerprint' is used to identify the client implementation and
626-- version which also contained in 'Peer'. For exsample first 6
627-- bytes of peer id of this this library are @-HS0100-@ while for
628-- mainline we have @M4-3-6--@. We could extract this info and
629-- print in human-friendly form: this is useful for debugging and
630-- logging.
631--
632-- For more information see:
633-- <http://bittorrent.org/beps/bep_0020.html>
634--
635--
636-- NOTE: Do /not/ use this information to control client
637-- capabilities (such as supported enchancements), this should be
638-- done using 'Network.BitTorrent.Extension'!
639--
640
641-- TODO FIXME
642version :: Version
643version = Version [0, 0, 0, 3] []
644
645-- | List of registered client versions + 'IlibHSbittorrent' (this
646-- package) + 'IUnknown' (for not recognized software). All names are
647-- prefixed by \"I\" because some of them starts from lowercase letter
648-- but that is not a valid Haskell constructor name.
649--
650data Software =
651 IUnknown
652
653 | IMainline
654
655 | IABC
656 | IOspreyPermaseed
657 | IBTQueue
658 | ITribler
659 | IShadow
660 | IBitTornado
661
662-- UPnP(!) Bit Torrent !???
663-- 'U' - UPnP NAT Bit Torrent
664 | IBitLord
665 | IOpera
666 | IMLdonkey
667
668 | IAres
669 | IArctic
670 | IAvicora
671 | IBitPump
672 | IAzureus
673 | IBitBuddy
674 | IBitComet
675 | IBitflu
676 | IBTG
677 | IBitRocket
678 | IBTSlave
679 | IBittorrentX
680 | IEnhancedCTorrent
681 | ICTorrent
682 | IDelugeTorrent
683 | IPropagateDataClient
684 | IEBit
685 | IElectricSheep
686 | IFoxTorrent
687 | IGSTorrent
688 | IHalite
689 | IlibHSbittorrent
690 | IHydranode
691 | IKGet
692 | IKTorrent
693 | ILH_ABC
694 | ILphant
695 | ILibtorrent
696 | ILibTorrent
697 | ILimeWire
698 | IMonoTorrent
699 | IMooPolice
700 | IMiro
701 | IMoonlightTorrent
702 | INetTransport
703 | IPando
704 | IqBittorrent
705 | IQQDownload
706 | IQt4TorrentExample
707 | IRetriever
708 | IShareaza
709 | ISwiftbit
710 | ISwarmScope
711 | ISymTorrent
712 | Isharktorrent
713 | ITorrentDotNET
714 | ITransmission
715 | ITorrentstorm
716 | ITuoTu
717 | IuLeecher
718 | IuTorrent
719 | IVagaa
720 | IBitLet
721 | IFireTorrent
722 | IXunlei
723 | IXanTorrent
724 | IXtorrent
725 | IZipTorrent
726 deriving (Show, Eq, Ord, Enum, Bounded)
727
728parseSoftware :: ByteString -> Software
729parseSoftware = f . BC.unpack
730 where
731 f "AG" = IAres
732 f "A~" = IAres
733 f "AR" = IArctic
734 f "AV" = IAvicora
735 f "AX" = IBitPump
736 f "AZ" = IAzureus
737 f "BB" = IBitBuddy
738 f "BC" = IBitComet
739 f "BF" = IBitflu
740 f "BG" = IBTG
741 f "BR" = IBitRocket
742 f "BS" = IBTSlave
743 f "BX" = IBittorrentX
744 f "CD" = IEnhancedCTorrent
745 f "CT" = ICTorrent
746 f "DE" = IDelugeTorrent
747 f "DP" = IPropagateDataClient
748 f "EB" = IEBit
749 f "ES" = IElectricSheep
750 f "FT" = IFoxTorrent
751 f "GS" = IGSTorrent
752 f "HL" = IHalite
753 f "HS" = IlibHSbittorrent
754 f "HN" = IHydranode
755 f "KG" = IKGet
756 f "KT" = IKTorrent
757 f "LH" = ILH_ABC
758 f "LP" = ILphant
759 f "LT" = ILibtorrent
760 f "lt" = ILibTorrent
761 f "LW" = ILimeWire
762 f "MO" = IMonoTorrent
763 f "MP" = IMooPolice
764 f "MR" = IMiro
765 f "ML" = IMLdonkey
766 f "MT" = IMoonlightTorrent
767 f "NX" = INetTransport
768 f "PD" = IPando
769 f "qB" = IqBittorrent
770 f "QD" = IQQDownload
771 f "QT" = IQt4TorrentExample
772 f "RT" = IRetriever
773 f "S~" = IShareaza
774 f "SB" = ISwiftbit
775 f "SS" = ISwarmScope
776 f "ST" = ISymTorrent
777 f "st" = Isharktorrent
778 f "SZ" = IShareaza
779 f "TN" = ITorrentDotNET
780 f "TR" = ITransmission
781 f "TS" = ITorrentstorm
782 f "TT" = ITuoTu
783 f "UL" = IuLeecher
784 f "UT" = IuTorrent
785 f "VG" = IVagaa
786 f "WT" = IBitLet
787 f "WY" = IFireTorrent
788 f "XL" = IXunlei
789 f "XT" = IXanTorrent
790 f "XX" = IXtorrent
791 f "ZT" = IZipTorrent
792 f _ = IUnknown
793
794-- | Used to represent a not recognized implementation
795instance Default Software where
796 def = IUnknown
797 {-# INLINE def #-}
798
799-- | Example: @\"BitLet\" == 'IBitLet'@
800instance IsString Software where
801 fromString str
802 | Just impl <- L.lookup str alist = impl
803 | otherwise = error $ "fromString: not recognized " ++ str
804 where
805 alist = L.map mk [minBound..maxBound]
806 mk x = (L.tail $ show x, x)
807
808-- | Example: @pPrint 'IBitLet' == \"IBitLet\"@
809instance Pretty Software where
810 pPrint = text . L.tail . show
811
812-- | Just the '0' version.
813instance Default Version where
814 def = Version [0] []
815 {-# INLINE def #-}
816
817-- | For dot delimited version strings.
818-- Example: @fromString \"0.1.0.2\" == Version [0, 1, 0, 2]@
819--
820instance IsString Version where
821 fromString str
822 | Just nums <- chunkNums str = Version nums []
823 | otherwise = error $ "fromString: invalid version string " ++ str
824 where
825 chunkNums = sequence . L.map readMaybe . L.linesBy ('.' ==)
826
827instance Pretty Version where
828 pPrint = text . showVersion
829
830-- | The all sensible infomation that can be obtained from a peer
831-- identifier or torrent /createdBy/ field.
832data Fingerprint = Fingerprint Software Version
833 deriving (Show, Eq, Ord)
834
835-- | Unrecognized client implementation.
836instance Default Fingerprint where
837 def = Fingerprint def def
838 {-# INLINE def #-}
839
840-- | Example: @\"BitComet-1.2\" == ClientInfo IBitComet (Version [1, 2] [])@
841instance IsString Fingerprint where
842 fromString str
843 | _ : ver <- _ver = Fingerprint (fromString impl) (fromString ver)
844 | otherwise = error $ "fromString: invalid client info string" ++ str
845 where
846 (impl, _ver) = L.span ((/=) '-') str
847
848instance Pretty Fingerprint where
849 pPrint (Fingerprint s v) = pPrint s <+> "version" <+> pPrint v
850
851-- | Fingerprint of this (the bittorrent library) package. Normally,
852-- applications should introduce its own fingerprints, otherwise they
853-- can use 'libFingerprint' value.
854--
855libFingerprint :: Fingerprint
856libFingerprint = Fingerprint IlibHSbittorrent version
857
858-- | HTTP user agent of this (the bittorrent library) package. Can be
859-- used in HTTP tracker requests.
860libUserAgent :: String
861libUserAgent = render (pPrint IlibHSbittorrent <> "/" <> pPrint version)
862
863{-----------------------------------------------------------------------
864-- For torrent file
865-----------------------------------------------------------------------}
866-- TODO collect information about createdBy torrent field
867-- renderImpl :: ClientImpl -> Text
868-- renderImpl = T.pack . L.tail . show
869--
870-- renderVersion :: Version -> Text
871-- renderVersion = undefined
872--
873-- renderClientInfo :: ClientInfo -> Text
874-- renderClientInfo ClientInfo {..} = renderImpl ciImpl <> "/" <> renderVersion ciVersion
875--
876-- parseClientInfo :: Text -> ClientImpl
877-- parseClientInfo t = undefined
878
879
880-- code used for generation; remove it later on
881--
882-- mkEnumTyDef :: NM -> String
883-- mkEnumTyDef = unlines . map (" | I" ++) . nub . map snd
884--
885-- mkPars :: NM -> String
886-- mkPars = unlines . map (\(code, impl) -> " f \"" ++ code ++ "\" = " ++ "I" ++ impl)
887--
888-- type NM = [(String, String)]
889-- nameMap :: NM
890-- nameMap =
891-- [ ("AG", "Ares")
892-- , ("A~", "Ares")
893-- , ("AR", "Arctic")
894-- , ("AV", "Avicora")
895-- , ("AX", "BitPump")
896-- , ("AZ", "Azureus")
897-- , ("BB", "BitBuddy")
898-- , ("BC", "BitComet")
899-- , ("BF", "Bitflu")
900-- , ("BG", "BTG")
901-- , ("BR", "BitRocket")
902-- , ("BS", "BTSlave")
903-- , ("BX", "BittorrentX")
904-- , ("CD", "EnhancedCTorrent")
905-- , ("CT", "CTorrent")
906-- , ("DE", "DelugeTorrent")
907-- , ("DP", "PropagateDataClient")
908-- , ("EB", "EBit")
909-- , ("ES", "ElectricSheep")
910-- , ("FT", "FoxTorrent")
911-- , ("GS", "GSTorrent")
912-- , ("HL", "Halite")
913-- , ("HS", "libHSnetwork_bittorrent")
914-- , ("HN", "Hydranode")
915-- , ("KG", "KGet")
916-- , ("KT", "KTorrent")
917-- , ("LH", "LH_ABC")
918-- , ("LP", "Lphant")
919-- , ("LT", "Libtorrent")
920-- , ("lt", "LibTorrent")
921-- , ("LW", "LimeWire")
922-- , ("MO", "MonoTorrent")
923-- , ("MP", "MooPolice")
924-- , ("MR", "Miro")
925-- , ("MT", "MoonlightTorrent")
926-- , ("NX", "NetTransport")
927-- , ("PD", "Pando")
928-- , ("qB", "qBittorrent")
929-- , ("QD", "QQDownload")
930-- , ("QT", "Qt4TorrentExample")
931-- , ("RT", "Retriever")
932-- , ("S~", "Shareaza")
933-- , ("SB", "Swiftbit")
934-- , ("SS", "SwarmScope")
935-- , ("ST", "SymTorrent")
936-- , ("st", "sharktorrent")
937-- , ("SZ", "Shareaza")
938-- , ("TN", "TorrentDotNET")
939-- , ("TR", "Transmission")
940-- , ("TS", "Torrentstorm")
941-- , ("TT", "TuoTu")
942-- , ("UL", "uLeecher")
943-- , ("UT", "uTorrent")
944-- , ("VG", "Vagaa")
945-- , ("WT", "BitLet")
946-- , ("WY", "FireTorrent")
947-- , ("XL", "Xunlei")
948-- , ("XT", "XanTorrent")
949-- , ("XX", "Xtorrent")
950-- , ("ZT", "ZipTorrent")
951-- ]
952
953-- TODO use regexps
954
955-- | Tries to extract meaningful information from peer ID bytes. If
956-- peer id uses unknown coding style then client info returned is
957-- 'def'.
958--
959fingerprint :: PeerId -> Fingerprint
960fingerprint pid = either (const def) id $ runGet getCI (getPeerId pid)
961 where
962 getCI = do
963 leading <- BS.w2c <$> getWord8
964 case leading of
965 '-' -> Fingerprint <$> getAzureusImpl <*> getAzureusVersion
966 'M' -> Fingerprint <$> pure IMainline <*> getMainlineVersion
967 'e' -> Fingerprint <$> getBitCometImpl <*> getBitCometVersion
968 'F' -> Fingerprint <$> getBitCometImpl <*> getBitCometVersion
969 c -> do
970 c1 <- BS.w2c <$> S.lookAhead getWord8
971 if c1 == 'P'
972 then do
973 _ <- getWord8
974 Fingerprint <$> pure IOpera <*> getOperaVersion
975 else Fingerprint <$> pure (getShadowImpl c) <*> getShadowVersion
976
977 getMainlineVersion = do
978 str <- BC.unpack <$> getByteString 7
979 let mnums = L.filter (not . L.null) $ L.linesBy ('-' ==) str
980 return $ Version (fromMaybe [] $ sequence $ L.map readMaybe mnums) []
981
982 getAzureusImpl = parseSoftware <$> getByteString 2
983 getAzureusVersion = mkVer <$> getByteString 4
984 where
985 mkVer bs = Version [fromMaybe 0 $ readMaybe $ BC.unpack bs] []
986
987 getBitCometImpl = do
988 bs <- getByteString 3
989 S.lookAhead $ do
990 _ <- getByteString 2
991 lr <- getByteString 4
992 return $
993 if lr == "LORD" then IBitLord else
994 if bs == "UTB" then IBitComet else
995 if bs == "xbc" then IBitComet else def
996
997 getBitCometVersion = do
998 x <- getWord8
999 y <- getWord8
1000 return $ Version [fromIntegral x, fromIntegral y] []
1001
1002 getOperaVersion = do
1003 str <- BC.unpack <$> getByteString 4
1004 return $ Version [fromMaybe 0 $ readMaybe str] []
1005
1006 getShadowImpl 'A' = IABC
1007 getShadowImpl 'O' = IOspreyPermaseed
1008 getShadowImpl 'Q' = IBTQueue
1009 getShadowImpl 'R' = ITribler
1010 getShadowImpl 'S' = IShadow
1011 getShadowImpl 'T' = IBitTornado
1012 getShadowImpl _ = IUnknown
1013
1014 decodeShadowVerNr :: Char -> Maybe Int
1015 decodeShadowVerNr c
1016 | '0' < c && c <= '9' = Just (fromEnum c - fromEnum '0')
1017 | 'A' < c && c <= 'Z' = Just ((fromEnum c - fromEnum 'A') + 10)
1018 | 'a' < c && c <= 'z' = Just ((fromEnum c - fromEnum 'a') + 36)
1019 | otherwise = Nothing
1020
1021 getShadowVersion = do
1022 str <- BC.unpack <$> getByteString 5
1023 return $ Version (catMaybes $ L.map decodeShadowVerNr str) []
1024
1025
1026
1027-- | Given a string specifying a port (numeric or service name)
1028-- and a flag indicating whether you want to support IPv6, this
1029-- function will return a SockAddr to bind to. If the input
1030-- is not understood as a port number, zero will be set in order
1031-- to ask the system for an unused port.
1032--
1033-- TODO: Also interpret local ip address specifications in the input
1034-- string.
1035getBindAddress :: String -> Bool -> IO SockAddr
1036getBindAddress listenPortString enabled6 = do
1037 -- Bind addresses for localhost
1038 xs <- getAddrInfo (Just (defaultHints {addrFlags = [AI_PASSIVE] }))
1039 Nothing
1040 (Just listenPortString)
1041 `onException` return []
1042 -- We prefer IPv6 because that can also handle connections from IPv4
1043 -- clients...
1044 let (x6s,x4s) = partition (\s -> addrFamily s == AF_INET6) xs
1045 listenAddr =
1046 case if enabled6 then x6s++x4s else x4s of
1047 AddrInfo { addrAddress = addr } : _ -> addr
1048 _ -> if enabled6
1049 then SockAddrInet6 (parsePort listenPortString) 0 iN6ADDR_ANY 0
1050 else SockAddrInet (parsePort listenPortString) iNADDR_ANY
1051 where parsePort s = fromMaybe 0 $ readMaybe s
1052 return listenAddr
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 20:11:29 +0000