Main.hs

   1 {-# LANGUAGE CPP #-}
   2 import           Control.Monad
   3 import           Data.Maybe
   4 import           Network
   5 import           Network.HTTP.Lucu
   6 import           Rakka.Environment
   7 import           Rakka.Resource.Index
   8 import           Rakka.Resource.Object
   9 import           Rakka.Resource.Render
  10 import           System.Console.GetOpt
  11 import           System.Directory
  12 import           System.Environment
  13 import           System.Exit
  14 import           System.Posix.Files
  15 import           System.Posix.Types
  16 import           System.Posix.User
  17
  18
  19 data CmdOpt
  20     = OptPortNum   PortNumber
  21     | OptLSDir     FilePath
  22     | OptUserName  String
  23     | OptGroupName String
  24     | OptHelp
  25     deriving (Eq, Show)
  26
  27
  28 defaultPort :: PortNumber
  29 defaultPort = fromIntegral 8080
  30
  31 defaultLocalStateDir :: FilePath
  32 defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP
  33
  34 defaultUserName :: String
  35 defaultUserName = "daemon"
  36
  37 defaultGroupName :: String
  38 defaultGroupName = "daemon"
  39
  40
  41 options :: [OptDescr CmdOpt]
  42 options = [ Option ['p'] ["port"]
  43                    (ReqArg (OptPortNum . fromIntegral . read) "NUM")
  44                    ("Port number to listen. (default: " ++ show defaultPort ++ ")")
  45
  46           , Option ['d'] ["localstatedir"]
  47                    (ReqArg OptLSDir "DIR")
  48                    ("Path to the database directory. (default: " ++ defaultLocalStateDir ++ ")")
  49
  50           , Option ['u'] ["user"]
  51                    (ReqArg OptUserName "USER")
  52                    ("Which user to setuid. (default: " ++ defaultUserName ++ ")")
  53
  54           , Option ['g'] ["group"]
  55                    (ReqArg OptGroupName "GROUP")
  56                    ("Which user to setgid. (default: " ++ defaultGroupName ++ ")")
  57
  58           , Option ['h'] ["help"]
  59                    (NoArg OptHelp)
  60                    "Print this message."
  61           ]
  62
  63
  64 printUsage :: IO ()
  65 printUsage = do putStrLn "Usage:"
  66                 putStrLn "  rakka [OPTIONS...]"
  67                 putStrLn ""
  68                 putStr $ usageInfo "Options:" options
  69
  70
  71 main :: IO ()
  72 main = do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
  73
  74           when (not $ null errors)
  75                    $ do mapM_ putStr errors
  76                         exitWith $ ExitFailure 1
  77
  78           when (any (\ x -> x == OptHelp) opts)
  79                    $ do printUsage
  80                         exitWith ExitSuccess
  81
  82           when (not $ null nonOpts)
  83                    $ do printUsage
  84                         exitWith $ ExitFailure 1
  85
  86           portNum <- getPortNum opts
  87           uid     <- getUserID  opts
  88           gid     <- getGroupID opts
  89           lsdir   <- getLocalStateDir opts
  90
  91           createLocalStateDir lsdir uid gid
  92
  93           setGroupID gid
  94           setUserID  uid
  95
  96           env     <- setupEnv lsdir portNum
  97           runHttpd (envLucuConf env) (resTree env) [fallbackRender env]
  98
  99
 100 resTree :: Environment -> ResTree
 101 resTree env
 102     = mkResTree [ ([]        , resIndex  env)
 103                 , (["object"], resObject env)
 104                 ]
 105
 106
 107 getPortNum :: [CmdOpt] -> IO PortNumber
 108 getPortNum opts
 109     = do let xs = mapMaybe (\ x -> case x of
 110                                      OptPortNum n -> Just n
 111                                      _            -> Nothing) opts
 112          case xs of
 113            []     -> return defaultPort
 114            (x:[]) -> return x
 115            _      -> error "too many --port options."
 116
 117
 118 getUserID :: [CmdOpt] -> IO UserID
 119 getUserID opts
 120     = do let xs   = mapMaybe (\ x -> case x of
 121                                        OptUserName n -> Just n
 122                                        _             -> Nothing) opts
 123              name = case xs of
 124                       []     -> defaultUserName
 125                       (x:[]) -> x
 126                       _      -> error "too many --user options."
 127
 128          userEnt <- getUserEntryForName name
 129          return $ userID userEnt
 130
 131
 132 getGroupID :: [CmdOpt] -> IO GroupID
 133 getGroupID opts
 134     = do let xs   = mapMaybe (\ x -> case x of
 135                                        OptGroupName n -> Just n
 136                                        _              -> Nothing) opts
 137              name = case xs of
 138                       []     -> defaultGroupName
 139                       (x:[]) -> x
 140                       _      -> error "too many --group options."
 141
 142          groupEnt <- getGroupEntryForName name
 143          return $ groupID groupEnt
 144
 145
 146 getLocalStateDir :: [CmdOpt] -> IO FilePath
 147 getLocalStateDir opts
 148     = do let xs   = mapMaybe (\ x -> case x of
 149                                        OptLSDir n -> Just n
 150                                        _          -> Nothing) opts
 151              path = case xs of
 152                       []     -> defaultLocalStateDir
 153                       (x:[]) -> x
 154                       _      -> error "too many --localstatedir options."
 155
 156          return path
 157
 158
 159 createLocalStateDir :: FilePath -> UserID -> GroupID -> IO ()
 160 createLocalStateDir path uid gid
 161     = do createDirectoryIfMissing True path
 162          setOwnerAndGroup path uid gid