Paste number 4121: code I used to do basic auth not too long ago

Paste number 4121: code I used to do basic auth not too long ago
Pasted by: chandler
When:12 years, 10 months ago
Share:Tweet this! | http://paste.lisp.org/+36H
Channel:#macdev
Paste contents:
Raw Source | XML | Display As
(defclass auth-mixin () ())

(defmacro with-split-1 ((one rest) split on &body body)
  (let ((one-list (gensym)) (pos (gensym)) (on-binding (gensym)))
    `(let ((,on-binding ,on))
       (multiple-value-bind
             (,one-list ,pos) (split-sequence
                               ,split ,on-binding :count 1)
         (let ((,one (car ,one-list))
               (,rest (subseq ,on-binding ,pos)))
           ,@body)))))

(defun split-whitespace-scrub (str)
  (delete ""
          (split-sequence-if
           #'(lambda (char)
               (member char '(#\space #\tab #\return #\newline))) str)
          :test #'string=))

(defmethod handle-request-response :around ((handler auth-mixin) method request)
  (let ((auth (car (request-header request :authorization)))
        (authenticated nil)
        (authed-user nil))
    (if auth
        (let* ((base64-auth (second (split-whitespace-scrub auth)))
               (de-base64 (base64-string-to-string base64-auth)))
          (with-split-1 (user pass) #\: de-base64
                        (if (and
                             (string= user *user*)
                             (equal (coerce
                                     (md5sum-sequence pass) 'list)
                                    (coerce
                                     *password*
                                     'list)))
                            (setf
                             authed-user user
                             authenticated t)))))
    ;;(format t "auth is ~S ~S~%" auth authenticated)
    (if authenticated
        (call-next-method)
        (progn
          (request-send-headers request
                                :content-type "text/html; charset=iso-8859-1"
                                :expires 0
                                :response-code 401
                                :response-text "Unauthorized"
                                :www-authenticate
                                (format nil "Basic realm=\"~A\""
                                        "Simple Finance"))
          (request-send-headers request)
          (html-stream
           (request-stream request)
           `(html (body (h1 "No page for you!"))))))))

This paste has no annotations.

Colorize as:
Show Line Numbers

Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.