diff --git a/yesod-auth/Yesod/Auth/GoogleEmail.hs b/yesod-auth/Yesod/Auth/GoogleEmail.hs index 9d796123..e06e584f 100644 --- a/yesod-auth/Yesod/Auth/GoogleEmail.hs +++ b/yesod-auth/Yesod/Auth/GoogleEmail.hs @@ -72,12 +72,13 @@ authGoogleEmail = completeHelper :: YesodAuth m => [(Text, Text)] -> GHandler Auth m () completeHelper gets' = do master <- getYesod - eres <- lift $ try $ OpenId.authenticate gets' (authHttpManager master) + eres <- lift $ try $ OpenId.authenticateClaimed gets' (authHttpManager master) toMaster <- getRouteToMaster let onFailure err = do setMessage $ toHtml $ show (err :: SomeException) redirect $ toMaster LoginR - let onSuccess (OpenId.Identifier ident, _) = do + let onSuccess oir = do + let OpenId.Identifier ident = OpenId.oirOpLocal oir memail <- lookupGetParam "openid.ext1.value.email" case (memail, "https://www.google.com/accounts/o8/id" `T.isPrefixOf` ident) of (Just email, True) -> setCreds True $ Creds "openid" email [] diff --git a/yesod-auth/Yesod/Auth/OpenId.hs b/yesod-auth/Yesod/Auth/OpenId.hs index 97706651..a93840a8 100644 --- a/yesod-auth/Yesod/Auth/OpenId.hs +++ b/yesod-auth/Yesod/Auth/OpenId.hs @@ -92,7 +92,7 @@ completeHelper gets' = do let claimed = case OpenId.oirClaimed oir of Nothing -> id - Just (OpenId.Identifier i) -> ((claimedKey, i):) + Just (OpenId.Identifier i') -> ((claimedKey, i'):) gets'' = claimed $ filter (\(k, _) -> not $ "__" `isPrefixOf` k) gets' i = OpenId.identifier $ OpenId.oirOpLocal oir setCreds True $ Creds "openid" i gets'' @@ -118,5 +118,10 @@ claimedKey = "__CLAIMED" -- -- Since 1.0.2 credsIdentClaimed :: Creds m -> Text + +-- Prevent other backends from overloading the __CLAIMED value, which could +-- possibly open us to security holes. +credsIdentClaimed c | credsPlugin c /= "openid" = credsIdent c + credsIdentClaimed c = fromMaybe (credsIdent c) $ lookup claimedKey (credsExtra c)