, runXmlA
, getEntityType
, outputXmlPage
+ , getUserID
)
where
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
>>>
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
where
import Network.HTTP.Lucu
-import Rakka.Authorization
import Rakka.Environment
+import Rakka.Resource
resCheckAuth :: Environment -> ResourceDef
, 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
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
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
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)]
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
}
-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
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 ()
contentType: "text/xml",
data : doc,
processData: false,
+ beforeSend : function (req) {
+ Rakka.setAuthorization(req);
+ },
success : function () {
window.location.replace(url);
},
contentType: "text/xml",
data : doc,
processData: false,
+ beforeSend : function (req) {
+ Rakka.setAuthorization(req);
+ },
success : function () {
window.location.replace(url);
},
contentType: "text/xml",
data : doc,
processData: false,
+ beforeSend : function (req) {
+ Rakka.setAuthorization(req);
+ },
success : function () {
window.location.replace(url);
},
$.ajax({
type : "DELETE",
url : url,
+ beforeSend : function (req) {
+ Rakka.setAuthorization(req);
+ },
success : function () {
window.location.replace(url);
},
}
};
+ Rakka.setAuthorization = function (req) {
+ if (currentUserID != null) {
+ req.setRequestHeader(
+ "Authorization",
+ "Basic " + Rakka.encodeBase64(currentUserID + ":" + currentPassword));
+ }
+ };
+
$(document).ready(function () {
updateLoginState();
});
projects / Rakka.git / commitdiff