1 files changed, 243 insertions, 0 deletions
diff --git a/compojure-3.2/src/compojure/http/session.clj b/compojure-3.2/src/compojure/http/session.clj
new file mode 100755
index 0000000..d176dec
--- /dev/null
+++ b/compojure-3.2/src/compojure/http/session.clj
@@ -0,0 +1,243 @@
+;; Copyright (c) James Reeves. All rights reserved.
+;; The use and distribution terms for this software are covered by the Eclipse
+;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which
+;; can be found in the file epl-v10.html at the root of this distribution. By
+;; using this software in any fashion, you are agreeing to be bound by the
+;; terms of this license. You must not remove this notice, or any other, from
+;; this software.
+
+(ns compojure.http.session
+  "Functions for creating and updating HTTP sessions."
+  (:use compojure.str-utils
+        compojure.http.helpers
+        compojure.http.request
+        compojure.http.response
+        compojure.encodings
+        compojure.crypto
+        clojure.contrib.except))
+
+;; Override these mulitmethods to create your own session storage.
+;; Uses the Compojure repository pattern.
+
+(defmulti create-session
+  "Create a new session map. Should not attempt to save the session."
+  (fn [repository] (:type repository)))
+
+(defmulti read-session
+  "Read in the session using the supplied data. Usually the data is a key used
+  to find the session in a store."
+  (fn [repository data] (:type repository)))
+
+(defmulti write-session
+  "Write a new or existing session to the session store."
+  (fn [repository session] (:type repository)))
+
+(defmulti destroy-session
+  "Remove the session from the session store."
+  (fn [repository session] (:type repository)))
+
+(defmulti session-cookie
+  "Return the session data to be stored in the cookie. This is usually the
+  session ID."
+  (fn [repository new? session] (:type repository)))
+
+;; Default implementations of create-session and set-session-cookie
+
+(defmethod create-session :default
+  [repository]
+  {:id (gen-uuid)})
+
+(defmethod session-cookie :default
+  [repository new? session]
+  (if new?
+    (session :id)))
+
+;; In memory sessions
+
+(def memory-sessions (ref {}))
+
+(defmethod read-session :memory
+  [repository id]
+  (@memory-sessions id))
+
+(defmethod write-session :memory
+  [repository session]
+  (dosync
+    (alter memory-sessions
+      assoc (session :id) session)))
+
+(defmethod destroy-session :memory
+  [repository session]
+  (dosync
+    (alter memory-sessions
+      dissoc (session :id))))
+
+;; Cookie sessions
+
+(def default-session-key
+  (delay (gen-secret-key {:key-size 128})))
+
+(defn- get-session-key
+  "Get the session key from the repository or use the default key."
+  [repository]
+  (force (repository :session-key default-session-key)))
+
+(defmethod create-session :cookie
+  [repository]
+  {})
+
+(defmethod session-cookie :cookie
+  [repository new? session]
+  (let [session-key (get-session-key repository)
+        cookie-data (seal session-key session)]
+    (if (> (count cookie-data) 4000)
+      (throwf "Session data exceeds 4K")
+      cookie-data)))
+
+(defmethod read-session :cookie
+  [repository data]
+  (unseal (get-session-key repository) data))
+
+(defmethod write-session :cookie
+  [repository session])
+
+(defmethod destroy-session :cookie
+  [repository session])
+
+;; Session middleware
+
+(defn timestamp-after
+  "Return the current time plus seconds as milliseconds."
+  [seconds]
+  (+ (* seconds 1000) (System/currentTimeMillis)))
+
+(defn assoc-expiry
+  "Associate an :expires-at key with the session if the session repository
+  contains the :expires key."
+  [repository session]
+  (if-let [expires (:expires repository)]
+    (assoc session :expires-at (timestamp-after expires))
+    session))
+
+(defn session-expired?
+  "True if this session's timestamp is in the past."
+  [session]
+  (if-let [expires-at (:expires-at session)]
+    (< expires-at (System/currentTimeMillis))))
+
+(defn- get-session
+  "Retrieve the session using the 'session' cookie in the request."
+  [repository request]
+  (if-let [session-data (-> request :cookies :compojure-session)]
+    (read-session repository session-data)))
+
+(defn- assoc-new-session
+  "Associate a new session with a request."
+  [repository request]
+  (assoc request
+    :session (assoc-expiry repository (create-session repository))
+    :new-session? true))
+
+(defn assoc-session
+  "Associate the session with the request."
+  [request repository]
+  (if-let [session (get-session repository request)]
+    (if (session-expired? session)
+      (do
+        (destroy-session repository session)
+        (assoc-new-session repository request))
+      (assoc request :session
+        (assoc-expiry repository session)))
+    (assoc-new-session repository request)))
+
+(defn assoc-flash
+  "Associate the session flash with the request and remove it from the
+  session."
+  [request]
+  (let [session (:session request)]
+    (-> request
+      (assoc :flash   (session :flash {}))
+      (assoc :session (dissoc session :flash)))))
+
+(defn set-session-cookie
+  "Set the session cookie on the response if required."
+  [repository request response session]
+  (let [new?   (:new-session? request)
+        cookie (session-cookie repository new? session)
+        update (set-cookie :compojure-session cookie
+                           :path (repository :path "/"))]
+    (if cookie
+      (update-response request response update)
+      response)))
+
+(defn save-handler-session
+  "Save the session for a handler if required."
+  [repository request response session]
+  (when (and (contains? response :session)
+             (nil? (response :session)))
+    (destroy-session repository session))
+  (when (or (:session response)
+            (:new-session? request)
+            (not-empty (:flash request))
+            (contains? repository :expires))
+    (write-session repository session)))
+
+(defn- keyword->repository
+  "If the argument is a keyword, expand it into a repository map."
+  [repository]
+  (if (keyword? repository)
+    {:type repository}
+    repository))
+
+(defn with-session
+  "Wrap a handler in a session of the specified type. Session type defaults to
+  :memory if not supplied."
+  ([handler]
+    (with-session handler :memory))
+  ([handler repository]
+    (fn [request]
+      (let [repo     (keyword->repository repository)
+            request  (-> request (assoc-cookies)
+                                 (assoc-session repo)
+                                 (assoc-flash))
+            response (handler request)
+            session  (if (contains? response :session)
+                       (:session response)
+                       (:session request))]
+        (when response
+          (save-handler-session repo request response session)
+          (set-session-cookie   repo request response session))))))
+
+;; Useful functions for modifying the session
+
+(defn set-session
+  "Return a response map with the session set."
+  [session]
+  {:session session})
+
+(defn clear-session
+  "Set the session to nil."
+  []
+  (set-session nil))
+
+(defn alter-session
+  "Use a function to alter the session."
+  [func & args]
+  (fn [request]
+    (set-session
+      (apply func (request :session) args))))
+
+(defn session-assoc
+  "Associate key value pairs with the session."
+  [& keyvals]
+  (apply alter-session assoc keyvals))
+
+(defn session-dissoc
+  "Dissociate keys from the session."
+  [& keys]
+  (apply alter-session dissoc keys))
+
+(defn flash-assoc
+  "Associate key value pairs with the session flash."
+  [& keyvals]
+  (alter-session merge {:flash (apply hash-map keyvals)}))