Main.hs

   1 {-# LANGUAGE CPP #-}
   2 import           Control.Monad
   3 import           Data.List
   4 import           Data.Maybe
   5 import           Network
   6 import           Network.HTTP.Lucu
   7 import           OpenSSL
   8 import           Rakka.Environment
   9 import           Rakka.Resource.CheckAuth
  10 import           Rakka.Resource.DumpRepos
  11 import           Rakka.Resource.Index
  12 import           Rakka.Resource.JavaScript
  13 import           Rakka.Resource.PageEntity
  14 import           Rakka.Resource.Object
  15 import           Rakka.Resource.Render
  16 import           Rakka.Resource.Search
  17 import           Rakka.Resource.SystemConfig
  18 -- import           Rakka.Resource.TrackBack
  19 import           Rakka.Resource.Users
  20 import           Rakka.Storage
  21 import           Subversion
  22 import           System.Console.GetOpt
  23 import           System.Directory
  24 import           System.Environment
  25 import           System.Exit
  26 import           System.IO
  27 import           System.Log.Handler.Simple
  28 import           System.Log.Logger
  29 import           System.Posix.Files
  30 import           System.Posix.Types
  31 import           System.Posix.User
  32
  33
  34 logger :: String
  35 logger = "Main"
  36
  37
  38 data CmdOpt
  39     = OptPortNum   PortNumber
  40     | OptLSDir     FilePath
  41     | OptUserName  String
  42     | OptGroupName String
  43     | OptLogLevel  Priority
  44     | OptVerbose
  45     | OptRebuildIndex
  46     | OptHelp
  47     deriving (Eq, Show)
  48
  49
  50 defaultPort :: PortNumber
  51 defaultPort = toEnum 8080
  52
  53 defaultLocalStateDir :: FilePath
  54 defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP
  55
  56 defaultUserName :: String
  57 defaultUserName = "daemon"
  58
  59 defaultGroupName :: String
  60 defaultGroupName = "daemon"
  61
  62
  63 defaultLogLevel :: Priority
  64 defaultLogLevel = NOTICE
  65
  66
  67 options :: [OptDescr CmdOpt]
  68 options = [ Option ['p'] ["port"]
  69                    (ReqArg (OptPortNum . toEnum . read) "NUM")
  70                    ("Port number to listen. (default: " ++ show defaultPort ++ ")")
  71
  72           , Option ['d'] ["localstatedir"]
  73                    (ReqArg OptLSDir "DIR")
  74                    ("Path to the database directory. (default: " ++ defaultLocalStateDir ++ ")")
  75
  76           , Option ['u'] ["user"]
  77                    (ReqArg OptUserName "USER")
  78                    ("Which user to setuid. (default: " ++ defaultUserName ++ ")")
  79
  80           , Option ['g'] ["group"]
  81                    (ReqArg OptGroupName "GROUP")
  82                    ("Which user to setgid. (default: " ++ defaultGroupName ++ ")")
  83
  84           , Option ['l'] ["log-level"]
  85                    (ReqArg (OptLogLevel . read) "LEVEL")
  86                    ("The lowest log level to show. (default: " ++ show defaultLogLevel ++ ")")
  87
  88           , Option ['v'] ["verbose"]
  89                    (NoArg OptVerbose)
  90                    "Enable logging to stderr."
  91
  92           , Option ['r'] ["rebuild-index"]
  93                    (NoArg OptRebuildIndex)
  94                    "Rebuild the index database."
  95
  96           , Option ['h'] ["help"]
  97                    (NoArg OptHelp)
  98                    "Print this message."
  99           ]
 100
 101
 102 printUsage :: IO ()
 103 printUsage = do putStrLn "Usage:"
 104                 putStrLn "  rakka [OPTIONS...]"
 105                 putStrLn ""
 106                 putStr $ usageInfo "Options:" options
 107
 108
 109 main :: IO ()
 110 main = withOpenSSL $
 111        withSubversion $
 112        do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
 113
 114           unless (null errors)
 115                    $ do mapM_ putStr errors
 116                         exitWith $ ExitFailure 1
 117
 118           when (any (\ x -> x == OptHelp) opts)
 119                    $ do printUsage
 120                         exitWith ExitSuccess
 121
 122           unless (null nonOpts)
 123                    $ do printUsage
 124                         exitWith $ ExitFailure 1
 125
 126           portNum <- getPortNum opts
 127           uid     <- getUserID  opts
 128           gid     <- getGroupID opts
 129           lsdir   <- getLocalStateDir opts
 130
 131           createLocalStateDir lsdir uid gid
 132
 133           setGroupID gid
 134           setUserID  uid
 135
 136           setupLogger opts
 137           env <- setupEnv lsdir portNum
 138
 139           rebuildIndexIfRequested env opts
 140
 141           infoM logger ("Listening to " ++ show portNum ++ "/tcp...")
 142           runHttpd (envLucuConf env) (resTree env) [fallbackPageEntity env]
 143
 144
 145 resTree :: Environment -> ResTree
 146 resTree env
 147     = mkResTree [ ([]              , resIndex        env)
 148                 , (["checkAuth"   ], resCheckAuth    env)
 149                 , (["dumpRepos"   ], resDumpRepos    env)
 150                 , (["js"          ], javaScript         )
 151                 , (["object"      ], resObject       env)
 152                 , (["render"      ], resRender       env)
 153                 , (["search"      ], resSearch       env)
 154                 , (["search.html" ], resSearch       env)
 155                 , (["search.xml"  ], resSearch       env)
 156                 , (["systemConfig"], resSystemConfig env)
 157                 -- , (["trackback"   ], resTrackBack    env)
 158                 , (["users"       ], resUsers        env)
 159                 ]
 160
 161
 162 getPortNum :: [CmdOpt] -> IO PortNumber
 163 getPortNum opts
 164     = do let xs = mapMaybe (\ x -> case x of
 165                                      OptPortNum n -> Just n
 166                                      _            -> Nothing) opts
 167          case xs of
 168            []     -> return defaultPort
 169            (x:[]) -> return x
 170            _      -> error "too many --port options."
 171
 172
 173 getUserID :: [CmdOpt] -> IO UserID
 174 getUserID opts
 175     = do let xs   = mapMaybe (\ x -> case x of
 176                                        OptUserName n -> Just n
 177                                        _             -> Nothing) opts
 178              name = case xs of
 179                       []     -> defaultUserName
 180                       (x:[]) -> x
 181                       _      -> error "too many --user options."
 182
 183          userEnt <- getUserEntryForName name
 184          return $ userID userEnt
 185
 186
 187 getGroupID :: [CmdOpt] -> IO GroupID
 188 getGroupID opts
 189     = do let xs   = mapMaybe (\ x -> case x of
 190                                        OptGroupName n -> Just n
 191                                        _              -> Nothing) opts
 192              name = case xs of
 193                       []     -> defaultGroupName
 194                       (x:[]) -> x
 195                       _      -> error "too many --group options."
 196
 197          groupEnt <- getGroupEntryForName name
 198          return $ groupID groupEnt
 199
 200
 201 getLocalStateDir :: [CmdOpt] -> IO FilePath
 202 getLocalStateDir opts
 203     = do let xs   = mapMaybe (\ x -> case x of
 204                                        OptLSDir n -> Just n
 205                                        _          -> Nothing) opts
 206              path = case xs of
 207                       []     -> defaultLocalStateDir
 208                       (x:[]) -> x
 209                       _      -> error "too many --localstatedir options."
 210
 211          return path
 212
 213
 214 setupLogger :: [CmdOpt] -> IO ()
 215 setupLogger opts
 216     = do let verbose     = find (== OptVerbose) opts /= Nothing
 217              logHandlers = if verbose then
 218                                [verboseStreamHandler stderr DEBUG]
 219                            else
 220                                [] -- FIXME: enable file log
 221              logLevel    = fromMaybe defaultLogLevel
 222                            $ do OptLogLevel l <- find (\ x -> case x of
 223                                                                 OptLogLevel _ -> True
 224                                                                 _             -> False) opts
 225                                 return l
 226
 227          logHandlers' <- sequence logHandlers
 228          updateGlobalLogger rootLoggerName (setHandlers logHandlers' . setLevel logLevel)
 229
 230
 231 createLocalStateDir :: FilePath -> UserID -> GroupID -> IO ()
 232 createLocalStateDir path uid gid
 233     = do createDirectoryIfMissing True path
 234          setOwnerAndGroup path uid gid
 235
 236
 237 rebuildIndexIfRequested :: Environment -> [CmdOpt] -> IO ()
 238 rebuildIndexIfRequested env opts
 239     = do let rebuild = isJust $ find (\ x -> case x of
 240                                                OptRebuildIndex -> True
 241                                                _               -> False) opts
 242          when rebuild
 243                   $ rebuildIndex (envStorage env)