+{-# LANGUAGE CPP #-}
+import Control.Monad
+import Data.Maybe
+import Network
+import System.Console.GetOpt
+import System.Environment
+import System.Exit
+import System.Posix.Types
+import System.Posix.User
+
+data CmdOpt
+ = OptPortNum PortNumber
+ | OptLSDir FilePath
+ | OptUserName String
+ | OptGroupName String
+ | OptHelp
+ deriving (Eq, Show)
+
+
+defaultPort :: PortNumber
+defaultPort = fromIntegral 8080
+
+defaultUserName :: String
+defaultUserName = "daemon"
+
+defaultGroupName :: String
+defaultGroupName = "daemon"
+
+
+options :: [OptDescr CmdOpt]
+options = [ Option ['p'] ["port"]
+ (ReqArg (OptPortNum . fromIntegral . read) "NUM")
+ ("Port number to listen. (default: " ++ show defaultPort ++ ")")
+
+ , Option ['d'] ["localstatedir"]
+ (ReqArg OptLSDir "DIR")
+ ("Path to the database directory. (default: " ++ LOCALSTATEDIR ++ ")")
+
+ , Option ['u'] ["user"]
+ (ReqArg OptUserName "USER")
+ ("Which user to setuid. (default: " ++ defaultUserName ++ ")")
+
+ , Option ['g'] ["group"]
+ (ReqArg OptGroupName "GROUP")
+ ("Which user to setgid. (default: " ++ defaultGroupName ++ ")")
+
+ , Option ['h'] ["help"]
+ (NoArg OptHelp)
+ "Print this message."
+ ]
+
+
+printUsage :: IO ()
+printUsage = do putStrLn "Usage:"
+ putStrLn " rakka [OPTIONS...]"
+ putStrLn ""
+ putStr $ usageInfo "Options:" options
+
+
+main :: IO ()
+main = do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
+
+ when (not $ null errors)
+ $ do mapM_ putStr errors
+ exitWith $ ExitFailure 1
+
+ when (any (\ x -> x == OptHelp) opts)
+ $ do printUsage
+ exitWith ExitSuccess
+
+ when (not $ null nonOpts)
+ $ do printUsage
+ exitWith $ ExitFailure 1
+
+ portNum <- getPortNum opts
+ uid <- getUserID opts
+
+ print portNum
+ print uid
+
+
+getPortNum :: [CmdOpt] -> IO PortNumber
+getPortNum opts
+ = do let xs = mapMaybe (\ x -> case x of
+ OptPortNum n -> Just n
+ _ -> Nothing) opts
+ case xs of
+ [] -> return defaultPort
+ (x:[]) -> return x
+ _ -> error "too many --port options."
+
+
+getUserID :: [CmdOpt] -> IO UserID
+getUserID opts
+ = do let xs = mapMaybe (\ x -> case x of
+ OptUserName n -> Just n
+ _ -> Nothing) opts
+ name = case xs of
+ [] -> defaultUserName
+ (x:[]) -> x
+ _ -> error "too many --user options."
+
+ userEnt <- getUserEntryForName name
+ return $ userID userEnt
+
\ No newline at end of file