diff --git a/config/settings-default.yaml b/config/settings-default.yaml index ae627f7..bfb7bbf 100644 --- a/config/settings-default.yaml +++ b/config/settings-default.yaml @@ -172,6 +172,9 @@ retry-delivery-base: # List of (hosts of) other known federating instances. #instances: [] +# Maximal length we allow for Grant chains (default: 16) +max-grant-chain-length: 16 + ############################################################################### # User interface ############################################################################### diff --git a/src/Vervis/Settings.hs b/src/Vervis/Settings.hs index a7f298d..6f8fa89 100644 --- a/src/Vervis/Settings.hs +++ b/src/Vervis/Settings.hs @@ -1,6 +1,7 @@ {- This file is part of Vervis. - - - Written in 2016, 2018, 2019, 2022 by fr33domlover . + - Written in 2016, 2018, 2019, 2022, 2024 + - by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -196,6 +197,8 @@ data AppSettings = AppSettings , appInboxDebugReportLength :: Maybe Int -- | List of (hosts of) other known federating instances. , appInstances :: [Text] + -- | Maximal length we allow for Grant chains. + , appMaxGrantChainLength :: Int -- | Default color scheme for syntax highlighting of code blocks inside -- documentes rendered with pandoc. @@ -260,6 +263,7 @@ instance FromJSON AppSettings where appDeliveryRetryBase <- interval <$> o .: "retry-delivery-base" appInboxDebugReportLength <- o .:? "activity-debug-reports" appInstances <- o .:? "instances" .!= [] + appMaxGrantChainLength <- o .:? "max-grant-chain-length" .!= 16 appHighlightStyle <- do s <- o .:? "highlight-style" .!= "zenburn" diff --git a/src/Vervis/Web/Collab.hs b/src/Vervis/Web/Collab.hs index f83db53..eef8453 100644 --- a/src/Vervis/Web/Collab.hs +++ b/src/Vervis/Web/Collab.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2023 by fr33domlover . + - Written in 2023, 2024 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -96,23 +96,24 @@ verifyCapability'' -> ActE () verifyCapability'' uCap recipientActor resource requiredRole = do manager <- asksEnv envHttpManager + maxDepth <- appMaxGrantChainLength <$> asksEnv envSettings encodeRouteHome <- getEncodeRouteHome uResource <- encodeRouteHome . VR.renderLocalActor <$> hashLocalActor resource now <- liftIO getCurrentTime - grants <- traverseGrants manager uResource now + grants <- traverseGrants maxDepth manager uResource now unless (checkRole grants) $ throwE "checkRole returns False" where - traverseGrants manager uResource now = do + traverseGrants maxDepth manager uResource now = do encodeRouteHome <- getEncodeRouteHome uActor <- case recipientActor of Left (a, _, _) -> encodeRouteHome . VR.renderLocalActor <$> hashLocalActor a Right (a, _, _) -> return $ remoteAuthorURI a - go uCap uActor [] + go uCap uActor 1 [] where - go u@(ObjURI h lu) recipActor l = do + go u@(ObjURI h lu) recipActor depth l = do cap <- parseActivityURI' u AP.Doc host activity <- case cap of @@ -247,6 +248,8 @@ verifyCapability'' uCap recipientActor resource requiredRole = do return $ (u, activity, grant, role, targetIsProject, targetIsTeam) : l Just uParent -> nameExceptT "Extension-Grant" $ do + when (depth >= maxDepth) $ + throwE "Chain is longer than the max depth" case cap of Left (actor, _, _) | resource == actor -> @@ -262,7 +265,7 @@ verifyCapability'' uCap recipientActor resource requiredRole = do unless (status == ok200 || status == noContent204) $ throwE "Result URI gave neither 200 nor 204 status" let uNextRecip = ObjURI host $ AP.activityActor activity - go uParent uNextRecip $ (u, activity, grant, role, targetIsProject, targetIsTeam) : l + go uParent uNextRecip (depth + 1) $ (u, activity, grant, role, targetIsProject, targetIsTeam) : l checkRole [] = error "Ended up with empty list of grants, impossible" checkRole (g:gs) = go g gs (view _4 g) where