Remember-me feature

.gitignore

@@ -11,5 +11,13 @@ pom.xml*
 .classpath
 .project
 .settings
-
+.DS_Store
+.#*
+.idea
+.lein
 .externalToolBuilders
+.nrepl-port
+.lein-repl-history
+*.iml
+*.paw
+dev

project.clj

@@ -11,7 +11,7 @@
                  [org.mindrot/jbcrypt "0.3m"]
 
                  ;; http-basic
-                 [commons-codec "1.6"]
+                 [commons-codec/commons-codec "1.9"]
 
                  ;; openid
                  [org.clojure/core.cache "0.6.2"]
@@ -22,20 +22,27 @@
                  [com.google.inject/guice "2.0"]
                  [net.sourceforge.nekohtml/nekohtml "1.9.10"]
                  ; need different httpclient rev for https://issues.apache.org/jira/browse/HTTPCLIENT-1118
-                 [org.apache.httpcomponents/httpclient "4.2.1"]]
-
+                 [org.apache.httpcomponents/httpclient "4.3.5"]
+
+                 ]
+  :plugins [[lein-ring "0.8.12"]]
+  :ring {:handler test-friend.mock-app/mock-app :port 8080}
   :deploy-repositories {"releases" {:url "https://clojars.org/repo/" :creds :gpg}
                         "snapshots" {:url "https://clojars.org/repo/" :creds :gpg}}
-
-  :profiles {:dev {:dependencies [[ring-mock "0.1.1"]
+
+  :profiles {:dev {:source-paths ["dev" "src" "test"]
+                   :dependencies [[org.clojure/tools.namespace "0.2.7"]
+                                  [org.clojure/java.classpath "0.2.2"]
+                                  [ring-mock "0.1.1"]
+                                  [aprint "0.1.3-SNAPSHOT"]
                                   [compojure "1.1.5"]
                                   [ring "1.2.0"]
                                   [robert/hooke "1.3.0"]
-                                  [clj-http "0.3.6"]]}
+                                  [clj-http "1.0.0"]
+                                  [expectations "2.0.9"]]}
              :sanity-check {:aot :all
                             :warn-on-reflection true
-                            :compile-path "target/sanity-check-aot"}
-             :1.5 [:dev {:dependencies [[org.clojure/clojure "1.5.1"]]}]}
+                            :compile-path "target/sanity-check-aot"}}
   :aliases  {"all" ["with-profile" "1.5:dev"]
              "sanity-check" ["do" "clean," "with-profile" "sanity-check" "compile"]})
 

remember-me-token-with-friend.md

