From e3ee3bf4b174363f55c3af2195bd191e9c0d25b7 Mon Sep 17 00:00:00 2001
From: Sam Truzjan <pxqr.sta@gmail.com>
Date: Sat, 23 Nov 2013 04:29:59 +0400
Subject: Add mainline client implementation id

---
 src/Data/Torrent/Client.hs            |  1 +
 src/Network/BitTorrent/Core/PeerId.hs | 21 +++++++++++++++++----
 2 files changed, 18 insertions(+), 4 deletions(-)

(limited to 'src')

diff --git a/src/Data/Torrent/Client.hs b/src/Data/Torrent/Client.hs
index 0fd6722b..079b63c1 100644
--- a/src/Data/Torrent/Client.hs
+++ b/src/Data/Torrent/Client.hs
@@ -50,6 +50,7 @@ import Paths_bittorrent (version)
 --
 data ClientImpl =
    IUnknown
+ | IMainline
  | IAres
  | IArctic
  | IAvicora
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