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

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

@ -176,10 +176,8 @@
(with-handlers ([exn? (lambda (exn)
(kill-connection! conn)
(raise exn))])
(call-with-semaphore (connection-mutex conn)
(lambda ()
(apply f conn args)
(flush-output (connection-o-port conn))))))))
(apply f conn args)
(flush-output (connection-o-port conn))))))
(define ext: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)]
[op (open-output-bytes)])
(values (make-connection (make-timer ip +inf.0 (lambda () (void)))
ip op (make-custodian) #f (make-semaphore))
ip op (make-custodian) #f)
headers)))
(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 op (open-output-bytes))
(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
op))