test: add graceful-shutdown e2e test

Also, rework e2e tests to use ephemeral ports.

Author: Bogdanp

web-server-test/tests/web-server/e2e/README.md

@@ -4,9 +4,10 @@ These tests spin up real web servers in order to ensure that the
 system works end-to-end.  Each subfolder is expected to contain two
 files: `server.rkt` and `tests.rkt`.
 
-Each `server.rkt` module must provide a function called `start` that
-takes a port, starts a web server on that port and returns a function
-that can be used to stop the server.
+Each `server.rkt` module must provide a function called `start` starts a
+web server on an open port and returns a procedure that can be used to
+stop the server and the port the server is listening on.
 
 Each `tests.rkt` module must provide a function called `make-tests`
-that takes a port and returns a rackunit `test-suite`.
+that takes a port and a procedure that stops the server when called and
+returns a rackunit `test-suite`.

web-server-test/tests/web-server/e2e/all-e2e-tests.rkt

@@ -1,54 +1,39 @@
 #lang racket/base
 
 (require racket/path
-         racket/tcp
          rackunit)
 
 (provide all-e2e-tests)
 
-(define here
-  (simplify-path
-   (build-path (syntax-source #'here) 'up)))
-
-(define (wait-for-local-port port)
-  (let loop ([attempts 1])
-    (sync (system-idle-evt))
-    (with-handlers ([exn:fail?
-                     (lambda (e)
-                       (if (> attempts 99)
-                           (raise e)
-                           (loop (add1 attempts))))])
-      (define-values (in out)
-        (tcp-connect "127.0.0.1" port))
-      (close-output-port out)
-      (close-input-port in))))
+(define here (path-only (syntax-source #'here)))
 
 (define all-e2e-tests
   (make-test-suite
    "e2e"
 
    (for/list ([test-path (in-list (directory-list here))]
-              [port (in-naturals 9111)]
               #:when (directory-exists? test-path)
               #:unless (equal? #"compiled" (path->bytes test-path)))
      (define server-mod-path (build-path test-path "server.rkt"))
      (define tests-mod-path (build-path test-path "tests.rkt"))
-     (define stopper #f)
+     (define stop-box (box void))
+     (define port-box (box #f))
      (make-test-suite
       (path->string (file-name-from-path test-path))
       #:before
-      (lambda _
-        (define start
-          (dynamic-require server-mod-path 'start))
-
-        (set! stopper (start port))
-        (wait-for-local-port port))
+      (lambda ()
+        (define start (dynamic-require server-mod-path 'start))
+        (let-values ([(stop port) (start)])
+          (set-box! stop-box stop)
+          (set-box! port-box port)))
       #:after
-      (lambda _
-        (stopper))
-
+      (lambda ()
+        ((unbox stop-box)))
       (let ([make-tests (dynamic-require tests-mod-path 'make-tests)])
-        (list (make-tests port)))))))
+        (list
+         (make-tests
+          (λ () (unbox port-box))
+          (λ () (unbox stop-box)))))))))
 
 (module+ test
   (require rackunit/text-ui)

web-server-test/tests/web-server/e2e/echo/server.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 
-(require web-server/servlet
+(require racket/async-channel
+         web-server/servlet
          web-server/servlet-dispatch
          web-server/web-server)
 
@@ -15,7 +16,16 @@
    (lambda (out)
      (display msg out))))
 
-(define (start port)
-  (serve
-   #:port port
-   #:dispatch (dispatch/servlet echo)))
+(define (start)
+  (define confirmation-ch
+    (make-async-channel))
+  (define stop
+    (serve
+     #:port 0
+     #:dispatch (dispatch/servlet echo)
+     #:confirmation-channel confirmation-ch))
+  (define port-or-exn
+    (sync confirmation-ch))
+  (when (exn:fail? port-or-exn)
+    (raise port-or-exn))
+  (values stop port-or-exn))

web-server-test/tests/web-server/e2e/echo/tests.rkt

@@ -9,9 +9,9 @@
 (define get-response
   (compose1 port->string get-pure-port string->url))
 
-(define (make-tests port)
+(define (make-tests get-port _get-stop)
   (define (make-uri [path "/"])
-    (format "http://127.0.0.1:~a/~a" port path))
+    (format "http://127.0.0.1:~a/~a" (get-port) path))
 
   (test-suite
    "echo"

web-server-test/tests/web-server/e2e/file-upload/server.rkt

@@ -1,10 +1,11 @@
 #lang racket/base
 
 (require openssl/sha1
+         racket/async-channel
          racket/port
+         web-server/safety-limits
          web-server/servlet
          web-server/servlet-dispatch
-         web-server/safety-limits
          web-server/web-server)
 
 (provide start)
@@ -18,15 +19,24 @@
      (for ([h (in-list hashes)])
        (displayln h out)))))
 
-(define (start port)
+(define (start)
   ;; We're testing file limits and those end up raising exceptions in
   ;; the request-handling threads which get reported to stderr so we
   ;; need to drop those messages in order for drdr not to fail.
   (parameterize ([current-error-port (open-output-nowhere)])
-    (serve
-     #:port port
-     #:dispatch (dispatch/servlet file-upload)
-     #:safety-limits (make-safety-limits
-                      #:max-form-data-files 2
-                      #:max-form-data-file-length 500
-                      #:form-data-file-memory-threshold 250))))
+    (define confirmation-ch
+      (make-async-channel))
+    (define stop
+      (serve
+       #:port 0
+       #:dispatch (dispatch/servlet file-upload)
+       #:confirmation-channel confirmation-ch
+       #:safety-limits (make-safety-limits
+                        #:max-form-data-files 2
+                        #:max-form-data-file-length 500
+                        #:form-data-file-memory-threshold 250)))
+    (define port-or-exn
+      (sync confirmation-ch))
+    (when (exn:fail? port-or-exn)
+      (raise port-or-exn))
+    (values stop port-or-exn)))

web-server-test/tests/web-server/e2e/file-upload/tests.rkt

@@ -1,20 +1,18 @@
 #lang racket/base
 
-(require net/url
-         openssl/sha1
-         racket/list
+(require openssl/sha1
          racket/port
+         racket/random
          racket/string
          racket/tcp
-         racket/random
          rackunit)
 
 (provide make-tests)
 
-(define (make-tests port)
+(define (make-tests get-port _get-stop)
   (define (upload-files . ins)
     (define-values (in out)
-      (tcp-connect "127.0.0.1" port))
+      (tcp-connect "127.0.0.1" (get-port)))
 
     (define boundary
       (sha1-bytes (open-input-bytes (crypto-random-bytes 32))))

web-server-test/tests/web-server/e2e/graceful-shutdown/server.rkt

@@ -0,0 +1,35 @@
+#lang racket/base
+
+(require racket/async-channel
+         web-server/safety-limits
+         web-server/servlet
+         web-server/servlet-dispatch
+         web-server/web-server)
+
+(provide start)
+
+(define (app _req)
+  (response/output
+   (lambda (out)
+     (for ([idx (in-range 5)])
+       (displayln idx out)
+       (sleep 1)))))
+
+(define (start)
+  (define confirmation-ch
+    (make-async-channel))
+  (define stop
+    (serve
+     #:port 0
+     #:dispatch (dispatch/servlet app)
+     #:confirmation-channel confirmation-ch
+     #:safety-limits
+     (make-safety-limits
+      #:max-concurrent 1
+      #:max-waiting 10
+      #:shutdown-grace-period 6)))
+  (define port-or-exn
+    (sync confirmation-ch))
+  (when (exn:fail? port-or-exn)
+    (raise port-or-exn))
+  (values stop port-or-exn))

web-server-test/tests/web-server/e2e/graceful-shutdown/tests.rkt

@@ -0,0 +1,19 @@
+#lang racket/base
+
+(require net/http-client
+         racket/port
+         rackunit)
+
+(provide make-tests)
+
+(define (make-tests get-port get-stop)
+  (test-suite
+   "graceful-shutdown"
+
+   (test-case "waits for in-progress connections on stop"
+     (define hc (http-conn-open "127.0.0.1" #:port (get-port)))
+     (define-values (status _headers in)
+       (http-conn-sendrecv! hc "/"))
+     ((get-stop))
+     (check-equal? status #"HTTP/1.1 200 OK")
+     (check-equal? (port->bytes in) #"0\n1\n2\n3\n4\n"))))

web-server-test/tests/web-server/e2e/head/server.rkt

@@ -1,17 +1,27 @@
 #lang racket/base
 
-(require web-server/servlet
+(require racket/async-channel
+         web-server/servlet
          web-server/servlet-dispatch
          web-server/web-server)
 
 (provide start)
 
-(define (start port)
-  (serve
-   #:port port
-   #:dispatch (dispatch/servlet
-               (lambda (_req)
-                 (response/output
-                  #:headers (list (make-header #"X-Example" #"Found"))
-                  (lambda (out)
-                    (displayln "hello" out)))))))
+(define (start)
+  (define confirmation-ch
+    (make-async-channel))
+  (define stop
+    (serve
+     #:port 0
+     #:dispatch (dispatch/servlet
+                 (lambda (_req)
+                   (response/output
+                    #:headers (list (make-header #"X-Example" #"Found"))
+                    (lambda (out)
+                      (displayln "hello" out)))))
+     #:confirmation-channel confirmation-ch))
+  (define port-or-exn
+    (sync confirmation-ch))
+  (when (exn:fail? port-or-exn)
+    (raise port-or-exn))
+  (values stop port-or-exn))

web-server-test/tests/web-server/e2e/head/tests.rkt

@@ -5,12 +5,12 @@
 
 (provide make-tests)
 
-(define (make-tests port)
+(define (make-tests get-port _get-stop)
   ;; net/url and net/http-client both ignore the body of HEAD requests
   ;; if present so we can't use them to test this.
   (define (request method path)
     (define-values (in out)
-      (tcp-connect "127.0.0.1" port))
+      (tcp-connect "127.0.0.1" (get-port)))
 
     (display (format "~a ~a HTTP/1.1\r\n" method path) out)
     (display "\r\n" out)