[plt-scheme] Limiting Concurrent Connections to Web Server
Here is a concrete example. First the server code:
----
#lang scheme
(require setup/dirs
web-server/web-server
web-server/http
web-server/http/response
web-server/dispatchers/dispatch
(prefix-in filter: web-server/dispatchers/dispatch-filter)
(prefix-in sequencer: web-server/dispatchers/dispatch-sequencer))
(define (make-limit-dispatcher num inner)
(let ([sem (make-semaphore num)])
(lambda (conn req)
(printf "Enter limit~n")
(call-with-semaphore
sem
(lambda () (inner conn req)))
(printf "Exit limit~n"))))
(serve #:dispatch
(sequencer:make
(filter:make
#rx"/limited"
(make-limit-dispatcher
5
(lambda (conn req)
(output-response/method
conn
(make-response/full
200 "Okay"
(current-seconds) TEXT/HTML-MIME-TYPE
empty
(list (format "hello world ~a"
(sort (build-list 100000 (λ x (random 1000)))
<))))
(request-method req)))))
(lambda (conn req)
(output-response/method
conn
(make-response/full 200 "Okay"
(current-seconds) TEXT/HTML-MIME-TYPE
empty
(list "<html><body>Unlimited</body></html>"))
(request-method req))))
#:port 8080)
(do-not-return)
----
Using the following httperf command (the timeout seems to have the
same effect as hitting refresh a second time in firefox):
httperf --port 8080 --uri=/limited --timeout=0.1 --connections
The web server output is:
henk at korhal ~/test $ mzscheme server.ss
#<procedure:...server/web-server.ss:22:7>
Enter limit
Enter limit
Enter limit
Enter limit
Enter limit
See that the semaphore is never released. After this, no further
requests get served. Could this be due to the same thing that I hit
here?
http://list.cs.brown.edu/pipermail/plt-scheme/2008-July/026121.html
Henk