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
12 import Rakka.Resource.Render
15 import System.Console.GetOpt
16 import System.Directory
17 import System.Environment
20 import System.Log.Handler.Simple
21 import System.Log.Logger
22 import System.Posix.Files
23 import System.Posix.Types
24 import System.Posix.User
32 = OptPortNum PortNumber
36 | OptLogLevel Priority
43 defaultPort :: PortNumber
44 defaultPort = toEnum 8080
46 defaultLocalStateDir :: FilePath
47 defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP
49 defaultUserName :: String
50 defaultUserName = "daemon"
52 defaultGroupName :: String
53 defaultGroupName = "daemon"
56 defaultLogLevel :: Priority
57 defaultLogLevel = NOTICE
60 options :: [OptDescr CmdOpt]
61 options = [ Option ['p'] ["port"]
62 (ReqArg (OptPortNum . toEnum . read) "NUM")
63 ("Port number to listen. (default: " ++ show defaultPort ++ ")")
65 , Option ['d'] ["localstatedir"]
66 (ReqArg OptLSDir "DIR")
67 ("Path to the database directory. (default: " ++ defaultLocalStateDir ++ ")")
69 , Option ['u'] ["user"]
70 (ReqArg OptUserName "USER")
71 ("Which user to setuid. (default: " ++ defaultUserName ++ ")")
73 , Option ['g'] ["group"]
74 (ReqArg OptGroupName "GROUP")
75 ("Which user to setgid. (default: " ++ defaultGroupName ++ ")")
77 , Option ['l'] ["log-level"]
78 (ReqArg (OptLogLevel . read) "LEVEL")
79 ("The lowest log level to show. (default: " ++ show defaultLogLevel ++ ")")
81 , Option [] ["disable-stderr-log"]
82 (NoArg OptDisableStderrLog)
83 ("Disable logging to stderr.")
85 , Option [] ["rebuild-index"]
86 (NoArg OptRebuildIndex)
87 ("Rebuild the index database.")
89 , Option ['h'] ["help"]
96 printUsage = do putStrLn "Usage:"
97 putStrLn " rakka [OPTIONS...]"
99 putStr $ usageInfo "Options:" options
103 main = withSubversion $
104 do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
106 when (not $ null errors)
107 $ do mapM_ putStr errors
108 exitWith $ ExitFailure 1
110 when (any (\ x -> x == OptHelp) opts)
114 when (not $ null nonOpts)
116 exitWith $ ExitFailure 1
118 portNum <- getPortNum opts
119 uid <- getUserID opts
120 gid <- getGroupID opts
121 lsdir <- getLocalStateDir opts
123 createLocalStateDir lsdir uid gid
129 env <- setupEnv lsdir portNum
131 rebuildIndexIfRequested env opts
133 infoM logger ("Listening to " ++ show portNum ++ "/tcp...")
134 runHttpd (envLucuConf env) (resTree env) [fallbackPageEntity env]
137 resTree :: Environment -> ResTree
139 = mkResTree [ ([] , resIndex env)
140 , (["js" ], javaScript )
141 , (["object"], resObject env)
142 , (["render"], resRender env)
146 getPortNum :: [CmdOpt] -> IO PortNumber
148 = do let xs = mapMaybe (\ x -> case x of
149 OptPortNum n -> Just n
152 [] -> return defaultPort
154 _ -> error "too many --port options."
157 getUserID :: [CmdOpt] -> IO UserID
159 = do let xs = mapMaybe (\ x -> case x of
160 OptUserName n -> Just n
163 [] -> defaultUserName
165 _ -> error "too many --user options."
167 userEnt <- getUserEntryForName name
168 return $ userID userEnt
171 getGroupID :: [CmdOpt] -> IO GroupID
173 = do let xs = mapMaybe (\ x -> case x of
174 OptGroupName n -> Just n
177 [] -> defaultGroupName
179 _ -> error "too many --group options."
181 groupEnt <- getGroupEntryForName name
182 return $ groupID groupEnt
185 getLocalStateDir :: [CmdOpt] -> IO FilePath
186 getLocalStateDir opts
187 = do let xs = mapMaybe (\ x -> case x of
191 [] -> defaultLocalStateDir
193 _ -> error "too many --localstatedir options."
198 setupLogger :: [CmdOpt] -> IO ()
200 = do let disableStderrLog = find (== OptDisableStderrLog) opts /= Nothing
201 logHandlers = if disableStderrLog then
204 [verboseStreamHandler stderr DEBUG]
205 logLevel = fromMaybe defaultLogLevel
206 $ do OptLogLevel l <- find (\ x -> case x of
207 OptLogLevel _ -> True
211 logHandlers' <- sequence logHandlers
212 updateGlobalLogger rootLoggerName (setHandlers logHandlers' . setLevel logLevel)
215 createLocalStateDir :: FilePath -> UserID -> GroupID -> IO ()
216 createLocalStateDir path uid gid
217 = do createDirectoryIfMissing True path
218 setOwnerAndGroup path uid gid
221 rebuildIndexIfRequested :: Environment -> [CmdOpt] -> IO ()
222 rebuildIndexIfRequested env opts
223 = do let rebuild = isJust $ find (\ x -> case x of
224 OptRebuildIndex -> True
227 $ rebuildIndex (envStorage env)