File: auth.lisp

package info (click to toggle)
araneida 0.90.1-dfsg-2
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 700 kB
  • ctags: 643
  • sloc: lisp: 4,878; perl: 166; sh: 109; makefile: 34
file content (26 lines) | stat: -rw-r--r-- 1,039 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
(in-package :araneida)

(defun make-basic-authentication-handler (realm lookup-user)
  "Returns a function suitable for use as a :authentication handler
for REALM.  The called should supply a function LOOKUP-USER taking
two arguments NAME and PASSWORD and returning some unique user identifier"
  (lambda (r arg-string)
    (declare (ignore arg-string))
    (seqlet ((auth (car (request-header r :authorization)))
             (user (apply lookup-user
                          (split (base64-decode (cadr (split auth))) nil '(#\:)))))
      (cond (user
             (setf (request-user r) user))
            (t
             (format (request-stream r) "HTTP/1.0 401 Unauthorized~%WWW-Authenticate: Basic realm=~D~%Content-type: text/html~%~%<h1>Unauthorized</h1><p>Either your browser does not support HTTP basic authentication or you have supplied an incorrect username/password for this page.  Sorry"
                     realm)
             (close (request-stream r))
	     (signal 'response-sent)))
      t)))