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:
Sibi Prabakaran 2016-11-20 03:59:32 +05:30
parent 10a751cdbc
commit 7f17d829b3
No known key found for this signature in database
GPG Key ID: D19E3E0EBB557613

View File

@ -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.