src/FuncTorrent/Server.hs

   1 {-
   2  - Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
   3  -
   4  - This file is part of FuncTorrent.
   5  -
   6  - FuncTorrent is free software; you can redistribute it and/or modify
   7  - it under the terms of the GNU General Public License as published by
   8  - the Free Software Foundation; either version 3 of the License, or
   9  - (at your option) any later version.
  10  -
  11  - FuncTorrent is distributed in the hope that it will be useful,
  12  - but WITHOUT ANY WARRANTY; without even the implied warranty of
  13  - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14  - GNU General Public License for more details.
  15  -
  16  - You should have received a copy of the GNU General Public License
  17  - along with FuncTorrent; if not,  see <http://www.gnu.org/licenses/>
  18  -}
  19
  20 {-# LANGUAGE OverloadedStrings #-}
  21
  22 module FuncTorrent.Server where
  23
  24 import Control.Concurrent (forkIO)
  25 import Control.Monad (forever)
  26 import Network (withSocketsDo, listenOn, accept, Socket, PortID ( PortNumber ))
  27 import System.IO (hSetBuffering, BufferMode ( NoBuffering ))
  28
  29 import FuncTorrent.Metainfo (Metainfo)
  30 import FuncTorrent.Peer (handlePeerMsgs, PieceMap)
  31 import FuncTorrent.PeerMsgs (Peer(..))
  32 import qualified FuncTorrent.FileSystem as FS (MsgChannel)
  33
  34 -- server is listening on any port from 6881 - 6889
  35 -- return the port number used
  36 start :: IO (Socket, PortID)
  37 start = withSocketsDo $ do
  38   let portnums = [6881 .. 6889]
  39   sock <- listenOn $ PortNumber $ fromIntegral (head portnums)
  40   return (sock, PortNumber $ head portnums)
  41
  42 run :: Socket -> String -> Metainfo -> PieceMap -> FS.MsgChannel -> IO ()
  43 run listenSock peerid m pieceMap c = forever $ do
  44   (handle, ip, port) <- accept listenSock
  45   let peer = Peer ip (fromIntegral port)
  46   hSetBuffering handle NoBuffering
  47   forkIO $ handlePeerMsgs peer peerid m pieceMap False c