Permalink
Browse files

added handling of command line options;

added an option to set the TCP port to listen on;
in absence of this option, made the server automatically determine a free port (using linear search)
  • Loading branch information...
ttencate committed Jun 12, 2009
1 parent af8738e commit e8483535ca520d320d7a31bf4024c0754e9d1f38
Showing with 62 additions and 7 deletions.
  1. +4 −1 server/Main.hs
  2. +19 −6 server/Scion/Server/Emacs.hs
  3. +38 −0 server/Scion/Server/Options.hs
  4. +1 −0 server/scion-server.cabal
View
@@ -1,6 +1,9 @@
module Main where
import Scion
+import Scion.Server.Options
import Scion.Server.Emacs
-main = runScion $ runServer
+main = do
+ opts <- readOptions
+ runScion $ runServer opts
@@ -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
@@ -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>")
+ "port number to listen on"
+ , Option
+ ['v'] ["verbosity"]
+ (ReqArg (\v opts -> opts { optLogLevel = read v }) "<number>")
+ "log level (not yet implemented)"
+ ]
@@ -29,4 +29,5 @@ executable scion_server
other-modules: Scion.Server.Emacs,
Scion.Server.Commands,
+ Scion.Server.Options,
Scion.Server.Protocol

0 comments on commit e848353

Please sign in to comment.