6 import Network.HTTP.Lucu
7 import Rakka.Environment
8 import Rakka.Resource.Index
9 import Rakka.Resource.JavaScript
10 import Rakka.Resource.PageEntity
11 import Rakka.Resource.Object
14 import System.Console.GetOpt
15 import System.Directory
16 import System.Environment
19 import System.Log.Handler.Simple
20 import System.Log.Logger
21 import System.Posix.Files
22 import System.Posix.Types
23 import System.Posix.User
31 = OptPortNum PortNumber
35 | OptLogLevel Priority
42 defaultPort :: PortNumber
43 defaultPort = toEnum 8080
45 defaultLocalStateDir :: FilePath
46 defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP
48 defaultUserName :: String
49 defaultUserName = "daemon"
51 defaultGroupName :: String
52 defaultGroupName = "daemon"
55 defaultLogLevel :: Priority
56 defaultLogLevel = NOTICE
59 options :: [OptDescr CmdOpt]
60 options = [ Option ['p'] ["port"]
61 (ReqArg (OptPortNum . toEnum . read) "NUM")
62 ("Port number to listen. (default: " ++ show defaultPort ++ ")")
64 , Option ['d'] ["localstatedir"]
65 (ReqArg OptLSDir "DIR")
66 ("Path to the database directory. (default: " ++ defaultLocalStateDir ++ ")")
68 , Option ['u'] ["user"]
69 (ReqArg OptUserName "USER")
70 ("Which user to setuid. (default: " ++ defaultUserName ++ ")")
72 , Option ['g'] ["group"]
73 (ReqArg OptGroupName "GROUP")
74 ("Which user to setgid. (default: " ++ defaultGroupName ++ ")")
76 , Option ['l'] ["log-level"]
77 (ReqArg (OptLogLevel . read) "LEVEL")
78 ("The lowest log level to show. (default: " ++ show defaultLogLevel ++ ")")
80 , Option [] ["disable-stderr-log"]
81 (NoArg OptDisableStderrLog)
82 ("Disable logging to stderr.")
84 , Option [] ["rebuild-index"]
85 (NoArg OptRebuildIndex)
86 ("Rebuild the index database.")
88 , Option ['h'] ["help"]
95 printUsage = do putStrLn "Usage:"
96 putStrLn " rakka [OPTIONS...]"
98 putStr $ usageInfo "Options:" options
102 main = withSubversion $
103 do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
105 when (not $ null errors)
106 $ do mapM_ putStr errors
107 exitWith $ ExitFailure 1
109 when (any (\ x -> x == OptHelp) opts)
113 when (not $ null nonOpts)
115 exitWith $ ExitFailure 1
117 portNum <- getPortNum opts
118 uid <- getUserID opts
119 gid <- getGroupID opts
120 lsdir <- getLocalStateDir opts
122 createLocalStateDir lsdir uid gid
128 env <- setupEnv lsdir portNum
130 rebuildIndexIfRequested env opts
132 infoM logger ("Listening to " ++ show portNum ++ "/tcp...")
133 runHttpd (envLucuConf env) (resTree env) [fallbackPageEntity env]
136 resTree :: Environment -> ResTree
138 = mkResTree [ ([] , resIndex env)
139 , (["object"], resObject env)
140 , (["js" ], javaScript )
144 getPortNum :: [CmdOpt] -> IO PortNumber
146 = do let xs = mapMaybe (\ x -> case x of
147 OptPortNum n -> Just n
150 [] -> return defaultPort
152 _ -> error "too many --port options."
155 getUserID :: [CmdOpt] -> IO UserID
157 = do let xs = mapMaybe (\ x -> case x of
158 OptUserName n -> Just n
161 [] -> defaultUserName
163 _ -> error "too many --user options."
165 userEnt <- getUserEntryForName name
166 return $ userID userEnt
169 getGroupID :: [CmdOpt] -> IO GroupID
171 = do let xs = mapMaybe (\ x -> case x of
172 OptGroupName n -> Just n
175 [] -> defaultGroupName
177 _ -> error "too many --group options."
179 groupEnt <- getGroupEntryForName name
180 return $ groupID groupEnt
183 getLocalStateDir :: [CmdOpt] -> IO FilePath
184 getLocalStateDir opts
185 = do let xs = mapMaybe (\ x -> case x of
189 [] -> defaultLocalStateDir
191 _ -> error "too many --localstatedir options."
196 setupLogger :: [CmdOpt] -> IO ()
198 = do let disableStderrLog = find (== OptDisableStderrLog) opts /= Nothing
199 logHandlers = if disableStderrLog then
202 [verboseStreamHandler stderr DEBUG]
203 logLevel = fromMaybe defaultLogLevel
204 $ do OptLogLevel l <- find (\ x -> case x of
205 OptLogLevel _ -> True
209 logHandlers' <- sequence logHandlers
210 updateGlobalLogger rootLoggerName (setHandlers logHandlers' . setLevel logLevel)
213 createLocalStateDir :: FilePath -> UserID -> GroupID -> IO ()
214 createLocalStateDir path uid gid
215 = do createDirectoryIfMissing True path
216 setOwnerAndGroup path uid gid
219 rebuildIndexIfRequested :: Environment -> [CmdOpt] -> IO ()
220 rebuildIndexIfRequested env opts
221 = do let rebuild = isJust $ find (\ x -> case x of
222 OptRebuildIndex -> True
225 $ rebuildIndex (envStorage env)