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

Removing connection mutex

Browse Source 
svn: r6656
This commit is contained in:
Jay McCarthy 2007-06-14 02:40:28 +00:00
parent 9d425a0bbf
commit 31999c4898
9 changed files with 84 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/web-server/bench/NOTES
View File

@ -1,3 +1,13 @@
* data/1181788603.ss
Removing all references to semaphores doesn't change much.
* data/1181787772.ss
Removing the semaphores on connections---no longer needed---
seems to improve the average case. 12ms were cut off. The
memory usage seems strange.
* data/1181686382.ss * data/1181686382.ss
The memory-usage data implies that there is a leak The memory-usage data implies that there is a leak

1
collects/web-server/bench/data/1181787772.ss Normal file
View File

@ -0,0 +1 @@
(benchmark (cmd "ab -c 10 -t 120 -e /tmp/mztmp1181787597671591189 http://localhost:9480/file") (timing (start 1181787597) (stop 1181787717) (shutdown 1181787772)) (memory-usage (mzscheme (before 15501312) (after 271469624) (after-gc 240140744)) (server (before 11486956) (after 11767936) (after-gc 11737348))) (response-times (1.0 5.0 5.0 6.0 6.0 7.0 7.0 7.0 8.0 8.0 8.0 9.0 9.0 9.0 10.0 10.0 10.0 11.0 11.0 11.0 12.0 12.0 12.0 13.0 13.0 13.0 14.0 14.0 14.0 15.0 15.0 15.0 16.0 16.0 17.0 17.0 17.0 18.0 18.0 18.0 19.0 19.0 20.0 20.0 20.0 21.0 21.0 21.0 22.0 22.0 23.0 23.0 24.0 24.0 25.0 25.0 26.0 26.0 27.0 27.0 28.0 28.0 29.0 29.0 29.0 30.0 30.0 31.0 31.0 32.0 33.0 33.0 34.0 35.0 35.0 36.0 37.0 38.0 38.0 39.0 40.0 41.0 42.0 42.0 43.0 45.0 46.0 47.0 49.0 50.0 51.0 53.0 55.0 58.0 61.0 64.0 69.0 78.0 99.0 284.0)))

1
collects/web-server/bench/data/1181788603.ss Normal file
View File

@ -0,0 +1 @@
(benchmark (cmd "ab -c 10 -t 120 -e /tmp/mztmp1181788425672419526 http://localhost:9480/file") (timing (start 1181788425) (stop 1181788546) (shutdown 1181788603)) (memory-usage (mzscheme (before 15474656) (after 256099040) (after-gc 246890536)) (server (before 11476576) (after 238827648) (after-gc 239474740))) (response-times (1.0 5.0 5.0 6.0 6.0 7.0 7.0 7.0 8.0 8.0 8.0 8.0 9.0 9.0 9.0 10.0 10.0 10.0 10.0 11.0 11.0 11.0 12.0 12.0 12.0 13.0 13.0 14.0 14.0 14.0 15.0 15.0 15.0 16.0 16.0 17.0 17.0 17.0 18.0 18.0 19.0 19.0 19.0 20.0 20.0 21.0 21.0 22.0 22.0 22.0 23.0 23.0 24.0 24.0 25.0 25.0 26.0 26.0 27.0 27.0 28.0 28.0 29.0 29.0 29.0 30.0 30.0 31.0 31.0 32.0 32.0 33.0 34.0 34.0 35.0 36.0 37.0 38.0 38.0 39.0 40.0 41.0 41.0 42.0 43.0 44.0 46.0 47.0 48.0 50.0 51.0 53.0 55.0 57.0 60.0 63.0 68.0 77.0 104.0 291.0)))

7
collects/web-server/docs/reference/private.scrbl
View File

