From: Ramakrishnan Muthukrishnan Date: Sun, 13 Sep 2015 16:52:17 +0000 (+0530) Subject: a crude server implementation X-Git-Url: https://git.rkrishnan.org/components/com_hotproperty/flags/frontends/index.html?a=commitdiff_plain;h=1d114193577940b181252c097fcd61366158ce7c;p=functorrent.git a crude server implementation --- diff --git a/functorrent.cabal b/functorrent.cabal index dd0a306..b937472 100644 --- a/functorrent.cabal +++ b/functorrent.cabal @@ -23,6 +23,7 @@ library FuncTorrent.Network FuncTorrent.Peer, FuncTorrent.PeerMsgs, + FuncTorrent.Server, FuncTorrent.Tracker, FuncTorrent.Utils diff --git a/src/FuncTorrent/Server.hs b/src/FuncTorrent/Server.hs new file mode 100644 index 0000000..e675c6c --- /dev/null +++ b/src/FuncTorrent/Server.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE OverloadedStrings #-} +module FuncTorrent.Server where + +import Control.Concurrent (forkIO) +import Control.Monad (forever) +import Network (withSocketsDo, listenOn, accept, Socket, PortID ( PortNumber )) +import System.IO (hSetBuffering, BufferMode ( NoBuffering )) + +import FuncTorrent.Metainfo (Metainfo) +import FuncTorrent.Peer (handlePeerMsgs, Peer(..)) + +-- server is listening on any port from 6881 - 6889 +-- return the port number used +start :: IO (Socket, PortID) +start = withSocketsDo $ do + let portnums = [6881 .. 6889] + sock <- listenOn $ PortNumber $ fromIntegral (head portnums) + return (sock, PortNumber $ head portnums) + +run :: Socket -> String -> Metainfo -> IO () +run listenSock peerid m = forever $ do + (handle, ip, port) <- accept listenSock + let peer = Peer "" ip (fromIntegral port) + hSetBuffering handle NoBuffering + forkIO $ handlePeerMsgs peer peerid m diff --git a/src/main/Main.hs b/src/main/Main.hs index dff915f..997801b 100644 --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -3,6 +3,7 @@ module Main where import Prelude hiding (log, length, readFile, getContents) +import Control.Concurrent (forkIO) import Data.ByteString.Char8 (ByteString, getContents, readFile, unpack) import System.Environment (getArgs) import System.Exit (exitSuccess) @@ -12,6 +13,7 @@ import System.Random (getStdGen, randomRs) import FuncTorrent.Logger (initLogger, logMessage, logStop) import FuncTorrent.Metainfo (Info(..), Metainfo(..), torrentToMetainfo) import FuncTorrent.Peer (handlePeerMsgs) +import qualified FuncTorrent.Server as Server import FuncTorrent.Tracker (peers, getTrackerResponse) logError :: String -> (String -> IO ()) -> IO () @@ -56,8 +58,11 @@ main = do Right m -> do log "Input File OK" log $ "Downloading file : " ++ name (info m) - log "Trying to fetch peers" + log $ "starting server" + (serverSock, portnum) <- Server.start + log "Trying to fetch peers" + forkIO $ Server.run serverSock peerId m log $ "Trackers: " ++ head (announceList m) trackerResp <- getTrackerResponse peerId m case trackerResp of