import Data.Maybe
import Network
import Network.HTTP.Lucu
+import OpenSSL
import Rakka.Environment
+import Rakka.Resource.CheckAuth
+import Rakka.Resource.DumpRepos
import Rakka.Resource.Index
+import Rakka.Resource.JavaScript
+import Rakka.Resource.PageEntity
import Rakka.Resource.Object
import Rakka.Resource.Render
+import Rakka.Resource.Search
+import Rakka.Resource.SystemConfig
+-- import Rakka.Resource.TrackBack
+import Rakka.Resource.Users
+import Rakka.Storage
import Subversion
import System.Console.GetOpt
import System.Directory
import System.Posix.Types
import System.Posix.User
+
+logger :: String
logger = "Main"
| OptUserName String
| OptGroupName String
| OptLogLevel Priority
- | OptDisableStderrLog
+ | OptVerbose
+ | OptRebuildIndex
| OptHelp
deriving (Eq, Show)
defaultPort :: PortNumber
-defaultPort = fromIntegral 8080
+defaultPort = toEnum 8080
defaultLocalStateDir :: FilePath
defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP
options :: [OptDescr CmdOpt]
options = [ Option ['p'] ["port"]
- (ReqArg (OptPortNum . fromIntegral . read) "NUM")
+ (ReqArg (OptPortNum . toEnum . read) "NUM")
("Port number to listen. (default: " ++ show defaultPort ++ ")")
, Option ['d'] ["localstatedir"]
(ReqArg (OptLogLevel . read) "LEVEL")
("The lowest log level to show. (default: " ++ show defaultLogLevel ++ ")")
- , Option [] ["disable-stderr-log"]
- (NoArg OptDisableStderrLog)
- ("Disable logging to stderr.")
+ , Option ['v'] ["verbose"]
+ (NoArg OptVerbose)
+ "Enable logging to stderr."
+
+ , Option ['r'] ["rebuild-index"]
+ (NoArg OptRebuildIndex)
+ "Rebuild the index database."
, Option ['h'] ["help"]
(NoArg OptHelp)
main :: IO ()
-main = withSubversion $
+main = withOpenSSL $
+ withSubversion $
do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs
- when (not $ null errors)
+ unless (null errors)
$ do mapM_ putStr errors
exitWith $ ExitFailure 1
$ do printUsage
exitWith ExitSuccess
- when (not $ null nonOpts)
+ unless (null nonOpts)
$ do printUsage
exitWith $ ExitFailure 1
setupLogger opts
env <- setupEnv lsdir portNum
- noticeM logger ("Listening to " ++ show portNum ++ "/tcp...")
- runHttpd (envLucuConf env) (resTree env) [fallbackRender env]
+ rebuildIndexIfRequested env opts
+
+ infoM logger ("Listening to " ++ show portNum ++ "/tcp...")
+ runHttpd (envLucuConf env) (resTree env) [fallbackPageEntity env]
resTree :: Environment -> ResTree
resTree env
- = mkResTree [ ([] , resIndex env)
- , (["object"], resObject env)
+ = mkResTree [ ([] , resIndex env)
+ , (["checkAuth" ], resCheckAuth env)
+ , (["dumpRepos" ], resDumpRepos env)
+ , (["js" ], javaScript )
+ , (["object" ], resObject env)
+ , (["render" ], resRender env)
+ , (["search" ], resSearch env)
+ , (["search.html" ], resSearch env)
+ , (["search.xml" ], resSearch env)
+ , (["systemConfig"], resSystemConfig env)
+ -- , (["trackback" ], resTrackBack env)
+ , (["users" ], resUsers env)
]
setupLogger :: [CmdOpt] -> IO ()
setupLogger opts
- = do let disableStderrLog = find (== OptDisableStderrLog) opts /= Nothing
- logHandlers = if disableStderrLog then
- []
- else
- [verboseStreamHandler stderr DEBUG]
- logLevel = fromMaybe defaultLogLevel
- $ do OptLogLevel l <- find (\ x -> case x of
- OptLogLevel _ -> True
- _ -> False) opts
- return l
+ = do let verbose = find (== OptVerbose) opts /= Nothing
+ logHandlers = if verbose then
+ [verboseStreamHandler stderr DEBUG]
+ else
+ [] -- FIXME: enable file log
+ logLevel = fromMaybe defaultLogLevel
+ $ do OptLogLevel l <- find (\ x -> case x of
+ OptLogLevel _ -> True
+ _ -> False) opts
+ return l
logHandlers' <- sequence logHandlers
updateGlobalLogger rootLoggerName (setHandlers logHandlers' . setLevel logLevel)
createLocalStateDir path uid gid
= do createDirectoryIfMissing True path
setOwnerAndGroup path uid gid
+
+
+rebuildIndexIfRequested :: Environment -> [CmdOpt] -> IO ()
+rebuildIndexIfRequested env opts
+ = do let rebuild = isJust $ find (\ x -> case x of
+ OptRebuildIndex -> True
+ _ -> False) opts
+ when rebuild
+ $ rebuildIndex (envStorage env)