@@ -0,0 +1,33 @@
+# Remember-me token with [Clojure friend](https://github.com/cemerick/friend)
+
+## Reminder about remember-me cookie
+[The best way to implement a remember-me feature](http://stackoverflow.com/questions/244882/what-is-the-best-way-to-implement-remember-me-for-a-website).
+
+In short, given the login id and the hashed password, the remember-me library issue a token with an expiration and salt in it.
+
+[Token should not be stored as-is](http://stackoverflow.com/questions/549/the-definitive-guide-to-form-based-website-authentication#477579), as a database leak would means a way for attacker to log in the accounts. The hash use a SHA3 digest ([because SHA1 should not be used anymore](https://konklone.com/post/why-google-is-hurrying-the-web-to-kill-sha-1)).
+
+The persistence functions are defined through a protocol and a Datomic implementation is provided, you can also implement you own and inject it when using the functionality.
+
+
+## Friend implementation
+
+### Issuing a remember-me Cookie at login
+
+* The `interactive-form` workflow retrieve the remember-me form parameters. 
+* The workflow function verifies the supplied credentials (username/password) with the `bcrypt-credential-fn` (through the login config), 
+	* if the form parameters `remember-me` is set to "true" then 
+		* the `bcrypt-credential-fn` invoke the `credentials/remember-me` function that issue new remember-me data (not the cookie yet) that will be returned through the authenticate response. 
+		* The `remember-me` function is given a `save-remember-me-fn!` as a first parameters to allow the persistent storage of the issued data. The `save-remember-me-fn!` is defined with the login config. 
+* If any remember-me data is present in the interactive-login workflow response then it is encoded into a persistent cookie in the `friend/authenticate*` function with the `friend/set-cookies-if-any` function.
+
+### Authenticate with a remember-me cookie
+
+Once issued and sent to the client, each subsequent http request will include the persistent remember-me cookie.
+
+* The `workflow/remember-me-hash` function workflow test if a remember-me cookie is present in the request.
+	* It verifies the validity of the cookie with the `credentials/remember-me-hash-fn` that loads the stored remember-me data and then compare with the data provided in the cookie (validity, expiration, etc.), otherwise it returns nil and the `make-auth` fn does not make it.
+	* The `workflow/remember-me-hash` then `make-auth` and transmit the authenticated request to the subsequent handler
+
+
+

src/cemerick/friend.clj

@@ -1,8 +1,14 @@
 (ns cemerick.friend
   (:require [cemerick.friend.util :as util]
-            [clojure.set :as set])
+            [clojure.set :as set]
+            [clojure.tools.trace :refer :all]
+            [clj-time.core :as time]
+            [clj-time.format :refer [with-locale formatter]]
+            [clj-time.coerce :as time-coerce :refer [from-long]])
   (:use (ring.util [response :as response :only (redirect)])
         [slingshot.slingshot :only (throw+ try+)])
+  (:import (org.joda.time DateTimeZone)
+           (java.util Locale))
   (:refer-clojure :exclude (identity)))
 
 (def ^{:dynamic true} *default-scheme-ports* {:http 80 :https 443})
@@ -75,14 +81,24 @@ being added back into the final response)."
   [response]
   (update-in response [:session] dissoc ::identity))
 
+(defn logout-remember-me!
+  "remove all remember-me token associated with the current username
+  with the storage fn provided with auth-config"
+  [request]
+   (let [username (get-in request [:session ::identity :current])
+         reset-remember-me-fn! (get-in request [::auth-config :reset-remember-me-fn!])]
+     (reset-remember-me-fn! username)))
+
 (defn logout
   "Ring middleware that modifies the response to drop all retained
 authentications."
   [handler]
-  #(when-let [response (handler %)]
-     (->> (or (:session response) (:session %))
-       (assoc response :session)
-       logout*)))
+  (fn [request]
+    (logout-remember-me! request)
+    (when-let [response (handler request)]
+      (->> (or (:session response) (:session request))
+           (assoc response :session)
+           logout*))))
 
 (defn- default-unauthorized-handler
   [request]
@@ -146,18 +162,20 @@ Equivalent to (complement current-authentication)."}
                                     ::identity identity))
     response))
 
+
+
 (defn- redirect-new-auth
   [authentication-map request]
   (when-let [redirect (::redirect-on-auth? (meta authentication-map) true)]
     (let [unauthorized-uri (-> request :session ::unauthorized-uri)
           resp (response/redirect-after-post
-                 (or unauthorized-uri
-                     (and (string? redirect) redirect)
-                      (str (:context request) (-> request ::auth-config :default-landing-uri ))))]
+                (or unauthorized-uri
+                    (and (string? redirect) redirect)
+                    (str (:context request) (-> request ::auth-config :default-landing-uri ))))]
       (if unauthorized-uri
         (-> resp
-          (assoc :session (:session request))
-          (update-in [:session] dissoc ::unauthorized-uri))
+            (assoc :session (:session request))
+            (update-in [:session] dissoc ::unauthorized-uri))
         resp))))
 
 (defn default-unauthenticated-handler
@@ -235,23 +253,50 @@ which contains a map to be called with a ring handler."
                config)
         request (assoc request ::auth-config config)
         workflow-result (some #(% request) workflows)]
-
       (if (and workflow-result (not (auth? workflow-result)))
         ;; workflow assumed to be a ring response
         workflow-result
         (no-workflow-result-request request config workflow-result))))
 
