X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Main.hs;h=1b441ee2725d5b2678e1b944722746f371b9d837;hb=8a7556db44cd91ac0bb52279472bcc2abaa3f18e;hp=942787c025443fd4a8daee4f88ee9cf0c4478222;hpb=03d4363a24998cd670061fde1ea4b8db8cbc5b32;p=Rakka.git diff --git a/Main.hs b/Main.hs index 942787c..1b441ee 100644 --- a/Main.hs +++ b/Main.hs @@ -2,12 +2,20 @@ import Control.Monad import Data.Maybe import Network +import Network.HTTP.Lucu +import Rakka.Environment +import Rakka.Resource.Index +import Rakka.Resource.Object +import Rakka.Resource.Render import System.Console.GetOpt +import System.Directory import System.Environment import System.Exit +import System.Posix.Files import System.Posix.Types import System.Posix.User + data CmdOpt = OptPortNum PortNumber | OptLSDir FilePath @@ -20,6 +28,9 @@ data CmdOpt defaultPort :: PortNumber defaultPort = fromIntegral 8080 +defaultLocalStateDir :: FilePath +defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP + defaultUserName :: String defaultUserName = "daemon" @@ -34,7 +45,7 @@ options = [ Option ['p'] ["port"] , Option ['d'] ["localstatedir"] (ReqArg OptLSDir "DIR") - ("Path to the database directory. (default: " ++ LOCALSTATEDIR ++ ")") + ("Path to the database directory. (default: " ++ defaultLocalStateDir ++ ")") , Option ['u'] ["user"] (ReqArg OptUserName "USER") @@ -73,10 +84,24 @@ main = do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs exitWith $ ExitFailure 1 portNum <- getPortNum opts - uid <- getUserID opts + uid <- getUserID opts + gid <- getGroupID opts + lsdir <- getLocalStateDir opts + + createLocalStateDir lsdir uid gid + + setGroupID gid + setUserID uid + + env <- setupEnv lsdir portNum + runHttpd (envLucuConf env) (resTree env) [fallbackRender env] - print portNum - print uid + +resTree :: Environment -> ResTree +resTree env + = mkResTree [ ([] , resIndex env) + , (["object"], resObject env) + ] getPortNum :: [CmdOpt] -> IO PortNumber @@ -102,4 +127,36 @@ getUserID opts userEnt <- getUserEntryForName name return $ userID userEnt - \ No newline at end of file + + +getGroupID :: [CmdOpt] -> IO GroupID +getGroupID opts + = do let xs = mapMaybe (\ x -> case x of + OptGroupName n -> Just n + _ -> Nothing) opts + name = case xs of + [] -> defaultGroupName + (x:[]) -> x + _ -> error "too many --group options." + + groupEnt <- getGroupEntryForName name + return $ groupID groupEnt + + +getLocalStateDir :: [CmdOpt] -> IO FilePath +getLocalStateDir opts + = do let xs = mapMaybe (\ x -> case x of + OptLSDir n -> Just n + _ -> Nothing) opts + path = case xs of + [] -> defaultLocalStateDir + (x:[]) -> x + _ -> error "too many --localstatedir options." + + return path + + +createLocalStateDir :: FilePath -> UserID -> GroupID -> IO () +createLocalStateDir path uid gid + = do createDirectoryIfMissing True path + setOwnerAndGroup path uid gid