diff options
Diffstat (limited to 'web/panettone/src/panettone.lisp')
-rw-r--r-- | web/panettone/src/panettone.lisp | 85 |
1 files changed, 4 insertions, 81 deletions
diff --git a/web/panettone/src/panettone.lisp b/web/panettone/src/panettone.lisp index 15d3ba7577fc..4dc00db23923 100644 --- a/web/panettone/src/panettone.lisp +++ b/web/panettone/src/panettone.lisp @@ -2,91 +2,11 @@ (declaim (optimize (safety 3))) ;;; -;;; Data model -;;; - -(defclass/std user () - ((cn dn mail displayname :type string))) - -;;; -;;; LDAP integration -;;; - -(defvar *ldap* nil - "The ldap connection") - -(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))))) - -(defun author (object) - (find-user-by-dn (author-dn object))) - -;;; ;;; Views ;;; (defvar *title* "Panettone") -(defvar *user* nil) - (setf (who:html-mode) :html5) (defun render/footer-nav () @@ -112,6 +32,9 @@ successful, `nil' otherwise" :utf-8)) "Log In"))))))) +(defun author (object) + (find-user-by-dn (author-dn object))) + (defmacro render ((&key (footer t)) &body body) `(who:with-html-output-to-string (*standard-output* nil :prologue t) (:html @@ -349,7 +272,7 @@ successful, `nil' otherwise" (defun @handle-issue-not-found (next) (handler-case (funcall next) - (issue-not-found (err) + (model:issue-not-found (err) (render/not-found (format nil "Issue #~A" (model:id err)))))) |