Main.hs

   1 {-# LANGUAGE CPP #-}
   2 import           Control.Monad
   3 import           Data.Maybe
   4 import           Network
   5 import           System.Console.GetOpt
   6 import           System.Environment
   7 import           System.Exit
   8 import           System.Posix.Types
   9 import           System.Posix.User
  10
  11 data CmdOpt
  12     = OptPortNum   PortNumber
  13     | OptLSDir     FilePath
  14     | OptUserName  String
  15     | OptGroupName String
  16     | OptHelp
  17     deriving (Eq, Show)
  18
  19
  20 defaultPort :: PortNumber
  21 defaultPort = fromIntegral 8080
  22
  23 defaultUserName :: String
  24 defaultUserName = "daemon"
  25
  26 defaultGroupName :: String
  27 defaultGroupName = "daemon"
  28
  29
  30 options :: [OptDescr CmdOpt]
  31 options = [ Option ['p'] ["port"]
  32                    (ReqArg (OptPortNum . fromIntegral . read) "NUM")
  33                    ("Port number to listen. (default: " ++ show defaultPort ++ ")")
  34
  35           , Option ['d'] ["localstatedir"]
  36                    (ReqArg OptLSDir "DIR")
  37                    ("Path to the database directory. (default: " ++ LOCALSTATEDIR ++ ")")
  38
  39           , Option ['u'] ["user"]
  40                    (ReqArg OptUserName "USER")
  41                    ("Which user to setuid. (default: " ++ defaultUserName ++ ")")
  42
  43           , Option ['g'] ["group"]
  44                    (ReqArg OptGroupName "GROUP")
  45                    ("Which user to setgid. (default: " ++ defaultGroupName ++ ")")
  46
  47           , Option ['h'] ["help"]
  48                    (NoArg OptHelp)
  49                    "Print this message."
  50           ]
  51
  52
  53 printUsage :: IO ()
  54 printUsage = do putStrLn "Usage:"
  55                 putStrLn "  rakka [OPTIONS...]"
  56                 putStrLn ""
  57                 putStr $ usageInfo "Options:" options
  58
  59
  60 main :: IO ()
  61 main = do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
  62
  63           when (not $ null errors)
  64                    $ do mapM_ putStr errors
  65                         exitWith $ ExitFailure 1
  66
  67           when (any (\ x -> x == OptHelp) opts)
  68                    $ do printUsage
  69                         exitWith ExitSuccess
  70
  71           when (not $ null nonOpts)
  72                    $ do printUsage
  73                         exitWith $ ExitFailure 1
  74
  75           portNum <- getPortNum opts
  76           uid     <- getUserID opts
  77
  78           print portNum
  79           print uid
  80
  81
  82 getPortNum :: [CmdOpt] -> IO PortNumber
  83 getPortNum opts
  84     = do let xs = mapMaybe (\ x -> case x of
  85                                      OptPortNum n -> Just n
  86                                      _            -> Nothing) opts
  87          case xs of
  88            []     -> return defaultPort
  89            (x:[]) -> return x
  90            _      -> error "too many --port options."
  91
  92
  93 getUserID :: [CmdOpt] -> IO UserID
  94 getUserID opts
  95     = do let xs   = mapMaybe (\ x -> case x of
  96                                        OptUserName n -> Just n
  97                                        _             -> Nothing) opts
  98              name = case xs of
  99                       []     -> defaultUserName
 100                       (x:[]) -> x
 101                       _      -> error "too many --user options."
 102
 103          userEnt <- getUserEntryForName name
 104          return $ userID userEnt
 105