From c5e1ae4c18a7bb8ecf9370b913e1de1ebc64f398 Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <code@mail.matthias.benkard.de>
Date: Sat, 16 Jun 2012 16:05:33 +0200
Subject: Accept client certificate information from a frontend reverse proxy.

---
 project.clj             |  1 +
 schema.sql              | 15 +++++++++++++++
 src/mulk/benki/main.clj | 34 +++++++++++++++++++++++++++++++++-
 src/mulk/benki/util.clj |  1 +
 4 files changed, 50 insertions(+), 1 deletion(-)

diff --git a/project.clj b/project.clj
index 6269f70..4a49f2a 100644
--- a/project.clj
+++ b/project.clj
@@ -47,6 +47,7 @@
                  [org.pegdown/pegdown "1.1.0"]
                  [jivesoftware/smack "3.1.0"]
                  [jivesoftware/smackx "3.1.0"]
+                 [joda-time/joda-time "2.1"]
                  ]
   :plugins [[lein-swank "1.4.3"]]
   :exclusions [org.clojure/clojure-contrib]  ;you know, the old pre-1.3.0 versions
diff --git a/schema.sql b/schema.sql
index f1f07fc..ab9abb8 100644
--- a/schema.sql
+++ b/schema.sql
@@ -21,6 +21,21 @@ CREATE TABLE openids(
   FOREIGN KEY("user") REFERENCES users
 );
 
+CREATE TABLE rsa_keys(
+  modulus  VARCHAR   NOT NULL,
+  exponent VARCHAR   NOT NULL,
+  PRIMARY KEY(modulus, exponent)
+);
+
+CREATE TABLE user_rsa_keys(
+  "user"   INTEGER   NOT NULL,
+  modulus  VARCHAR   NOT NULL,
+  exponent VARCHAR   NOT NULL,
+  PRIMARY KEY("user", modulus, exponent),
+  FOREIGN KEY("user") REFERENCES users,
+  FOREIGN KEY(modulus, exponent) REFERENCES rsa_keys
+);
+
 CREATE TABLE user_email_addresses(
   "user"       INTEGER   NOT NULL,
   email        VARCHAR   NOT NULL,
diff --git a/src/mulk/benki/main.clj b/src/mulk/benki/main.clj
index 55239d5..43809ca 100644
--- a/src/mulk/benki/main.clj
+++ b/src/mulk/benki/main.clj
@@ -13,7 +13,9 @@
             [lamina.core       :as lamina]
             [aleph.http        :as ahttp]
             [aleph.formats     :as aformats]
-            [ring.util.codec   :as codec])
+            [ring.util.codec   :as codec]
+            [clojure.algo.monads :as m]
+            [clojure.data.json   :as json])
   (:import [java.math BigDecimal BigInteger])
   (:gen-class))
 
@@ -59,6 +61,35 @@
                   (session/get :user))]
       (handler request))))
 
+(defn parse-certificate [cert-data]
+  (let [{modulus :modulus,
+         exponent :exponent,
+         fingerprint :fingerprint,
+         valid-to :valid_to
+         valid-from :valid_from
+         subject-alt-name :subjectaltname
+         subject :subject
+         }
+        cert-data]
+    {:modulus          (bigint (BigInteger. modulus 16))
+     :exponent         (bigint (BigInteger. exponent 16))
+     :fingerprint      fingerprint
+     :valid-to         (org.joda.time.DateTime. (Long. valid-to))
+     :valid-from       (org.joda.time.DateTime. (Long. valid-from))
+     :subject          subject
+     :subject-alt-name subject-alt-name}))
+
+(defn wrap-client-cert [handler]
+  (fn [request]
+    (binding [*client-cert*
+              (m/domonad m/maybe-m
+                         [cert-json (get-in request [:headers "x-mulk-peer-certificate"])
+                          cert-data (json/read-json cert-json)
+                          cert      (parse-certificate cert-data)]
+                cert)]
+      (handler request))))
+
+
 (defn wrap-extension-mimetype [handler]
   (fn [request]
     (let [uri       (codec/url-decode (:uri request))
@@ -81,6 +112,7 @@
   (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-client-cert %))
   (noir.server/add-middleware #(wrap-cache-control %))
   (noir.server/add-middleware #(ring.middleware.file/wrap-file % "static"))
   (noir.server/add-middleware #(wrap-extension-mimetype %)))
diff --git a/src/mulk/benki/util.clj b/src/mulk/benki/util.clj
index 55806eb..d3df4af 100644
--- a/src/mulk/benki/util.clj
+++ b/src/mulk/benki/util.clj
@@ -20,6 +20,7 @@
 
 
 (def ^:dynamic *user*)
+(def ^:dynamic *client-cert*)
 
 
 (defonce #^:private finished-initializations (atom #{}))
-- 
cgit v1.2.3