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

Continuing 11072

Browse Source
This commit is contained in:
Jay McCarthy 2010-08-02 10:05:17 -06:00
parent 00f5ffc22c
commit 53ff7a1092
12 changed files with 46 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/unstable/contract.rkt
View File

@ -7,6 +7,7 @@
;; from this (see `string->path-element') . ;; from this (see `string->path-element') .
(define port-number? (between/c 1 65535)) (define port-number? (between/c 1 65535))
(define tcp-listen-port? (between/c 0 65535))
(define non-empty-string/c (define non-empty-string/c
(and/c string? (and/c string?
@ -364,6 +365,7 @@
[non-empty-string/c contract?] [non-empty-string/c contract?]
[path-element? contract?] [path-element? contract?]
[port-number? contract?] [port-number? contract?]
[tcp-listen-port? contract?]
[non-empty-string? predicate/c] [non-empty-string? predicate/c]
[non-empty-bytes? predicate/c] [non-empty-bytes? predicate/c]

4
collects/unstable/scribblings/contract.scrbl
View File

@ -15,6 +15,10 @@ Contract for non-empty strings.
Equivalent to @racket[(between/c 1 65535)]. Equivalent to @racket[(between/c 1 65535)].
} }
@defthing[tcp-listen-port? contract?]{
Equivalent to @racket[(between/c 0 65535)].
}
@defthing[path-element? contract?]{ @defthing[path-element? contract?]{
Equivalent to @racket[(or/c path-string? (symbols 'up 'same))]. Equivalent to @racket[(or/c path-string? (symbols 'up 'same))].
} }

3
collects/web-server/http/request.rkt
View File

@ -1,6 +1,7 @@
#lang racket #lang racket
(require net/url (require net/url
net/uri-codec net/uri-codec
unstable/contract
web-server/private/util web-server/private/util
web-server/private/connection-manager web-server/private/connection-manager
web-server/http/request-structs) web-server/http/request-structs)
@ -8,7 +9,7 @@
(provide/contract (provide/contract
[rename ext:read-request read-request [rename ext:read-request read-request
(connection? (connection?
port-number? tcp-listen-port?
(input-port? . -> . (values string? string?)) (input-port? . -> . (values string? string?))
. -> . . -> .
(values request? boolean?))]) (values request? boolean?))])

1
collects/web-server/insta/insta.rkt
View File

@ -63,5 +63,6 @@
'you 'web-server 'you 'web-server
"start" "start"
#f) #f)
#:port 0
#:extra-files-paths (if extra-files-path (list extra-files-path) empty) #:extra-files-paths (if extra-files-path (list extra-files-path) empty)
#:launch-browser? launch-browser?))))])) #:launch-browser? launch-browser?))))]))

5
collects/web-server/private/dispatch-server-sig.rkt
View File

@ -1,6 +1,7 @@
#lang racket #lang racket
(require racket/async-channel (require racket/async-channel
web-server/private/util web-server/private/util
unstable/contract
web-server/private/connection-manager) web-server/private/connection-manager)
(define-signature dispatch-server^ (define-signature dispatch-server^
@ -10,13 +11,13 @@
(define-signature dispatch-server-config^ (define-signature dispatch-server-config^
((contracted ((contracted
[port port-number?] [port tcp-listen-port?]
[listen-ip (or/c string? false/c)] [listen-ip (or/c string? false/c)]
[max-waiting integer?] [max-waiting integer?]
[initial-connection-timeout integer?] [initial-connection-timeout integer?]
[read-request [read-request
(connection? (connection?
port-number? tcp-listen-port?
(input-port? . -> . (values string? string?)) (input-port? . -> . (values string? string?))
. -> . . -> .
(values any/c boolean?))] (values any/c boolean?))]

11
collects/web-server/private/dispatch-server-unit.rkt
View File

@ -24,21 +24,22 @@
(start-connection-manager) (start-connection-manager)
(thread (thread
(lambda () (lambda ()
(run-server config:port (run-server 1 ; This is the port argument, but because we specialize listen, it is ignored.
handle-connection handle-connection
#f #f
(lambda (exn) (lambda (exn)
((error-display-handler) ((error-display-handler)
(format "Connection error: ~a" (exn-message exn)) (format "Connection error: ~a" (exn-message exn))
exn)) exn))
(lambda (p mw re) (lambda (_ mw re)
(with-handlers ([exn? (with-handlers ([exn?
(λ (x) (λ (x)
(async-channel-put* confirmation-channel x) (async-channel-put* confirmation-channel x)
(raise x))]) (raise x))])
(begin0 (define listener (tcp-listen config:port config:max-waiting #t config:listen-ip))
(tcp-listen p config:max-waiting #t config:listen-ip) (let-values ([(local-addr local-port end-addr end-port) (tcp-addresses listener #t)])
(async-channel-put* confirmation-channel #f)))) (async-channel-put* confirmation-channel local-port))
listener))
tcp-close tcp-close
tcp-accept tcp-accept
tcp-accept/enable-break)))) tcp-accept/enable-break))))

7
collects/web-server/scribblings/dispatch-server.scrbl
View File

@ -7,6 +7,7 @@
web-server/private/util web-server/private/util
web-server/private/connection-manager web-server/private/connection-manager
net/tcp-sig net/tcp-sig
unstable/contract
racket/async-channel racket/async-channel
racket/tcp racket/tcp
web-server/web-server-sig)) web-server/web-server-sig))
@ -26,7 +27,7 @@ The @racket[dispatch-server^] signature is an alias for
@racket[web-server^]. @racket[web-server^].
@defproc[(serve) (->* () (#:confirmation-channel (or/c false/c async-channel?)) (-> void))]{ @defproc[(serve) (->* () (#:confirmation-channel (or/c false/c async-channel?)) (-> void))]{
Runs the server---the confirmation channel will be send an exception if one occurs starting the server or @racket[#f] if the is none---and returns a procedure that shuts down the server. Runs the server---the confirmation channel will be send an exception if one occurs starting the server or the port number if there is none---and returns a procedure that shuts down the server.
} }
@defproc[(serve-ports [ip input-port?] @defproc[(serve-ports [ip input-port?]
@ -39,12 +40,12 @@ The @racket[dispatch-server^] signature is an alias for
@defsignature[dispatch-server-config^ ()]{ @defsignature[dispatch-server-config^ ()]{
@defthing[port port-number?]{Specifies the port to serve on.} @defthing[port tcp-listen-port?]{Specifies the port to serve on.}
@defthing[listen-ip (or/c string? false/c)]{Passed to @racket[tcp-listen].} @defthing[listen-ip (or/c string? false/c)]{Passed to @racket[tcp-listen].}
@defthing[max-waiting integer?]{Passed to @racket[tcp-accept].} @defthing[max-waiting integer?]{Passed to @racket[tcp-accept].}
@defthing[initial-connection-timeout integer?]{Specifies the initial timeout given to a connection.} @defthing[initial-connection-timeout integer?]{Specifies the initial timeout given to a connection.}
@defproc[(read-request [c connection?] @defproc[(read-request [c connection?]
[p port-number?] [p tcp-listen-port?]
[port-addresses [port-addresses
(input-port? . -> . (values string? string?))]) (input-port? . -> . (values string? string?))])
(values any/c boolean?)]{ (values any/c boolean?)]{

7
collects/web-server/scribblings/launch.scrbl
View File

@ -11,6 +11,7 @@
web-server/private/dispatch-server-sig web-server/private/dispatch-server-sig
web-server/dispatchers/dispatch web-server/dispatchers/dispatch
racket/async-channel racket/async-channel
unstable/contract
web-server/configuration/configuration-table) web-server/configuration/configuration-table)
(prefix-in raw: (for-label net/tcp-unit)) (prefix-in raw: (for-label net/tcp-unit))
(prefix-in files: (for-label web-server/dispatchers/dispatch-files))) (prefix-in files: (for-label web-server/dispatchers/dispatch-files)))
@ -22,7 +23,7 @@ This module provides functions for launching dispatching servers.
@defproc[(serve [#:dispatch dispatch dispatcher/c] @defproc[(serve [#:dispatch dispatch dispatcher/c]
[#:confirmation-channel confirmation-channel (or/c false/c async-channel?) #f] [#:confirmation-channel confirmation-channel (or/c false/c async-channel?) #f]
[#:tcp@ tcp@ (unit/c (import) (export tcp^)) raw:tcp@] [#:tcp@ tcp@ (unit/c (import) (export tcp^)) raw:tcp@]
[#:port port integer? 80] [#:port port tcp-listen-port? 80]
[#:listen-ip listen-ip (or/c string? false/c) #f] [#:listen-ip listen-ip (or/c string? false/c) #f]
[#:max-waiting max-waiting integer? 40] [#:max-waiting max-waiting integer? 40]
[#:initial-connection-timeout initial-connection-timeout integer? 60]) [#:initial-connection-timeout initial-connection-timeout integer? 60])
@ -51,7 +52,7 @@ from a given path:
@defproc[(serve/ports [#:dispatch dispatch dispatcher/c] @defproc[(serve/ports [#:dispatch dispatch dispatcher/c]
[#:confirmation-channel confirmation-channel (or/c false/c async-channel?) #f] [#:confirmation-channel confirmation-channel (or/c false/c async-channel?) #f]
[#:tcp@ tcp@ (unit/c (import) (export tcp^)) raw:tcp@] [#:tcp@ tcp@ (unit/c (import) (export tcp^)) raw:tcp@]
[#:ports ports (listof integer?) (list 80)] [#:ports ports (listof tcp-listen-port?) (list 80)]
[#:listen-ip listen-ip (or/c string? false/c) #f] [#:listen-ip listen-ip (or/c string? false/c) #f]
[#:max-waiting max-waiting integer? 40] [#:max-waiting max-waiting integer? 40]
[#:initial-connection-timeout initial-connection-timeout integer? 60]) [#:initial-connection-timeout initial-connection-timeout integer? 60])
@ -63,7 +64,7 @@ from a given path:
@defproc[(serve/ips+ports [#:dispatch dispatch dispatcher/c] @defproc[(serve/ips+ports [#:dispatch dispatch dispatcher/c]
[#:confirmation-channel confirmation-channel (or/c false/c async-channel?) #f] [#:confirmation-channel confirmation-channel (or/c false/c async-channel?) #f]
[#:tcp@ tcp@ (unit/c (import) (export tcp^)) raw:tcp@] [#:tcp@ tcp@ (unit/c (import) (export tcp^)) raw:tcp@]
[#:ips+ports ips+ports (listof (cons/c (or/c string? false/c) (listof integer?))) (list (cons #f (list 80)))] [#:ips+ports ips+ports (listof (cons/c (or/c string? false/c) (listof tcp-listen-port?))) (list (cons #f (list 80)))]
[#:max-waiting max-waiting integer? 40] [#:max-waiting max-waiting integer? 40]
[#:initial-connection-timeout initial-connection-timeout integer? 60]) [#:initial-connection-timeout initial-connection-timeout integer? 60])
(-> void)]{ (-> void)]{

2
collects/web-server/scribblings/servlet-env.scrbl
View File

@ -128,7 +128,7 @@ and if @racket[serve/servlet] is run in another module.
[#:quit? quit? boolean? (not command-line?)] [#:quit? quit? boolean? (not command-line?)]
[#:banner? banner? boolean? (not command-line?)] [#:banner? banner? boolean? (not command-line?)]
[#:listen-ip listen-ip (or/c false/c string?) "127.0.0.1"] [#:listen-ip listen-ip (or/c false/c string?) "127.0.0.1"]
[#:port port number? 8000] [#:port port tcp-listen-port? 8000]
[#:servlet-path servlet-path string? [#:servlet-path servlet-path string?
"/servlets/standalone.rkt"] "/servlets/standalone.rkt"]
[#:servlet-regexp servlet-regexp regexp? [#:servlet-regexp servlet-regexp regexp?

25
collects/web-server/servlet-dispatch.rkt
View File

@ -9,6 +9,7 @@
racket/serialize racket/serialize
net/tcp-unit net/tcp-unit
net/tcp-sig net/tcp-sig
unstable/contract
net/ssl-tcp-unit) net/ssl-tcp-unit)
(require web-server/web-server (require web-server/web-server
web-server/managers/lru web-server/managers/lru
@ -37,7 +38,7 @@
(#:launch-path (or/c false/c string?) (#:launch-path (or/c false/c string?)
#:banner? boolean? #:banner? boolean?
#:listen-ip (or/c false/c string?) #:listen-ip (or/c false/c string?)
#:port number? #:port tcp-listen-port?
#:ssl-cert (or/c false/c path-string?) #:ssl-cert (or/c false/c path-string?)
#:ssl-key (or/c false/c path-string?)) #:ssl-key (or/c false/c path-string?))
. ->* . . ->* .
@ -93,24 +94,19 @@
#:listen-ip #:listen-ip
[listen-ip "127.0.0.1"] [listen-ip "127.0.0.1"]
#:port #:port
[port 8000] [port-arg 8000]
#:ssl-cert #:ssl-cert
[ssl-cert #f] [ssl-cert #f]
#:ssl-key #:ssl-key
[ssl-key #f]) [ssl-key #f])
(define ssl? (and ssl-cert ssl-key)) (define ssl? (and ssl-cert ssl-key))
(define server-url
(string-append (if ssl? "https" "http")
"://localhost"
(if (and (not ssl?) (= port 80))
"" (format ":~a" port))))
(define sema (make-semaphore 0)) (define sema (make-semaphore 0))
(define confirm-ch (make-async-channel 1)) (define confirm-ch (make-async-channel 1))
(define shutdown-server (define shutdown-server
(serve #:confirmation-channel confirm-ch (serve #:confirmation-channel confirm-ch
#:dispatch (dispatcher sema) #:dispatch (dispatcher sema)
#:listen-ip listen-ip #:listen-ip listen-ip
#:port port #:port port-arg
#:tcp@ (if ssl? #:tcp@ (if ssl?
(let () (let ()
(define-unit-binding ssl-tcp@ (define-unit-binding ssl-tcp@
@ -121,15 +117,20 @@
ssl-tcp@) ssl-tcp@)
tcp@))) tcp@)))
(define serve-res (async-channel-get confirm-ch)) (define serve-res (async-channel-get confirm-ch))
(if serve-res (if (exn? serve-res)
(begin (begin
(when banner? (eprintf "There was an error starting the Web server.\n")) (when banner? (eprintf "There was an error starting the Web server.\n"))
(match serve-res (match serve-res
[(and (? exn?) (app exn-message (regexp "tcp-listen: listen on .+ failed \\(Address already in use; errno=.+\\)" (list _)))) [(app exn-message (regexp "tcp-listen: listen on .+ failed \\(Address already in use; errno=.+\\)" (list _)))
(when banner? (eprintf "\tThe TCP port (~a) is already in use.\n" port))] (when banner? (eprintf "\tThe TCP port (~a) is already in use.\n" port-arg))]
[_ [_
(void)])) (void)]))
(begin (local [(define port serve-res)
(define server-url
(string-append (if ssl? "https" "http")
"://localhost"
(if (and (not ssl?) (= port 80))
"" (format ":~a" port))))]
(when launch-path (when launch-path
((send-url) (string-append server-url launch-path) #t)) ((send-url) (string-append server-url launch-path) #t))
(when banner? (when banner?

3
collects/web-server/servlet-env.rkt
View File

@ -14,6 +14,7 @@
web-server/private/mime-types web-server/private/mime-types
web-server/servlet/setup web-server/servlet/setup
web-server/servlet-dispatch web-server/servlet-dispatch
unstable/contract
(prefix-in lift: web-server/dispatchers/dispatch-lift) (prefix-in lift: web-server/dispatchers/dispatch-lift)
(prefix-in fsmap: web-server/dispatchers/filesystem-map) (prefix-in fsmap: web-server/dispatchers/filesystem-map)
(prefix-in sequencer: web-server/dispatchers/dispatch-sequencer) (prefix-in sequencer: web-server/dispatchers/dispatch-sequencer)
@ -43,7 +44,7 @@
#:quit? boolean? #:quit? boolean?
#:banner? boolean? #:banner? boolean?
#:listen-ip (or/c false/c string?) #:listen-ip (or/c false/c string?)
#:port number? #:port tcp-listen-port?
#:ssl? boolean? #:ssl? boolean?
#:ssl-cert (or/c false/c path-string?) #:ssl-cert (or/c false/c path-string?)
#:ssl-key (or/c false/c path-string?) #:ssl-key (or/c false/c path-string?)

7
collects/web-server/web-server.rkt
View File

@ -5,6 +5,7 @@
racket/unit racket/unit
racket/async-channel racket/async-channel
racket/contract racket/contract
unstable/contract
web-server/dispatchers/dispatch web-server/dispatchers/dispatch
web-server/private/dispatch-server-sig web-server/private/dispatch-server-sig
web-server/private/dispatch-server-unit web-server/private/dispatch-server-unit
@ -17,7 +18,7 @@
(->* (#:dispatch dispatcher/c) (->* (#:dispatch dispatcher/c)
(#:confirmation-channel (or/c false/c async-channel?) (#:confirmation-channel (or/c false/c async-channel?)
#:tcp@ (unit/c (import) (export tcp^)) #:tcp@ (unit/c (import) (export tcp^))
#:port number? #:port tcp-listen-port?
#:listen-ip (or/c false/c string?) #:listen-ip (or/c false/c string?)
#:max-waiting number? #:max-waiting number?
#:initial-connection-timeout number?) #:initial-connection-timeout number?)
@ -26,7 +27,7 @@
(->* (#:dispatch dispatcher/c) (->* (#:dispatch dispatcher/c)
(#:confirmation-channel (or/c false/c async-channel?) (#:confirmation-channel (or/c false/c async-channel?)
#:tcp@ (unit/c (import) (export tcp^)) #:tcp@ (unit/c (import) (export tcp^))
#:ports (listof number?) #:ports (listof tcp-listen-port?)
#:listen-ip (or/c false/c string?) #:listen-ip (or/c false/c string?)
#:max-waiting number? #:max-waiting number?
#:initial-connection-timeout number?) #:initial-connection-timeout number?)
@ -35,7 +36,7 @@
(->* (#:dispatch dispatcher/c) (->* (#:dispatch dispatcher/c)
(#:confirmation-channel (or/c false/c async-channel?) (#:confirmation-channel (or/c false/c async-channel?)
#:tcp@ (unit/c (import) (export tcp^)) #:tcp@ (unit/c (import) (export tcp^))
#:ips+ports (listof (cons/c (or/c false/c string?) (listof number?))) #:ips+ports (listof (cons/c (or/c false/c string?) (listof tcp-listen-port?)))
#:max-waiting number? #:max-waiting number?
#:initial-connection-timeout number?) #:initial-connection-timeout number?)
(-> void))] (-> void))]