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

Prevent endless YADIS-redirect loop

Browse Source
This commit is contained in:
Michael Snoyman 2010-10-06 05:55:25 +02:00
parent 63853a78df
commit e0011ad2b5
2 changed files with 6 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
OpenId2/Discovery.hs
View File

@ -70,13 +70,15 @@ discoverYADIS ident mb_loc = do
let uri = fromMaybe (identifier ident) mb_loc let uri = fromMaybe (identifier ident) mb_loc
req <- parseUrl uri req <- parseUrl uri
res <- httpLbs req res <- httpLbs req
let mloc = lookup "x-xrds-location" let mloc = fmap S8.unpack
$ lookup "x-xrds-location"
$ map (first $ map toLower . S8.unpack) $ map (first $ map toLower . S8.unpack)
$ responseHeaders res $ responseHeaders res
let mloc' = if mloc == mb_loc then Nothing else mloc
case statusCode res of case statusCode res of
200 -> 200 ->
case mloc of case mloc' of
Just loc -> discoverYADIS ident (Just $ S8.unpack loc) Just loc -> discoverYADIS ident (Just loc)
Nothing -> do Nothing -> do
let mdoc = parseXRDS $ BSLU.toString $ responseBody res let mdoc = parseXRDS $ BSLU.toString $ responseBody res
case mdoc of case mdoc of

2
authenticate.cabal
View File

@ -1,5 +1,5 @@
name: authenticate name: authenticate
version: 0.6.6 version: 0.6.6.1
license: BSD3 license: BSD3
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>