[plt-scheme] Limiting Concurrent Connections to Web Server

From: Henk Boom (lunarc.lists at gmail.com)
Date: Wed Jan 7 22:07:19 EST 2009

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

Posted on the users mailing list.