Fix CSRF security vulnerability in registerHelper function
Return a 403 status code if the csrf tokens are matched. This currently affects two endpoints: During registration and during password reset forms. This curl request demonstrates how this can be exploited to register new email: curl -i --header "Accept: application/json" --request POST -F "email=sibi@psibi.in" http://localhost:3005/auth/page/email/register With the patch applied, it will respond with this: {"message":"Permission Denied. 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."}
This commit is contained in:
parent
10a751cdbc
commit
7f17d829b3
@ -5,6 +5,7 @@
|
|||||||
{-# LANGUAGE QuasiQuotes #-}
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
{-# LANGUAGE Rank2Types #-}
|
{-# LANGUAGE Rank2Types #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
{-# LANGUAGE DoAndIfThenElse #-}
|
||||||
-- | A Yesod plugin for Authentication via e-mail
|
-- | A Yesod plugin for Authentication via e-mail
|
||||||
--
|
--
|
||||||
-- This plugin works out of the box by only setting a few methods on the type class
|
-- This plugin works out of the box by only setting a few methods on the type class
|
||||||
@ -383,19 +384,22 @@ registerHelper :: YesodAuthEmail master
|
|||||||
-> HandlerT Auth (HandlerT master IO) TypedContent
|
-> HandlerT Auth (HandlerT master IO) TypedContent
|
||||||
registerHelper allowUsername dest = do
|
registerHelper allowUsername dest = do
|
||||||
y <- lift getYesod
|
y <- lift getYesod
|
||||||
|
req <- getRequest
|
||||||
midentifier <- lookupPostParam "email"
|
midentifier <- lookupPostParam "email"
|
||||||
let eidentifier = case midentifier of
|
csrfToken <- lookupPostParam "_token"
|
||||||
Nothing -> Left Msg.NoIdentifierProvided
|
if (csrfToken /= reqToken req)
|
||||||
Just x
|
then permissionDenied csrfErrorMessage
|
||||||
| Just x' <- Text.Email.Validate.canonicalizeEmail (encodeUtf8 x) ->
|
else do
|
||||||
Right $ normalizeEmailAddress y $ decodeUtf8With lenientDecode x'
|
let eidentifier = case midentifier of
|
||||||
| allowUsername -> Right $ TS.strip x
|
Nothing -> Left Msg.NoIdentifierProvided
|
||||||
| otherwise -> Left Msg.InvalidEmailAddress
|
Just x
|
||||||
|
| Just x' <- Text.Email.Validate.canonicalizeEmail (encodeUtf8 x) ->
|
||||||
case eidentifier of
|
Right $ normalizeEmailAddress y $ decodeUtf8With lenientDecode x'
|
||||||
|
| allowUsername -> Right $ TS.strip x
|
||||||
|
| otherwise -> Left Msg.InvalidEmailAddress
|
||||||
|
case eidentifier of
|
||||||
Left route -> loginErrorMessageI dest route
|
Left route -> loginErrorMessageI dest route
|
||||||
Right identifier -> do
|
Right identifier -> do
|
||||||
|
|
||||||
mecreds <- lift $ getEmailCreds identifier
|
mecreds <- lift $ getEmailCreds identifier
|
||||||
registerCreds <-
|
registerCreds <-
|
||||||
case mecreds of
|
case mecreds of
|
||||||
@ -709,6 +713,9 @@ setLoginLinkKey aid = do
|
|||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
setSession loginLinkKey $ TS.pack $ show (toPathPiece aid, now)
|
setSession loginLinkKey $ TS.pack $ show (toPathPiece aid, now)
|
||||||
|
|
||||||
|
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."
|
||||||
|
|
||||||
|
|
||||||
-- See https://github.com/yesodweb/yesod/issues/1245 for discussion on this
|
-- See https://github.com/yesodweb/yesod/issues/1245 for discussion on this
|
||||||
-- use of unsafePerformIO.
|
-- use of unsafePerformIO.
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user