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