haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #1302 from psibi/csrf-fix

Browse Source 
yesod-auth: Fix CSRF security vulnerability in registerHelper function
This commit is contained in:
Maximilian Tagher 2016-11-22 10:49:26 -08:00 committed by GitHub
commit 54cc4205d8
1 changed files with 9 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
yesod-auth/Yesod/Auth/Email.hs
View File

@ -71,7 +71,6 @@ import Safe (readMay)
import System.IO.Unsafe (unsafePerformIO) import System.IO.Unsafe (unsafePerformIO)
import qualified Text.Email.Validate import qualified Text.Email.Validate
loginR, registerR, forgotPasswordR, setpassR :: AuthRoute loginR, registerR, forgotPasswordR, setpassR :: AuthRoute
loginR = PluginR "email" ["login"] loginR = PluginR "email" ["login"]
registerR = PluginR "email" ["register"] registerR = PluginR "email" ["register"]
@ -383,19 +382,18 @@ 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
checkCsrfHeaderOrParam defaultCsrfHeaderName defaultCsrfParamName
midentifier <- lookupPostParam "email" midentifier <- lookupPostParam "email"
let eidentifier = case midentifier of let eidentifier = case midentifier of
Nothing -> Left Msg.NoIdentifierProvided Nothing -> Left Msg.NoIdentifierProvided
Just x Just x
| Just x' <- Text.Email.Validate.canonicalizeEmail (encodeUtf8 x) -> | Just x' <- Text.Email.Validate.canonicalizeEmail (encodeUtf8 x) ->
Right $ normalizeEmailAddress y $ decodeUtf8With lenientDecode x' Right $ normalizeEmailAddress y $ decodeUtf8With lenientDecode x'
| allowUsername -> Right $ TS.strip x | allowUsername -> Right $ TS.strip x
| otherwise -> Left Msg.InvalidEmailAddress | otherwise -> Left Msg.InvalidEmailAddress
case eidentifier of 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,7 +707,6 @@ 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)
-- 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.
defaultNonceGen :: Nonce.Generator defaultNonceGen :: Nonce.Generator