#|
Most uses will want to just do user/password. In this case, define
an authentication function like:
(defun auth-user-pw (user pw)
(... return non-nil to indicate success ...))
...
(yield (make-login #'auth-user-pw))
email: sohail/@/taggedtype.net if you have any questions
|#
(defun make-login (auth-method)
(make-instance 'login
:auth-method auth-method))
(defwidget login (weblocks:composite)
((auth-method
:accessor login-auth-method
:initarg :auth-method)))
(defwidget login-form (weblocks:dataform)
())
(defmethod initialize-instance :after ((self login)
&rest args
&key auth-method
(login-title "Login")
&allow-other-keys)
(declare (ignore args))
(setf (widget-name self) "login-composite")
(when (functionp auth-method)
(setq auth-method
(make-instance 'default-auth-method :auth-fn auth-method)))
(setf (composite-widgets self)
(list (lambda () (with-html (:h1 (str login-title))))
(make-instance 'login-form
:name 'loginform
:data auth-method
:ui-state :form
:allow-close-p nil
:widget-args '(:persist-object-p nil)
:on-success
(lambda (&rest args)
(declare (ignore args))
(answer self (slot-value auth-method 'result)))))))
(defclass auth-method ()
(result))
(defun authenticate (method)
(let ((result (auth-method-authenticate method)))
(if result
(progn
(tbnl:log-message* "Successful authentication")
(setf (slot-value method 'result) result)
(values t nil))
(progn
(tbnl:log-message* "Failed authentication: ~A" method)
(values nil '(("Authentication failed" "Authentication failed")))))))
;;; Weblocks hooks
(defmethod weblocks:update-object-from-request :around ((method auth-method)
&rest args)
(multiple-value-bind (success failed-slots)
(call-next-method)
(if success
(authenticate method)
(values success failed-slots))))
(defmethod weblocks:render-form-controls ((obj auth-method)
&rest keys
&key action
&allow-other-keys)
(with-html
(:div :class "submit"
(render-button *submit-control-name* :value "Login"))))
;;; AUTH-METHOD GENERIC
(defgeneric auth-method-authenticate (auth-method)
(:documentation "Return a generalized boolean to indicate
whether the values provided authenticate a user."))
(defmacro def-auth-method (name &body body)
"A macro used to define authentication methods."
`(defclass ,name (auth-method)
,@body))
;;; DEFAULT-AUTH-METHOD
(def-auth-method default-auth-method
((login
:initarg :login
:accessor default-auth-method-login
:type string
:initform nil)
(password
:initarg :password
:accessor default-auth-method-password
:type password
:initform nil)
(auth-fn
:initarg :auth-fn)))
(defmethod auth-method-authenticate ((dam default-auth-method))
(with-slots (auth-fn login password) dam
(funcall auth-fn login password)))
