suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix of address lookup for SSL

Browse Source 
svn: r832
This commit is contained in:
Jay McCarthy 2005-09-11 17:31:23 +00:00
parent 07598376bd
commit 700c36eccd
2 changed files with 20 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/web-server/request-parsing.ss
View File

@ -14,16 +14,16 @@
;; The part of the URL path that gets passed to the servlet as arguments.
(provide/contract
[read-request ((connection?) . ->* . (request? boolean?))]
[read-request ((connection? ((input-port?) . ->* . (string? string?))) . ->* . (request? boolean?))]
[read-bindings (connection? symbol? url? (listof header?)
. -> . (union (listof binding?) string?))])
;; **************************************************
;; read-request: input-port -> request boolean?
;; read-request: connection (input-port -> string string) -> request boolean?
;; read the request line, and the headers, determine if the connection should
;; be closed after servicing the request and build a request structure
(define (read-request conn)
(define (read-request conn port-addresses)
(call-with-semaphore
(connection-mutex conn)
(lambda ()
@ -31,10 +31,7 @@
(let-values ([(method uri major-version minor-version)
(read-request-line ip)])
(let ([headers (read-headers ip)])
(let-values ([(host-ip client-ip)
(if (tcp-port? ip)
(tcp-addresses ip)
(values "127.0.0.1" "127.0.0.1"))])
(let-values ([(host-ip client-ip) (port-addresses ip)])
(values
(make-request method uri headers '() host-ip client-ip)
(close-connection?

27
collects/web-server/web-server-unit.ss
View File

@ -77,18 +77,20 @@
(semaphore-post sema)
; Rethrow the error to this thread's error printer
(raise e))])
(server-loop get-ports))))))
(server-loop get-ports
tcp-addresses))))))
(semaphore-wait sema)
(loop))))
;; server-loop: (-> i-port o-port) -> void
;; server-loop: (-> input-port output-port) (input-port -> string string) -> void
;; start a thread to handle each incoming connection
(define (server-loop get-ports)
(define (server-loop get-ports port-addresses)
(let loop ()
(let ([connection-cust (make-custodian)])
(parameterize ([current-custodian connection-cust])
(let-values ([(ip op) (get-ports)])
(serve-ports/inner ip op))))
(serve-ports/inner ip op
port-addresses))))
(loop)))
;; serve-ports : input-port output-port -> void
@ -102,11 +104,14 @@
[current-server-custodian server-cust])
(let ([connection-cust (make-custodian)])
(parameterize ([current-custodian connection-cust])
(serve-ports/inner ip op))))))
(serve-ports/inner ip op
(lambda (ip)
(values "127.0.0.1"
"127.0.0.1"))))))))
;; serve-ports/inner : input-port output-port -> void
;; serve-ports/inner : input-port output-port (input-port -> string string) -> void
;; returns immediately, spawning a thread to handle
(define (serve-ports/inner ip op)
(define (serve-ports/inner ip op port-addresses)
(thread
(lambda ()
(let ([conn (new-connection config:initial-connection-timeout
@ -116,13 +121,13 @@
(set-connection-close?! conn #t)
(kill-connection! conn)
(raise e))])
(serve-connection conn))))))
(serve-connection conn port-addresses))))))
;; serve-connection: connection -> void
;; serve-connection: connection (input-port -> string string) -> void
;; respond to all requests on this connection
(define (serve-connection conn)
(define (serve-connection conn port-addresses)
(let connection-loop ()
(let-values ([(req close?) (config:read-request conn)])
(let-values ([(req close?) (config:read-request conn port-addresses)])
(set-connection-close?! conn close?)
(adjust-connection-timeout! conn config:initial-connection-timeout)
(config:dispatch conn req)