Skip to content
Newer
Older
100644 425 lines (377 sloc) 19.5 KB
a07b44b @hanshuebner make hunchentoot and usocket internal
hanshuebner authored
1 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10 -*-
2
c14db47 Copyright
Edi Weitz authored
3 ;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. All rights reserved.
a07b44b @hanshuebner make hunchentoot and usocket internal
hanshuebner authored
4
5 ;;; Redistribution and use in source and binary forms, with or without
6 ;;; modification, are permitted provided that the following conditions
7 ;;; are met:
8
9 ;;; * Redistributions of source code must retain the above copyright
10 ;;; notice, this list of conditions and the following disclaimer.
11
12 ;;; * Redistributions in binary form must reproduce the above
13 ;;; copyright notice, this list of conditions and the following
14 ;;; disclaimer in the documentation and/or other materials
15 ;;; provided with the distribution.
16
17 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
18 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
19 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
20 ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
21 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
22 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
23 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
24 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
25 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
26 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
27 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
28
29 (in-package :hunchentoot)
30
0d0e08f Rename
Edi Weitz authored
31 (defclass taskmaster ()
32 ((acceptor :accessor taskmaster-acceptor
a9bd9a1 More documentation
Edi Weitz authored
33 :documentation "A backpointer to the acceptor instance
34 this taskmaster works for."))
35 (:documentation "An instance of this class is responsible for
b07bbcf More changes
Edi Weitz authored
36 distributing the work of handling requests for its acceptor. This is
37 an \"abstract\" class in the sense that usually only instances of
38 subclasses of TASKMASTER will be used."))
a07b44b @hanshuebner make hunchentoot and usocket internal
hanshuebner authored
39
0d0e08f Rename
Edi Weitz authored
40 (defgeneric execute-acceptor (taskmaster)
a9bd9a1 More documentation
Edi Weitz authored
41 (:documentation "This is a callback called by the acceptor once it
42 has performed all initial processing to start listening for incoming
43 connections \(see START-LISTENING). It usually calls the
44 ACCEPT-CONNECTIONS method of the acceptor, but depending on the
45 taskmaster instance the method might be called from a new thread."))
a07b44b @hanshuebner make hunchentoot and usocket internal
hanshuebner authored
46
0d0e08f Rename
Edi Weitz authored
47 (defgeneric handle-incoming-connection (taskmaster socket)
b07bbcf More changes
Edi Weitz authored
48 (:documentation "This function is called by the acceptor to start
49 processing of requests on a new incoming connection. SOCKET is the
50 usocket instance that represents the new connection \(or a socket
51 handle on LispWorks). The taskmaster starts processing requests on
52 the incoming connection by calling the PROCESS-CONNECTION method of
53 the acceptor instance. The SOCKET argument is passed to
54 PROCESS-CONNECTION as an argument."))
a07b44b @hanshuebner make hunchentoot and usocket internal
hanshuebner authored
55
0d0e08f Rename
Edi Weitz authored
56 (defgeneric shutdown (taskmaster)
a9bd9a1 More documentation
Edi Weitz authored
57 (:documentation "Shuts down the taskmaster, i.e. frees all resources
58 that were set up by it. For example, a multi-threaded taskmaster
b07bbcf More changes
Edi Weitz authored
59 might terminate all threads that are currently associated with it.
60 This function is called by the acceptor's STOP method."))
a07b44b @hanshuebner make hunchentoot and usocket internal
hanshuebner authored
61
be332b7 @hanshuebner Patch from Dan Weinreb:
hanshuebner authored
62 (defgeneric create-request-handler-thread (taskmaster socket)
63 (:documentation
64 "Create a new thread in which to process the request.
65 This thread will call PROCESS-CONNECTION to process the request."))
66
67 (defgeneric too-many-taskmaster-requests (taskmaster socket)
68 (:documentation
69 "Signal a \"too many requests\" error, just prior to closing the connection."))
70
71 (defgeneric taskmaster-max-thread-count (taskmaster)
72 (:documentation
73 "The maximum number of request threads this taskmaster will simultaneously
74 run before refusing or queueing new connections requests. If the value
75 is null, then there is no limit.")
76 (:method ((taskmaster taskmaster))
77 "Default method -- no limit on the number of threads."
78 nil))
79
80 (defgeneric taskmaster-max-accept-count (taskmaster)
81 (:documentation
82 "The maximum number of connections this taskmaster will accept before refusing
83 new connections. If supplied, this must be greater than MAX-THREAD-COUNT.
84 The number of queued requests is the difference between MAX-ACCEPT-COUNT
85 and MAX-THREAD-COUNT.")
86 (:method ((taskmaster taskmaster))
87 "Default method -- no limit on the number of connections."
88 nil))
89
90 (defgeneric taskmaster-request-count (taskmaster)
91 (:documentation
92 "Returns the current number of taskmaster requests.")
93 (:method ((taskmaster taskmaster))
94 "Default method -- claim there is one connection thread."
95 1))
96
97 (defgeneric increment-taskmaster-request-count (taskmaster)
98 (:documentation
99 "Atomically increment the number of taskmaster requests.")
100 (:method ((taskmaster taskmaster))
101 "Default method -- do nothing."
102 nil))
103
104 (defgeneric decrement-taskmaster-request-count (taskmaster)
105 (:documentation
106 "Atomically decrement the number of taskmaster requests")
107 (:method ((taskmaster taskmaster))
108 "Default method -- do nothing."
109 nil))
110
111
0d0e08f Rename
Edi Weitz authored
112 (defclass single-threaded-taskmaster (taskmaster)
a07b44b @hanshuebner make hunchentoot and usocket internal
hanshuebner authored
113 ()
a9bd9a1 More documentation
Edi Weitz authored
114 (:documentation "A taskmaster that runs synchronously in the thread
115 where the START function was invoked \(or in the case of LispWorks in
116 the thread started by COMM:START-UP-SERVER). This is the simplest
117 possible taskmaster implementation in that its methods do nothing but
118 calling their acceptor \"sister\" methods - EXECUTE-ACCEPTOR calls
119 ACCEPT-CONNECTIONS, HANDLE-INCOMING-CONNECTION calls
120 PROCESS-CONNECTION."))
a07b44b @hanshuebner make hunchentoot and usocket internal
hanshuebner authored
121
0d0e08f Rename
Edi Weitz authored
122 (defmethod execute-acceptor ((taskmaster single-threaded-taskmaster))
a9bd9a1 More documentation
Edi Weitz authored
123 ;; in a single-threaded environment we just call ACCEPT-CONNECTIONS
0d0e08f Rename
Edi Weitz authored
124 (accept-connections (taskmaster-acceptor taskmaster)))
a07b44b @hanshuebner make hunchentoot and usocket internal
hanshuebner authored
125
0d0e08f Rename
Edi Weitz authored
126 (defmethod handle-incoming-connection ((taskmaster single-threaded-taskmaster) socket)
a9bd9a1 More documentation
Edi Weitz authored
127 ;; in a single-threaded environment we just call PROCESS-CONNECTION
0d0e08f Rename
Edi Weitz authored
128 (process-connection (taskmaster-acceptor taskmaster) socket))
a07b44b @hanshuebner make hunchentoot and usocket internal
hanshuebner authored
129
be332b7 @hanshuebner Patch from Dan Weinreb:
hanshuebner authored
130 (defvar *default-max-thread-count* 100)
131 (defvar *default-max-accept-count* (+ *default-max-thread-count* 20))
132
133 ;; You might think it would be nice to provide a taskmaster that takes
134 ;; threads out of a thread pool. There are two things to consider:
135 ;; - On a 2010-ish Linux box, thread creation takes less than 250 microseconds.
136 ;; - Bordeaux Threads doesn't provide a way to "reset" and restart a thread,
137 ;; and it's not clear how many Lisp implementations can do this.
138 ;; So for now, we leave this out of the mix.
ba8bc7e Some fixes
Edi Weitz authored
139 (defclass one-thread-per-connection-taskmaster (taskmaster)
a9bd9a1 More documentation
Edi Weitz authored
140 (#-:lispworks
be332b7 @hanshuebner Patch from Dan Weinreb:
hanshuebner authored
141 (acceptor-process
142 :accessor acceptor-process
143 :documentation
144 "A process that accepts incoming connections and hands them off to new processes
145 for request handling.")
146 ;; Support for bounding the number of threads we'll create
147 (max-thread-count
148 :type (or integer null)
149 :initarg :max-thread-count
150 :initform nil
151 :accessor taskmaster-max-thread-count
152 :documentation
153 "The maximum number of request threads this taskmaster will simultaneously
154 run before refusing or queueing new connections requests. If the value
155 is null, then there is no limit.")
156 (max-accept-count
157 :type (or integer null)
158 :initarg :max-accept-count
159 :initform nil
160 :accessor taskmaster-max-accept-count
161 :documentation
162 "The maximum number of connections this taskmaster will accept before refusing
163 new connections. If supplied, this must be greater than MAX-THREAD-COUNT.
164 The number of queued requests is the difference between MAX-ACCEPT-COUNT
165 and MAX-THREAD-COUNT.")
166 (request-count
167 :type integer
168 :initform 0
169 :accessor taskmaster-request-count
170 :documentation
171 "The number of taskmaster threads currently running.")
172 (request-count-lock
173 :initform (make-lock "taskmaster-request-count")
174 :reader taskmaster-request-count-lock
175 :documentation
176 "In the absence of 'atomic-incf', we need this to atomically
177 increment and decrement the request count.")
178 (wait-queue
179 :initform (make-condition-variable)
180 :reader taskmaster-wait-queue
181 :documentation
182 "A queue that we use to wait for a free connection.")
183 (wait-lock
184 :initform (make-lock "taskmaster-thread-lock")
185 :reader taskmaster-wait-lock
186 :documentation
187 "The lock for the connection wait queue.")
188 (worker-thread-name-format
189 :type (or string null)
190 :initarg :worker-thread-name-format
191 :initform "hunchentoot-worker-~A"
192 :accessor taskmaster-worker-thread-name-format))
193 (:default-initargs
194 :max-thread-count *default-max-thread-count*
195 :max-accept-count *default-max-accept-count*)
a9bd9a1 More documentation
Edi Weitz authored
196 (:documentation "A taskmaster that starts one thread for listening
be332b7 @hanshuebner Patch from Dan Weinreb:
hanshuebner authored
197 to incoming requests and one new thread for each incoming connection.
198
199 If MAX-THREAD-COUNT is null, a new thread will always be created for
200 each request.
201
202 If MAX-THREAD-COUNT is supplied, the number of request threads is
203 limited to that. Furthermore, if MAX-ACCEPT-COUNT is not supplied, an
204 HTTP 503 will be sent if the thread limit is exceeded. Otherwise, if
205 MAX-ACCEPT-COUNT is supplied, it must be greater than MAX-THREAD-COUNT;
206 in this case, requests are accepted up to MAX-ACCEPT-COUNT, and only
207 then is HTTP 503 sent.
208
209 In a load-balanced environment with multiple Hunchentoot servers, it's
210 reasonable to provide MAX-THREAD-COUNT but leave MAX-ACCEPT-COUNT null.
211 This will immediately result in HTTP 503 when one server is out of
212 resources, so the load balancer can try to find another server.
213
214 In an environment with a single Hunchentoot server, it's reasonable
215 to provide both MAX-THREAD-COUNT and a somewhat larger value for
216 MAX-ACCEPT-COUNT. This will cause a server that's almost out of
217 resources to wait a bit; if the server is completely out of resources,
218 then the reply will be HTTP 503.
b07bbcf More changes
Edi Weitz authored
219
220 This is the default taskmaster implementation for multi-threaded Lisp
221 implementations."))
a07b44b @hanshuebner make hunchentoot and usocket internal
hanshuebner authored
222
be332b7 @hanshuebner Patch from Dan Weinreb:
hanshuebner authored
223 (defmethod initialize-instance :after ((taskmaster one-thread-per-connection-taskmaster) &rest init-args)
224 "Ensure the if MAX-ACCEPT-COUNT is supplied, that it is greater than MAX-THREAD-COUNT."
225 (declare (ignore init-args))
226 (when (taskmaster-max-accept-count taskmaster)
227 (unless (taskmaster-max-thread-count taskmaster)
228 (parameter-error "MAX-THREAD-COUNT must be supplied if MAX-ACCEPT-COUNT is supplied"))
229 (unless (> (taskmaster-max-accept-count taskmaster) (taskmaster-max-thread-count taskmaster))
230 (parameter-error "MAX-ACCEPT-COUNT must be greater than MAX-THREAD-COUNT"))))
231
232 (defmethod increment-taskmaster-request-count ((taskmaster one-thread-per-connection-taskmaster))
233 (when (taskmaster-max-thread-count taskmaster)
234 (with-lock-held ((taskmaster-request-count-lock taskmaster))
235 (incf (taskmaster-request-count taskmaster)))))
236
237 (defmethod decrement-taskmaster-request-count ((taskmaster one-thread-per-connection-taskmaster))
238 (when (taskmaster-max-thread-count taskmaster)
239 (prog1
240 (with-lock-held ((taskmaster-request-count-lock taskmaster))
241 (decf (taskmaster-request-count taskmaster)))
242 (when (and (taskmaster-max-accept-count taskmaster)
243 (< (taskmaster-request-count taskmaster) (taskmaster-max-accept-count taskmaster)))
244 (note-free-connection taskmaster)))))
245
246 (defmethod note-free-connection ((taskmaster one-thread-per-connection-taskmaster))
247 "Note that a connection has been freed up"
248 (with-lock-held ((taskmaster-wait-lock taskmaster))
249 (condition-variable-signal (taskmaster-wait-queue taskmaster))))
250
251 (defmethod wait-for-free-connection ((taskmaster one-thread-per-connection-taskmaster))
252 "Wait for a connection to be freed up"
253 (with-lock-held ((taskmaster-wait-lock taskmaster))
254 (loop until (< (taskmaster-request-count taskmaster) (taskmaster-max-thread-count taskmaster))
255 do (condition-variable-wait (taskmaster-wait-queue taskmaster) (taskmaster-wait-lock taskmaster)))))
256
257 (defmethod too-many-taskmaster-requests ((taskmaster one-thread-per-connection-taskmaster) socket)
258 (declare (ignore socket))
259 (acceptor-log-message (taskmaster-acceptor taskmaster)
260 :warning "Can't handle a new request, too many request threads already"))
261
262 ;;; usocket implementation
faa032e Checkpoint
Edi Weitz authored
263
264 #-:lispworks
b07bbcf More changes
Edi Weitz authored
265 (defmethod shutdown ((taskmaster taskmaster))
266 taskmaster)
faa032e Checkpoint
Edi Weitz authored
267
268 #-:lispworks
ba8bc7e Some fixes
Edi Weitz authored
269 (defmethod shutdown ((taskmaster one-thread-per-connection-taskmaster))
faa032e Checkpoint
Edi Weitz authored
270 ;; just wait until the acceptor process has finished, then return
271 (loop
0d0e08f Rename
Edi Weitz authored
272 (unless (bt:thread-alive-p (acceptor-process taskmaster))
faa032e Checkpoint
Edi Weitz authored
273 (return))
b07bbcf More changes
Edi Weitz authored
274 (sleep 1))
275 taskmaster)
faa032e Checkpoint
Edi Weitz authored
276
277 #-:lispworks
ba8bc7e Some fixes
Edi Weitz authored
278 (defmethod execute-acceptor ((taskmaster one-thread-per-connection-taskmaster))
0d0e08f Rename
Edi Weitz authored
279 (setf (acceptor-process taskmaster)
be332b7 @hanshuebner Patch from Dan Weinreb:
hanshuebner authored
280 (bt:make-thread
281 (lambda ()
282 (accept-connections (taskmaster-acceptor taskmaster)))
283 :name (format nil "hunchentoot-listener-~A:~A"
284 (or (acceptor-address (taskmaster-acceptor taskmaster)) "*")
285 (acceptor-port (taskmaster-acceptor taskmaster))))))
286
287 #-:lispworks
288 (defmethod handle-incoming-connection ((taskmaster one-thread-per-connection-taskmaster) socket)
289 ;; Here's the idea, with the stipulations given in ONE-THREAD-PER-CONNECTION-TASKMASTER
290 ;; - If MAX-THREAD-COUNT is null, just start a taskmaster
291 ;; - If the connection count will exceed MAX-ACCEPT-COUNT or if MAX-ACCEPT-COUNT
292 ;; is null and the connection count will exceed MAX-THREAD-COUNT,
293 ;; return an HTTP 503 error to the client
294 ;; - Otherwise if we're between MAX-THREAD-COUNT and MAX-ACCEPT-COUNT,
295 ;; wait until the connection count drops, then handle the request
296 ;; - Otherwise, increment REQUEST-COUNT and start a taskmaster
297 (cond ((null (taskmaster-max-thread-count taskmaster))
298 ;; No limit on number of requests, just start a taskmaster
299 (create-request-handler-thread taskmaster socket))
300 ((if (taskmaster-max-accept-count taskmaster)
301 (>= (taskmaster-request-count taskmaster) (taskmaster-max-accept-count taskmaster))
302 (>= (taskmaster-request-count taskmaster) (taskmaster-max-thread-count taskmaster)))
303 ;; Send HTTP 503 to indicate that we can't handle the request right now
304 (too-many-taskmaster-requests taskmaster socket)
305 (send-service-unavailable-reply taskmaster socket))
306 ((and (taskmaster-max-accept-count taskmaster)
307 (>= (taskmaster-request-count taskmaster) (taskmaster-max-thread-count taskmaster)))
308 ;; Wait for a request to finish, then carry on
309 (wait-for-free-connection taskmaster)
310 (increment-taskmaster-request-count taskmaster)
311 (create-request-handler-thread taskmaster socket))
312 (t
313 ;; We're within both limits, just start a taskmaster
314 (increment-taskmaster-request-count taskmaster)
315 (create-request-handler-thread taskmaster socket))))
316
317 (defun send-service-unavailable-reply (taskmaster socket)
318 "A helper function to send out a quick error reply, before any state
319 is set up via PROCESS-REQUEST."
e096aa7 @fare Quick fix to allow send-service-unavailable-reply to work at all,
fare authored
320 (let* ((acceptor (taskmaster-acceptor taskmaster))
321 (*acceptor* acceptor)
322 (*hunchentoot-stream*
323 (initialize-connection-stream acceptor (make-socket-stream socket acceptor)))
324 (*reply* (make-instance (acceptor-reply-class acceptor)))
325 (*request*
326 (multiple-value-bind (remote-addr remote-port)
327 (get-peer-address-and-port socket)
328 (make-instance (acceptor-request-class acceptor)
329 :acceptor acceptor
330 :remote-addr remote-addr
331 :remote-port remote-port
332 :headers-in nil
333 :content-stream nil
334 :method nil
335 :uri nil
336 :server-protocol nil))))
337 (with-character-stream-semantics
338 (send-response acceptor
339 (flex:make-flexi-stream *hunchentoot-stream* :external-format :iso-8859-1)
340 +http-service-unavailable+
341 :content (acceptor-status-message acceptor +http-service-unavailable+)))))
ca35a3b @hanshuebner Split up setting up the socket to listen for connections and accepting
hanshuebner authored
342
343 #-:lispworks
faa032e Checkpoint
Edi Weitz authored
344 (defun client-as-string (socket)
5d41d2e More documentation
Edi Weitz authored
345 "A helper function which returns the client's address and port as a
be332b7 @hanshuebner Patch from Dan Weinreb:
hanshuebner authored
346 string and tries to act robustly in the presence of network problems."
faa032e Checkpoint
Edi Weitz authored
347 (let ((address (usocket:get-peer-address socket))
348 (port (usocket:get-peer-port socket)))
349 (when (and address port)
350 (format nil "~A:~A"
351 (usocket:vector-quad-to-dotted-quad address)
352 port))))
353
354 #-:lispworks
be332b7 @hanshuebner Patch from Dan Weinreb:
hanshuebner authored
355 (defmethod create-request-handler-thread ((taskmaster one-thread-per-connection-taskmaster) socket)
356 "Create a thread for handling a single request"
f3b41e5 Resurrect *catch-errors-p* and more
Edi Weitz authored
357 ;; we are handling all conditions here as we want to make sure that
dbea086 @hanshuebner Move the HANDLER-CASE to the right place in the code, ugh.
hanshuebner authored
358 ;; the acceptor process never crashes while trying to create a
f3b41e5 Resurrect *catch-errors-p* and more
Edi Weitz authored
359 ;; worker thread; one such problem exists in
dbea086 @hanshuebner Move the HANDLER-CASE to the right place in the code, ugh.
hanshuebner authored
360 ;; GET-PEER-ADDRESS-AND-PORT which can signal socket conditions on
361 ;; some platforms in certain situations.
f3b41e5 Resurrect *catch-errors-p* and more
Edi Weitz authored
362 (handler-case*
be332b7 @hanshuebner Patch from Dan Weinreb:
hanshuebner authored
363 (bt:make-thread
364 (lambda ()
365 (unwind-protect
366 (process-connection (taskmaster-acceptor taskmaster) socket)
367 (decrement-taskmaster-request-count taskmaster)))
368 :name (format nil (taskmaster-worker-thread-name-format taskmaster) (client-as-string socket)))
369 (error (cond)
370 ;; need to bind *ACCEPTOR* so that LOG-MESSAGE* can do its work.
371 (let ((*acceptor* (taskmaster-acceptor taskmaster)))
372 (log-message* *lisp-errors-log-level*
373 "Error while creating worker thread for new incoming connection: ~A" cond)))))
59b2aff Revert changes because they break LispWorks implementation
Edi Weitz authored
374
375 ;; LispWorks implementation
faa032e Checkpoint
Edi Weitz authored
376
377 #+:lispworks
0d0e08f Rename
Edi Weitz authored
378 (defmethod shutdown ((taskmaster taskmaster))
379 (when-let (process (acceptor-process (taskmaster-acceptor taskmaster)))
faa032e Checkpoint
Edi Weitz authored
380 ;; kill the main acceptor process, see LW documentation for
381 ;; COMM:START-UP-SERVER
b07bbcf More changes
Edi Weitz authored
382 (mp:process-kill process))
383 taskmaster)
faa032e Checkpoint
Edi Weitz authored
384
385 #+:lispworks
ba8bc7e Some fixes
Edi Weitz authored
386 (defmethod execute-acceptor ((taskmaster one-thread-per-connection-taskmaster))
0d0e08f Rename
Edi Weitz authored
387 (accept-connections (taskmaster-acceptor taskmaster)))
da587fe Random checkpoint
Edi Weitz authored
388
389 #+:lispworks
be332b7 @hanshuebner Patch from Dan Weinreb:
hanshuebner authored
390 (defmethod handle-incoming-connection ((taskmaster one-thread-per-connection-taskmaster) socket)
da587fe Random checkpoint
Edi Weitz authored
391 (incf *worker-counter*)
392 ;; check if we need to perform a global GC
393 (when (and *cleanup-interval*
394 (zerop (mod *worker-counter* *cleanup-interval*)))
395 (when *cleanup-function*
396 (funcall *cleanup-function*)))
be332b7 @hanshuebner Patch from Dan Weinreb:
hanshuebner authored
397 (cond ((null (taskmaster-max-thread-count taskmaster))
398 ;; No limit on number of requests, just start a taskmaster
399 (create-request-handler-thread taskmaster socket))
400 ((if (taskmaster-max-accept-count taskmaster)
401 (>= (taskmaster-request-count taskmaster) (taskmaster-max-accept-count taskmaster))
402 (>= (taskmaster-request-count taskmaster) (taskmaster-max-thread-count taskmaster)))
403 ;; Send HTTP 503 to indicate that we can't handle the request right now
404 (too-many-taskmaster-requests taskmaster socket)
405 (send-service-unavailable-reply taskmaster socket))
406 ((and (taskmaster-max-accept-count taskmaster)
407 (>= (taskmaster-request-count taskmaster) (taskmaster-max-thread-count taskmaster)))
408 ;; Lispworks doesn't have condition variables, so punt
409 (too-many-taskmaster-requests taskmaster socket)
410 (send-service-unavailable-reply taskmaster socket))
411 (t
412 ;; We're within both limits, just start a taskmaster
413 (increment-taskmaster-request-count taskmaster)
414 (create-request-handler-thread taskmaster socket))))
415
416 #+:lispworks
417 (defmethod create-request-handler-thread ((taskmaster one-thread-per-connection-taskmaster) socket)
3464fe2 @nicodejager Fix LispWorks create-request-handler-thread warning.
nicodejager authored
418 (mp:process-run-function (format nil "hunchentoot-worker~{-~A:~A~})"
419 (multiple-value-list (get-peer-address-and-port socket)))
420 nil
421 (lambda ()
422 (unwind-protect
423 (process-connection (taskmaster-acceptor taskmaster) socket)
424 (decrement-taskmaster-request-count taskmaster)))))
Something went wrong with that request. Please try again.