diff --git a/server/Main.hs b/server/Main.hs index 5618306..714fefd 100644 --- a/server/Main.hs +++ b/server/Main.hs @@ -1,6 +1,9 @@ module Main where import Scion +import Scion.Server.Options import Scion.Server.Emacs -main = runScion $ runServer \ No newline at end of file +main = do + opts <- readOptions + runScion $ runServer opts diff --git a/server/Scion/Server/Emacs.hs b/server/Scion/Server/Emacs.hs index 46fb2a1..baadfb1 100644 --- a/server/Scion/Server/Emacs.hs +++ b/server/Scion/Server/Emacs.hs @@ -14,14 +14,14 @@ module Scion.Server.Emacs where import Scion.Types +import Scion.Server.Options import Scion.Server.Protocol import Scion.Server.Commands -import Exception +import Exception ( Exception, ghandle, throwIO ) import MonadUtils import GHC -import Control.Exception import Control.Monad ( liftM, when ) import Data.Bits ( shiftL ) import Data.Char ( isHexDigit, digitToInt ) @@ -41,22 +41,30 @@ import qualified Data.ByteString.Char8 as S data SocketClosed = SocketClosed deriving (Show, Typeable) instance Exception SocketClosed +instance Bounded PortNumber where + minBound = 0 + maxBound = 0xFFFF + logLevel :: Int logLevel = 2 -runServer :: ScionM () -runServer = +runServer :: ServerOptions -> ScionM () +runServer opts = reifyScionM $ \s -> withSocketsDo $ do liftIO $ do hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering log 1 "starting up server..." - sock <- liftIO $ listenOn (PortNumber 4005) + let ports = case optPort opts of + AutoPort -> map PortNumber [4005..maxBound] + FixedPort p -> [PortNumber (fromIntegral p)] + sock <- liftIO $ listenOnOneOf ports reflectScionM (loop sock) s where loop sock = do log 4 "accepting" - liftIO $ putStrLn "=== Listening on port: 4005" + portNr <- liftIO $ socketPort sock + liftIO $ putStrLn $ "=== Listening on port: " ++ show portNr (sock', _addr) <- liftIO $ accept sock log 4 "starting to serve" more <- eventLoop sock' @@ -66,6 +74,11 @@ runServer = if more then loop sock else return () +listenOnOneOf :: [PortID] -> IO Socket +listenOnOneOf (p:ps) = catch + (listenOn p) + (\ex -> if null ps then throwIO ex else listenOnOneOf ps) + eventLoop :: Socket -> ScionM Bool eventLoop sock = ghandle (\(_e :: SocketClosed) -> return True) $ do diff --git a/server/Scion/Server/Options.hs b/server/Scion/Server/Options.hs new file mode 100644 index 0000000..72b2285 --- /dev/null +++ b/server/Scion/Server/Options.hs @@ -0,0 +1,38 @@ +module Scion.Server.Options where + +import System.Environment ( getArgs ) +import System.Exit ( exitWith, ExitCode(..) ) +import System.Console.GetOpt ( getOpt, usageInfo, ArgOrder(..), OptDescr(..), ArgDescr(..) ) + +data ServerPort = AutoPort | FixedPort Int + +data ServerOptions = ServerOptions + { optPort :: ServerPort + , optLogLevel :: Int + } + +defaultOptions = ServerOptions + { optPort = AutoPort + , optLogLevel = 2 + } + +readOptions :: IO ServerOptions +readOptions = do + argv <- getArgs + case getOpt Permute options argv of + (o, n, [] ) -> return $ foldl (flip id) defaultOptions o + (_, _, errs) -> putStr (concat errs ++ usageInfo header options) >> exitWith (ExitFailure 1) + where + header = "Command line options:" + + +options :: [OptDescr (ServerOptions -> ServerOptions)] +options = + [ Option ['p'] ["port"] + (ReqArg (\p opts -> opts { optPort = FixedPort (read p) }) "") + "port number to listen on" + , Option + ['v'] ["verbosity"] + (ReqArg (\v opts -> opts { optLogLevel = read v }) "") + "log level (not yet implemented)" + ] diff --git a/server/scion-server.cabal b/server/scion-server.cabal index 12bea42..40a6d05 100644 --- a/server/scion-server.cabal +++ b/server/scion-server.cabal @@ -29,4 +29,5 @@ executable scion_server other-modules: Scion.Server.Emacs, Scion.Server.Commands, + Scion.Server.Options, Scion.Server.Protocol