diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 85d0bba6f..78f999ee3 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -153,6 +153,7 @@ UnauthorizedAnd l@Text r@Text: (#{l} UND #{r}) UnauthorizedOr l@Text r@Text: (#{l} ODER #{r}) UnauthorizedSiteAdmin: Sie sind kein System-weiter Administrator. UnauthorizedSchoolAdmin: Sie sind nicht als Administrator für dieses Institut eingetragen. +UnauthorizedAdminEscalation: Sie sind nicht Administrator für alle Institute, für die dieser Nutzer Administrator oder Veranstalter ist. UnauthorizedSchoolLecturer: Sie sind nicht als Veranstalter für dieses Institut eingetragen. UnauthorizedLecturer: Sie sind nicht als Veranstalter für diese Veranstaltung eingetragen. UnauthorizedCorrector: Sie sind nicht als Korrektor für diese Veranstaltung eingetragen. @@ -556,6 +557,7 @@ AuthPredsActive: Aktive Authorisierungsprädikate AuthPredsActiveChanged: Authorisierungseinstellungen für aktuelle Sitzung gespeichert AuthTagFree: Seite ist generell zugänglich AuthTagAdmin: Nutzer ist Administrator +AuthTagNoEscalation: Nutzer-Rechte werden nicht erweitert AuthTagDeprecated: Seite ist nicht überholt AuthTagDevelopment: Seite ist nicht in Entwicklung AuthTagLecturer: Nutzer ist Dozent diff --git a/routes b/routes index 4508cb781..25d5bb346 100644 --- a/routes +++ b/routes @@ -36,7 +36,7 @@ /users UsersR GET -- no tags, i.e. admins only /admin/test AdminTestR GET POST /admin/user/#CryptoUUIDUser AdminUserR GET !development -/admin/user/#CryptoUUIDUser/hijack AdminHijackUserR POST +/admin/user/#CryptoUUIDUser/hijack AdminHijackUserR POST !adminANDno-escalation /admin/errMsg AdminErrMsgR GET POST /info VersionR GET !free /help HelpR GET POST !free diff --git a/src/Foundation.hs b/src/Foundation.hs index 5f2795e56..76af3794e 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -362,6 +362,16 @@ tagAccessPredicate AuthAdmin = APDB $ \route _ -> case route of adrights <- lift $ selectFirst [UserAdminUser ==. authId] [] guardMExceptT (isJust adrights) (unauthorizedI MsgUnauthorizedSiteAdmin) return Authorized +tagAccessPredicate AuthNoEscalation = APDB $ \route _ -> case route of + AdminHijackUserR cID -> exceptT return return $ do + myUid <- maybeExceptT AuthenticationRequired $ lift maybeAuthId + uid <- decrypt cID + otherSchoolsAdmin <- lift $ Set.fromList . map (userAdminSchool . entityVal) <$> selectList [UserAdminUser ==. uid] [] + otherSchoolsLecturer <- lift $ Set.fromList . map (userLecturerSchool . entityVal) <$> selectList [UserLecturerUser ==. uid] [] + mySchools <- lift $ Set.fromList . map (userAdminSchool . entityVal) <$> selectList [UserAdminUser ==. myUid] [] + guardMExceptT ((otherSchoolsAdmin `Set.union` otherSchoolsLecturer) `Set.isSubsetOf` mySchools) (unauthorizedI MsgUnauthorizedAdminEscalation) + return Authorized + r -> $unsupportedAuthPredicate AuthNoEscalation r tagAccessPredicate AuthDeprecated = APHandler $ \r _ -> do $logWarnS "AccessControl" ("deprecated route: " <> tshow r) addMessageI Error MsgDeprecatedRoute diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index 5104abf15..a2c21ec9f 100644 --- a/src/Handler/Users.hs +++ b/src/Handler/Users.hs @@ -9,18 +9,16 @@ import Utils.Lens import qualified Data.CaseInsensitive as CI import qualified Data.Map as Map -import qualified Data.Set as Set import qualified Database.Esqueleto as E -hijackUserForm :: UserId -> Form UserId -hijackUserForm uid csrf = do - cID <- encrypt uid +hijackUserForm :: CryptoUUIDUser -> Form () +hijackUserForm cID csrf = do (uidResult, uidView) <- mforced hiddenField "" (cID :: CryptoUUIDUser) (btnResult, btnView) <- mreq (buttonField BtnHijack) "" Nothing - return (uid <$ uidResult <* btnResult, mconcat [toWidget csrf, fvInput uidView, fvInput btnView]) + return (() <$ uidResult <* btnResult, mconcat [toWidget csrf, fvInput uidView, fvInput btnView]) getUsersR :: Handler Html getUsersR = do @@ -59,12 +57,15 @@ getUsersR = do
  • #{sh} |] , sortable Nothing mempty $ \DBRow{ dbrOutput = Entity uid _ } -> cell $ do - (hijackView, hijackEnctype) <- liftHandlerT . generateFormPost $ hijackUserForm uid cID <- encrypt uid - [whamlet| -
    - ^{hijackView} - |] + mayHijack <- (== Authorized) <$> evalAccess (AdminHijackUserR cID) True + myUid <- liftHandlerT maybeAuthId + when (mayHijack && Just uid /= myUid) $ do + (hijackView, hijackEnctype) <- liftHandlerT . generateFormPost $ hijackUserForm cID + [whamlet| + + ^{hijackView} + |] ] psValidator = def & defaultSorting [SortAscBy "name", SortAscBy "display-name"] @@ -99,21 +100,10 @@ getUsersR = do postAdminHijackUserR :: CryptoUUIDUser -> Handler TypedContent postAdminHijackUserR cID = do uid <- decrypt cID - ((hijackRes, _), _) <- runFormPost $ hijackUserForm uid + ((hijackRes, _), _) <- runFormPost $ hijackUserForm cID - case hijackRes of - FormSuccess uid' - | uid' == uid -> do - myUid <- requireAuthId - User{..} <- runDB $ do - otherSchoolsAdmin <- Set.fromList . map (userAdminSchool . entityVal) <$> selectList [UserAdminUser ==. uid] [] - otherSchoolsLecturer <- Set.fromList . map (userLecturerSchool . entityVal) <$> selectList [UserLecturerUser ==. uid] [] - mySchools <- Set.fromList . map (userAdminSchool . entityVal) <$> selectList [UserAdminUser ==. myUid] [] - unless ((otherSchoolsAdmin `Set.union` otherSchoolsLecturer) `Set.isSubsetOf` mySchools) $ - permissionDenied "Cannot escalate admin status to additional schools" + ret <- formResultMaybe hijackRes $ \() -> Just <$> do + User{userIdent} <- runDB $ get404 uid + setCredsRedirect $ Creds "dummy" (CI.original userIdent) [] - get404 uid - setCredsRedirect $ Creds "dummy" (CI.original userIdent) [] - | otherwise -> error "This should be impossible by definition of `hijackUserForm`" - FormFailure errs -> toTypedContent <$> mapM_ (addMessage Error . toHtml) errs - FormMissing -> return $ toTypedContent () + maybe (redirect UsersR) return ret diff --git a/src/Model/Types.hs b/src/Model/Types.hs index c0c60a023..57f9b7bb7 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -702,6 +702,7 @@ pseudonymFragments = folding data AuthTag = AuthFree | AuthAdmin + | AuthNoEscalation | AuthDeprecated | AuthDevelopment | AuthLecturer