prevent 'open redirect' via next param
This commit is contained in:
parent
daa7f3d600
commit
f962b947bc
|
@ -4,9 +4,9 @@ import Prelude hiding (div)
|
||||||
|
|
||||||
import App (destroy, editBookmark, lookupTitle)
|
import App (destroy, editBookmark, lookupTitle)
|
||||||
import Data.Lens (Lens', lens, use, (%=), (.=))
|
import Data.Lens (Lens', lens, use, (%=), (.=))
|
||||||
import Data.Maybe (Maybe(..), maybe)
|
import Data.Maybe (Maybe(..), maybe, isJust)
|
||||||
import Data.Monoid (guard)
|
import Data.Monoid (guard)
|
||||||
import Data.String (null)
|
import Data.String (Pattern(..), null, stripPrefix)
|
||||||
import Data.Tuple (fst, snd)
|
import Data.Tuple (fst, snd)
|
||||||
import Effect.Aff (Aff)
|
import Effect.Aff (Aff)
|
||||||
import Effect.Class (liftEffect)
|
import Effect.Class (liftEffect)
|
||||||
|
@ -16,10 +16,11 @@ import Halogen.HTML (button, div, form, input, label, p, span, table, tbody_, td
|
||||||
import Halogen.HTML.Events (onSubmit, onValueChange, onChecked, onClick)
|
import Halogen.HTML.Events (onSubmit, onValueChange, onChecked, onClick)
|
||||||
import Halogen.HTML.Properties (ButtonType(..), InputType(..), autocomplete, autofocus, checked, disabled, for, id_, name, required, rows, title, type_, value)
|
import Halogen.HTML.Properties (ButtonType(..), InputType(..), autocomplete, autofocus, checked, disabled, for, id_, name, required, rows, title, type_, value)
|
||||||
import Model (Bookmark)
|
import Model (Bookmark)
|
||||||
import Util (_curQuerystring, _loc, _lookupQueryStringValue, attr, class_, ifElseH, whenH)
|
import Util (_curQuerystring, _loc, _doc, _lookupQueryStringValue, attr, class_, ifElseH, whenH)
|
||||||
import Web.Event.Event (Event, preventDefault)
|
import Web.Event.Event (Event, preventDefault)
|
||||||
import Web.HTML (window)
|
import Web.HTML (window)
|
||||||
import Web.HTML.Location (setHref)
|
import Web.HTML.HTMLDocument (referrer)
|
||||||
|
import Web.HTML.Location (setHref, origin)
|
||||||
|
|
||||||
data BAction
|
data BAction
|
||||||
= BEditField EditField
|
= BEditField EditField
|
||||||
|
@ -183,9 +184,15 @@ addbmark b' =
|
||||||
edit_bm <- use _edit_bm
|
edit_bm <- use _edit_bm
|
||||||
void $ H.liftAff (editBookmark edit_bm)
|
void $ H.liftAff (editBookmark edit_bm)
|
||||||
_bm .= edit_bm
|
_bm .= edit_bm
|
||||||
loc <- liftEffect _loc
|
qs <- liftEffect $ _curQuerystring
|
||||||
qs <- liftEffect _curQuerystring
|
doc <- liftEffect $ _doc
|
||||||
|
ref <- liftEffect $ referrer doc
|
||||||
|
loc <- liftEffect $ _loc
|
||||||
|
org <- liftEffect $ origin loc
|
||||||
case _lookupQueryStringValue qs "next" of
|
case _lookupQueryStringValue qs "next" of
|
||||||
Just "closeWindow" -> liftEffect $ closeWindow =<< window
|
Just "closeWindow" -> liftEffect $ closeWindow =<< window
|
||||||
Just n -> liftEffect $ setHref n loc
|
Just "back" -> liftEffect $
|
||||||
|
if isJust (stripPrefix (Pattern org) ref)
|
||||||
|
then setHref ref loc
|
||||||
|
else setHref org loc
|
||||||
_ -> liftEffect $ closeWindow =<< window
|
_ -> liftEffect $ closeWindow =<< window
|
||||||
|
|
|
@ -7,12 +7,11 @@ import Component.Markdown as Markdown
|
||||||
import Data.Array (drop, foldMap)
|
import Data.Array (drop, foldMap)
|
||||||
import Data.Foldable (for_)
|
import Data.Foldable (for_)
|
||||||
import Data.Lens (Lens', lens, use, (%=), (.=))
|
import Data.Lens (Lens', lens, use, (%=), (.=))
|
||||||
import Data.Maybe (Maybe(..), maybe)
|
import Data.Maybe (Maybe(..), isJust, maybe)
|
||||||
import Data.Monoid (guard)
|
import Data.Monoid (guard)
|
||||||
import Data.String (null)
|
|
||||||
import Data.String (null, split) as S
|
import Data.String (null, split) as S
|
||||||
|
import Data.String (null, stripPrefix)
|
||||||
import Data.String.Pattern (Pattern(..))
|
import Data.String.Pattern (Pattern(..))
|
||||||
import Type.Proxy (Proxy(..))
|
|
||||||
import Data.Tuple (fst, snd)
|
import Data.Tuple (fst, snd)
|
||||||
import Effect.Aff (Aff)
|
import Effect.Aff (Aff)
|
||||||
import Effect.Class (liftEffect)
|
import Effect.Class (liftEffect)
|
||||||
|
@ -23,10 +22,12 @@ import Halogen.HTML as HH
|
||||||
import Halogen.HTML.Events (onChecked, onClick, onSubmit, onValueChange)
|
import Halogen.HTML.Events (onChecked, onClick, onSubmit, onValueChange)
|
||||||
import Halogen.HTML.Properties (ButtonType(..), InputType(..), autofocus, checked, for, id_, name, rows, title, type_, value)
|
import Halogen.HTML.Properties (ButtonType(..), InputType(..), autofocus, checked, for, id_, name, rows, title, type_, value)
|
||||||
import Model (Note)
|
import Model (Note)
|
||||||
import Util (_lookupQueryStringValue, _curQuerystring, _loc, class_, fromNullableStr, ifElseH, whenH)
|
import Type.Proxy (Proxy(..))
|
||||||
|
import Util (_curQuerystring, _doc, _loc, _lookupQueryStringValue, class_, fromNullableStr, ifElseH, whenH)
|
||||||
import Web.Event.Event (Event, preventDefault)
|
import Web.Event.Event (Event, preventDefault)
|
||||||
import Web.HTML.Location (setHref)
|
|
||||||
import Web.HTML (window)
|
import Web.HTML (window)
|
||||||
|
import Web.HTML.HTMLDocument (referrer)
|
||||||
|
import Web.HTML.Location (origin, setHref)
|
||||||
|
|
||||||
data NAction
|
data NAction
|
||||||
= NNop
|
= NNop
|
||||||
|
@ -211,8 +212,16 @@ nnote st' =
|
||||||
res' <- H.liftAff (editNote edit_note)
|
res' <- H.liftAff (editNote edit_note)
|
||||||
for_ res' \_ -> do
|
for_ res' \_ -> do
|
||||||
qs <- liftEffect _curQuerystring
|
qs <- liftEffect _curQuerystring
|
||||||
|
doc <- liftEffect $ _doc
|
||||||
|
ref <- liftEffect $ referrer doc
|
||||||
|
loc <- liftEffect $ _loc
|
||||||
|
org <- liftEffect $ origin loc
|
||||||
case _lookupQueryStringValue qs "next" of
|
case _lookupQueryStringValue qs "next" of
|
||||||
Just "closeWindow" -> liftEffect $ closeWindow =<< window
|
Just "closeWindow" -> liftEffect $ closeWindow =<< window
|
||||||
|
Just "back" -> liftEffect $
|
||||||
|
if isJust (stripPrefix (Pattern org) ref)
|
||||||
|
then setHref ref loc
|
||||||
|
else setHref org loc
|
||||||
_ -> if (edit_note.id == 0)
|
_ -> if (edit_note.id == 0)
|
||||||
then liftEffect $ setHref (fromNullableStr app.noteR) =<< _loc
|
then liftEffect $ setHref (fromNullableStr app.noteR) =<< _loc
|
||||||
else do
|
else do
|
||||||
|
|
|
@ -62,7 +62,6 @@ instance Yesod App where
|
||||||
mmsg <- getMessage
|
mmsg <- getMessage
|
||||||
musername <- maybeAuthUsername
|
musername <- maybeAuthUsername
|
||||||
muser <- (fmap.fmap) snd maybeAuthPair
|
muser <- (fmap.fmap) snd maybeAuthPair
|
||||||
mcurrentRoute <- getCurrentRoute
|
|
||||||
let msourceCodeUri = appSourceCodeUri (appSettings master)
|
let msourceCodeUri = appSourceCodeUri (appSettings master)
|
||||||
pc <- widgetToPageContent do
|
pc <- widgetToPageContent do
|
||||||
setTitle "Espial"
|
setTitle "Espial"
|
||||||
|
|
2
static/js/app.min.js
vendored
2
static/js/app.min.js
vendored
File diff suppressed because one or more lines are too long
Binary file not shown.
File diff suppressed because one or more lines are too long
Binary file not shown.
|
@ -14,12 +14,11 @@
|
||||||
<div .top_menu.fr>
|
<div .top_menu.fr>
|
||||||
|
|
||||||
$maybe userName <- musername
|
$maybe userName <- musername
|
||||||
$maybe currentroute <- mcurrentRoute
|
<a .link href="@?{(AddViewR, [("next","back")])}">add url
|
||||||
<a .link href="@?{(AddViewR, [("next",urlrender currentroute)])}">add url
|
<a .link href="@{AddNoteViewR (UserNameP userName)}">add note
|
||||||
<a .link href="@{AddNoteViewR (UserNameP userName)}">add note
|
<a .link href="@{NotesR (UserNameP userName)}">notes
|
||||||
<a .link href="@{NotesR (UserNameP userName)}">notes
|
<a .link href="@{AccountSettingsR}">settings
|
||||||
<a .link href="@{AccountSettingsR}">settings
|
<a .link onclick="PS['Main'].logoutE(event)()" href="@{AuthR LogoutR}">
|
||||||
<a .link onclick="PS['Main'].logoutE(event)()" href="@{AuthR LogoutR}">
|
|
||||||
log out
|
log out
|
||||||
$nothing
|
$nothing
|
||||||
<a .link href="@{AuthR LoginR}">
|
<a .link href="@{AuthR LoginR}">
|
||||||
|
|
Loading…
Reference in a new issue