6 import Network.HTTP.Lucu
8 import Rakka.Environment
9 import Rakka.Resource.CheckAuth
10 import Rakka.Resource.Index
11 import Rakka.Resource.JavaScript
12 import Rakka.Resource.PageEntity
13 import Rakka.Resource.Object
14 import Rakka.Resource.Render
15 import Rakka.Resource.Search
16 import Rakka.Resource.SystemConfig
17 import Rakka.Resource.TrackBack
20 import System.Console.GetOpt
21 import System.Directory
22 import System.Environment
25 import System.Log.Handler.Simple
26 import System.Log.Logger
27 import System.Posix.Files
28 import System.Posix.Types
29 import System.Posix.User
37 = OptPortNum PortNumber
41 | OptLogLevel Priority
48 defaultPort :: PortNumber
49 defaultPort = toEnum 8080
51 defaultLocalStateDir :: FilePath
52 defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP
54 defaultUserName :: String
55 defaultUserName = "daemon"
57 defaultGroupName :: String
58 defaultGroupName = "daemon"
61 defaultLogLevel :: Priority
62 defaultLogLevel = NOTICE
65 options :: [OptDescr CmdOpt]
66 options = [ Option ['p'] ["port"]
67 (ReqArg (OptPortNum . toEnum . read) "NUM")
68 ("Port number to listen. (default: " ++ show defaultPort ++ ")")
70 , Option ['d'] ["localstatedir"]
71 (ReqArg OptLSDir "DIR")
72 ("Path to the database directory. (default: " ++ defaultLocalStateDir ++ ")")
74 , Option ['u'] ["user"]
75 (ReqArg OptUserName "USER")
76 ("Which user to setuid. (default: " ++ defaultUserName ++ ")")
78 , Option ['g'] ["group"]
79 (ReqArg OptGroupName "GROUP")
80 ("Which user to setgid. (default: " ++ defaultGroupName ++ ")")
82 , Option ['l'] ["log-level"]
83 (ReqArg (OptLogLevel . read) "LEVEL")
84 ("The lowest log level to show. (default: " ++ show defaultLogLevel ++ ")")
86 , Option [] ["disable-stderr-log"]
87 (NoArg OptDisableStderrLog)
88 ("Disable logging to stderr.")
90 , Option [] ["rebuild-index"]
91 (NoArg OptRebuildIndex)
92 ("Rebuild the index database.")
94 , Option ['h'] ["help"]
101 printUsage = do putStrLn "Usage:"
102 putStrLn " rakka [OPTIONS...]"
104 putStr $ usageInfo "Options:" options
110 do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
112 when (not $ null errors)
113 $ do mapM_ putStr errors
114 exitWith $ ExitFailure 1
116 when (any (\ x -> x == OptHelp) opts)
120 when (not $ null nonOpts)
122 exitWith $ ExitFailure 1
124 portNum <- getPortNum opts
125 uid <- getUserID opts
126 gid <- getGroupID opts
127 lsdir <- getLocalStateDir opts
129 createLocalStateDir lsdir uid gid
135 env <- setupEnv lsdir portNum
137 rebuildIndexIfRequested env opts
139 infoM logger ("Listening to " ++ show portNum ++ "/tcp...")
140 runHttpd (envLucuConf env) (resTree env) [fallbackPageEntity env]
143 resTree :: Environment -> ResTree
145 = mkResTree [ ([] , resIndex env)
146 , (["checkAuth" ], resCheckAuth env)
147 , (["js" ], javaScript )
148 , (["object" ], resObject env)
149 , (["render" ], resRender env)
150 , (["search" ], resSearch env)
151 , (["search.html" ], resSearch env)
152 , (["search.xml" ], resSearch env)
153 , (["systemConfig"], resSystemConfig env)
154 , (["trackback" ], resTrackBack env)
158 getPortNum :: [CmdOpt] -> IO PortNumber
160 = do let xs = mapMaybe (\ x -> case x of
161 OptPortNum n -> Just n
164 [] -> return defaultPort
166 _ -> error "too many --port options."
169 getUserID :: [CmdOpt] -> IO UserID
171 = do let xs = mapMaybe (\ x -> case x of
172 OptUserName n -> Just n
175 [] -> defaultUserName
177 _ -> error "too many --user options."
179 userEnt <- getUserEntryForName name
180 return $ userID userEnt
183 getGroupID :: [CmdOpt] -> IO GroupID
185 = do let xs = mapMaybe (\ x -> case x of
186 OptGroupName n -> Just n
189 [] -> defaultGroupName
191 _ -> error "too many --group options."
193 groupEnt <- getGroupEntryForName name
194 return $ groupID groupEnt
197 getLocalStateDir :: [CmdOpt] -> IO FilePath
198 getLocalStateDir opts
199 = do let xs = mapMaybe (\ x -> case x of
203 [] -> defaultLocalStateDir
205 _ -> error "too many --localstatedir options."
210 setupLogger :: [CmdOpt] -> IO ()
212 = do let disableStderrLog = find (== OptDisableStderrLog) opts /= Nothing
213 logHandlers = if disableStderrLog then
216 [verboseStreamHandler stderr DEBUG]
217 logLevel = fromMaybe defaultLogLevel
218 $ do OptLogLevel l <- find (\ x -> case x of
219 OptLogLevel _ -> True
223 logHandlers' <- sequence logHandlers
224 updateGlobalLogger rootLoggerName (setHandlers logHandlers' . setLevel logLevel)
227 createLocalStateDir :: FilePath -> UserID -> GroupID -> IO ()
228 createLocalStateDir path uid gid
229 = do createDirectoryIfMissing True path
230 setOwnerAndGroup path uid gid
233 rebuildIndexIfRequested :: Environment -> [CmdOpt] -> IO ()
234 rebuildIndexIfRequested env opts
235 = do let rebuild = isJust $ find (\ x -> case x of
236 OptRebuildIndex -> True
239 $ rebuildIndex (envStorage env)