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