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
14 import Rakka.Resource.Search
15 import Rakka.Resource.TrackBack
18 import System.Console.GetOpt
19 import System.Directory
20 import System.Environment
23 import System.Log.Handler.Simple
24 import System.Log.Logger
25 import System.Posix.Files
26 import System.Posix.Types
27 import System.Posix.User
35 = OptPortNum PortNumber
39 | OptLogLevel Priority
46 defaultPort :: PortNumber
47 defaultPort = toEnum 8080
49 defaultLocalStateDir :: FilePath
50 defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP
52 defaultUserName :: String
53 defaultUserName = "daemon"
55 defaultGroupName :: String
56 defaultGroupName = "daemon"
59 defaultLogLevel :: Priority
60 defaultLogLevel = NOTICE
63 options :: [OptDescr CmdOpt]
64 options = [ Option ['p'] ["port"]
65 (ReqArg (OptPortNum . toEnum . read) "NUM")
66 ("Port number to listen. (default: " ++ show defaultPort ++ ")")
68 , Option ['d'] ["localstatedir"]
69 (ReqArg OptLSDir "DIR")
70 ("Path to the database directory. (default: " ++ defaultLocalStateDir ++ ")")
72 , Option ['u'] ["user"]
73 (ReqArg OptUserName "USER")
74 ("Which user to setuid. (default: " ++ defaultUserName ++ ")")
76 , Option ['g'] ["group"]
77 (ReqArg OptGroupName "GROUP")
78 ("Which user to setgid. (default: " ++ defaultGroupName ++ ")")
80 , Option ['l'] ["log-level"]
81 (ReqArg (OptLogLevel . read) "LEVEL")
82 ("The lowest log level to show. (default: " ++ show defaultLogLevel ++ ")")
84 , Option [] ["disable-stderr-log"]
85 (NoArg OptDisableStderrLog)
86 ("Disable logging to stderr.")
88 , Option [] ["rebuild-index"]
89 (NoArg OptRebuildIndex)
90 ("Rebuild the index database.")
92 , Option ['h'] ["help"]
99 printUsage = do putStrLn "Usage:"
100 putStrLn " rakka [OPTIONS...]"
102 putStr $ usageInfo "Options:" options
106 main = withSubversion $
107 do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
109 when (not $ null errors)
110 $ do mapM_ putStr errors
111 exitWith $ ExitFailure 1
113 when (any (\ x -> x == OptHelp) opts)
117 when (not $ null nonOpts)
119 exitWith $ ExitFailure 1
121 portNum <- getPortNum opts
122 uid <- getUserID opts
123 gid <- getGroupID opts
124 lsdir <- getLocalStateDir opts
126 createLocalStateDir lsdir uid gid
132 env <- setupEnv lsdir portNum
134 rebuildIndexIfRequested env opts
136 infoM logger ("Listening to " ++ show portNum ++ "/tcp...")
137 runHttpd (envLucuConf env) (resTree env) [fallbackPageEntity env]
140 resTree :: Environment -> ResTree
142 = mkResTree [ ([] , resIndex env)
143 , (["checkAuth" ], resCheckAuth env)
144 , (["js" ], javaScript )
145 , (["object" ], resObject env)
146 , (["render" ], resRender env)
147 , (["search" ], resSearch env)
148 , (["search.html"], resSearch env)
149 , (["search.xml" ], resSearch env)
150 , (["trackback" ], resTrackBack env)
154 getPortNum :: [CmdOpt] -> IO PortNumber
156 = do let xs = mapMaybe (\ x -> case x of
157 OptPortNum n -> Just n
160 [] -> return defaultPort
162 _ -> error "too many --port options."
165 getUserID :: [CmdOpt] -> IO UserID
167 = do let xs = mapMaybe (\ x -> case x of
168 OptUserName n -> Just n
171 [] -> defaultUserName
173 _ -> error "too many --user options."
175 userEnt <- getUserEntryForName name
176 return $ userID userEnt
179 getGroupID :: [CmdOpt] -> IO GroupID
181 = do let xs = mapMaybe (\ x -> case x of
182 OptGroupName n -> Just n
185 [] -> defaultGroupName
187 _ -> error "too many --group options."
189 groupEnt <- getGroupEntryForName name
190 return $ groupID groupEnt
193 getLocalStateDir :: [CmdOpt] -> IO FilePath
194 getLocalStateDir opts
195 = do let xs = mapMaybe (\ x -> case x of
199 [] -> defaultLocalStateDir
201 _ -> error "too many --localstatedir options."
206 setupLogger :: [CmdOpt] -> IO ()
208 = do let disableStderrLog = find (== OptDisableStderrLog) opts /= Nothing
209 logHandlers = if disableStderrLog then
212 [verboseStreamHandler stderr DEBUG]
213 logLevel = fromMaybe defaultLogLevel
214 $ do OptLogLevel l <- find (\ x -> case x of
215 OptLogLevel _ -> True
219 logHandlers' <- sequence logHandlers
220 updateGlobalLogger rootLoggerName (setHandlers logHandlers' . setLevel logLevel)
223 createLocalStateDir :: FilePath -> UserID -> GroupID -> IO ()
224 createLocalStateDir path uid gid
225 = do createDirectoryIfMissing True path
226 setOwnerAndGroup path uid gid
229 rebuildIndexIfRequested :: Environment -> [CmdOpt] -> IO ()
230 rebuildIndexIfRequested env opts
231 = do let rebuild = isJust $ find (\ x -> case x of
232 OptRebuildIndex -> True
235 $ rebuildIndex (envStorage env)