Allow concurrent execution of these tests, thanks for the catch Sam
This commit is contained in:
Jay McCarthy
parent
5ef5a4f3cf
commit
a5ecc5c92e
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
shutdown-server))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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!$"))
|
||||
|
||||
)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user