6 import Network.HTTP.Lucu
7 import Rakka.Environment
8 import Rakka.Resource.Index
9 import Rakka.Resource.JavaScript
10 import Rakka.Resource.Object
11 import Rakka.Resource.Render
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
29 = OptPortNum PortNumber
33 | OptLogLevel Priority
40 defaultPort :: PortNumber
41 defaultPort = fromIntegral 8080
43 defaultLocalStateDir :: FilePath
44 defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP
46 defaultUserName :: String
47 defaultUserName = "daemon"
49 defaultGroupName :: String
50 defaultGroupName = "daemon"
53 defaultLogLevel :: Priority
54 defaultLogLevel = NOTICE
57 options :: [OptDescr CmdOpt]
58 options = [ Option ['p'] ["port"]
59 (ReqArg (OptPortNum . fromIntegral . read) "NUM")
60 ("Port number to listen. (default: " ++ show defaultPort ++ ")")
62 , Option ['d'] ["localstatedir"]
63 (ReqArg OptLSDir "DIR")
64 ("Path to the database directory. (default: " ++ defaultLocalStateDir ++ ")")
66 , Option ['u'] ["user"]
67 (ReqArg OptUserName "USER")
68 ("Which user to setuid. (default: " ++ defaultUserName ++ ")")
70 , Option ['g'] ["group"]
71 (ReqArg OptGroupName "GROUP")
72 ("Which user to setgid. (default: " ++ defaultGroupName ++ ")")
74 , Option ['l'] ["log-level"]
75 (ReqArg (OptLogLevel . read) "LEVEL")
76 ("The lowest log level to show. (default: " ++ show defaultLogLevel ++ ")")
78 , Option [] ["disable-stderr-log"]
79 (NoArg OptDisableStderrLog)
80 ("Disable logging to stderr.")
82 , Option [] ["rebuild-index"]
83 (NoArg OptRebuildIndex)
84 ("Rebuild the index database.")
86 , Option ['h'] ["help"]
93 printUsage = do putStrLn "Usage:"
94 putStrLn " rakka [OPTIONS...]"
96 putStr $ usageInfo "Options:" options
100 main = withSubversion $
101 do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
103 when (not $ null errors)
104 $ do mapM_ putStr errors
105 exitWith $ ExitFailure 1
107 when (any (\ x -> x == OptHelp) opts)
111 when (not $ null nonOpts)
113 exitWith $ ExitFailure 1
115 portNum <- getPortNum opts
116 uid <- getUserID opts
117 gid <- getGroupID opts
118 lsdir <- getLocalStateDir opts
120 createLocalStateDir lsdir uid gid
126 env <- setupEnv lsdir portNum
128 rebuildIndexIfRequested env opts
130 infoM logger ("Listening to " ++ show portNum ++ "/tcp...")
131 runHttpd (envLucuConf env) (resTree env) [fallbackRender env]
134 resTree :: Environment -> ResTree
136 = mkResTree [ ([] , resIndex env)
137 , (["object"], resObject env)
138 , (["js" ], javaScript )
142 getPortNum :: [CmdOpt] -> IO PortNumber
144 = do let xs = mapMaybe (\ x -> case x of
145 OptPortNum n -> Just n
148 [] -> return defaultPort
150 _ -> error "too many --port options."
153 getUserID :: [CmdOpt] -> IO UserID
155 = do let xs = mapMaybe (\ x -> case x of
156 OptUserName n -> Just n
159 [] -> defaultUserName
161 _ -> error "too many --user options."
163 userEnt <- getUserEntryForName name
164 return $ userID userEnt
167 getGroupID :: [CmdOpt] -> IO GroupID
169 = do let xs = mapMaybe (\ x -> case x of
170 OptGroupName n -> Just n
173 [] -> defaultGroupName
175 _ -> error "too many --group options."
177 groupEnt <- getGroupEntryForName name
178 return $ groupID groupEnt
181 getLocalStateDir :: [CmdOpt] -> IO FilePath
182 getLocalStateDir opts
183 = do let xs = mapMaybe (\ x -> case x of
187 [] -> defaultLocalStateDir
189 _ -> error "too many --localstatedir options."
194 setupLogger :: [CmdOpt] -> IO ()
196 = do let disableStderrLog = find (== OptDisableStderrLog) opts /= Nothing
197 logHandlers = if disableStderrLog then
200 [verboseStreamHandler stderr DEBUG]
201 logLevel = fromMaybe defaultLogLevel
202 $ do OptLogLevel l <- find (\ x -> case x of
203 OptLogLevel _ -> True
207 logHandlers' <- sequence logHandlers
208 updateGlobalLogger rootLoggerName (setHandlers logHandlers' . setLevel logLevel)
211 createLocalStateDir :: FilePath -> UserID -> GroupID -> IO ()
212 createLocalStateDir path uid gid
213 = do createDirectoryIfMissing True path
214 setOwnerAndGroup path uid gid
217 rebuildIndexIfRequested :: Environment -> [CmdOpt] -> IO ()
218 rebuildIndexIfRequested env opts
219 = do let rebuild = isJust $ find (\ x -> case x of
220 OptRebuildIndex -> True
223 $ rebuildIndex (envStorage env)