X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FStorage%2FRepos.hs;h=8430068922a7e1b8e98676e539dc28d8f1f45296;hb=443af4d3304139bb2187a0c726327b9c05829810;hp=8e717ed27ee7008ec764ebd3f0637c51071d00d6;hpb=5311fe068286b30d52063ef97cc00f09f65a47f1;p=Rakka.git

diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs
index 8e717ed..8430068 100644
--- a/Rakka/Storage/Repos.hs
+++ b/Rakka/Storage/Repos.hs
@@ -131,7 +131,6 @@ loadPageInRepository repos name rev
                           , entityIsTheme    = any ((== "rakka:isTheme") . fst) props
                           , entityIsFeed     = any ((== "rakka:isFeed") . fst) props
                           , entityIsLocked   = any ((== "rakka:isLocked") . fst) props
-                          , entityIsBoring   = any ((== "rakka:isBoring") . fst) props
                           , entityIsBinary   = case mimeType of
                                                  MIMEType "text" _ _
                                                      -> any ((== "rakka:isBinary") . fst) props
@@ -168,34 +167,55 @@ loadPageInRepository repos name rev
                           }
 
 
-putPageIntoRepository :: Repository -> Page -> IO StatusCode
-putPageIntoRepository repos page
+putPageIntoRepository :: Repository -> Maybe String -> Page -> IO StatusCode
+putPageIntoRepository repos userID page
     = filterSvnError $
-      do let name = pageName page
-         ret <- case pageUpdateInfo page of
-                  Just ui
-                      -> doReposTxn
-                         repos
-                         (uiOldRevision ui)
-                         "[Rakka]"
-                         (Just "Automatic commit by Rakka for page update")
-                         $ do case uiOldName ui of
-                                Nothing      -> return ()
-                                Just oldName -> renamePage (uiOldRevision ui) oldName name
-                              updatePage name
-                  Nothing
-                      -> do fs  <- getRepositoryFS repos
-                            rev <- getYoungestRev fs
-                            doReposTxn repos
-                                       rev
-                                       "[Rakka]"
-                                       (Just "Automatic commit by Rakka for page creation")
-                                       $ do createPage name
-                                            updatePage name
-         case ret of
-           Left  _ -> return Conflict
-           Right _ -> return Created
+      do let name   = pageName page
+             author = fromMaybe "[Rakka]" userID
+         case pageUpdateInfo page of
+           Just ui
+               -> do let oldRev = uiOldRevision ui
+                     denied <- case uiOldName ui of
+                                 Nothing      -> checkDenial oldRev name
+                                 Just oldName -> checkDenial oldRev oldName
+                     if denied then
+                         return Forbidden
+                       else
+                         do ret <- doReposTxn
+                                   repos
+                                   (uiOldRevision ui)
+                                   author
+                                   (Just "Automatic commit by Rakka for page update")
+                                   $ do case uiOldName ui of
+                                          Nothing      -> return ()
+                                          Just oldName -> renamePage (uiOldRevision ui) oldName name
+                                        updatePage name
+                            case ret of
+                              Left  _ -> return Conflict
+                              Right _ -> return Created
+           Nothing
+               -> do fs  <- getRepositoryFS repos
+                     rev <- getYoungestRev fs
+                     ret <- doReposTxn
+                            repos
+                            rev
+                            author
+                            (Just "Automatic commit by Rakka for page creation")
+                            $ do createPage name
+                                 updatePage name
+                     case ret of
+                       Left  _ -> return Conflict
+                       Right _ -> return Created
     where
+      checkDenial :: RevNum -> PageName -> IO Bool
+      checkDenial rev name
+          = do fs <- getRepositoryFS repos
+               withRevision fs rev
+                   $ do prop <- getNodeProp (mkPagePath name) "rakka:isLocked"
+                        case prop of
+                          Just _  -> return (isNothing userID) -- 施錠されてゐるので匿名では駄目
+                          Nothing -> return False
+
       renamePage :: RevNum -> PageName -> PageName -> Txn ()
       renamePage oldRev oldName newName
           = do let oldPath = mkPagePath oldName
@@ -225,7 +245,6 @@ putPageIntoRepository repos page
                setNodeProp path "rakka:isTheme"   Nothing
                setNodeProp path "rakka:isFeed"    Nothing
                setNodeProp path "rakka:isLocked"  Nothing
-               setNodeProp path "rakka:isBoring"  Nothing
                setNodeProp path "rakka:isBinary"  Nothing
                setNodeProp path "rakka:summary"   Nothing
                setNodeProp path "rakka:otherLang" Nothing
@@ -239,7 +258,6 @@ putPageIntoRepository repos page
                setNodeProp path "rakka:isTheme"   (encodeFlag $ entityIsTheme page)
                setNodeProp path "rakka:isFeed"    (encodeFlag $ entityIsFeed page)
                setNodeProp path "rakka:isLocked"  (encodeFlag $ entityIsLocked page)
-               setNodeProp path "rakka:isBoring"  (encodeFlag $ entityIsBoring page)
                setNodeProp path "rakka:isBinary"  (encodeFlag $ entityIsBinary page)
                setNodeProp path "rakka:summary"   (entitySummary page)
                setNodeProp path "rakka:otherLang" (let otherLang = entityOtherLang page
@@ -266,23 +284,36 @@ createParentDirectories path
            DirNode  -> return ()
 
 
-deletePageFromRepository :: Repository -> PageName -> IO StatusCode
-deletePageFromRepository repos name
+deletePageFromRepository :: Repository -> Maybe String -> PageName -> IO StatusCode
+deletePageFromRepository repos userID name
     = filterSvnError $
       do let path = mkPagePath name
          fs     <- getRepositoryFS repos
          rev    <- getYoungestRev fs
-         exists <- withRevision fs rev $ isFile path
-         if exists then
-             do doReposTxn repos
-                           rev
-                           "[Rakka]"
-                           (Just "Automatic commit by Rakka for page deleting")
-                           $ do deleteEntry path
-                                deleteEmptyParentDirectories path
-                return NoContent
-           else
-             return NotFound
+         status <- withRevision fs rev
+                   $ do exists <- isFile path
+                        if exists then
+                            do prop <- getNodeProp path "rakka:isLocked"
+                               return $ case prop of
+                                          Just _
+                                              -> if isNothing userID then
+                                                     -- 施錠されてゐるので匿名では駄目
+                                                     Forbidden
+                                                 else
+                                                     NoContent
+                                          Nothing
+                                              -> NoContent
+                          else
+                            return NotFound
+         when (status == NoContent)
+             $ do doReposTxn repos
+                             rev
+                             "[Rakka]"
+                             (Just "Automatic commit by Rakka for page deleting")
+                             $ do deleteEntry path
+                                  deleteEmptyParentDirectories path
+                  return ()
+         return status
 
 
 deleteEmptyParentDirectories :: FilePath -> Txn ()