summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--network-bittorrent.cabal3
-rw-r--r--src/Network/BitTorrent.hs4
-rw-r--r--src/Network/BitTorrent/Peer.hs56
-rw-r--r--src/Network/BitTorrent/PeerID.hs50
-rw-r--r--src/Network/BitTorrent/PeerWire/Handshake.hs40
-rw-r--r--src/Network/BitTorrent/Tracker.hs1
6 files changed, 100 insertions, 54 deletions
diff --git a/network-bittorrent.cabal b/network-bittorrent.cabal
index b408620b..98423512 100644
--- a/network-bittorrent.cabal
+++ b/network-bittorrent.cabal
@@ -24,9 +24,12 @@ library
24 exposed-modules: Data.Torrent 24 exposed-modules: Data.Torrent
25 , Data.Torrent.InfoHash 25 , Data.Torrent.InfoHash
26 , Network.BitTorrent 26 , Network.BitTorrent
27 , Network.BitTorrent.Peer
27 , Network.BitTorrent.PeerID 28 , Network.BitTorrent.PeerID
29
28 , Network.BitTorrent.Tracker 30 , Network.BitTorrent.Tracker
29 , Network.BitTorrent.Tracker.Scrape 31 , Network.BitTorrent.Tracker.Scrape
32
30 , Network.BitTorrent.PeerWire 33 , Network.BitTorrent.PeerWire
31 , Network.BitTorrent.PeerWire.ClientInfo 34 , Network.BitTorrent.PeerWire.ClientInfo
32 , Network.BitTorrent.PeerWire.Block 35 , Network.BitTorrent.PeerWire.Block
diff --git a/src/Network/BitTorrent.hs b/src/Network/BitTorrent.hs
index 9c1977d4..97efbbda 100644
--- a/src/Network/BitTorrent.hs
+++ b/src/Network/BitTorrent.hs
@@ -1,9 +1,11 @@
1module Network.BitTorrent 1module Network.BitTorrent
2 ( module Network.BitTorrent.PeerID 2 ( module Network.BitTorrent.Peer
3 , module Network.BitTorrent.PeerID
3 , module Network.BitTorrent.Tracker 4 , module Network.BitTorrent.Tracker
4 , module Network.BitTorrent.PeerWire 5 , module Network.BitTorrent.PeerWire
5 ) where 6 ) where
6 7
8import Network.BitTorrent.Peer
7import Network.BitTorrent.PeerID 9import Network.BitTorrent.PeerID
8import Network.BitTorrent.Tracker 10import Network.BitTorrent.Tracker
9import Network.BitTorrent.PeerWire 11import Network.BitTorrent.PeerWire
diff --git a/src/Network/BitTorrent/Peer.hs b/src/Network/BitTorrent/Peer.hs
new file mode 100644
index 00000000..e16329d2
--- /dev/null
+++ b/src/Network/BitTorrent/Peer.hs
@@ -0,0 +1,56 @@
1-- |
2-- Copyright : (c) Sam T. 2013
3-- License : MIT
4-- Maintainer : pxqr.sta@gmail.com
5-- Stability : experimental
6-- Portability : non-portable
7--
8module Network.BitTorrent.Peer
9 ( Peer(..)
10 , peerSockAddr, connectToPeer
11 , ppPeer
12 ) where
13
14import Control.Applicative
15import Data.Word
16import Data.Bits
17import Network
18import Network.Socket
19
20import Network.BitTorrent.PeerID
21import Network.BitTorrent.PeerWire.ClientInfo
22
23
24data Peer = Peer {
25 peerID :: Maybe PeerID
26 , peerIP :: HostAddress
27 , peerPort :: PortNumber
28 } deriving Show
29
30-- TODO make platform independent, clarify htonl
31-- | Convert peer info from tracker response to socket address.
32-- Used for establish connection between peers.
33--
34peerSockAddr :: Peer -> SockAddr
35peerSockAddr = SockAddrInet <$> (g . peerPort) <*> (htonl . peerIP)
36 where
37 htonl :: Word32 -> Word32
38 htonl d =
39 ((d .&. 0xff) `shiftL` 24) .|.
40 (((d `shiftR` 8 ) .&. 0xff) `shiftL` 16) .|.
41 (((d `shiftR` 16) .&. 0xff) `shiftL` 8) .|.
42 ((d `shiftR` 24) .&. 0xff)
43
44 g :: PortNumber -> PortNumber
45 g = id
46
47-- | Tries to connect to peer using reasonable default parameters.
48connectToPeer :: Peer -> IO Socket
49connectToPeer p = do
50 sock <- socket AF_INET Stream Network.Socket.defaultProtocol
51 connect sock (peerSockAddr p)
52 return sock
53
54ppPeer :: Peer -> String
55ppPeer p = maybe "" (++ " at ") ((ppClientInfo . clientInfo) <$> peerID p)
56 ++ show (peerSockAddr p)
diff --git a/src/Network/BitTorrent/PeerID.hs b/src/Network/BitTorrent/PeerID.hs
index cef1fa58..2c8818fe 100644
--- a/src/Network/BitTorrent/PeerID.hs
+++ b/src/Network/BitTorrent/PeerID.hs
@@ -8,17 +8,14 @@
8-- 8--
9-- This module provides 'Peer' and 'PeerID' datatypes and all related 9-- This module provides 'Peer' and 'PeerID' datatypes and all related
10-- operations. 10-- operations.
11--
11-- Recommended method for generation of the peer ID's is 'newPeerID', 12-- Recommended method for generation of the peer ID's is 'newPeerID',
12-- though this module exports some other goodies for custom generation. 13-- though this module exports some other goodies for custom generation.
13-- 14--
14{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-} 15{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}
15module Network.BitTorrent.PeerID 16module Network.BitTorrent.PeerID
16 ( -- * Peer addr 17 ( -- * Peer identification
17 Peer(..) 18 PeerID (getPeerID), ppPeerID
18 , peerSockAddr, connectToPeer
19
20 -- * Peer identification
21 , PeerID (getPeerID)
22 19
23 -- ** Encoding styles 20 -- ** Encoding styles
24 , azureusStyle, shadowStyle 21 , azureusStyle, shadowStyle
@@ -34,8 +31,6 @@ module Network.BitTorrent.PeerID
34 ) where 31 ) where
35 32
36import Control.Applicative 33import Control.Applicative
37import Data.Word
38import Data.Bits
39import Data.BEncode 34import Data.BEncode
40import Data.ByteString (ByteString) 35import Data.ByteString (ByteString)
41import qualified Data.ByteString as B 36import qualified Data.ByteString as B
@@ -50,8 +45,6 @@ import Data.Version (Version(Version), versionBranch)
50import Data.Time.Clock (getCurrentTime) 45import Data.Time.Clock (getCurrentTime)
51import Data.Time.Format (formatTime) 46import Data.Time.Format (formatTime)
52import System.Locale (defaultTimeLocale) 47import System.Locale (defaultTimeLocale)
53import Network
54import Network.Socket
55 48
56 49
57-- TODO we have linker error here, so manual hardcoded version for a while. 50-- TODO we have linker error here, so manual hardcoded version for a while.
@@ -60,40 +53,6 @@ version :: Version
60version = Version [0, 10, 0, 0] [] 53version = Version [0, 10, 0, 0] []
61 54
62 55
63
64data Peer = Peer {
65 peerID :: Maybe PeerID
66 , peerIP :: HostAddress
67 , peerPort :: PortNumber
68 } deriving Show
69
70-- TODO make platform independent, clarify htonl
71-- | Convert peer info from tracker response to socket address.
72-- Used for establish connection between peers.
73--
74peerSockAddr :: Peer -> SockAddr
75peerSockAddr = SockAddrInet <$> (g . peerPort) <*> (htonl . peerIP)
76 where
77 htonl :: Word32 -> Word32
78 htonl d =
79 ((d .&. 0xff) `shiftL` 24) .|.
80 (((d `shiftR` 8 ) .&. 0xff) `shiftL` 16) .|.
81 (((d `shiftR` 16) .&. 0xff) `shiftL` 8) .|.
82 ((d `shiftR` 24) .&. 0xff)
83
84 g :: PortNumber -> PortNumber
85 g = id
86
87-- ipv6 extension
88-- | Tries to connect to peer using reasonable default parameters.
89--
90connectToPeer :: Peer -> IO Socket
91connectToPeer p = do
92 sock <- socket AF_INET Stream Network.Socket.defaultProtocol
93 connect sock (peerSockAddr p)
94 return sock
95
96
97-- | Peer identifier is exactly 20 bytes long bytestring. 56-- | Peer identifier is exactly 20 bytes long bytestring.
98newtype PeerID = PeerID { getPeerID :: ByteString } 57newtype PeerID = PeerID { getPeerID :: ByteString }
99 deriving (Show, Eq, Ord, BEncodable) 58 deriving (Show, Eq, Ord, BEncodable)
@@ -105,6 +64,9 @@ instance Serialize PeerID where
105instance URLShow PeerID where 64instance URLShow PeerID where
106 urlShow = BC.unpack . getPeerID 65 urlShow = BC.unpack . getPeerID
107 66
67ppPeerID :: PeerID -> String
68ppPeerID = BC.unpack . getPeerID
69
108 70
109-- | Azureus-style encoding have the following layout: 71-- | Azureus-style encoding have the following layout:
110-- 72--
diff --git a/src/Network/BitTorrent/PeerWire/Handshake.hs b/src/Network/BitTorrent/PeerWire/Handshake.hs
index 6ce37887..a80728aa 100644
--- a/src/Network/BitTorrent/PeerWire/Handshake.hs
+++ b/src/Network/BitTorrent/PeerWire/Handshake.hs
@@ -11,30 +11,47 @@ module Network.BitTorrent.PeerWire.Handshake
11 , handshakeMaxSize 11 , handshakeMaxSize
12 , defaultBTProtocol, defaultReserved, defaultHandshake 12 , defaultBTProtocol, defaultReserved, defaultHandshake
13 , handshake 13 , handshake
14 , ppHandshake
14 ) where 15 ) where
15 16
16import Control.Applicative 17import Control.Applicative
17import Data.Word 18import Data.Word
18import Data.ByteString (ByteString) 19import Data.ByteString (ByteString)
19import qualified Data.ByteString as B 20import qualified Data.ByteString as B
21import qualified Data.ByteString.Char8 as BC
20import Data.Serialize as S 22import Data.Serialize as S
21import Data.Torrent.InfoHash 23import Data.Torrent.InfoHash
22import Network 24import Network
23import Network.Socket.ByteString 25import Network.Socket.ByteString
24 26
25import Network.BitTorrent.PeerID 27import Network.BitTorrent.PeerID
28import Network.BitTorrent.PeerWire.ClientInfo
26 29
27 30
28-- | In order to establish the connection between peers we should send 'Handshake' 31-- | In order to establish the connection between peers we should send
29-- message. The 'Handshake' is a required message and must be the first message 32-- 'Handshake' message. The 'Handshake' is a required message and
30-- transmitted by the peer to the another peer. 33-- must be the first message transmitted by the peer to the another
34-- peer.
35--
31data Handshake = Handshake { 36data Handshake = Handshake {
32 hsProtocol :: ByteString -- ^ Identifier of the protocol. 37 -- ^ Identifier of the protocol.
33 , hsReserved :: Word64 -- ^ Reserved bytes, rarely used. 38 hsProtocol :: ByteString
34 , hsInfoHash :: InfoHash -- ^ Hash from the metainfo file. 39
35 -- This /should be/ same hash that is transmitted in tracker requests. 40 -- ^ Reserved bytes used to specify supported BEP's.
36 , hsPeerID :: PeerID -- ^ Peer id of the initiator. 41 , hsReserved :: Word64
37 -- This is /usually the same peer id that is transmitted in tracker requests. 42
43 -- ^ Info hash of the info part of the metainfo file. that is
44 -- transmitted in tracker requests. Info hash of the initiator
45 -- handshake and response handshake should match, otherwise
46 -- initiator should break the connection.
47 --
48 , hsInfoHash :: InfoHash
49
50 -- ^ Peer id of the initiator. This is usually the same peer id
51 -- that is transmitted in tracker requests.
52 --
53 , hsPeerID :: PeerID
54
38 } deriving (Show, Eq) 55 } deriving (Show, Eq)
39 56
40instance Serialize Handshake where 57instance Serialize Handshake where
@@ -52,6 +69,11 @@ instance Serialize Handshake where
52 <*> get 69 <*> get
53 <*> get 70 <*> get
54 71
72-- TODO add reserved bits info
73ppHandshake :: Handshake -> String
74ppHandshake hs = BC.unpack (hsProtocol hs) ++ " "
75 ++ ppClientInfo (clientInfo (hsPeerID hs))
76
55-- | Maximum size of handshake message in bytes. 77-- | Maximum size of handshake message in bytes.
56handshakeMaxSize :: Int 78handshakeMaxSize :: Int
57handshakeMaxSize = 1 + 256 + 8 + 20 + 20 79handshakeMaxSize = 1 + 256 + 8 + 20 + 20
diff --git a/src/Network/BitTorrent/Tracker.hs b/src/Network/BitTorrent/Tracker.hs
index 643aca16..99ffc280 100644
--- a/src/Network/BitTorrent/Tracker.hs
+++ b/src/Network/BitTorrent/Tracker.hs
@@ -46,6 +46,7 @@ import Network.Socket
46import Network.HTTP 46import Network.HTTP
47import Network.URI 47import Network.URI
48 48
49import Network.BitTorrent.Peer
49import Network.BitTorrent.PeerID 50import Network.BitTorrent.PeerID
50import Network.BitTorrent.Tracker.Scrape 51import Network.BitTorrent.Tracker.Scrape
51 52