blob: 51c72116f86ec97544024bc6efe94757b0e5b657 (
plain)
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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
(in-package #:weekend)
;;; CONDITIONS
(defvar *debugging* nil
"If T, the debugger will be evoked.")
(define-condition protocol-error (error)
((raw-request
:reader raw-request
:initarg :raw-request
:documentation "The server backend's request object, if available")
(class
:reader endpoint-class
:initarg :class
:documentation "The class registered to handle the raw-request.")
(note
:reader note
:initform nil
:initarg :note
:type (or null string))
(status-code
:reader status-code
:initform nil
:initarg :status-code
:type (or nil (integer 100 599))))
(:documentation "Conditions signalled during the request handling protocol."))
(defmethod status-code ((err error)) 500)
(define-condition cannot-authenticate (protocol-error) ()
(:default-initargs :status-code 401)
(:documentation "Signalled when a endpoint's AUTHENTICATE method returns NIL,
indicating that the user's identity is required but cannot be determined."))
(define-condition not-authorized (protocol-error) ()
(:default-initargs :status-code 403)
(:documentation "Signalled when an endpoint's AUTHORIZE method returns NIL, indiating
that the request has insufficient permissions to evoke the endpoint handler. "))
(define-condition bad-body-error (protocol-error)
((wrapped
:reader wrapped
:initarg :error
:documentation "A root error that may have caused this error to be signalled."))
(:default-initargs :status-code 400)
(:documentation "Signalled when the body of a request cannot be deserialized."))
(define-condition slot-required (protocol-error)
((mising-slot
:reader missing-slot
:initarg :slot))
(:default-initargs :status-code 400)
(:documentation "Signalled whenever a required slot is missing from a endpoint
instance object."))
(define-condition not-found (protocol-error) ()
(:default-initargs :status-code 404))
(defgeneric protocol-error-result (err)
(:documentation "The content and mimetype to returned to the client having encountered
an error.")
(:method ((err error)) (values nil nil)))
(defun abort-on-error (err)
"Assign a return code based on the type of error encountered and
immediately reply."
(setf (http:return-code*) (status-code err))
(multiple-value-bind (content type) (protocol-error-result err)
(cond ((and content type)
(setf (http:content-type*) type)
(http:abort-request-handler content))
(t
(http:abort-request-handler)))))
(defvar *debugging* nil
"If T, conditions signalled during request handling will invoke the
debugger.")
(defmethod http:acceptor-dispatch-request :around ((acceptor http:acceptor) request)
(handler-case (call-next-method)
(error (err)
(if *debugging*
(invoke-debugger err)
(abort-on-error err)))))
(defun protocol-error (error-class ep &rest kwargs)
(apply #'error
error-class
:raw-request http:*request*
:class (class-of ep)
kwargs))
(defun slot-required (ep slot)
"Signals a SLOT-REQUIRED condition"
(protocol-error 'slot-required ep :missing-slot slot))
;;; HANDLER PROTOCOL
(defgeneric authenticate (endpoint)
(:documentation "Returns a boolean. Any protected endpoint should implement
this. Called before handling, should be used to supply
user-identifying data to the endpoint instance that might be needed by
the handle function.")
(:method ((ep t)) t))
(defgeneric authorize (endpoint)
(:documentation "Returns a boolean. Any endpoint requiring special ownership
permissions should implement this. Called before handling and after
authenticate.")
(:method ((ep t)) t))
(defgeneric handle (endpoint)
(:documentation "The beef of the endpoint handling protocol.
_(__)_ V
'-e e -'__,--.__)
(o_o) )
\. /___. |
||| _)/_)/
//_(/_(/_(
By the time this has been called, both AUTHENTICATE and AUTHORIZE have
been called. This method can be defined with the assumption that any
work done by AUTHORIZE and AUTHENTICATE has been accomplished
successfully.
This method should return data to be sent back to the client and
MUST be implemented for every endpoint class.")
(:method :before ((endpoint t))
;; The default before method checks that the endpoint is
;; authenticated, authorized, default, each of these is T.
(unless (authenticate endpoint)
(protocol-error 'cannot-authenticate endpoint))
(unless (authorize endpoint)
(protocol-error 'not-authorized endpoint))))
;;; HANDLER TOOLS
(defun not-found (ep)
"Signals a NOT-FOUND condition. Usually called within HANDLE or
AUTHORIZE while handling endpoint-class instance EP."
(protocol-error 'not-found ep))
(defun redirect (url)
"Redirect to URL."
(http:redirect url :code http:+http-see-other+))
(defun endpoint-redirect (class &rest kwargs)
"Redirect to another endpoint. CLASS can be either a symbol or a
class. KWARGS is a PLIST of keyword arguments supplied to the
CLASS' route builder function."
(redirect (apply #'route-to class kwargs)))
(defun get-cookie (name)
"Returns the cookie with name NAME the actively"
(http:cookie-in name))
|
