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

Streamlining a few feautures

Browse Source 
svn: r6773
This commit is contained in:
Jay McCarthy 2007-06-29 20:21:59 +00:00
parent 13371cd418
commit 0214f207e7
7 changed files with 55 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
collects/web-server/private/connection-manager.ss
View File

@ -2,11 +2,16 @@
(require (lib "contract.ss") (require (lib "contract.ss")
"timer.ss") "timer.ss")
(define-struct connection (timer i-port o-port custodian close?)) (define-struct connection (id timer i-port o-port custodian close?))
(provide/contract (provide/contract
[struct connection [struct connection
([timer timer?] [i-port input-port?] [o-port output-port?] [custodian custodian?] [close? boolean?])] ([id integer?]
[timer timer?]
[i-port input-port?]
[o-port output-port?]
[custodian custodian?]
[close? boolean?])]
[start-connection-manager (custodian? . -> . void)] [start-connection-manager (custodian? . -> . void)]
[new-connection (number? input-port? output-port? custodian? boolean? . -> . connection?)] [new-connection (number? input-port? output-port? custodian? boolean? . -> . connection?)]
[kill-connection! (connection? . -> . void)] [kill-connection! (connection? . -> . void)]
@ -19,24 +24,34 @@
;; new-connection: number i-port o-port custodian -> connection ;; new-connection: number i-port o-port custodian -> connection
;; ask the connection manager for a new connection ;; ask the connection manager for a new connection
(define i (box 0))
(define (new-connection time-to-live i-port o-port cust close?) (define (new-connection time-to-live i-port o-port cust close?)
(letrec ([conn (define conn
(make-connection (make-connection
(start-timer time-to-live (begin0 (unbox i) (set-box! i (add1 (unbox i))))
(lambda () (kill-connection! conn))) #f i-port o-port cust close?))
i-port o-port cust close?)]) (define conn-wb (make-weak-box conn))
conn)) (set-connection-timer!
conn
(start-timer time-to-live
(lambda ()
(cond
[(weak-box-value conn-wb)
=> kill-connection!]))))
conn)
;; kill-connection!: connection -> void ;; kill-connection!: connection -> void
;; kill this connection ;; kill this connection
(define (kill-connection! conn-demned) (define (kill-connection! conn)
(cancel-timer! (connection-timer conn-demned)) #;(printf "K: ~a~n" (connection-id conn))
; XXX Don't need to do this when called from timer
(with-handlers ([exn? void])
(cancel-timer! (connection-timer conn)))
(with-handlers ([exn:fail:network? void]) (with-handlers ([exn:fail:network? void])
(close-output-port (connection-o-port conn-demned))) (close-output-port (connection-o-port conn)))
(with-handlers ([exn:fail:network? void]) (with-handlers ([exn:fail:network? void])
(close-input-port (connection-i-port conn-demned))) (close-input-port (connection-i-port conn)))
(set-connection-close?! conn-demned #t) (custodian-shutdown-all (connection-custodian conn)))
(custodian-shutdown-all (connection-custodian conn-demned)))
;; adjust-connection-timeout!: connection number -> void ;; adjust-connection-timeout!: connection number -> void
;; change the expiration time for this connection ;; change the expiration time for this connection

24
collects/web-server/private/dispatch-server-unit.ss
View File

@ -18,14 +18,16 @@
(start-connection-manager the-server-custodian) (start-connection-manager the-server-custodian)
(parameterize ([current-custodian the-server-custodian] (parameterize ([current-custodian the-server-custodian]
[current-server-custodian the-server-custodian] [current-server-custodian the-server-custodian]
[current-thread-initial-stack-size 3]) #;[current-thread-initial-stack-size 3])
(thread (thread
(lambda () (lambda ()
(run-server config:port (run-server config:port
handle-connection handle-connection
#f #f
(lambda (exn) (lambda (exn)
#f) ((error-display-handler)
(format "Connection error: ~a" (exn-message exn))
exn))
(lambda (p mw re) (lambda (p mw re)
(tcp-listen p config:max-waiting #t config:listen-ip)) (tcp-listen p config:max-waiting #t config:listen-ip))
tcp-close tcp-close
@ -60,15 +62,11 @@
(define conn (define conn
(new-connection config:initial-connection-timeout (new-connection config:initial-connection-timeout
ip op (current-custodian) #f)) ip op (current-custodian) #f))
(with-handlers ([exn:fail:network? (let connection-loop ()
(lambda (e) #;(printf "C: ~a~n" (connection-id conn))
(kill-connection! conn) (let-values ([(req close?) (config:read-request conn config:port port-addresses)])
(raise e))]) (set-connection-close?! conn close?)
(let connection-loop ()
(define-values (req close?) (config:read-request conn config:port port-addresses))
(config:dispatch conn req) (config:dispatch conn req)
(unless (connection-close? conn) (if (connection-close? conn)
(set-connection-close?! conn close?)) (kill-connection! conn)
(cond (connection-loop))))))
[(connection-close? conn) (kill-connection! conn)]
[else (connection-loop)])))))

8
collects/web-server/private/request.ss
View File

@ -9,7 +9,13 @@
"../private/request-structs.ss") "../private/request-structs.ss")
(provide/contract (provide/contract
[read-request ((connection? number? ((input-port?) . ->* . (string? string?))) . ->* . (request? boolean?))]) [rename ext:read-request read-request ((connection? number? ((input-port?) . ->* . (string? string?))) . ->* . (request? boolean?))])
(define (ext:read-request conn host-port port-addresses)
(with-handlers ([exn? (lambda (exn)
(kill-connection! conn)
(raise exn))])
(read-request conn host-port port-addresses)))
;; ************************************************** ;; **************************************************
;; read-request: connection number (input-port -> string string) -> request boolean? ;; read-request: connection number (input-port -> string string) -> request boolean?

12
collects/web-server/private/response.ss
View File

@ -171,13 +171,11 @@
(define (ext:wrap f) (define (ext:wrap f)
(lambda (conn . args) (lambda (conn . args)
(if (connection-close? conn) (with-handlers ([exn? (lambda (exn)
(error 'output-response "Attempt to write to closed connection.") (kill-connection! conn)
(with-handlers ([exn? (lambda (exn) (raise exn))])
(kill-connection! conn) (apply f conn args)
(raise exn))]) (flush-output (connection-o-port conn)))))
(apply f conn args)
(flush-output (connection-o-port conn))))))
(define ext:output-response (define ext:output-response
(ext:wrap output-response)) (ext:wrap output-response))

1
collects/web-server/private/timer.ss
View File

@ -14,6 +14,7 @@
(thread (thread
(lambda () (lambda ()
(let loop ([timers null]) (let loop ([timers null])
#;(printf "Timers: ~a~n" (length timers))
;; Wait for either... ;; Wait for either...
(apply sync (apply sync
;; ... a timer-request message ... ;; ... a timer-request message ...

2
collects/web-server/tests/private/request-test.ss
View File

@ -18,7 +18,7 @@
(number->string (bytes-length b)))))] (number->string (bytes-length b)))))]
[ip (open-input-bytes b)] [ip (open-input-bytes b)]
[op (open-output-bytes)]) [op (open-output-bytes)])
(values (make-connection (make-timer ip +inf.0 (lambda () (void))) (values (make-connection 0 (make-timer ip +inf.0 (lambda () (void)))
ip op (make-custodian) #f) ip op (make-custodian) #f)
headers))) headers)))

2
collects/web-server/tests/util.ss
View File

@ -30,7 +30,7 @@
(define (make-mock-connection ib) (define (make-mock-connection ib)
(define ip (open-input-bytes ib)) (define ip (open-input-bytes ib))
(define op (open-output-bytes)) (define op (open-output-bytes))
(values (make-connection (make-timer never-evt +inf.0 (lambda () (void))) (values (make-connection 0 (make-timer never-evt +inf.0 (lambda () (void)))
ip op (current-custodian) #f) ip op (current-custodian) #f)
ip ip
op)) op))