From e3ee3bf4b174363f55c3af2195bd191e9c0d25b7 Mon Sep 17 00:00:00 2001 From: Sam Truzjan Date: Sat, 23 Nov 2013 04:29:59 +0400 Subject: Add mainline client implementation id --- src/Network/BitTorrent/Core/PeerId.hs | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) (limited to 'src/Network/BitTorrent/Core/PeerId.hs') diff --git a/src/Network/BitTorrent/Core/PeerId.hs b/src/Network/BitTorrent/Core/PeerId.hs index 6aebe8d4..75a4d7a0 100644 --- a/src/Network/BitTorrent/Core/PeerId.hs +++ b/src/Network/BitTorrent/Core/PeerId.hs @@ -39,12 +39,14 @@ import Control.Applicative import Data.Aeson import Data.BEncode as BE import Data.ByteString as BS +import Data.ByteString.Internal as BS import Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Builder as BS import Data.Default import Data.Foldable (foldMap) import Data.List as L +import Data.List.Split as L import Data.Maybe (fromMaybe) import Data.Monoid import Data.Serialize as S @@ -279,9 +281,20 @@ parseImpl = f . BC.unpack -- clientInfo :: PeerId -> ClientInfo clientInfo pid = either (const def) id $ runGet getCI (getPeerId pid) - where -- TODO other styles - getCI = getWord8 >> ClientInfo <$> getClientImpl <*> getClientVersion - getClientImpl = parseImpl <$> getByteString 2 - getClientVersion = mkVer <$> getByteString 4 + where + getCI = do + leading <- BS.w2c <$> getWord8 + case leading of + '-' -> ClientInfo <$> getAzureusImpl <*> getAzureusVersion + 'M' -> ClientInfo <$> pure IMainline <*> getMainlineVersion + _ -> pure def + + getMainlineVersion = do + str <- BC.unpack <$> getByteString 7 + let mnums = L.filter (not . L.null) $ L.linesBy ('-' ==) str + return $ Version (fromMaybe [] $ sequence $ L.map readMaybe mnums) [] + + getAzureusImpl = parseImpl <$> getByteString 2 + getAzureusVersion = mkVer <$> getByteString 4 where mkVer bs = Version [fromMaybe 0 $ readMaybe $ BC.unpack bs] [] -- cgit v1.2.3