@ -66,12 +66,11 @@ for doing this.
@defstruct[connection @defstruct[connection
([timer timer?] ([timer timer?]
[i-port input-port?] [o-port output-port?] [custodian custodian?] [i-port input-port?] [o-port output-port?] [custodian custodian?]
[close? boolean?] [mutex semaphore?])]{ [close? boolean?])]{
A connection is a pair of ports (@scheme[i-port] and @scheme[o-port]) that is A connection is a pair of ports (@scheme[i-port] and @scheme[o-port]) that is
ready to close after the current job if @scheme[close?] is @scheme[#t]. Resources ready to close after the current job if @scheme[close?] is @scheme[#t]. Resources
associated with the connection should be allocated under @scheme[custodian] and associated with the connection should be allocated under @scheme[custodian].
locked by @scheme[mutex]---including access to the ports. The connection will last The connection will last until @scheme[timer] triggers.
until @scheme[timer] triggers.
} }
@; XXX Don't pass in parent-cust @; XXX Don't pass in parent-cust

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

@ -2,14 +2,11 @@
(require (lib "contract.ss") (require (lib "contract.ss")
"timer.ss") "timer.ss")
(define-struct connection (timer i-port o-port custodian close? mutex) (define-struct connection (timer i-port o-port custodian close?))
(make-inspector))
(provide/contract (provide/contract
[struct connection [struct connection
([timer timer?] ([timer timer?] [i-port input-port?] [o-port output-port?] [custodian custodian?] [close? boolean?])]
[i-port input-port?] [o-port output-port?] [custodian custodian?]
[close? boolean?] [mutex semaphore?])]
[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)]
@ -27,8 +24,7 @@
(make-connection (make-connection
(start-timer time-to-live (start-timer time-to-live
(lambda () (kill-connection! conn))) (lambda () (kill-connection! conn)))
i-port o-port cust close? i-port o-port cust close?)])
(make-semaphore 1))])
conn)) conn))
;; kill-connection!: connection -> void ;; kill-connection!: connection -> void

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

