In early development

darcs-hash:20071008014524-62b54-96eff5b1009a2abef4a8347fa559718b8f43d9af.gz

diff --git a/Main.hs b/Main.hs
index 942787c025443fd4a8daee4f88ee9cf0c4478222..df2cccb5a17ccfd5e37835adb22eeba0c3f709d3 100644 (file)
--- a/Main.hs
+++ b/Main.hs
@@ -2,9 +2,16 @@
 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.Page
 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
 
@@ -20,6 +27,9 @@ data CmdOpt
 defaultPort :: PortNumber
 defaultPort = fromIntegral 8080
 
+defaultLocalStateDir :: FilePath
+defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP
+
 defaultUserName :: String
 defaultUserName = "daemon"
 
@@ -34,7 +44,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 +83,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) [fallbackPage env]
 
-          print portNum
-          print uid
+          
+resTree :: Environment -> ResTree
+resTree env
+    = mkResTree [ ([]        , resIndex  env)
+                , (["object"], resObject env)
+                ]
 
 
 getPortNum :: [CmdOpt] -> IO PortNumber
@@ -102,4 +126,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

diff --git a/Rakka.cabal b/Rakka.cabal
index ebb453155135ba9cea9d93f8946c3541089a7204..a1c8a7181a8c3d9b082385058a08d14ea2f8a272 100644 (file)
--- a/Rakka.cabal
+++ b/Rakka.cabal
@@ -22,6 +22,9 @@ Tested-With:
     GHC == 6.6.1
 Build-Depends:
     base, network, unix, Lucu
+Data-Files:
+    defaultPages/Main_Page
+    schemas/rakka-page-1.0.rng
 
 Executable:
     rakka

diff --git a/Rakka/Environment.hs b/Rakka/Environment.hs
new file mode 100644 (file)
index 0000000..069f9eb
--- /dev/null
+++ b/Rakka/Environment.hs
@@ -0,0 +1,25 @@
+module Rakka.Environment
+    ( Environment(..)
+    , setupEnv
+    )
+    where
+
+import           Network
+import qualified Network.HTTP.Lucu.Config as LC
+
+
+data Environment = Environment {
+      envLocalStateDir :: FilePath
+    , envLucuConf      :: LC.Config
+    }
+
+
+setupEnv :: FilePath -> PortNumber -> IO Environment
+setupEnv lsdir portNum
+    = do let lucuConf = LC.defaultConfig {
+                          LC.cnfServerPort = PortNumber portNum
+                        }
+         return $ Environment {
+                      envLocalStateDir = lsdir
+                    , envLucuConf      = lucuConf
+                    }
\ No newline at end of file

diff --git a/Rakka/Resource/Index.hs b/Rakka/Resource/Index.hs
new file mode 100644 (file)
index 0000000..859b8eb
--- /dev/null
+++ b/Rakka/Resource/Index.hs
@@ -0,0 +1,22 @@
+module Rakka.Resource.Index
+    ( resIndex
+    )
+    where
+
+import           Network.HTTP.Lucu
+import           Rakka.Environment
+
+
+resIndex :: Environment -> ResourceDef
+resIndex env
+    = ResourceDef {
+        resUsesNativeThread = False
+      , resIsGreedy         = False
+      , resGet              = Just $ do setContentType $ read "text/plain"
+                                        output "FIXME: not implemented"
+      , resHead             = Nothing
+      , resPost             = Nothing
+      , resPut              = Nothing
+      , resDelete           = Nothing
+      }
+

diff --git a/Rakka/Resource/Object.hs b/Rakka/Resource/Object.hs
new file mode 100644 (file)
index 0000000..9e30d1e
--- /dev/null
+++ b/Rakka/Resource/Object.hs
@@ -0,0 +1,22 @@
+module Rakka.Resource.Object
+    ( resObject
+    )
+    where
+
+import           Network.HTTP.Lucu
+import           Rakka.Environment
+
+
+resObject :: Environment -> ResourceDef
+resObject env
+    = ResourceDef {
+        resUsesNativeThread = False
+      , resIsGreedy         = False
+      , resGet              = Just $ do setContentType $ read "text/plain"
+                                        output "FIXME: not implemented"
+      , resHead             = Nothing
+      , resPost             = Nothing
+      , resPut              = Nothing
+      , resDelete           = Nothing
+      }
+

diff --git a/Rakka/Resource/Page.hs b/Rakka/Resource/Page.hs
new file mode 100644 (file)
index 0000000..8077c4f
--- /dev/null
+++ b/Rakka/Resource/Page.hs
@@ -0,0 +1,37 @@
+module Rakka.Resource.Page
+    ( fallbackPage
+    )
+    where
+
+import           Data.Char
+import           Network.HTTP.Lucu
+import           Rakka.Environment
+
+
+fallbackPage :: Environment -> [String] -> IO (Maybe ResourceDef)
+fallbackPage env path
+    | null path                        = return Nothing
+    | null $ head path                 = return Nothing
+    | not $ isUpper $ head $ head path = return Nothing -- /Foo/bar のような形式でない。
+    | otherwise
+        = return $ Just $ ResourceDef {
+            resUsesNativeThread = False
+          , resIsGreedy         = True
+          , resGet              = Just $ handleGet env path
+          , resHead             = Nothing
+          , resPost             = Nothing
+          , resPut              = Just $ handlePut env path
+          , resDelete           = Just $ handleDelete env path
+          }
+
+
+handleGet :: Environment -> [String] -> Resource ()
+handleGet = fail "FIXME: not implemented"
+
+
+handlePut :: Environment -> [String] -> Resource ()
+handlePut = fail "FIXME: not implemented"
+
+
+handleDelete :: Environment -> [String] -> Resource ()
+handleDelete = fail "FIXME: not implemented"

diff --git a/defaultPages/Main_Page b/defaultPages/Main_Page
new file mode 100644 (file)
index 0000000..1c0a421
--- /dev/null
+++ b/defaultPages/Main_Page
@@ -0,0 +1,7 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<page xmlns="http://cielonegro.org/schema/Rakka/Page/1.0"
+      type="text/x-rakka">
+  <textData>
+    This is the main page. Hello, world!
+  </textData>
+</page>
\ No newline at end of file

diff --git a/schemas/rakka-page-1.0.rng b/schemas/rakka-page-1.0.rng
new file mode 100644 (file)
index 0000000..b85385b
--- /dev/null
+++ b/schemas/rakka-page-1.0.rng
@@ -0,0 +1,20 @@
+<?xml version="1.0" encoding="utf-8"?>
+<element name="page"
+         ns="http://cielonegro.org/schema/Rakka/Page/1.0"
+         datatypeLibrary="http://www.w3.org/2001/XMLSchema-datatypes"
+         xmlns="http://relaxng.org/ns/structure/1.0">
+
+  <attribute name="type">
+    <text />
+  </attribute>
+
+  <choice>
+    <element name="textData">
+      <text />
+    </element>
+
+    <element name="binaryData">
+      <text />
+    </element>
+  </choice>
+</element>