From 07ac8270807140fac201b7c973e12f924ca4b36b Mon Sep 17 00:00:00 2001
From: Sam T <pxqr.sta@gmail.com>
Date: Fri, 14 Jun 2013 11:06:31 +0400
Subject: ~ Minor changes.

---
 src/Network/BitTorrent/Exchange.hs |  9 ++++++++-
 src/Network/BitTorrent/Peer.hs     | 33 ++++++++++++++++++++++++++++++---
 2 files changed, 38 insertions(+), 4 deletions(-)

(limited to 'src/Network/BitTorrent')

diff --git a/src/Network/BitTorrent/Exchange.hs b/src/Network/BitTorrent/Exchange.hs
index 2d0393c0..862611f9 100644
--- a/src/Network/BitTorrent/Exchange.hs
+++ b/src/Network/BitTorrent/Exchange.hs
@@ -102,7 +102,7 @@ runSession  se addr p2p =
     isIOException _ = return ()
 
 -- | Run P2P session in the current thread. Normally you don't need this
--- function in client application.
+-- function in client application, except for debugging.
 runP2P :: SwarmSession -> PeerAddr -> P2P () -> IO ()
 runP2P se addr p2p = waitVacancy se $ runSession se addr p2p
 
@@ -115,6 +115,13 @@ spawnP2P se addr p2p = do
   forkIO $ do
     runSession se addr p2p `finally` leaveSwarm se
 
+-- TODO unify this all using PeerConnection
+{-
+listenP2P :: SwarmSession -> P2P () -> IO PortNumber
+listenP2P _ _ = undefined
+
+chainP2P :: SwarmSession -> PeerConnection -> P2P () -> IO ()
+-}
 {-----------------------------------------------------------------------
     Exceptions
 -----------------------------------------------------------------------}
diff --git a/src/Network/BitTorrent/Peer.hs b/src/Network/BitTorrent/Peer.hs
index 9aa924d3..41630c6d 100644
--- a/src/Network/BitTorrent/Peer.hs
+++ b/src/Network/BitTorrent/Peer.hs
@@ -44,12 +44,14 @@ module Network.BitTorrent.Peer
 
          -- ** Generation
        , newPeerID, timestampByteString
+
          -- ** Extra
        , byteStringPadded
 
          -- * Peer address
        , PeerAddr(..)
-       , peerSockAddr, connectToPeer
+       , peerSockAddr
+       , connectToPeer, forkListener
        , ppPeer
 
          -- * Client version detection
@@ -66,6 +68,8 @@ module Network.BitTorrent.Peer
 
 
 import Control.Applicative
+import Control.Concurrent
+import Control.Exception
 import Data.BEncode
 import Data.Bits
 import Data.Word
@@ -84,7 +88,7 @@ import Data.Time.Format (formatTime)
 import Text.PrettyPrint (text, Doc, (<+>))
 import System.Locale    (defaultTimeLocale)
 
-import Network
+import Network hiding (accept)
 import Network.Socket
 
 
@@ -489,7 +493,8 @@ data PeerAddr = PeerAddr {
     , peerIP   :: HostAddress
     , peerPort :: PortNumber
     } deriving (Show, Eq, Ord)
-               -- TODO verify semantic of ord and eq instances
+
+-- TODO check semantic of ord and eq instances
 
 instance BEncodable PortNumber where
   toBEncode = toBEncode . fromEnum
@@ -535,6 +540,28 @@ connectToPeer p = do
   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
-- 
cgit v1.2.3