🐛 System start and stop without LDAP connection

This commit is contained in:
Vitaly Kornilov 2020-07-25 00:13:04 +03:00 committed by Andrey Antukh
parent 272c27061d
commit f2c4ff7518

View file

@ -6,52 +6,58 @@
[uxbox.common.exceptions :as ex] [uxbox.common.exceptions :as ex]
[uxbox.config :as cfg] [uxbox.config :as cfg]
[uxbox.services.mutations :as sm] [uxbox.services.mutations :as sm]
[uxbox.http.session :as session])) [uxbox.http.session :as session]
[clojure.tools.logging :as log]))
(defn replace-several [s & {:as replacements}] (defn replace-several [s & {:as replacements}]
(reduce-kv clojure.string/replace s replacements)) (reduce-kv clojure.string/replace s replacements))
(defstate ldap-pool (defstate *ldap-pool
:start (client/connect (merge :start (delay
{:host {:address (:ldap-auth-host cfg/config) (try
:port (:ldap-auth-port cfg/config)}} (client/connect (merge {:host {:address (:ldap-auth-host cfg/config)
(-> cfg/config :port (:ldap-auth-port cfg/config)}}
(select-keys [:ldap-auth-ssl (-> cfg/config
:ldap-auth-starttls (select-keys [:ldap-auth-ssl
:ldap-bind-dn :ldap-auth-starttls
:ldap-bind-password]) :ldap-bind-dn
(set/rename-keys {:ldap-auth-ssl :ssl? :ldap-bind-password])
:ldap-auth-starttls :startTLS? (set/rename-keys {:ldap-auth-ssl :ssl?
:ldap-bind-dn :bind-dn :ldap-auth-starttls :startTLS?
:ldap-bind-password :password})))) :ldap-bind-dn :bind-dn
:stop (client/close ldap-pool)) :ldap-bind-password :password}))))
(catch Exception e
(log/errorf e "Cannot connect to LDAP %s:%s"
(:ldap-auth-host cfg/config) (:ldap-auth-port cfg/config)))))
:stop (when (realized? *ldap-pool)
(some-> *ldap-pool deref (client/close))))
(defn- auth-with-ldap [username password] (defn- auth-with-ldap [username password]
(let [conn (client/get-connection ldap-pool) (when-let [conn (some-> *ldap-pool deref (client/get-connection))]
user-search-query (replace-several (:ldap-auth-user-query cfg/config) (let [user-search-query (replace-several (:ldap-auth-user-query cfg/config)
"$username" username) "$username" username)
user-attributes (-> cfg/config user-attributes (-> cfg/config
(select-keys [:ldap-auth-username-attribute (select-keys [:ldap-auth-username-attribute
:ldap-auth-email-attribute :ldap-auth-email-attribute
:ldap-auth-fullname-attribute :ldap-auth-fullname-attribute
:ldap-auth-avatar-attribute]) :ldap-auth-avatar-attribute])
vals)] vals)]
(try (try
(when-some [user-entry (-> conn (when-some [user-entry (-> conn
(client/search (client/search
(:ldap-auth-base-dn cfg/config) (:ldap-auth-base-dn cfg/config)
{:filter user-search-query {:filter user-search-query
:sizelimit 1 :sizelimit 1
:attributes user-attributes}) :attributes user-attributes})
first)] first)]
(when-not (client/bind? conn (:dn user-entry) password) (when-not (client/bind? conn (:dn user-entry) password)
(ex/raise :type :authentication (ex/raise :type :authentication
:code ::wrong-credentials)) :code ::wrong-credentials))
(set/rename-keys user-entry {(keyword (:ldap-auth-avatar-attribute cfg/config)) :photo (set/rename-keys user-entry {(keyword (:ldap-auth-avatar-attribute cfg/config)) :photo
(keyword (:ldap-auth-fullname-attribute cfg/config)) :fullname (keyword (:ldap-auth-fullname-attribute cfg/config)) :fullname
(keyword (:ldap-auth-email-attribute cfg/config)) :email})) (keyword (:ldap-auth-email-attribute cfg/config)) :email}))
(finally (client/release-connection ldap-pool conn))))) (finally (client/release-connection @*ldap-pool conn))))))
(defn auth [req] (defn auth [req]
(let [data (:body-params req) (let [data (:body-params req)