-(defn- authenticate*
+(def #^{:private true}
+  cookie-date-formatter (with-locale
+                          (formatter "EEE, dd MMM YYYY HH:mm:ss" DateTimeZone/UTC)
+                          Locale/US))
+
+(defn cookie-date [date]
+  "convert a clj-time/joda-time instant to the correct date formatting
+for HTTP cookies."
+  (str (.print cookie-date-formatter date) " GMT"))
+
+(defn persistent-cookie
+  "create a persistent cookie. expires can be milliseconds epoch time
+or joda-time (clj-time) compatible instant/partial."
+  ([name value expires attrs]
+     {name (assoc attrs :value value :expires (cookie-date expires))})
+  ([name value expires]
+     (persistent-cookie name value expires {})))
+
+(defn set-cookies-if-any [response]
+  (let [current-identity (get-in response [:session :cemerick.friend/identity :current])
+        expiration-time (get-in response [:session :cemerick.friend/identity :authentications current-identity :expiration-time])
+        cookie-value (get-in response [:session :cemerick.friend/identity :authentications current-identity :remember-me-cookie-value])]
+    (if cookie-value
+      (assoc response :cookies (persistent-cookie :remember-me cookie-value
+                                                  (time-coerce/from-long expiration-time) {:path "/"}))
+      response)))
+
+(defn authenticate*
   [ring-handler auth-config request]
   (let [response-or-handler-map (authenticate-request request auth-config)
         response (if-let [handler-map (:friend/handler-map response-or-handler-map)]
-                   (handler-request ring-handler handler-map) response-or-handler-map)]
-    (authenticate-response
-      (update-in response
-        [:friend/ensure-identity-request]
-        (fn [x]
-          (or x (:friend/ensure-identity-request response-or-handler-map))))
-      request)))
+                   (handler-request ring-handler handler-map)
+                   response-or-handler-map)]
+    (set-cookies-if-any (authenticate-response
+                         (update-in response
+                                    [:friend/ensure-identity-request]
+                                    (fn [x]
+                                      (or x (:friend/ensure-identity-request response-or-handler-map))))
+                         request))))
 
 (defn authenticate
   [ring-handler auth-config]
@@ -261,8 +306,8 @@ which contains a map to be called with a ring handler."
 (defn throw-unauthorized
   "Throws a slingshot stone (see `slingshot.slingshot/throw+`) containing
    the [authorization-info] map, in addition to these slots:
- 
-   :cemerick.friend/type - the type of authorization failure that has 
+
+   :cemerick.friend/type - the type of authorization failure that has
         occurred, defaults to `:unauthorized`
    :cemerick.friend/identity - the current identity, defaults to the
         provided [identity] argument
@@ -326,7 +371,7 @@ which contains a map to be called with a ring handler."
 
      (authorize #{::user :some.ns/admin}
        {:op-name \"descriptive name for secured operation\"}
-        
+
 
    Note that this macro depends upon the *identity* var being bound to the
    current user's authentications.  This will work fine in e.g. agent sends

src/cemerick/friend/credentials.clj

@@ -1,5 +1,9 @@
 (ns cemerick.friend.credentials
-  (:import org.mindrot.jbcrypt.BCrypt))
+  (:require [clojure.edn]
+            [clojure.tools.trace :refer :all])
+  (:import (org.mindrot.jbcrypt BCrypt)
+           (org.apache.commons.codec.binary Base64)
+           (java.util UUID)))
 
 (defn hash-bcrypt
   "Hashes a given plaintext password using bcrypt and an optional
@@ -17,9 +21,54 @@ the result of previously hashing that password."
   [password hash]
   (BCrypt/checkpw password hash))
 
+(defn- remember-me-str [{:keys [userid password-crypted expiration-time salt]}]
+  (str "userid=" userid
+       ":password-crypted=" password-crypted
+       ":expiration-time=" expiration-time
+       ":salt=" salt))
+
+(defn- encode-remember-me-hash-cookie-value
+  "generate the cookie value made of:
+  base64({:userid userid
+          :expiration-time expiration-time
+          :hash (bcrypt {:userid userid
+                         :expiration-time expiration-time
+                         :password-hash password-hash
+                         :key key})})
+  with:
+  * userid:        the id of the user
+  * password-hash:   the user password hash as found in the creds
+  * expiration-time: the time when the cookie will expire expressed in milliseconds
+  * key:             a unique key (salt) to prevent modification of the cookie hash, defined with a java random UUID
+  validity-duration is a duration in milliseconds that define the expiration time (now + validation duration = expiration time)"
+  [{:keys [userid password-crypted expiration-time salt] :as all}]
+  (Base64/encodeBase64String
+   (.getBytes
+    (str "{:userid \"" userid "\""
+         " :expiration-time " expiration-time
+         " :hash \"" (hash-bcrypt (remember-me-str all)) "\"}"))))
+
+(defn decode-remember-me-hash-cookie-value
+  "decode a cookie value previously encoded with the fn generate-remember-me-has-cookie-value"
+  [cookie-value]
+  (try
+    (clojure.edn/read-string
+     (String. (Base64/decodeBase64 cookie-value)))
+    (catch RuntimeException e nil)))
+
+(defn remember-me [save-remember-me-fn! creds]
+  (let [remember-me-data {:userid (:userid creds)
+                          :password-crypted (:password-crypted creds)
+                          :expiration-time (+ (System/currentTimeMillis) 2592000000);;30 days
+                          :salt (.toString (UUID/randomUUID))}
+        cookie-value (encode-remember-me-hash-cookie-value remember-me-data)]
+    (save-remember-me-fn! (:userid creds) remember-me-data)
+    (dissoc (merge creds (assoc remember-me-data :remember-me-cookie-value cookie-value)) :salt :password-crypted)))
+
 (defn bcrypt-credential-fn
   "A bcrypt credentials function intended to be used with `cemerick.friend/authenticate`
    or individual authentication workflows.  You must supply a function of one argument
+
    that will look up stored user credentials given a username/id.  e.g.:
 
    (authenticate {:credential-fn (partial bcrypt-credential-fn load-user-record)
@@ -41,8 +90,32 @@ the result of previously hashing that password."
    ...then the hash will be verified correctly as long as the credentials
    map contains a [:cemerick.friend.credentials/password-key :app.foo/passphrase]
    entry."
-  [load-credentials-fn {:keys [username password]}]
-  (when-let [creds (load-credentials-fn username)]
-    (let [password-key (or (-> creds meta ::password-key) :password)]
-      (when (bcrypt-verify password (get creds password-key))
-        (dissoc creds password-key)))))
+  ([load-credentials-fn {:keys [username password remember-me?] :as provided-user-data}]
+     (bcrypt-credential-fn load-credentials-fn nil provided-user-data))
+  ([load-credentials-fn save-remember-me-fn! {:keys [username password remember-me? remember-me-short-life?] :as provided-user-data}]
+     (when-let [creds (load-credentials-fn username)]
+       (let [password-key (or (-> creds meta ::password-key) :password)]
+         (when (bcrypt-verify password (get creds password-key))
+           (if remember-me?
+             (dissoc (remember-me save-remember-me-fn! creds) password-key)
+             (dissoc creds password-key)))))))
+
+(defn remember-me-hash-fn
+  [load-credentials-fn
+   load-rem-me-credentials-fn
+   {:keys [remember-me-cookie-value]}]
+  (if-let [{:keys [username expiration-time hash]} (decode-remember-me-hash-cookie-value remember-me-cookie-value)]
+    (when-let [creds (load-credentials-fn username)]
+      (when-let [{exp-time-from-storage :expiration-time
+                  salt-from-storage :salt} (load-rem-me-credentials-fn username)]
+        (let [password-key (or (-> creds meta ::password-key) :password)
+              password-from-creds (get creds password-key)
+              rem-me-data {:username username
+                           :expiration-time exp-time-from-storage
+                           :salt salt-from-storage
+                           :password-hash password-from-creds}
+              creds-with-rem-me (merge rem-me-data creds)
+              not-expired? (fn [exp]  (> exp (System/currentTimeMillis)))]
+          (when (and (bcrypt-verify (remember-me-str rem-me-data) hash)
+                     (not-expired? expiration-time))
+            (dissoc creds-with-rem-me password-key :salt :password-hash)))))))