Merge branch 'master' of https://github.com/SciMed/shared-resource

Conflicts:
	src/shared_resource/datomic.clj

resources/config.properties.example

@@ -4,8 +4,12 @@
 
 ldap.host = localhost
 ldap.port = 389
-ldap.user = 
-ldap.pass = 
+ldap.user =
+ldap.pass =
+ldap.email-field =
+ldap.username-field =
+ldap.full-name-field =
+ldap.connection-string =
 
 ############################
 # Datomic

src/shared_resource/datomic.clj

@@ -90,14 +90,6 @@
 
 ;; This should really be abstracted and model specific code should be moved to
 ;; that model.
-(defn create-user [username full-name]
-  (let [conn (d/connect (uri datomic-config))]
-    (d/transact
-     conn
-     [{:db/id #db/id [:db.part/user]
-     :user/username username
-       :user/name full-name}])))
-
 (defn create-resource [resource-name description]
   (let [conn (d/connect (uri datomic-config))]
     (d/transact
@@ -106,10 +98,6 @@
        :resource/name resource-name
        :resource/description description}])))
 
-(defn get-all-usernames []
-  (let [conn (d/connect (uri datomic-config))]
-    (q '[:find ?n :where [?c user/username ?n ]] (db conn))))
-
 (defn get-all-resources []
   (let [conn (d/connect (uri datomic-config))]
     (q '[:find ?n ?a ?b :where [?n :resource/name ?a] [?n :resource/description ?b]] (db conn))))
@@ -127,3 +115,4 @@
    }
   )
 )
+

src/shared_resource/models/authentication.clj

@@ -6,9 +6,29 @@
 (defn ldap-config [key]
   (config-value (str "ldap." key)))
 
-(defn ldap-authenticate? [username password]
+(defn authenticate? [user-entry password]
   "Authenticate a user against ldap and return true if successful, false otherwise."
-  (let [ldap-server (ldap/connect {:host (ldap-config "host") :port (ldap-config "port") :bind-dn (ldap-config "user") :password (ldap-config "pass")})
-        user-entry  (ldap/search ldap-server "ou=netfriends,DC=netfriends,DC=com" {:filter (str "sAMAccountName=" username) :attributes [:dn]})
-        user-dn     (apply :dn user-entry)]
+  (let [host        (ldap-config "host")
+        port        (ldap-config "port")
+        bind-dn     (ldap-config "user")
+        bind-pass   (ldap-config "pass")
+        ldap-server (ldap/connect {:host host :port port :bind-dn bind-dn :password bind-pass})
+        user-dn     (:dn user-entry)]
     (ldap/bind? ldap-server user-dn password)))
+
+(defn find-user [username]
+  "Find a user in ldap and a user entry (a map of values like dn, etc.)"
+  (let [host              (ldap-config "host")
+        port              (ldap-config "port")
+        bind-dn           (ldap-config "user")
+        bind-pass         (ldap-config "pass")
+        ldap-server       (ldap/connect {:host host :port port :bind-dn bind-dn :password bind-pass})
+        connection-string (ldap-config "connection-string")
+        filter-string     (str (ldap-config "username-field") "=" username)]
+    (first (ldap/search ldap-server connection-string {:filter filter-string}))))
+
+(defn user-attributes [user-entry]
+  (let [username  ((keyword (ldap-config "username-field"))  user-entry)
+        email     ((keyword (ldap-config "email-field"))     user-entry)
+        full-name ((keyword (ldap-config "full-name-field")) user-entry)]
+    {:username username :email email :full-name full-name}))

src/shared_resource/models/user.clj

@@ -1,4 +1,41 @@
 (ns shared-resource.models.user
-  (:use shared-resource.models.authentication))
+  (:use shared-resource.datomic
+        [datomic.api :only (q db) :as d])
+  (:require [shared-resource.models.authentication :as auth]))
 
+(defn create-user [username full-name email]
+  (let [conn (d/connect (uri datomic-config))]
+    (d/transact
+     conn
+     [{:db/id #db/id [:db.part/user]
+       :user/username username
+       :user/name full-name
+       :user/email email}])))
 
+(defn get-all-usernames []
+  (let [conn (d/connect (uri datomic-config))]
+    (q '[:find ?n :where [?c user/username ?n ]] (db conn))))
+
+;(defn destroy-user [username]
+  ;(let [conn (d/connect (uri datomic-config))]
+    ;(d/transact
+     ;conn
+     ;[[:db.fn/retractEntity (find-user username)]])))
+
+(defn find-user [username]
+  (let [conn (d/connect (uri datomic-config))]
+    (first (first (q `[:find ?c :where [?c user/username ~username]] (db conn))))))
+
+(defn find-or-create-user [{:keys [username full-name email]}]
+  (if-let [user-record (find-user username)]
+    user-record
+    (create-user username full-name email)))
+
+(defn login?
+  ([username password] (login? username password false))
+  ([username password save-user]
+    (if-let [user-entry (auth/find-user username)]
+      (when (auth/authenticate? user-entry password)
+        (if save-user (find-or-create-user (auth/user-attributes user-entry)))
+        true)
+      false)))

src/shared_resource/views/common.clj

@@ -1,12 +1,20 @@
 (ns shared-resource.views.common
-  (:use [noir.core :only [defpartial]]
-        [hiccup.page :only [include-css html5]]))
+  (:use noir.core
+        hiccup.core
+        hiccup.element
+        [hiccup.page :only [include-css html5]])
+  (:require [noir.session :as session]))
 
 (defpartial layout [& content]
-            (html5
-              [:head
-               [:title "shared-resource"]
-               (include-css "/css/reset.css")]
-              [:body
-               [:div#wrapper
-                content]]))
+  (html5
+    [:head
+     [:title "shared-resource"]
+     (include-css "/css/reset.css")]
+    [:body
+     [:div#session
+      [:div#user-info (session/get :username)]
+      (if (session/get :username) (link-to "/sessions/destroy" "Logout") "")]
+     [:div#flash.success (session/flash-get :success)]
+     [:div#flash.error   (session/flash-get :error)]
+     [:div#wrapper
+      content]]))

src/shared_resource/views/sessions.clj

@@ -0,0 +1,52 @@
+(ns shared-resource.views.sessions
+  (:use noir.core
+        hiccup.core
+        hiccup.page
+        hiccup.element
+        hiccup.form)
+  (:require [shared-resource.models.user :as user]
+            [shared-resource.views.common :as common]
+            [noir.response :as resp]
+            [noir.session :as session]))
+
+(defpartial login-page [username]
+  (common/layout
+    (form-to [:post "/sessions"]
+      (label "username" "Username: ")
+      (text-field "username" username)
+      (label "password" "Password: ")
+      (password-field "password")
+      (submit-button "Login"))))
+
+(defn logged-in? []
+  (not (nil? (session/get :username))))
+
+;; Routes
+
+(pre-route "/" {}
+  (when-not (logged-in?)
+    (resp/redirect "/sessions/new")))
+
+(pre-route "/resources/*" {}
+  (when-not (logged-in?)
+    (resp/redirect "/sessions/new")))
+
+(defpage "/sessions/new" []
+  (if (session/get :username) (resp/redirect "/") (login-page "")))
+
+(defpage [:post "/sessions"] {:keys [username password]}
+  (if (user/login? username password)
+    (do
+      (session/clear!)
+      (session/put! :username username)
+      (session/flash-put! :success "Successfully logged in.")
+      (resp/redirect "/"))
+    (do
+      (session/flash-put! :error "Failed to log in.")
+      (login-page username))))
+
+(defpage "/sessions/destroy" []
+  (do
+    (session/clear!)
+    ;; (session/flash-put! :success "Logged out.") can't session/clear to work with this
+    (resp/redirect "/sessions/new")))