ldap.clj

(ns de.mpg.shh.util-ldap.ldap
  (:require [clojure.tools.logging :refer [info error]]
            [clojure.string :as str]
            [de.mpg.shh.util-properties.properties :refer [load-properties]])
  (:import [java.io ByteArrayOutputStream ObjectOutputStream StringWriter PrintWriter]
           [java.nio.charset StandardCharsets]
           [java.lang NumberFormatException]
           [java.util Hashtable]
           [javax.naming Context]
           [javax.naming.directory InitialDirContext]
           [com.novell.ldap LDAPJSSEStartTLSFactory LDAPBindHandler LDAPConnection LDAPConstraints LDAPUrl LDAPException]))

(defn stack-trace-to-string
  "Returns a string containing the output of .printStackTrace"
  [t]
  (let [sw (StringWriter.)
        pw (PrintWriter. sw)
        _ (.printStackTrace t pw)]
    (.toString sw)))

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

(def ldap-host (if-let [host (get-in @properties [:ldap :host])] host (throw (Exception. "No configuration found for ldap.host check resources/shh-auth.properties"))))
(def 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 (into-array String ["cn" "sn"]))

(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 ldap-host 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 ldap-entry->map
  [ldap-entry]
  {:name (.getName ldap-entry)
   :values (vec (.getStringValueArray ldap-entry))})

(defn filter-user
  [maybe-user-entry]
  (when-let [m (re-matches #"^(.*),ou=dag,dc=shh,dc=mpg,dc=de$" (str/lower-case (:dn maybe-user-entry)))]
    (and (not (empty? (->> (:attrs maybe-user-entry)
                           (filter (comp #(= % "sn") :name))
                           (remove (comp #(= (str/lower-case %) "dag") first :values)))))
         (= (count m) 2)
         (empty? (filter #(str/starts-with? % "ou=")  (-> m second str/lower-case (str/split #","))))))) 

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

(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 ldap-host ldap-port)
                                  (.startTLS)
                                  (.bind LDAPConnection/LDAP_V3 username (.getBytes password)))
                            (.search "ou=dag,dc=shh,dc=mpg,dc=de" LDAPConnection/SCOPE_SUB "(objectclass=user)" 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)
             :attrs (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))))