@ -16,32 +16,29 @@
;; read the request line, and the headers, determine if the connection should ;; read the request line, and the headers, determine if the connection should
;; be closed after servicing the request and build a request structure ;; be closed after servicing the request and build a request structure
(define (read-request conn host-port port-addresses) (define (read-request conn host-port port-addresses)
(call-with-semaphore (define ip
(connection-mutex conn) (connection-i-port conn))
(lambda () (define-values (method uri major minor)
(define ip (read-request-line ip))
(connection-i-port conn)) (define headers
(define-values (method uri major minor) (read-headers ip))
(read-request-line ip)) (define _
(define headers (match (headers-assq* #"Content-Length" headers)
(read-headers ip)) [(struct header (f v))
(define _ ; Give it one second per byte (with 5 second minimum... a bit arbitrary)
(match (headers-assq* #"Content-Length" headers) ; XXX Can this be abstracted?
[(struct header (f v)) (adjust-connection-timeout! conn (max 5 (string->number (bytes->string/utf-8 v))))]
; Give it one second per byte (with 5 second minimum... a bit arbitrary) [#f
; XXX Can this be abstracted? (void)]))
(adjust-connection-timeout! conn (max 5 (string->number (bytes->string/utf-8 v))))] (define-values (host-ip client-ip)
[#f (port-addresses ip))
(void)])) (define-values (bindings raw-post-data)
(define-values (host-ip client-ip) (read-bindings&post-data/raw conn method uri headers))
(port-addresses ip)) (values
(define-values (bindings raw-post-data) (make-request method uri headers bindings raw-post-data
(read-bindings&post-data/raw conn method uri headers)) host-ip host-port client-ip)
(values (close-connection? headers major minor
(make-request method uri headers bindings raw-post-data client-ip host-ip)))
host-ip host-port client-ip)
(close-connection? headers major minor
client-ip host-ip)))))
;; ************************************************** ;; **************************************************
;; close-connection? ;; close-connection?
@ -146,46 +143,46 @@
(define (read-bindings&post-data/raw conn meth uri headers) (define (read-bindings&post-data/raw conn meth uri headers)
(match meth (match meth
['get ['get
(values (map (match-lambda (values (map (match-lambda
[(list-rest k v) [(list-rest k v)
(make-binding:form (string->bytes/utf-8 (symbol->string k)) (make-binding:form (string->bytes/utf-8 (symbol->string k))
(string->bytes/utf-8 v))]) (string->bytes/utf-8 v))])
(url-query uri)) (url-query uri))
#f)] #f)]
['post ['post
(define content-type (headers-assq #"Content-Type" headers)) (define content-type (headers-assq #"Content-Type" headers))
(define in (connection-i-port conn)) (define in (connection-i-port conn))
(cond (cond
[(and content-type (regexp-match FILE-FORM-REGEXP (header-value content-type))) [(and content-type (regexp-match FILE-FORM-REGEXP (header-value content-type)))
=> (match-lambda => (match-lambda
[(list _ content-boundary) [(list _ content-boundary)
(values (values
(map (match-lambda (map (match-lambda
[(struct mime-part (headers contents)) [(struct mime-part (headers contents))
(define rhs (header-value (headers-assq #"Content-Disposition" headers))) (define rhs (header-value (headers-assq #"Content-Disposition" headers)))
(match (list (regexp-match #"filename=(\"([^\"]*)\"|([^ ;]*))" rhs) (match (list (regexp-match #"filename=(\"([^\"]*)\"|([^ ;]*))" rhs)
(regexp-match #"[^e]name=(\"([^\"]*)\"|([^ ;]*))" rhs)) (regexp-match #"[^e]name=(\"([^\"]*)\"|([^ ;]*))" rhs))
[(list #f #f) [(list #f #f)
(network-error 'reading-bindings "Couldn't extract form field name for file upload")] (network-error 'reading-bindings "Couldn't extract form field name for file upload")]
[(list #f (list _ _ f0 f1)) [(list #f (list _ _ f0 f1))
(make-binding:form (or f0 f1) (apply bytes-append contents))] (make-binding:form (or f0 f1) (apply bytes-append contents))]
[(list (list _ _ f00 f01) (list _ _ f10 f11)) [(list (list _ _ f00 f01) (list _ _ f10 f11))
(make-binding:file (or f10 f11) (or f00 f01) (apply bytes-append contents))])]) (make-binding:file (or f10 f11) (or f00 f01) (apply bytes-append contents))])])
(read-mime-multipart content-boundary in)) (read-mime-multipart content-boundary in))
#f)])] #f)])]
[else [else
(match (headers-assq #"Content-Length" headers) (match (headers-assq #"Content-Length" headers)
[(struct header (_ value)) [(struct header (_ value))
(cond (cond
[(string->number (bytes->string/utf-8 value)) [(string->number (bytes->string/utf-8 value))
=> (lambda (len) => (lambda (len)
(let ([raw-bytes (read-bytes len in)]) (let ([raw-bytes (read-bytes len in)])
(values (parse-bindings raw-bytes) raw-bytes)))] (values (parse-bindings raw-bytes) raw-bytes)))]
[else [else
(network-error 'read-bindings "Post request contained a non-numeric content-length")])] (network-error 'read-bindings "Post request contained a non-numeric content-length")])]
[#f [#f
(let ([raw-bytes (apply bytes-append (read-to-eof in))]) (let ([raw-bytes (apply bytes-append (read-to-eof in))])
(values (parse-bindings raw-bytes) raw-bytes))])])] (values (parse-bindings raw-bytes) raw-bytes))])])]
[meth [meth
(values empty #f)])) (values empty #f)]))

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

@ -176,10 +176,8 @@
(with-handlers ([exn? (lambda (exn) (with-handlers ([exn? (lambda (exn)
(kill-connection! conn) (kill-connection! conn)
(raise exn))]) (raise exn))])
(call-with-semaphore (connection-mutex conn) (apply f conn args)
(lambda () (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))

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

@ -19,7 +19,7 @@
[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 (make-timer ip +inf.0 (lambda () (void)))
ip op (make-custodian) #f (make-semaphore)) ip op (make-custodian) #f)
headers))) headers)))
(define (get-bindings post-data) (define (get-bindings post-data)

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

@ -31,7 +31,7 @@
(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 (make-timer never-evt +inf.0 (lambda () (void)))
ip op (current-custodian) #f (make-semaphore 1)) ip op (current-custodian) #f)
ip ip
op)) op))