src/FuncTorrent/Server.hs

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