From 1275cce1af983e20f6015ac7e201d3a8783d0329 Mon Sep 17 00:00:00 2001 From: Maximilian Tagher Date: Thu, 16 Nov 2017 23:03:16 -0800 Subject: [PATCH] Give better error messages when CSRF validation fails * This is important because historically these errors have tripped people up * Making security as easy as possible is important so that it doesn't just get turned off * Giving clear directions about where to get the CSRF token (a cookie) and where to send it (a header/param) is especially helpful to frontend developers not necessarily familiar with the backend codebase --- yesod-core/ChangeLog.md | 7 +++- yesod-core/Yesod/Core/Handler.hs | 59 ++++++++++++++++++++++++-------- yesod-core/yesod-core.cabal | 2 +- 3 files changed, 51 insertions(+), 17 deletions(-) diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md index b24dc010..43266e77 100644 --- a/yesod-core/ChangeLog.md +++ b/yesod-core/ChangeLog.md @@ -1,5 +1,10 @@ +## 1.4.37.2 + +* Improve error messages for the CSRF checking functions [#1455](https://github.com/yesodweb/yesod/issues/1455) + ## 1.4.37.1 -* Fix documentation on `languages` function, update `getMessageRender` to use said function. [#1457] (https://github.com/yesodweb/yesod/pull/1457) + +* Fix documentation on `languages` function, update `getMessageRender` to use said function. [#1457](https://github.com/yesodweb/yesod/pull/1457) ## 1.4.37 diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs index b393a641..9a340803 100644 --- a/yesod-core/Yesod/Core/Handler.hs +++ b/yesod-core/Yesod/Core/Handler.hs @@ -242,7 +242,7 @@ import Yesod.Core.Types import Yesod.Routes.Class (Route) import Blaze.ByteString.Builder (Builder) import Safe (headMay) -import Data.CaseInsensitive (CI) +import Data.CaseInsensitive (CI, original) import qualified Data.Conduit.List as CL import Control.Monad.Trans.Resource (MonadResource, InternalState, runResourceT, withInternalState, getInternalState, liftResourceT, resourceForkIO) import qualified System.PosixCompat.Files as PC @@ -1501,18 +1501,22 @@ defaultCsrfHeaderName = "X-XSRF-TOKEN" -- @since 1.4.14 checkCsrfHeaderNamed :: MonadHandler m => CI S8.ByteString -> m () checkCsrfHeaderNamed headerName = do - valid <- hasValidCsrfHeaderNamed headerName - unless valid (permissionDenied csrfErrorMessage) + (valid, mHeader) <- hasValidCsrfHeaderNamed' headerName + unless valid (permissionDenied $ csrfErrorMessage [CSRFHeader (decodeUtf8 $ original headerName) mHeader]) -- | Takes a header name to lookup a CSRF token, and returns whether the value matches the token stored in the session. -- -- @since 1.4.14 hasValidCsrfHeaderNamed :: MonadHandler m => CI S8.ByteString -> m Bool -hasValidCsrfHeaderNamed headerName = do +hasValidCsrfHeaderNamed headerName = fst <$> hasValidCsrfHeaderNamed' headerName + +-- | Like 'hasValidCsrfHeaderNamed', but also returns the header value to be used in error messages. +hasValidCsrfHeaderNamed' :: MonadHandler m => CI S8.ByteString -> m (Bool, Maybe Text) +hasValidCsrfHeaderNamed' headerName = do mCsrfToken <- reqToken <$> getRequest mXsrfHeader <- lookupHeader headerName - return $ validCsrf mCsrfToken mXsrfHeader + return $ (validCsrf mCsrfToken mXsrfHeader, decodeUtf8 <$> mXsrfHeader) -- CSRF Parameter checking @@ -1528,18 +1532,22 @@ defaultCsrfParamName = "_token" -- @since 1.4.14 checkCsrfParamNamed :: MonadHandler m => Text -> m () checkCsrfParamNamed paramName = do - valid <- hasValidCsrfParamNamed paramName - unless valid (permissionDenied csrfErrorMessage) + (valid, mParam) <- hasValidCsrfParamNamed' paramName + unless valid (permissionDenied $ csrfErrorMessage [CSRFParam paramName mParam]) -- | Takes a POST parameter name to lookup a CSRF token, and returns whether the value matches the token stored in the session. -- -- @since 1.4.14 hasValidCsrfParamNamed :: MonadHandler m => Text -> m Bool -hasValidCsrfParamNamed paramName = do +hasValidCsrfParamNamed paramName = fst <$> hasValidCsrfParamNamed' paramName + +-- | Like 'hasValidCsrfParamNamed', but also returns the param value to be used in error messages. +hasValidCsrfParamNamed' :: MonadHandler m => Text -> m (Bool, Maybe Text) +hasValidCsrfParamNamed' paramName = do mCsrfToken <- reqToken <$> getRequest mCsrfParam <- lookupPostParam paramName - return $ validCsrf mCsrfToken (encodeUtf8 <$> mCsrfParam) + return $ (validCsrf mCsrfToken (encodeUtf8 <$> mCsrfParam), mCsrfParam) -- | Checks that a valid CSRF token is present in either the request headers or POST parameters. -- If the value doesn't match the token stored in the session, this function throws a 'PermissionDenied' error. @@ -1550,11 +1558,12 @@ checkCsrfHeaderOrParam :: (MonadHandler m, MonadLogger m) -> Text -- ^ The POST parameter name to lookup the CSRF token -> m () checkCsrfHeaderOrParam headerName paramName = do - validHeader <- hasValidCsrfHeaderNamed headerName - validParam <- hasValidCsrfParamNamed paramName + (validHeader, mHeader) <- hasValidCsrfHeaderNamed' headerName + (validParam, mParam) <- hasValidCsrfParamNamed' paramName unless (validHeader || validParam) $ do - $logWarnS "yesod-core" csrfErrorMessage - permissionDenied csrfErrorMessage + let errorMessage = csrfErrorMessage $ [CSRFHeader (decodeUtf8 $ original headerName) mHeader, CSRFParam paramName mParam] + $logWarnS "yesod-core" errorMessage + permissionDenied errorMessage validCsrf :: Maybe Text -> Maybe S.ByteString -> Bool -- It's important to use constant-time comparison (constEqBytes) in order to avoid timing attacks. @@ -1562,5 +1571,25 @@ validCsrf (Just token) (Just param) = encodeUtf8 token `constEqBytes` param validCsrf Nothing _param = True validCsrf (Just _token) Nothing = False -csrfErrorMessage :: Text -csrfErrorMessage = "A valid CSRF token wasn't present in HTTP headers or POST parameters. Because the request could have been forged, it's been rejected altogether. Check the Yesod.Core.Handler docs of the yesod-core package for details on CSRF protection." +data CSRFExpectation = CSRFHeader Text (Maybe Text) -- Key/Value + | CSRFParam Text (Maybe Text) -- Key/Value + +csrfErrorMessage :: [CSRFExpectation] + -> Text -- ^ Error message +csrfErrorMessage expectedLocations = T.intercalate "\n" + [ "A valid CSRF token wasn't present. Because the request could have been forged, it's been rejected altogether." + , "If you're a developer of this site, these tips will help you debug the issue:" + , "- Read the Yesod.Core.Handler docs of the yesod-core package for details on CSRF protection." + , "- Check that your HTTP client is persisting cookies between requests, like a browser does." + , "- By default, the CSRF token is sent to the client in a cookie named " `mappend` (decodeUtf8 defaultCsrfCookieName) `mappend` "." + , "- The server is looking for the token in the following locations:\n" `mappend` T.intercalate "\n" (map csrfLocation expectedLocations) + ] + + where csrfLocation expected = case expected of + CSRFHeader k v -> T.intercalate " " [" - An HTTP header named", k, (formatValue v)] + CSRFParam k v -> T.intercalate " " [" - A POST parameter named", k, (formatValue v)] + + formatValue :: Maybe Text -> Text + formatValue maybeText = case maybeText of + Nothing -> "(which is not currently set)" + Just t -> T.concat ["(which has the current, incorrect value: '", t, "')"] diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 859b391a..c1d6f8a8 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.4.37.1 +version: 1.4.37.2 license: MIT license-file: LICENSE author: Michael Snoyman