diff options
author | Griffin Smith <grfn@gws.fyi> | 2020-08-28T22·49-0400 |
---|---|---|
committer | glittershark <grfn@gws.fyi> | 2020-08-31T23·03+0000 |
commit | 21690c644bc503e4c8cc55df00b398ab81fd7444 (patch) | |
tree | 9d80b320d7c9300b8fea204e203de187fde5ce01 /web/panettone/src/authentication.lisp | |
parent | 2bc564bd0dfc886cc27d14271a8423c9a266482c (diff) |
fix(panettone): Automatically reconnect to ldap r/1746
Wrap all ldap access in a macro that automatically reconnects and retries operations that fail due to a connection error, to handle the case where the ldap server restarts while we still have an open connection. Fixes: #44 Change-Id: I4859cf509106e480f97fed17e7f08e0eea909352 Reviewed-on: https://cl.tvl.fyi/c/depot/+/1871 Tested-by: BuildkiteCI Reviewed-by: eta <eta@theta.eu.org>
Diffstat (limited to 'web/panettone/src/authentication.lisp')
-rw-r--r-- | web/panettone/src/authentication.lisp | 68 |
1 files changed, 52 insertions, 16 deletions
diff --git a/web/panettone/src/authentication.lisp b/web/panettone/src/authentication.lisp index e4f893f88330..20510257539f 100644 --- a/web/panettone/src/authentication.lisp +++ b/web/panettone/src/authentication.lisp @@ -6,13 +6,46 @@ (defvar *ldap* nil "The ldap connection") +(defvar *ldap-host* "localhost" + "The host for the ldap connection") + +(defvar *ldap-port* 389 + "The port for the ldap connection") + (defclass/std user () ((cn dn mail displayname :type string))) (defun connect-ldap (&key (host "localhost") (port 389)) - (setq *ldap* (ldap:new-ldap :host host :port port))) + (setq *ldap-host* host + *ldap-port* port + *ldap* (ldap:new-ldap :host host :port port))) + +(defun reconnect-ldap () + (setq *ldap* (ldap:new-ldap + :host *ldap-host* + :port *ldap-port*))) + +(defmacro with-ldap ((&key (max-tries 1)) &body body) + "Execute BODY in a context where ldap connection errors trigger a reconnect +and a retry" + (with-gensyms (n try retry e) + `(flet + ((,try + (,n) + (flet ((,retry (,e) + (if (>= ,n ,max-tries) + (error ,e) + (progn + (reconnect-ldap) + (,try (1+ ,n)))))) + (handler-case + (progn + ,@body) + (end-of-file (,e) (,retry ,e)) + (trivial-ldap:ldap-connection-error (,e) (,retry ,e)))))) + (,try 0)))) (defun ldap-entry->user (entry) (apply @@ -28,15 +61,16 @@ (defun find-user/ldap (username) (check-type username (simple-array character (*))) - (ldap:search - *ldap* - `(and (= objectClass organizationalPerson) - (or - (= cn ,username) - (= dn ,username))) - ;; TODO(grfn): make this configurable - :base "ou=users,dc=tvl,dc=fyi") - (ldap:next-search-result *ldap*)) + (with-ldap () + (ldap:search + *ldap* + `(and (= objectClass organizationalPerson) + (or + (= cn ,username) + (= dn ,username))) + ;; TODO(grfn): make this configurable + :base "ou=users,dc=tvl,dc=fyi") + (ldap:next-search-result *ldap*))) (defun find-user (username) (check-type username (simple-array character (*))) @@ -44,14 +78,16 @@ (ldap-entry->user ldap-entry))) (defun find-user-by-dn (dn) - (ldap:search *ldap* `(= objectClass organizationalPerson) - :base dn - :scope 'ldap:base) - (when-let ((ldap-entry (ldap:next-search-result *ldap*))) - (ldap-entry->user ldap-entry))) + (with-ldap () + (progn + (ldap:search *ldap* `(= objectClass organizationalPerson) + :base dn + :scope 'ldap:base) + (when-let ((ldap-entry (ldap:next-search-result *ldap*))) + (ldap-entry->user ldap-entry))))) (comment - (user-by-dn "cn=glittershark,ou=users,dc=tvl,dc=fyi") + (find-user-by-dn "cn=glittershark,ou=users,dc=tvl,dc=fyi") ) (defun authenticate-user (user-or-username password) |