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

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

@ -2,11 +2,16 @@
(require (lib "contract.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
[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)]
[new-connection (number? input-port? output-port? custodian? boolean? . -> . connection?)]
[kill-connection! (connection? . -> . void)]
@ -19,24 +24,34 @@
;; new-connection: number i-port o-port custodian -> 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?)
(letrec ([conn
(define conn
(make-connection
(begin0 (unbox i) (set-box! i (add1 (unbox i))))
#f i-port o-port cust close?))
(define conn-wb (make-weak-box conn))
(set-connection-timer!
conn
(start-timer time-to-live
(lambda () (kill-connection! conn)))
i-port o-port cust close?)])
conn))
(lambda ()
(cond
[(weak-box-value conn-wb)
=> kill-connection!]))))
conn)
;; kill-connection!: connection -> void
;; kill this connection
(define (kill-connection! conn-demned)
(cancel-timer! (connection-timer conn-demned))
(define (kill-connection! conn)
#;(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])
(close-output-port (connection-o-port conn-demned)))
(close-output-port (connection-o-port conn)))
(with-handlers ([exn:fail:network? void])
(close-input-port (connection-i-port conn-demned)))
(set-connection-close?! conn-demned #t)
(custodian-shutdown-all (connection-custodian conn-demned)))
(close-input-port (connection-i-port conn)))
(custodian-shutdown-all (connection-custodian conn)))
;; adjust-connection-timeout!: connection number -> void
;; change the expiration time for this connection

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

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

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

@ -9,7 +9,13 @@
"../private/request-structs.ss")
(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?

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

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

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

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

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

@ -18,7 +18,7 @@
(number->string (bytes-length b)))))]
[ip (open-input-bytes b)]
[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)
headers)))

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

@ -30,7 +30,7 @@
(define (make-mock-connection ib)
(define ip (open-input-bytes ib))
(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))