Book Marx: Implement support for page-specific authentication tokens.

4 files changed, 77 insertions, 28 deletions

diff --git a/src/mulk/benki/book_marx.clj b/src/mulk/benki/book_marx.clj
index e5e8701..bbaa9f6 100644
--- a/src/mulk/benki/book_marx.clj
+++ b/src/mulk/benki/book_marx.clj
@@ -84,8 +84,7 @@
       (cq/sort [:date#desc])))
 
 (defpage "/marx" {}
-  (let [user (session/get :user)
-        marks (bookmarks-visible-by user)]
+  (let [marks (bookmarks-visible-by *user*)]
     (with-dbt
       (layout bookmarx-list-page "Book Marx"
         [:div {:id "login-message"
@@ -133,9 +132,8 @@
         (.toString feed)))))
 
 (defpage "/marx/feed" {}
-  (let [user  (session/get :user)]
-    (response/content-type "application/atom+xml; charset=UTF-8"
-      (marx-feed-for-user user))))
+  (response/content-type "application/atom+xml; charset=UTF-8"
+    (marx-feed-for-user *user*)))
 
 (defpage "/marx/tags" {}
   (with-auth
@@ -188,8 +186,7 @@
                                  title :title, tags :tags, visibility :visibility,
                                  origin :origin}
   (with-auth
-    (let [tagseq (map string/trim (string/split tags #","))
-          user   (session/get :user)]
+    (let [tagseq (map string/trim (string/split tags #","))]
       (with-dbt
         (let [bookmark (sql/with-query-results
                          results
@@ -197,7 +194,7 @@
                                                   visibility)
                               VALUES (?, ?, ?, ?, ?)
                            RETURNING id"
-                          user uri title description visibility]
+                          *user* uri title description visibility]
                          (:id (first (into () results))))]
           (doseq [tag tagseq]
             (sql/insert-values :bookmark_tags [:bookmark :tag] [bookmark tag]))))))
diff --git a/src/mulk/benki/main.clj b/src/mulk/benki/main.clj
index 169b60b..7ec01ec 100644
--- a/src/mulk/benki/main.clj
+++ b/src/mulk/benki/main.clj
@@ -3,11 +3,14 @@
   (:use [clojure         core repl pprint]
         noir.core
         [hiccup core     page-helpers]
-        [mulk.benki      util config])
+        [mulk.benki      util config db])
   (:require [noir server options]
             [mulk.benki wiki auth book_marx]
             [ring.middleware.file]
-            [noir.session      :as session]))
+            [noir.session      :as session]
+            [noir.request      :as request]
+            [clojure.java.jdbc :as sql])
+  (:import [java.math BigDecimal BigInteger]))
 
 
 (defn wrap-utf-8 [handler]
@@ -37,9 +40,24 @@
         ;; (is must-revalidate even valid for server responses?)
         ))))
 
+(defn wrap-auth-token [handler]
+  (fn [request]
+    (binding [*user*
+              (or (when-let [key (get-in request [:params :auth])]
+                    (with-dbt
+                      (sql/with-query-results results
+                          ["SELECT \"user\" AS uid FROM page_keys
+                             WHERE page = ? AND \"key\" = ?"
+                           (:uri request)
+                           (BigDecimal. (BigInteger. key 36))]
+                        (:uid (first results)))))
+                  (session/get :user))]
+      (handler request))))
+
 (do-once ::init
   (noir.server/add-middleware #(wrap-utf-8 %))
   (noir.server/add-middleware #(wrap-base-uri %))
+  (noir.server/add-middleware #(wrap-auth-token %))
   (noir.server/add-middleware #(wrap-cache-control %))
   (noir.server/add-middleware #(ring.middleware.file/wrap-file % "static")))
 
diff --git a/src/mulk/benki/util.clj b/src/mulk/benki/util.clj
index 3600f9e..0c91b7d 100644
--- a/src/mulk/benki/util.clj
+++ b/src/mulk/benki/util.clj
@@ -7,12 +7,17 @@
             [noir.request  :as request]
             [noir.response :as response]
             [clojure.java.jdbc :as sql])
-  (:import [java.text DateFormat]))
+  (:import [java.text DateFormat]
+           [java.security SecureRandom]
+           [java.math BigInteger]))
 
 
 (def fmt clojure.pprint/cl-format)
 
 
+(def ^:dynamic *user*)
+
+
 (defonce #^:private finished-initializations (atom #{}))
 
 (defmacro do-once [key & body]
@@ -42,21 +47,20 @@
     content
     (:bottom kind)]))
 
-
-(defn fresolve [s & args]
-  (resolve-uri (apply fmt nil s args)))
-
-(defn link [& args]
+(defn linkrel [& args]
   (match [(vec args)]
-    [[:login]]           (fresolve "/login")
-    [[:marx]]            (fresolve "/marx")
-    [[:marx :submit]]    (fresolve "/marx/submit")
-    [[:marx id]]         (fresolve "/marx/~a" id)
-    [[:wiki title & xs]] (fresolve "/wiki/~a~@[~a~]" title (first xs))
+    [[:login]]           (fmt nil "/login")
+    [[:marx]]            (fmt nil "/marx")
+    [[:marx :submit]]    (fmt nil "/marx/submit")
+    [[:marx id]]         (fmt nil "/marx/~a" id)
+    [[:wiki title & xs]] (fmt nil "/wiki/~a~@[~a~]" title (first xs))
     ))
 
+(defn link [& args]
+  (resolve-uri (apply linkrel args)))
+
 (defn call-with-auth [thunk]
-  (if (session/get :user)
+  (if *user*
     (thunk)
     (do (session/flash-put! (:uri (request/ring-request)))
         (response/redirect "/login"))))
@@ -70,3 +74,8 @@
 (defn format-date [x]
   (.format (DateFormat/getDateTimeInstance DateFormat/FULL DateFormat/FULL)
            x))
+
+(defonce secure-random (SecureRandom.))
+(defn genkey []
+  ;;(.toString (BigInteger. 260 secure-random) 32)
+  (BigInteger. 260 secure-random))
diff --git a/src/mulk/benki/webutil.clj b/src/mulk/benki/webutil.clj
index 37b93a3..3a2cb1e 100644
--- a/src/mulk/benki/webutil.clj
+++ b/src/mulk/benki/webutil.clj
@@ -8,15 +8,40 @@
             [noir.request  :as request]
             [noir.response :as response]
             [clojure.java.jdbc :as sql])
-  (:import [java.text DateFormat]))
+  (:import [java.text DateFormat]
+           [java.math BigDecimal]))
+
+
+
+(defn authlink []
+  (with-dbt
+    (let [req  (request/ring-request)
+          user *user*
+          uri  (:uri req)
+          dkey (sql/with-query-results results
+                   ["SELECT * FROM page_keys WHERE \"user\" = ? AND page = ?"
+                    user uri]
+                 (if-let [rec (first results)]
+                   (:key rec)
+                   (let [key (BigDecimal. (genkey))]
+                     (sql/with-query-results results
+                         ["INSERT INTO page_keys(\"user\", page, \"key\")
+                                VALUES (?, ?, ?)
+                             RETURNING \"key\""
+                          user uri key]
+                       (:key (first results))))))
+          key  (.toBigIntegerExact dkey)]
+      (fmt nil "~A?auth=~A" uri (.toString key 36)))))
 
 
 (defpartial login-message []
-  (let [user-id (session/get :user)
-        user    (and user-id
+  (let [user    (and *user*
                      (with-dbt (sql/with-query-results results
-                                   ["SELECT * FROM users WHERE id = ?" user-id]
+                                 ["SELECT * FROM users WHERE id = ?" *user*]
                                  (first results))))]
-    (if user-id
-      [:div {:class "logged-in-as"}  (:first_name user) " " (:last_name user)]
+    (if *user*
+      [:div {:class "logged-in-as"}
+       (:first_name user) " " (:last_name user)
+       " "
+       [:a {:href (authlink)} "[authlink]"]]
       [:div {:class "not-logged-in"} [:a {:href (link :login)} "Log in"]])))