6 import Network.HTTP.Lucu
7 import Rakka.Environment
8 import Rakka.Resource.CheckAuth
9 import Rakka.Resource.Index
10 import Rakka.Resource.JavaScript
11 import Rakka.Resource.PageEntity
12 import Rakka.Resource.Object
13 import Rakka.Resource.Render
16 import System.Console.GetOpt
17 import System.Directory
18 import System.Environment
21 import System.Log.Handler.Simple
22 import System.Log.Logger
23 import System.Posix.Files
24 import System.Posix.Types
25 import System.Posix.User
33 = OptPortNum PortNumber
37 | OptLogLevel Priority
44 defaultPort :: PortNumber
45 defaultPort = toEnum 8080
47 defaultLocalStateDir :: FilePath
48 defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP
50 defaultUserName :: String
51 defaultUserName = "daemon"
53 defaultGroupName :: String
54 defaultGroupName = "daemon"
57 defaultLogLevel :: Priority
58 defaultLogLevel = NOTICE
61 options :: [OptDescr CmdOpt]
62 options = [ Option ['p'] ["port"]
63 (ReqArg (OptPortNum . toEnum . read) "NUM")
64 ("Port number to listen. (default: " ++ show defaultPort ++ ")")
66 , Option ['d'] ["localstatedir"]
67 (ReqArg OptLSDir "DIR")
68 ("Path to the database directory. (default: " ++ defaultLocalStateDir ++ ")")
70 , Option ['u'] ["user"]
71 (ReqArg OptUserName "USER")
72 ("Which user to setuid. (default: " ++ defaultUserName ++ ")")
74 , Option ['g'] ["group"]
75 (ReqArg OptGroupName "GROUP")
76 ("Which user to setgid. (default: " ++ defaultGroupName ++ ")")
78 , Option ['l'] ["log-level"]
79 (ReqArg (OptLogLevel . read) "LEVEL")
80 ("The lowest log level to show. (default: " ++ show defaultLogLevel ++ ")")
82 , Option [] ["disable-stderr-log"]
83 (NoArg OptDisableStderrLog)
84 ("Disable logging to stderr.")
86 , Option [] ["rebuild-index"]
87 (NoArg OptRebuildIndex)
88 ("Rebuild the index database.")
90 , Option ['h'] ["help"]
97 printUsage = do putStrLn "Usage:"
98 putStrLn " rakka [OPTIONS...]"
100 putStr $ usageInfo "Options:" options
104 main = withSubversion $
105 do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
107 when (not $ null errors)
108 $ do mapM_ putStr errors
109 exitWith $ ExitFailure 1
111 when (any (\ x -> x == OptHelp) opts)
115 when (not $ null nonOpts)
117 exitWith $ ExitFailure 1
119 portNum <- getPortNum opts
120 uid <- getUserID opts
121 gid <- getGroupID opts
122 lsdir <- getLocalStateDir opts
124 createLocalStateDir lsdir uid gid
130 env <- setupEnv lsdir portNum
132 rebuildIndexIfRequested env opts
134 infoM logger ("Listening to " ++ show portNum ++ "/tcp...")
135 runHttpd (envLucuConf env) (resTree env) [fallbackPageEntity env]
138 resTree :: Environment -> ResTree
140 = mkResTree [ ([] , resIndex env)
141 , (["checkAuth"], resCheckAuth env)
142 , (["js" ], javaScript )
143 , (["object" ], resObject env)
144 , (["render" ], resRender env)
148 getPortNum :: [CmdOpt] -> IO PortNumber
150 = do let xs = mapMaybe (\ x -> case x of
151 OptPortNum n -> Just n
154 [] -> return defaultPort
156 _ -> error "too many --port options."
159 getUserID :: [CmdOpt] -> IO UserID
161 = do let xs = mapMaybe (\ x -> case x of
162 OptUserName n -> Just n
165 [] -> defaultUserName
167 _ -> error "too many --user options."
169 userEnt <- getUserEntryForName name
170 return $ userID userEnt
173 getGroupID :: [CmdOpt] -> IO GroupID
175 = do let xs = mapMaybe (\ x -> case x of
176 OptGroupName n -> Just n
179 [] -> defaultGroupName
181 _ -> error "too many --group options."
183 groupEnt <- getGroupEntryForName name
184 return $ groupID groupEnt
187 getLocalStateDir :: [CmdOpt] -> IO FilePath
188 getLocalStateDir opts
189 = do let xs = mapMaybe (\ x -> case x of
193 [] -> defaultLocalStateDir
195 _ -> error "too many --localstatedir options."
200 setupLogger :: [CmdOpt] -> IO ()
202 = do let disableStderrLog = find (== OptDisableStderrLog) opts /= Nothing
203 logHandlers = if disableStderrLog then
206 [verboseStreamHandler stderr DEBUG]
207 logLevel = fromMaybe defaultLogLevel
208 $ do OptLogLevel l <- find (\ x -> case x of
209 OptLogLevel _ -> True
213 logHandlers' <- sequence logHandlers
214 updateGlobalLogger rootLoggerName (setHandlers logHandlers' . setLevel logLevel)
217 createLocalStateDir :: FilePath -> UserID -> GroupID -> IO ()
218 createLocalStateDir path uid gid
219 = do createDirectoryIfMissing True path
220 setOwnerAndGroup path uid gid
223 rebuildIndexIfRequested :: Environment -> [CmdOpt] -> IO ()
224 rebuildIndexIfRequested env opts
225 = do let rebuild = isJust $ find (\ x -> case x of
226 OptRebuildIndex -> True
229 $ rebuildIndex (envStorage env)