feat(web/panettone): Log when users change issue statuses
Log in the database, in a way that will generalize to tracking edit history as well, when users change the status of an issue. To facilitate easily knowing who is currently authenticated (without introducing a circular dependency) the authentication-relaated code has also been factored out into its own package, which is nice because we want to replace that sooner rather than later anyway. Fixes: #13 Change-Id: I65a544fab660ed1c295ee8f6b293e0d4945a8203 Reviewed-on: https://cl.tvl.fyi/c/depot/+/1496 Tested-by: BuildkiteCI Reviewed-by: tazjin <mail@tazj.in>
This commit is contained in:
parent
14a8142f76
commit
8e7ba41a34
7 changed files with 215 additions and 112 deletions
71
web/panettone/src/authentication.lisp
Normal file
71
web/panettone/src/authentication.lisp
Normal file
|
|
@ -0,0 +1,71 @@
|
|||
(in-package :panettone.authentication)
|
||||
|
||||
(defvar *user* nil
|
||||
"The currently logged-in user")
|
||||
|
||||
(defvar *ldap* nil
|
||||
"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)))
|
||||
|
||||
(defun ldap-entry->user (entry)
|
||||
(apply
|
||||
#'make-instance
|
||||
'user
|
||||
:dn (ldap:dn entry)
|
||||
(alexandria:mappend
|
||||
(lambda (field)
|
||||
(list field (car (ldap:attr-value entry field))))
|
||||
(list :mail
|
||||
:cn
|
||||
:displayname))))
|
||||
|
||||
(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*))
|
||||
|
||||
(defun find-user (username)
|
||||
(check-type username (simple-array character (*)))
|
||||
(when-let ((ldap-entry (find-user/ldap username)))
|
||||
(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)))
|
||||
|
||||
(comment
|
||||
(user-by-dn "cn=glittershark,ou=users,dc=tvl,dc=fyi")
|
||||
)
|
||||
|
||||
(defun authenticate-user (user-or-username password)
|
||||
"Checks the given USER-OR-USERNAME has the given PASSWORD, by making a bind
|
||||
request against the ldap server at *ldap*. Returns the user if authentication is
|
||||
successful, `nil' otherwise"
|
||||
(when-let ((user (if (typep user-or-username 'user) user-or-username
|
||||
(find-user user-or-username))))
|
||||
(let ((dn (dn user)))
|
||||
(let ((code-sym
|
||||
(nth-value 1 (ldap:bind
|
||||
(ldap:new-ldap :host (ldap:host *ldap*)
|
||||
:port (ldap:port *ldap*)
|
||||
:user dn
|
||||
:pass password)))))
|
||||
(when (equalp code-sym 'trivial-ldap:success)
|
||||
user)))))
|
||||
Loading…
Add table
Add a link
Reference in a new issue