-- | -- Copyright : (c) Sam T. 2013 -- License : MIT -- Maintainer : pxqr.sta@gmail.com -- Stability : experimental -- Portability : non-portable -- -- This modules provides three datatypes related to a peer as a host: -- -- * 'PeerID' represent self assigned peer identificator. Ideally -- each host in the network should have unique peer id to avoid -- collisions, therefor for peer ID generation we use good entropy -- source. (FIX not really) Peer ID is sent in /tracker request/, -- sent and received in /peer handshakes/ and used in /distributed -- hash table/ queries. -- -- * 'PeerAddr' is used to represent peer location. Currently it's -- just peer IP and peer port but this might be changed later. -- -- * 'ClientInfo' is used to identify the client implementation and -- version which also contained in 'Peer'. For exsample first -- 6 bytes of peer id of this this library are @-HS0100-@ while -- for mainline we have @M4-3-6--@. -- We could extract this info and print in human frienly form: this -- is useful for debugging and logging. For more information see: -- -- NOTE: Do _not_ use this information to control client -- capabilities (such as supported enchancements), this should be -- done using 'Network.BitTorrent.Extension'! -- {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS -fno-warn-orphans #-} module Network.BitTorrent.Peer ( -- * Peer identificators PeerID (getPeerID), ppPeerID -- ** Encoding styles , azureusStyle, shadowStyle -- ** Defaults , defaultClientID, defaultVersionNumber -- ** Generation , newPeerID, timestampByteString -- ** Extra , byteStringPadded -- * Peer address , PeerAddr(..) , peerSockAddr , connectToPeer, forkListener , ppPeer -- * Client version detection -- ** Info , ClientInfo(..), clientInfo, ppClientInfo, unknownClient -- ** Version , ClientVersion, ppClientVersion -- ** Implementation , ClientImpl(..), ppClientImpl ) where import Control.Applicative import Control.Concurrent import Control.Exception import Data.BEncode import Data.Bits import Data.Word import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Builder as B import Data.Foldable (foldMap) import Data.Monoid ((<>)) import Data.Serialize import Data.URLEncoded import Data.Version (Version(Version), versionBranch) import Data.Time.Clock (getCurrentTime) import Data.Time.Format (formatTime) import Text.PrettyPrint (text, Doc, (<+>)) import System.Locale (defaultTimeLocale) import Network hiding (accept) import Network.Socket -- TODO we have linker error here, so manual hardcoded version for a -- while. -- import Paths_network_bittorrent (version) version :: Version version = Version [0, 10, 0, 0] [] {----------------------------------------------------------------------- Peer identification -----------------------------------------------------------------------} -- | Peer identifier is exactly 20 bytes long bytestring. newtype PeerID = PeerID { getPeerID :: ByteString } deriving (Show, Eq, Ord, BEncodable) instance Serialize PeerID where put = putByteString . getPeerID get = PeerID <$> getBytes 20 instance URLShow PeerID where urlShow = BC.unpack . getPeerID -- | Format peer id in human readable form. ppPeerID :: PeerID -> Doc ppPeerID = text . BC.unpack . getPeerID -- | Azureus-style encoding have the following layout: -- -- * 1 byte : '-' -- -- * 2 bytes: client id -- -- * 4 bytes: version number -- -- * 1 byte : '-' -- -- * 12 bytes: random number -- azureusStyle :: ByteString -- ^ 2 character client ID, padded with 'H'. -> ByteString -- ^ Version number, padded with 'X'. -> ByteString -- ^ Random number, padded with '0'. -> PeerID -- ^ Azureus-style encoded peer ID. azureusStyle cid ver rnd = PeerID $ BL.toStrict $ B.toLazyByteString $ B.char8 '-' <> byteStringPadded cid 2 'H' <> byteStringPadded ver 4 'X' <> B.char8 '-' <> byteStringPadded rnd 12 '0' -- | Shadow-style encoding have the following layout: -- -- * 1 byte : client id. -- -- * 0-4 bytes: version number. If less than 4 then padded with -- '-' char. -- -- * 15 bytes : random number. If length is less than 15 then -- padded with '0' char. -- shadowStyle :: Char -- ^ Client ID. -> ByteString -- ^ Version number. -> ByteString -- ^ Random number. -> PeerID -- ^ Shadow style encoded peer ID. shadowStyle cid ver rnd = PeerID $ BL.toStrict $ B.toLazyByteString $ B.char8 cid <> byteStringPadded ver 4 '-' <> byteStringPadded rnd 15 '0' -- | "HS" - 2 bytes long client identifier. defaultClientID :: ByteString defaultClientID = "HS" -- | Gives exactly 4 bytes long version number for any version of the -- package. Version is taken from .cabal. defaultVersionNumber :: ByteString defaultVersionNumber = B.take 4 $ BC.pack $ foldMap show $ versionBranch version -- | Gives 15 characters long decimal timestamp such that: -- -- * 6 bytes : first 6 characters from picoseconds obtained with %q. -- -- * 1 bytes : character '.' for readability. -- -- * 9..* bytes: number of whole seconds since the Unix epoch -- (!)REVERSED. -- -- Can be used both with shadow and azureus style encoding. This -- format is used to make the ID's readable(for debugging) and more -- or less random. -- timestampByteString :: IO ByteString timestampByteString = (BC.pack . format) <$> getCurrentTime where format t = take 6 (formatTime defaultTimeLocale "%q" t) ++ "." ++ take 9 (reverse (formatTime defaultTimeLocale "%s" t)) -- | Here we use Azureus-style encoding with the following args: -- -- * 'HS' for the client id. -- -- * Version of the package for the version number -- -- * UTC time day ++ day time for the random number. -- newPeerID :: IO PeerID newPeerID = azureusStyle defaultClientID defaultVersionNumber <$> timestampByteString -- | Pad bytestring so it's becomes exactly request length. Conversion -- is done like so: -- -- * length < size: Complete bytestring by given charaters. -- -- * length = size: Output bytestring as is. -- -- * length > size: Drop last (length - size) charaters from a -- given bytestring. -- byteStringPadded :: ByteString -- ^ bytestring to be padded. -> Int -- ^ size of result builder. -> Char -- ^ character used for padding. -> B.Builder byteStringPadded bs s c = B.byteString (B.take s bs) <> B.byteString (BC.replicate padLen c) where padLen = s - min (B.length bs) s {----------------------------------------------------------------------- Client detection -----------------------------------------------------------------------} -- | All known client versions. data ClientImpl = IUnknown | IAres | IArctic | IAvicora | IBitPump | IAzureus | IBitBuddy | IBitComet | IBitflu | IBTG | IBitRocket | IBTSlave | IBittorrentX | IEnhancedCTorrent | ICTorrent | IDelugeTorrent | IPropagateDataClient | IEBit | IElectricSheep | IFoxTorrent | IGSTorrent | IHalite | IlibHSbittorrent | IHydranode | IKGet | IKTorrent | ILH_ABC | ILphant | ILibtorrent | ILibTorrent | ILimeWire | IMonoTorrent | IMooPolice | IMiro | IMoonlightTorrent | INetTransport | IPando | IqBittorrent | IQQDownload | IQt4TorrentExample | IRetriever | IShareaza | ISwiftbit | ISwarmScope | ISymTorrent | Isharktorrent | ITorrentDotNET | ITransmission | ITorrentstorm | ITuoTu | IuLeecher | IuTorrent | IVagaa | IBitLet | IFireTorrent | IXunlei | IXanTorrent | IXtorrent | IZipTorrent deriving (Show, Eq, Ord) parseImpl :: ByteString -> ClientImpl parseImpl = f . BC.unpack where f "AG" = IAres f "A~" = IAres f "AR" = IArctic f "AV" = IAvicora f "AX" = IBitPump f "AZ" = IAzureus f "BB" = IBitBuddy f "BC" = IBitComet f "BF" = IBitflu f "BG" = IBTG f "BR" = IBitRocket f "BS" = IBTSlave f "BX" = IBittorrentX f "CD" = IEnhancedCTorrent f "CT" = ICTorrent f "DE" = IDelugeTorrent f "DP" = IPropagateDataClient f "EB" = IEBit f "ES" = IElectricSheep f "FT" = IFoxTorrent f "GS" = IGSTorrent f "HL" = IHalite f "HS" = IlibHSbittorrent f "HN" = IHydranode f "KG" = IKGet f "KT" = IKTorrent f "LH" = ILH_ABC f "LP" = ILphant f "LT" = ILibtorrent f "lt" = ILibTorrent f "LW" = ILimeWire f "MO" = IMonoTorrent f "MP" = IMooPolice f "MR" = IMiro f "MT" = IMoonlightTorrent f "NX" = INetTransport f "PD" = IPando f "qB" = IqBittorrent f "QD" = IQQDownload f "QT" = IQt4TorrentExample f "RT" = IRetriever f "S~" = IShareaza f "SB" = ISwiftbit f "SS" = ISwarmScope f "ST" = ISymTorrent f "st" = Isharktorrent f "SZ" = IShareaza f "TN" = ITorrentDotNET f "TR" = ITransmission f "TS" = ITorrentstorm f "TT" = ITuoTu f "UL" = IuLeecher f "UT" = IuTorrent f "VG" = IVagaa f "WT" = IBitLet f "WY" = IFireTorrent f "XL" = IXunlei f "XT" = IXanTorrent f "XX" = IXtorrent f "ZT" = IZipTorrent f _ = IUnknown -- | Format client implementation info in human readable form. ppClientImpl :: ClientImpl -> Doc ppClientImpl = text . tail . show -- | Used to represent not recognized implementation unknownImpl :: ClientImpl unknownImpl = IUnknown -- TODO use Data.Version -- | Raw version of client, normally extracted from peer id. type ClientVersion = ByteString -- | Format client implementation version in human readable form. ppClientVersion :: ClientVersion -> Doc ppClientVersion = text . BC.unpack unknownVersion :: ClientVersion unknownVersion = "0000" -- | All useful infomation that can be obtained from a peer -- identifier. data ClientInfo = ClientInfo { ciImpl :: ClientImpl , ciVersion :: ClientVersion } deriving (Show, Eq, Ord) -- | Format client implementation in human readable form. ppClientInfo :: ClientInfo -> Doc ppClientInfo ClientInfo {..} = ppClientImpl ciImpl <+> "version" <+> ppClientVersion ciVersion -- | Unrecognized client implementation. unknownClient :: ClientInfo unknownClient = ClientInfo unknownImpl unknownVersion -- | Tries to extract meaningful information from peer ID bytes. If -- peer id uses unknown coding style then client info returned is -- 'unknownClient'. -- clientInfo :: PeerID -> ClientInfo clientInfo pid = either (const unknownClient) id $ runGet getCI (getPeerID pid) where -- TODO other styles getCI = do _ <- getWord8 ClientInfo <$> (parseImpl <$> getByteString 2) <*> getByteString 4 {- -- code used for generation; remove it later on mkEnumTyDef :: NM -> String mkEnumTyDef = unlines . map (" | I" ++) . nub . map snd mkPars :: NM -> String mkPars = unlines . map (\(code, impl) -> " f \"" ++ code ++ "\" = " ++ "I" ++ impl) type NM = [(String, String)] nameMap :: NM nameMap = [ ("AG", "Ares") , ("A~", "Ares") , ("AR", "Arctic") , ("AV", "Avicora") , ("AX", "BitPump") , ("AZ", "Azureus") , ("BB", "BitBuddy") , ("BC", "BitComet") , ("BF", "Bitflu") , ("BG", "BTG") , ("BR", "BitRocket") , ("BS", "BTSlave") , ("BX", "BittorrentX") , ("CD", "EnhancedCTorrent") , ("CT", "CTorrent") , ("DE", "DelugeTorrent") , ("DP", "PropagateDataClient") , ("EB", "EBit") , ("ES", "ElectricSheep") , ("FT", "FoxTorrent") , ("GS", "GSTorrent") , ("HL", "Halite") , ("HS", "libHSnetwork_bittorrent") , ("HN", "Hydranode") , ("KG", "KGet") , ("KT", "KTorrent") , ("LH", "LH_ABC") , ("LP", "Lphant") , ("LT", "Libtorrent") , ("lt", "LibTorrent") , ("LW", "LimeWire") , ("MO", "MonoTorrent") , ("MP", "MooPolice") , ("MR", "Miro") , ("MT", "MoonlightTorrent") , ("NX", "NetTransport") , ("PD", "Pando") , ("qB", "qBittorrent") , ("QD", "QQDownload") , ("QT", "Qt4TorrentExample") , ("RT", "Retriever") , ("S~", "Shareaza") , ("SB", "Swiftbit") , ("SS", "SwarmScope") , ("ST", "SymTorrent") , ("st", "sharktorrent") , ("SZ", "Shareaza") , ("TN", "TorrentDotNET") , ("TR", "Transmission") , ("TS", "Torrentstorm") , ("TT", "TuoTu") , ("UL", "uLeecher") , ("UT", "uTorrent") , ("VG", "Vagaa") , ("WT", "BitLet") , ("WY", "FireTorrent") , ("XL", "Xunlei") , ("XT", "XanTorrent") , ("XX", "Xtorrent") , ("ZT", "ZipTorrent") ] -} {----------------------------------------------------------------------- Peer address -----------------------------------------------------------------------} -- | Peer address info normally extracted from peer list or peer -- compact list encoding. data PeerAddr = PeerAddr { peerID :: Maybe PeerID , peerIP :: HostAddress , peerPort :: PortNumber } deriving (Show, Eq, Ord) -- TODO check semantic of ord and eq instances instance BEncodable PortNumber where toBEncode = toBEncode . fromEnum fromBEncode b = toEnum <$> fromBEncode b instance BEncodable PeerAddr where toBEncode (PeerAddr pid pip pport) = fromAssocs [ "peer id" -->? pid , "ip" --> pip , "port" --> pport ] fromBEncode (BDict d) = PeerAddr <$> d >--? "peer id" <*> d >-- "ip" <*> d >-- "port" fromBEncode _ = decodingError "PeerAddr" -- TODO make platform independent, clarify htonl -- | Convert peer info from tracker response to socket address. Used -- for establish connection between peers. -- peerSockAddr :: PeerAddr -> SockAddr peerSockAddr = SockAddrInet <$> (g . peerPort) <*> (htonl . peerIP) where htonl :: Word32 -> Word32 htonl d = ((d .&. 0xff) `shiftL` 24) .|. (((d `shiftR` 8 ) .&. 0xff) `shiftL` 16) .|. (((d `shiftR` 16) .&. 0xff) `shiftL` 8) .|. ((d `shiftR` 24) .&. 0xff) g :: PortNumber -> PortNumber g = id -- | Tries to connect to peer using reasonable default parameters. connectToPeer :: PeerAddr -> IO Socket connectToPeer p = do sock <- socket AF_INET Stream Network.Socket.defaultProtocol connect sock (peerSockAddr p) return sock forkListener :: ((PeerAddr, Socket) -> IO ()) -> IO PortNumber forkListener action = do sock <- socket AF_INET Stream defaultProtocol bindSocket sock (SockAddrInet 0 0) listen sock 1 addr <- getSocketName sock case addr of SockAddrInet port _ -> do forkIO (loop sock) return port _ -> do throwIO $ userError "listener: impossible happened" where loop sock = do (conn, addr) <- accept sock case addr of SockAddrInet port host -> action (PeerAddr Nothing host port, conn) _ -> return () loop sock -- | Pretty print peer address in human readable form. ppPeer :: PeerAddr -> Doc ppPeer p @ PeerAddr {..} = case peerID of Just pid -> ppClientInfo (clientInfo pid) <+> "at" <+> paddr Nothing -> paddr where paddr = text (show (peerSockAddr p))