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.TrackBack
17 import System.Console.GetOpt
18 import System.Directory
19 import System.Environment
22 import System.Log.Handler.Simple
23 import System.Log.Logger
24 import System.Posix.Files
25 import System.Posix.Types
26 import System.Posix.User
34 = OptPortNum PortNumber
38 | OptLogLevel Priority
45 defaultPort :: PortNumber
46 defaultPort = toEnum 8080
48 defaultLocalStateDir :: FilePath
49 defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP
51 defaultUserName :: String
52 defaultUserName = "daemon"
54 defaultGroupName :: String
55 defaultGroupName = "daemon"
58 defaultLogLevel :: Priority
59 defaultLogLevel = NOTICE
62 options :: [OptDescr CmdOpt]
63 options = [ Option ['p'] ["port"]
64 (ReqArg (OptPortNum . toEnum . read) "NUM")
65 ("Port number to listen. (default: " ++ show defaultPort ++ ")")
67 , Option ['d'] ["localstatedir"]
68 (ReqArg OptLSDir "DIR")
69 ("Path to the database directory. (default: " ++ defaultLocalStateDir ++ ")")
71 , Option ['u'] ["user"]
72 (ReqArg OptUserName "USER")
73 ("Which user to setuid. (default: " ++ defaultUserName ++ ")")
75 , Option ['g'] ["group"]
76 (ReqArg OptGroupName "GROUP")
77 ("Which user to setgid. (default: " ++ defaultGroupName ++ ")")
79 , Option ['l'] ["log-level"]
80 (ReqArg (OptLogLevel . read) "LEVEL")
81 ("The lowest log level to show. (default: " ++ show defaultLogLevel ++ ")")
83 , Option [] ["disable-stderr-log"]
84 (NoArg OptDisableStderrLog)
85 ("Disable logging to stderr.")
87 , Option [] ["rebuild-index"]
88 (NoArg OptRebuildIndex)
89 ("Rebuild the index database.")
91 , Option ['h'] ["help"]
98 printUsage = do putStrLn "Usage:"
99 putStrLn " rakka [OPTIONS...]"
101 putStr $ usageInfo "Options:" options
105 main = withSubversion $
106 do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
108 when (not $ null errors)
109 $ do mapM_ putStr errors
110 exitWith $ ExitFailure 1
112 when (any (\ x -> x == OptHelp) opts)
116 when (not $ null nonOpts)
118 exitWith $ ExitFailure 1
120 portNum <- getPortNum opts
121 uid <- getUserID opts
122 gid <- getGroupID opts
123 lsdir <- getLocalStateDir opts
125 createLocalStateDir lsdir uid gid
131 env <- setupEnv lsdir portNum
133 rebuildIndexIfRequested env opts
135 infoM logger ("Listening to " ++ show portNum ++ "/tcp...")
136 runHttpd (envLucuConf env) (resTree env) [fallbackPageEntity env]
139 resTree :: Environment -> ResTree
141 = mkResTree [ ([] , resIndex env)
142 , (["checkAuth"], resCheckAuth env)
143 , (["js" ], javaScript )
144 , (["object" ], resObject env)
145 , (["render" ], resRender env)
146 , (["trackback"], resTrackBack env)
150 getPortNum :: [CmdOpt] -> IO PortNumber
152 = do let xs = mapMaybe (\ x -> case x of
153 OptPortNum n -> Just n
156 [] -> return defaultPort
158 _ -> error "too many --port options."
161 getUserID :: [CmdOpt] -> IO UserID
163 = do let xs = mapMaybe (\ x -> case x of
164 OptUserName n -> Just n
167 [] -> defaultUserName
169 _ -> error "too many --user options."
171 userEnt <- getUserEntryForName name
172 return $ userID userEnt
175 getGroupID :: [CmdOpt] -> IO GroupID
177 = do let xs = mapMaybe (\ x -> case x of
178 OptGroupName n -> Just n
181 [] -> defaultGroupName
183 _ -> error "too many --group options."
185 groupEnt <- getGroupEntryForName name
186 return $ groupID groupEnt
189 getLocalStateDir :: [CmdOpt] -> IO FilePath
190 getLocalStateDir opts
191 = do let xs = mapMaybe (\ x -> case x of
195 [] -> defaultLocalStateDir
197 _ -> error "too many --localstatedir options."
202 setupLogger :: [CmdOpt] -> IO ()
204 = do let disableStderrLog = find (== OptDisableStderrLog) opts /= Nothing
205 logHandlers = if disableStderrLog then
208 [verboseStreamHandler stderr DEBUG]
209 logLevel = fromMaybe defaultLogLevel
210 $ do OptLogLevel l <- find (\ x -> case x of
211 OptLogLevel _ -> True
215 logHandlers' <- sequence logHandlers
216 updateGlobalLogger rootLoggerName (setHandlers logHandlers' . setLevel logLevel)
219 createLocalStateDir :: FilePath -> UserID -> GroupID -> IO ()
220 createLocalStateDir path uid gid
221 = do createDirectoryIfMissing True path
222 setOwnerAndGroup path uid gid
225 rebuildIndexIfRequested :: Environment -> [CmdOpt] -> IO ()
226 rebuildIndexIfRequested env opts
227 = do let rebuild = isJust $ find (\ x -> case x of
228 OptRebuildIndex -> True
231 $ rebuildIndex (envStorage env)