Permalink
Browse files

The redirect on the login page is more restrictive and redirects cann…

…ot leave 4clojure.com
  • Loading branch information...
cryptcat cryptcat
cryptcat authored and cryptcat committed Oct 11, 2012
1 parent 6a9a821 commit c14c67a314656226cc5047a3d372a940d8962efe
Showing with 18 additions and 7 deletions.
  1. +4 −3 src/foreclojure/login.clj
  2. +14 −4 src/foreclojure/utils.clj
@@ -3,7 +3,7 @@
[ring.util.response :as response])
(:import [org.jasypt.util.password StrongPasswordEncryptor])
(:use [hiccup.form :only [form-to label text-field password-field check-box]]
- [foreclojure.utils :only [from-mongo flash-error flash-msg form-row assuming send-email login-url is-relative-url?]]
+ [foreclojure.utils :only [from-mongo flash-error flash-msg form-row assuming send-email login-url decode-url]]
[foreclojure.template :only [def-page content-page]]
[foreclojure.messages :only [err-msg]]
[compojure.core :only [defroutes GET POST]]
@@ -33,11 +33,12 @@
(def-page my-login-page [location]
(do
- (if (and location (is-relative-url? location)) (session/put! :login-to location))
+ (let [sanitized-location (sanitize-url location)]
+ (if sanitized-location (session/put! :login-to sanitized-location)))
{:title "4clojure - login"
:content
(content-page
- {:main login-box})}))
+ {:main login-box})}))
(defn do-login [user pwd]
(let [user (.toLowerCase user)
View
@@ -16,7 +16,7 @@
[hiccup.form :only [label]]
[useful.fn :only [to-fix]]
[somnium.congomongo :only [fetch-one]]
- [foreclojure.ring-utils :only [*url* static-url]]
+ [foreclojure.ring-utils :only [*url* static-url universal-url]]
[foreclojure.config :only [config repo-url]]))
(defn as-int [s]
@@ -84,8 +84,18 @@
([m ks f & args]
(maybe-update m ks #(apply f % args))))
-(defn is-relative-url? [location]
- (.startsWith (URLDecoder/decode location) "/"))
+(defn decode-url [url]
+ (URLDecoder/decode url))
+
+(defn encode-url [url]
+ (URLEncoder/encode url))
+
+(defn sanitize-url [url]
+ (if (nil? url)
+ nil
+ (let [decoded-url (decode-url url)]
+ (if (re-matches #"[a-zA-Z0-9/]+" decoded-url)
+ (str (encode-url (universal-url decoded-url)))))))
(defn login-url
([] (login-url *url*))
@@ -216,4 +226,4 @@
(defn get-theme []
(if-user [{:keys [theme]}]
(or theme default-theme)
- default-theme))
+ default-theme))

0 comments on commit c14c67a

Please sign in to comment.