prevent 'open redirect' via next param

jonschoning · Sep 26, 2021 · db00a13 · db00a13
1 parent d8f74bc
commit db00a13
Show file tree

Hide file tree

Showing 8 changed files with 35 additions and 21 deletions.
diff --git a/purs/src/Component/Add.purs b/purs/src/Component/Add.purs
@@ -4,9 +4,9 @@ import Prelude hiding (div)
 
 import App (destroy, editBookmark, lookupTitle)
 import Data.Lens (Lens', lens, use, (%=), (.=))
-import Data.Maybe (Maybe(..), maybe)
+import Data.Maybe (Maybe(..), maybe, isJust)
 import Data.Monoid (guard)
-import Data.String (null)
+import Data.String (Pattern(..), null, stripPrefix)
 import Data.Tuple (fst, snd)
 import Effect.Aff (Aff)
 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.Properties (ButtonType(..), InputType(..), autocomplete, autofocus, checked, disabled, for, id_, name, required, rows, title, type_, value)
 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.HTML (window)
-import Web.HTML.Location (setHref)
+import Web.HTML.HTMLDocument (referrer)
+import Web.HTML.Location (setHref, origin)
 
 data BAction
   = BEditField EditField
@@ -183,9 +184,15 @@ addbmark b' =
     edit_bm <- use _edit_bm 
     void $ H.liftAff (editBookmark 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
       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
diff --git a/purs/src/Component/NNote.purs b/purs/src/Component/NNote.purs
@@ -7,12 +7,11 @@ import Component.Markdown as Markdown
 import Data.Array (drop, foldMap)
 import Data.Foldable (for_)
 import Data.Lens (Lens', lens, use, (%=), (.=))
-import Data.Maybe (Maybe(..), maybe)
+import Data.Maybe (Maybe(..), isJust, maybe)
 import Data.Monoid (guard)
-import Data.String (null)
 import Data.String (null, split) as S
+import Data.String (null, stripPrefix)
 import Data.String.Pattern (Pattern(..))
-import Type.Proxy (Proxy(..))
 import Data.Tuple (fst, snd)
 import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
@@ -23,10 +22,12 @@ import Halogen.HTML as HH
 import Halogen.HTML.Events (onChecked, onClick, onSubmit, onValueChange)
 import Halogen.HTML.Properties (ButtonType(..), InputType(..), autofocus, checked, for, id_, name, rows, title, type_, value)
 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.HTML.Location (setHref)
 import Web.HTML (window)
+import Web.HTML.HTMLDocument (referrer)
+import Web.HTML.Location (origin, setHref)
 
 data NAction
   = NNop
@@ -211,8 +212,16 @@ nnote st' =
     res' <- H.liftAff (editNote edit_note)
     for_ res' \_ -> do
       qs <- liftEffect _curQuerystring
+      doc <- liftEffect $ _doc
+      ref <- liftEffect $ referrer doc
+      loc <- liftEffect $ _loc
+      org <- liftEffect $ origin loc
       case _lookupQueryStringValue qs "next" of
         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)
                then liftEffect $ setHref (fromNullableStr app.noteR) =<< _loc
                else do

diff --git a/src/Foundation.hs b/src/Foundation.hs
@@ -62,7 +62,6 @@ instance Yesod App where
         mmsg <- getMessage
         musername <- maybeAuthUsername
         muser <- (fmap.fmap) snd maybeAuthPair
-        mcurrentRoute <- getCurrentRoute
         let msourceCodeUri = appSourceCodeUri (appSettings master)
         pc <- widgetToPageContent do
             setTitle "Espial"

diff --git a/static/js/app.min.js b/static/js/app.min.js
diff --git a/static/js/app.min.js.gz b/static/js/app.min.js.gz
diff --git a/static/js/app.min.js.map b/static/js/app.min.js.map
diff --git a/static/js/app.min.js.map.gz b/static/js/app.min.js.map.gz
diff --git a/templates/default-layout.hamlet b/templates/default-layout.hamlet
@@ -14,12 +14,11 @@
       <div .top_menu.fr>
 
         $maybe userName <- musername
-          $maybe currentroute <- mcurrentRoute
-            <a .link href="@?{(AddViewR, [("next",urlrender currentroute)])}">add url&nbsp;&nbsp;
-            <a .link href="@{AddNoteViewR (UserNameP userName)}">add note&nbsp;&nbsp;
-            <a .link href="@{NotesR (UserNameP userName)}">notes&nbsp;&nbsp;
-            <a .link href="@{AccountSettingsR}">settings&nbsp;&nbsp;
-            <a .link onclick="PS['Main'].logoutE(event)()" href="@{AuthR LogoutR}">
+          <a .link href="@?{(AddViewR, [("next","back")])}">add url&nbsp;&nbsp;
+          <a .link href="@{AddNoteViewR (UserNameP userName)}">add note&nbsp;&nbsp;
+          <a .link href="@{NotesR (UserNameP userName)}">notes&nbsp;&nbsp;
+          <a .link href="@{AccountSettingsR}">settings&nbsp;&nbsp;
+          <a .link onclick="PS['Main'].logoutE(event)()" href="@{AuthR LogoutR}">
               log out
         $nothing
           <a .link href="@{AuthR LoginR}">