From a5ecc5c92e1ddd9f3a0adccbcfea10271ee9ecba Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Mon, 29 Aug 2016 07:56:41 -0400 Subject: [PATCH] Allow concurrent execution of these tests, thanks for the catch Sam --- pkgs/net-test/tests/net/http-client.rkt | 11 +++---- .../tests/net/http-proxy/echo-server.rkt | 10 +++---- .../tests/net/http-proxy/generic-server.rkt | 30 ++++++++----------- .../tests/net/http-proxy/https-non-server.rkt | 3 +- .../tests/net/http-proxy/proxy-server.rkt | 21 +++++++------ pkgs/net-test/tests/net/url.rkt | 20 +++++++------ 6 files changed, 46 insertions(+), 49 deletions(-) diff --git a/pkgs/net-test/tests/net/http-client.rkt b/pkgs/net-test/tests/net/http-client.rkt index ae52e90264..770914dec6 100644 --- a/pkgs/net-test/tests/net/http-client.rkt +++ b/pkgs/net-test/tests/net/http-client.rkt @@ -301,15 +301,16 @@ (require (prefix-in es: "http-proxy/echo-server.rkt") (prefix-in ps: "http-proxy/proxy-server.rkt")) - (define-values (es:server-thread es:shutdown-server) - (parameterize ([es:current-listen-port 12345]) (es:server))) + (define-values (es:port es:server-thread es:shutdown-server) + (es:server)) - (define-values (ps:server-thread ps:shutdown-server) - (parameterize ([ps:current-listen-port 12380]) (ps:server))) + (define-values (ps:port ps:server-thread ps:shutdown-server) + (ps:server)) (check-equal? (let-values (([ssl-ctx from to abandon-p] - (hc:http-conn-CONNECT-tunnel "localhost" 12380 "localhost" 12345 #:ssl? #f))) + (hc:http-conn-CONNECT-tunnel "localhost" ps:port + "localhost" es:port #:ssl? #f))) (fprintf to "MONKEYS\n") (abandon-p to) (begin0 diff --git a/pkgs/net-test/tests/net/http-proxy/echo-server.rkt b/pkgs/net-test/tests/net/http-proxy/echo-server.rkt index 7fef5a9739..327317db4b 100644 --- a/pkgs/net-test/tests/net/http-proxy/echo-server.rkt +++ b/pkgs/net-test/tests/net/http-proxy/echo-server.rkt @@ -1,5 +1,5 @@ #lang racket/base -(provide server current-listen-port current-conn-timeout) +(provide server current-conn-timeout) (require racket/port "generic-server.rkt") @@ -10,7 +10,7 @@ (module+ main - (define-values (server-thread shutdown-server) (server)) + (define-values (the-port server-thread shutdown-server) (server)) (dynamic-wind void (λ () (thread-wait server-thread)) @@ -19,12 +19,12 @@ (module+ test (require rackunit racket/tcp) - (define-values (server-thread shutdown-server) (server)) + (define-values (the-port server-thread shutdown-server) (server)) (dynamic-wind void (λ () (define-values (cl:from cl:to) - (tcp-connect "localhost" (current-listen-port))) + (tcp-connect "localhost" the-port)) (file-stream-buffer-mode cl:to 'none) (file-stream-buffer-mode cl:from 'none) (fprintf cl:to "Monkeys!") @@ -32,4 +32,4 @@ (close-output-port cl:to) (check-equal? (read-string 1024 cl:from) "Monkeys!") (tcp-abandon-port cl:from)) - shutdown-server)) \ No newline at end of file + shutdown-server)) diff --git a/pkgs/net-test/tests/net/http-proxy/generic-server.rkt b/pkgs/net-test/tests/net/http-proxy/generic-server.rkt index cdc8879b11..a5577852dd 100644 --- a/pkgs/net-test/tests/net/http-proxy/generic-server.rkt +++ b/pkgs/net-test/tests/net/http-proxy/generic-server.rkt @@ -1,35 +1,31 @@ #lang racket/base (provide serve - current-listen-port current-conn-timeout) (require mzlib/thread racket/tcp) -(define current-listen-port (make-parameter 12345)) - (define current-conn-timeout (make-parameter #f)) (define (serve conn-proc) - ;; use of semaphore `s` allows us to wait until the server is listening before continuing - ;; -- needed for test suites that “just want to get on with it” - (define s (make-semaphore 0)) + ;; use of channel `ch` allows us to wait until the server is + ;; listening before continuing -- needed for test suites that “just + ;; want to get on with it” + (define ch (make-channel)) (define t (thread (λ () - (run-server (current-listen-port) + (run-server #f conn-proc (current-conn-timeout) void ; handler - (λ (port-no - (max-allow-wait 4) - (reuse? #f) - (hostname #f)) - (dynamic-wind - void - (λ () (tcp-listen port-no max-allow-wait reuse? hostname)) - (λ () (semaphore-post s)))))))) - (semaphore-wait s) - (values t (λ () (kill-thread t)))) + (λ (a-false [max-allow-wait 4] [reuse? #f] [hostname #f]) + (define listener + (tcp-listen 0 max-allow-wait reuse? hostname)) + (define-values (_0 the-port _1 _2) + (tcp-addresses listener #t)) + (channel-put ch the-port) + listener))))) + (values (channel-get ch) t (λ () (kill-thread t)))) ;; tested via the echo-server (in this directory) ;; (module+ test) diff --git a/pkgs/net-test/tests/net/http-proxy/https-non-server.rkt b/pkgs/net-test/tests/net/http-proxy/https-non-server.rkt index f262fb2b9b..32446f596a 100644 --- a/pkgs/net-test/tests/net/http-proxy/https-non-server.rkt +++ b/pkgs/net-test/tests/net/http-proxy/https-non-server.rkt @@ -1,7 +1,6 @@ #lang racket/base ; It may look like an HTTPS server, but it very isn’t (provide server - current-listen-port current-conn-timeout) (require racket/match @@ -43,7 +42,7 @@ (module+ main - (define-values (server-thread shutdown-server) (server)) + (define-values (the-port server-thread shutdown-server) (server)) (dynamic-wind void (λ () (thread-wait server-thread)) shutdown-server)) (module+ test) diff --git a/pkgs/net-test/tests/net/http-proxy/proxy-server.rkt b/pkgs/net-test/tests/net/http-proxy/proxy-server.rkt index f2c051c0a1..ac412630fa 100644 --- a/pkgs/net-test/tests/net/http-proxy/proxy-server.rkt +++ b/pkgs/net-test/tests/net/http-proxy/proxy-server.rkt @@ -1,10 +1,10 @@ #lang racket/base -;; A proxy HTTP server -- don’t get your hopes up it’s for testing and only proxies ports, probably -;; oozes security leaks and I wouldn’t be surprised if it leaked fids too. +;; A proxy HTTP server -- don’t get your hopes up it’s for testing and +;; only proxies ports, probably oozes security leaks and I wouldn’t be +;; surprised if it leaked fids too. (require racket/port racket/match racket/tcp "generic-server.rkt") (provide server - current-listen-port current-conn-timeout) (define (http-tunnel-serve in out) @@ -52,8 +52,8 @@ (module+ main - (define-values (server-thread shutdown-server) - (parameterize ([current-listen-port 12380]) (server))) + (define-values (the-port server-thread shutdown-server) + (server)) (thread-wait server-thread)) (module+ @@ -62,12 +62,10 @@ (require (prefix-in es: "echo-server.rkt")) - (define proxy-listen-port 12380) + (define-values (proxy-listen-port server-thread shutdown-server) + (server)) - (define-values (server-thread shutdown-server) - (parameterize ([current-listen-port proxy-listen-port]) (server))) - - (define-values (es:server-thread es:shutdown-server) (es:server)) + (define-values (echo-port es:server-thread es:shutdown-server) (es:server)) (let ((old-exit-handler (exit-handler))) (exit-handler (lambda (exit-code) @@ -102,7 +100,8 @@ (check-match (connect/test "GET" "/" #f) (regexp #px"^HTTP/\\S+\\s+405")) (check-match (connect/test "A B" "/" #f) (regexp #px"^HTTP/\\S+\\s+400")) (check-match (connect/test "CONNECT" "q.com:9887" #f) (regexp #px"^HTTP/\\S+\\s+410")) - (check-match (connect/test "CONNECT" "localhost:12345" #f #:body "blah blah blah!") + (check-match (connect/test "CONNECT" (format "localhost:~a" echo-port) + #f #:body "blah blah blah!") (regexp #px"^HTTP/\\S+\\s+200.*blah!$")) ) diff --git a/pkgs/net-test/tests/net/url.rkt b/pkgs/net-test/tests/net/url.rkt index d1c52bb0e9..d98f8dbbc3 100644 --- a/pkgs/net-test/tests/net/url.rkt +++ b/pkgs/net-test/tests/net/url.rkt @@ -195,19 +195,21 @@ => #f ) - (define-values (ss:server-thread ss:shutdown-server) - (parameterize ([ss:current-listen-port 12345]) (ss:server))) + (define-values (ss:port ss:server-thread ss:shutdown-server) + (ss:server)) - (define-values (ps:server-thread ps:shutdown-server) - (parameterize ([ps:current-listen-port 12380]) (ps:server))) + (define-values (ps:port ps:server-thread ps:shutdown-server) + (ps:server)) - (test (parameterize ([current-proxy-servers '(("https" "localhost" 12380))]) - (port->string (get-pure-port (string->url "https://localhost:12345/woo/yay")))) + (test (parameterize ([current-proxy-servers `(("https" "localhost" ,ps:port))]) + (port->string + (get-pure-port + (string->url + (format "https://localhost:~a/woo/yay" + ss:port))))) => "\"/woo/yay\" (but at least it's secure)") (ps:shutdown-server) - (ss:shutdown-server) - -) + (ss:shutdown-server)) (module+ test (require (submod ".." main))) ; for raco test & drdr