ldap.clj

(ns de.mpg.shh.util-ldap.ldap
  (:require [clojure.tools.logging :refer [info error]]
            [clojure.string :as str]
            [clojure.set :as set]
            [de.mpg.shh.util-properties.properties :refer [load-properties]])
  (:import [java.lang NumberFormatException]
           [javax.naming Context InvalidNameException]
           [javax.naming.directory InitialDirContext]
           [javax.naming.ldap LdapName]
           [com.novell.ldap LDAPJSSEStartTLSFactory LDAPConnection LDAPConstraints]))

(def properties (delay (load-properties "shh-auth.properties")))

(defn get-ldap-host
  []
  (if-let [host (get-in @properties [:ldap :host])] host (throw (Exception. "No configuration found for ldap.host check resources/shh-auth.properties"))))

(defn get-ldap-port
  []
  (if-let [port (get-in @properties [:ldap :port])]
    (try
      (java.lang.Long/valueOf port)
      (catch NumberFormatException nfe
        (throw (Exception. "Not a number check ldap.port in resources/shh-auth.properties"))))
    (throw (Exception. "No configuration found for ldap.port check resources/shh-auth.properties"))))

(def user-attributes #{"cn" "sn" "mail" "memberOf"})

(defn authenticate
  "Attempt to authenticate `username` via an LDAP simple bind with
  `password`. Returns true on success, otherwise false."
  [username password]
  (let [ldap-conn (LDAPConnection. (LDAPJSSEStartTLSFactory.))]
    (try
      (do
        (doto ldap-conn
            (.connect (get-ldap-host) (get-ldap-port))
            (.startTLS)
            (.bind LDAPConnection/LDAP_V3 username (.getBytes password)))
        true)
      (catch Exception e
        (error e "Failed to authenticate" username)
        false))))

(defn ldap-entry-iterator
  [ldap-result]
  (reify java.util.Iterator
    (hasNext [this] (.hasMore ldap-result))
           (next [this] (.next ldap-result))))

(defn attribute->map
  [accumulator item]
  (let [[attr value] (str/split item #"=")
        lc-attr (str/lower-case attr)]
    (if (contains? accumulator lc-attr)
      (update accumulator lc-attr conj value)
      (assoc accumulator lc-attr [value]))))

(defn attributes->map
  [attributes]
  (try
    (let [parsed-dn (LdapName. attributes)]
      (reduce attribute->map {} (enumeration-seq (.getAll parsed-dn))))
    (catch InvalidNameException ine
      attributes)))

(defn ldap-entry->map
  [ldap-entry]
  {:name (.getName ldap-entry)
   :values (vec (map attributes->map (.getStringValueArray ldap-entry)))})

(defn full-dag-filter
  [group]
  (and (= (get group "dc") ["de" "mpg" "shh"])
       (= (get group "ou") ["DAG"])
       (= (get group "cn") ["Full_DAG"])))

(defn filter-user
  [maybe-user-entry]
  (and (set/subset? user-attributes (into #{} (map :name (:attributes maybe-user-entry))))
       (when-let [groups (:values (first (filter (comp #(= % "memberOf") :name) (:attributes maybe-user-entry))))]
         (not (empty? (filter full-dag-filter groups))))))

(defn extract-user
  [user-entry]
  (let [full-name (->> (:attributes user-entry)
                       (filter (comp #(= % "cn") :name))
                       (map :values)
                       ffirst)
        name-parts (str/split full-name #" ")
        short-name (->> (:attributes user-entry)
                       (filter (comp #(= % "sn") :name))
                       (map :values)
                       ffirst)
        e-mail (->> (:attributes user-entry)
                       (filter (comp #(= % "mail") :name))
                       (map :values)
                       ffirst)]
    {:full-name full-name
     :first-name (first name-parts)
     :last-name (str/join " " (rest name-parts))
     :short-name short-name
     :e-mail e-mail}))

(defn user-entries
  "Get user ldap entries"
  [username password]
  (let [ldap-conn (LDAPConnection. (LDAPJSSEStartTLSFactory.))
        search-constraints (LDAPConstraints.)]
    (try
      (let [ldap-result (-> (doto ldap-conn
                                  (.setConstraints search-constraints)
                                  (.connect (get-ldap-host) (get-ldap-port))
                                  (.startTLS)
                                  (.bind LDAPConnection/LDAP_V3 username (.getBytes password)))
                            (.search "ou=dag,dc=shh,dc=mpg,dc=de" LDAPConnection/SCOPE_SUB "(objectclass=user)" (into-array String user-attributes) false))]
        (for [ldap-entry (iterator-seq (ldap-entry-iterator ldap-result))]
          (let [attributes (-> ldap-entry
                               (.getAttributeSet)
                               (.iterator)
                               (iterator-seq))]
            {:dn (.getDN ldap-entry)
             :attributes (vec (map ldap-entry->map attributes))})))
      (catch Exception e
        (error e "Failed to authenticate" username)))))

(defn users
  "Attempt to retrieve Active Directory users"
  [username password]
  (map extract-user (filter filter-user (user-entries username password))))