From 443af4d3304139bb2187a0c726327b9c05829810 Mon Sep 17 00:00:00 2001 From: pho Date: Thu, 17 Jan 2008 12:02:28 +0900 Subject: [PATCH] basic authorization support darcs-hash:20080117030228-62b54-445f94ec13059ec4ba269834bb0c4c12747ba169.gz --- Rakka/Resource.hs | 17 +++++- Rakka/Resource/CheckAuth.hs | 15 ++--- Rakka/Resource/PageEntity.hs | 12 ++-- Rakka/Storage.hs | 20 +++---- Rakka/Storage/Impl.hs | 4 +- Rakka/Storage/Repos.hs | 112 +++++++++++++++++++++++------------ js/editPage.js | 12 ++++ js/login.js | 8 +++ 8 files changed, 133 insertions(+), 67 deletions(-) diff --git a/Rakka/Resource.hs b/Rakka/Resource.hs index 8448ea1..26d7389 100644 --- a/Rakka/Resource.hs +++ b/Rakka/Resource.hs @@ -3,6 +3,7 @@ module Rakka.Resource , runXmlA , getEntityType , outputXmlPage + , getUserID ) where @@ -13,6 +14,7 @@ import Control.Monad.Trans import Network.HTTP.Lucu import Network.HTTP.Lucu.Utils import Network.URI hiding (path) +import Rakka.Authorization import Rakka.Environment import Rakka.Validation import System.Log.Logger @@ -145,4 +147,17 @@ outputXmlPage tree toXHTML >>> writeDocumentToString [ (a_indent, v_1) ] ) - output resultStr \ No newline at end of file + output resultStr + + +getUserID :: Environment -> Resource (Maybe String) +getUserID env + = do auth <- getAuthorization + case auth of + Just (BasicAuthCredential userID password) + -> do valid <- isValidPair (envAuthDB env) userID password + if valid then + return (Just userID) + else + return Nothing + _ -> return Nothing diff --git a/Rakka/Resource/CheckAuth.hs b/Rakka/Resource/CheckAuth.hs index 8b4d54b..928e90a 100644 --- a/Rakka/Resource/CheckAuth.hs +++ b/Rakka/Resource/CheckAuth.hs @@ -4,8 +4,8 @@ module Rakka.Resource.CheckAuth where import Network.HTTP.Lucu -import Rakka.Authorization import Rakka.Environment +import Rakka.Resource resCheckAuth :: Environment -> ResourceDef @@ -15,15 +15,10 @@ resCheckAuth env , resIsGreedy = False , resGet = Just $ - do authM <- getAuthorization - case authM of - Just (BasicAuthCredential userID password) - -> do valid <- isValidPair (envAuthDB env) userID password - if valid then - setStatus NoContent - else - setStatus Forbidden - _ -> setStatus Forbidden + do userID <- getUserID env + case userID of + Just _ -> setStatus NoContent + Nothing -> setStatus Forbidden , resHead = Nothing , resPost = Nothing , resPut = Nothing diff --git a/Rakka/Resource/PageEntity.hs b/Rakka/Resource/PageEntity.hs index 1ad3ffa..8f63bba 100644 --- a/Rakka/Resource/PageEntity.hs +++ b/Rakka/Resource/PageEntity.hs @@ -306,13 +306,15 @@ notFoundToXHTML env handlePut :: Environment -> PageName -> Resource () handlePut env name - = runXmlA env "rakka-page-1.0.rng" $ proc tree - -> do page <- parseXmlizedPage -< (name, tree) - status <- putPageA (envStorage env) -< page - returnA -< setStatus status + = do userID <- getUserID env + runXmlA env "rakka-page-1.0.rng" $ proc tree + -> do page <- parseXmlizedPage -< (name, tree) + status <- putPageA (envStorage env) -< (userID, page) + returnA -< setStatus status handleDelete :: Environment -> PageName -> Resource () handleDelete env name - = do status <- deletePage (envStorage env) name + = do userID <- getUserID env + status <- deletePage (envStorage env) userID name setStatus status diff --git a/Rakka/Storage.hs b/Rakka/Storage.hs index d88a336..a89a2af 100644 --- a/Rakka/Storage.hs +++ b/Rakka/Storage.hs @@ -47,16 +47,16 @@ getPage :: MonadIO m => Storage -> PageName -> Maybe RevNum -> m (Maybe Page) getPage = ((liftIO .) .) . getPage' . stoRepository -putPage :: MonadIO m => Storage -> Page -> m StatusCode -putPage sto page - = liftIO $ do st <- putPage' (stoRepository sto) page +putPage :: MonadIO m => Storage -> Maybe String -> Page -> m StatusCode +putPage sto userID page + = liftIO $ do st <- putPage' (stoRepository sto) userID page syncIndex sto return st -deletePage :: MonadIO m => Storage -> PageName -> m StatusCode -deletePage sto name - = liftIO $ do st <- deletePage' (stoRepository sto) name +deletePage :: MonadIO m => Storage -> Maybe String -> PageName -> m StatusCode +deletePage sto userID name + = liftIO $ do st <- deletePage' (stoRepository sto) userID name syncIndex sto return st @@ -65,12 +65,12 @@ getPageA :: ArrowIO a => Storage -> a (PageName, Maybe RevNum) (Maybe Page) getPageA = arrIO2 . getPage -putPageA :: ArrowIO a => Storage -> a Page StatusCode -putPageA = arrIO . putPage +putPageA :: ArrowIO a => Storage -> a (Maybe String, Page) StatusCode +putPageA = arrIO2 . putPage -deletePageA :: ArrowIO a => Storage -> a PageName StatusCode -deletePageA = arrIO . deletePage +deletePageA :: ArrowIO a => Storage -> a (Maybe String, PageName) StatusCode +deletePageA = arrIO2 . deletePage searchPages :: MonadIO m => Storage -> Condition -> m [(PageName, RevNum)] diff --git a/Rakka/Storage/Impl.hs b/Rakka/Storage/Impl.hs index d6d53a4..2073155 100644 --- a/Rakka/Storage/Impl.hs +++ b/Rakka/Storage/Impl.hs @@ -40,11 +40,11 @@ getPage' repos name rev p -> return p -putPage' :: Repository -> Page -> IO StatusCode +putPage' :: Repository -> Maybe String -> Page -> IO StatusCode putPage' = putPageIntoRepository -deletePage' :: Repository -> PageName -> IO StatusCode +deletePage' :: Repository -> Maybe String -> PageName -> IO StatusCode deletePage' = deletePageFromRepository diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs index 0c4e253..8430068 100644 --- a/Rakka/Storage/Repos.hs +++ b/Rakka/Storage/Repos.hs @@ -167,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 @@ -263,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 () diff --git a/js/editPage.js b/js/editPage.js index fb88735..d50e5b4 100644 --- a/js/editPage.js +++ b/js/editPage.js @@ -409,6 +409,9 @@ contentType: "text/xml", data : doc, processData: false, + beforeSend : function (req) { + Rakka.setAuthorization(req); + }, success : function () { window.location.replace(url); }, @@ -468,6 +471,9 @@ contentType: "text/xml", data : doc, processData: false, + beforeSend : function (req) { + Rakka.setAuthorization(req); + }, success : function () { window.location.replace(url); }, @@ -511,6 +517,9 @@ contentType: "text/xml", data : doc, processData: false, + beforeSend : function (req) { + Rakka.setAuthorization(req); + }, success : function () { window.location.replace(url); }, @@ -528,6 +537,9 @@ $.ajax({ type : "DELETE", url : url, + beforeSend : function (req) { + Rakka.setAuthorization(req); + }, success : function () { window.location.replace(url); }, diff --git a/js/login.js b/js/login.js index 95b1f00..174376b 100644 --- a/js/login.js +++ b/js/login.js @@ -121,6 +121,14 @@ } }; + Rakka.setAuthorization = function (req) { + if (currentUserID != null) { + req.setRequestHeader( + "Authorization", + "Basic " + Rakka.encodeBase64(currentUserID + ":" + currentPassword)); + } + }; + $(document).ready(function () { updateLoginState(); }); -- 2.40.0