6 import Network.HTTP.Lucu
7 import Rakka.Environment
8 import Rakka.Resource.Index
9 import Rakka.Resource.Object
10 import Rakka.Resource.Render
13 import System.Console.GetOpt
14 import System.Directory
15 import System.Environment
18 import System.Log.Handler.Simple
19 import System.Log.Logger
20 import System.Posix.Files
21 import System.Posix.Types
22 import System.Posix.User
28 = OptPortNum PortNumber
32 | OptLogLevel Priority
39 defaultPort :: PortNumber
40 defaultPort = fromIntegral 8080
42 defaultLocalStateDir :: FilePath
43 defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP
45 defaultUserName :: String
46 defaultUserName = "daemon"
48 defaultGroupName :: String
49 defaultGroupName = "daemon"
52 defaultLogLevel :: Priority
53 defaultLogLevel = NOTICE
56 options :: [OptDescr CmdOpt]
57 options = [ Option ['p'] ["port"]
58 (ReqArg (OptPortNum . fromIntegral . read) "NUM")
59 ("Port number to listen. (default: " ++ show defaultPort ++ ")")
61 , Option ['d'] ["localstatedir"]
62 (ReqArg OptLSDir "DIR")
63 ("Path to the database directory. (default: " ++ defaultLocalStateDir ++ ")")
65 , Option ['u'] ["user"]
66 (ReqArg OptUserName "USER")
67 ("Which user to setuid. (default: " ++ defaultUserName ++ ")")
69 , Option ['g'] ["group"]
70 (ReqArg OptGroupName "GROUP")
71 ("Which user to setgid. (default: " ++ defaultGroupName ++ ")")
73 , Option ['l'] ["log-level"]
74 (ReqArg (OptLogLevel . read) "LEVEL")
75 ("The lowest log level to show. (default: " ++ show defaultLogLevel ++ ")")
77 , Option [] ["disable-stderr-log"]
78 (NoArg OptDisableStderrLog)
79 ("Disable logging to stderr.")
81 , Option [] ["rebuild-index"]
82 (NoArg OptRebuildIndex)
83 ("Rebuild the index database.")
85 , Option ['h'] ["help"]
92 printUsage = do putStrLn "Usage:"
93 putStrLn " rakka [OPTIONS...]"
95 putStr $ usageInfo "Options:" options
99 main = withSubversion $
100 do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
102 when (not $ null errors)
103 $ do mapM_ putStr errors
104 exitWith $ ExitFailure 1
106 when (any (\ x -> x == OptHelp) opts)
110 when (not $ null nonOpts)
112 exitWith $ ExitFailure 1
114 portNum <- getPortNum opts
115 uid <- getUserID opts
116 gid <- getGroupID opts
117 lsdir <- getLocalStateDir opts
119 createLocalStateDir lsdir uid gid
125 env <- setupEnv lsdir portNum
127 rebuildIndexIfRequested env opts
129 infoM logger ("Listening to " ++ show portNum ++ "/tcp...")
130 runHttpd (envLucuConf env) (resTree env) [fallbackRender env]
133 resTree :: Environment -> ResTree
135 = mkResTree [ ([] , resIndex env)
136 , (["object"], resObject env)
140 getPortNum :: [CmdOpt] -> IO PortNumber
142 = do let xs = mapMaybe (\ x -> case x of
143 OptPortNum n -> Just n
146 [] -> return defaultPort
148 _ -> error "too many --port options."
151 getUserID :: [CmdOpt] -> IO UserID
153 = do let xs = mapMaybe (\ x -> case x of
154 OptUserName n -> Just n
157 [] -> defaultUserName
159 _ -> error "too many --user options."
161 userEnt <- getUserEntryForName name
162 return $ userID userEnt
165 getGroupID :: [CmdOpt] -> IO GroupID
167 = do let xs = mapMaybe (\ x -> case x of
168 OptGroupName n -> Just n
171 [] -> defaultGroupName
173 _ -> error "too many --group options."
175 groupEnt <- getGroupEntryForName name
176 return $ groupID groupEnt
179 getLocalStateDir :: [CmdOpt] -> IO FilePath
180 getLocalStateDir opts
181 = do let xs = mapMaybe (\ x -> case x of
185 [] -> defaultLocalStateDir
187 _ -> error "too many --localstatedir options."
192 setupLogger :: [CmdOpt] -> IO ()
194 = do let disableStderrLog = find (== OptDisableStderrLog) opts /= Nothing
195 logHandlers = if disableStderrLog then
198 [verboseStreamHandler stderr DEBUG]
199 logLevel = fromMaybe defaultLogLevel
200 $ do OptLogLevel l <- find (\ x -> case x of
201 OptLogLevel _ -> True
205 logHandlers' <- sequence logHandlers
206 updateGlobalLogger rootLoggerName (setHandlers logHandlers' . setLevel logLevel)
209 createLocalStateDir :: FilePath -> UserID -> GroupID -> IO ()
210 createLocalStateDir path uid gid
211 = do createDirectoryIfMissing True path
212 setOwnerAndGroup path uid gid
215 rebuildIndexIfRequested :: Environment -> [CmdOpt] -> IO ()
216 rebuildIndexIfRequested env opts
217 = do let rebuild = isJust $ find (\ x -> case x of
218 OptRebuildIndex -> True
221 $ rebuildIndex (envStorage env)