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') .
(define port-number? (between/c 1 65535))
(define tcp-listen-port? (between/c 0 65535))
(define non-empty-string/c
(and/c string?
@ -364,6 +365,7 @@
[non-empty-string/c contract?]
[path-element? contract?]
[port-number? contract?]
[tcp-listen-port? contract?]
[non-empty-string? 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)].
}
@defthing[tcp-listen-port? contract?]{
Equivalent to @racket[(between/c 0 65535)].
}
@defthing[path-element? contract?]{
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
(require net/url
net/uri-codec
unstable/contract
web-server/private/util
web-server/private/connection-manager
web-server/http/request-structs)
@ -8,7 +9,7 @@
(provide/contract
[rename ext:read-request read-request
(connection?
port-number?
tcp-listen-port?
(input-port? . -> . (values string? string?))
. -> .
(values request? boolean?))])

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

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

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

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

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

@ -24,21 +24,22 @@
(start-connection-manager)
(thread
(lambda ()
(run-server config:port
(run-server 1 ; This is the port argument, but because we specialize listen, it is ignored.
handle-connection
#f
(lambda (exn)
((error-display-handler)
(format "Connection error: ~a" (exn-message exn))
exn))
(lambda (p mw re)
(lambda (_ mw re)
(with-handlers ([exn?
(λ (x)
(async-channel-put* confirmation-channel x)
(raise x))])
(begin0
(tcp-listen p config:max-waiting #t config:listen-ip)
(async-channel-put* confirmation-channel #f))))
(define listener (tcp-listen config:port 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 local-port))
listener))
tcp-close
tcp-accept
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/connection-manager
net/tcp-sig
unstable/contract
racket/async-channel
racket/tcp
web-server/web-server-sig))
@ -26,7 +27,7 @@ The @racket[dispatch-server^] signature is an alias for
@racket[web-server^].
@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?]
@ -39,12 +40,12 @@ The @racket[dispatch-server^] signature is an alias for
@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[max-waiting integer?]{Passed to @racket[tcp-accept].}
@defthing[initial-connection-timeout integer?]{Specifies the initial timeout given to a connection.}
@defproc[(read-request [c connection?]
[p port-number?]
[p tcp-listen-port?]
[port-addresses
(input-port? . -> . (values string? string?))])
(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/dispatchers/dispatch
racket/async-channel
unstable/contract
web-server/configuration/configuration-table)
(prefix-in raw: (for-label net/tcp-unit))
(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]
[#:confirmation-channel confirmation-channel (or/c false/c async-channel?) #f]
[#: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]
[#:max-waiting max-waiting integer? 40]
[#:initial-connection-timeout initial-connection-timeout integer? 60])
@ -51,7 +52,7 @@ from a given path:
@defproc[(serve/ports [#:dispatch dispatch dispatcher/c]
[#:confirmation-channel confirmation-channel (or/c false/c async-channel?) #f]
[#: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]
[#:max-waiting max-waiting integer? 40]
[#:initial-connection-timeout initial-connection-timeout integer? 60])
@ -63,7 +64,7 @@ from a given path:
@defproc[(serve/ips+ports [#:dispatch dispatch dispatcher/c]
[#:confirmation-channel confirmation-channel (or/c false/c async-channel?) #f]
[#: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]
[#:initial-connection-timeout initial-connection-timeout integer? 60])
(-> 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?)]
[#:banner? banner? boolean? (not command-line?)]
[#: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?
"/servlets/standalone.rkt"]
[#:servlet-regexp servlet-regexp regexp?

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

@ -9,6 +9,7 @@
racket/serialize
net/tcp-unit
net/tcp-sig
unstable/contract
net/ssl-tcp-unit)
(require web-server/web-server
web-server/managers/lru
@ -37,7 +38,7 @@
(#:launch-path (or/c false/c string?)
#:banner? boolean?
#:listen-ip (or/c false/c string?)
#:port number?
#:port tcp-listen-port?
#:ssl-cert (or/c false/c path-string?)
#:ssl-key (or/c false/c path-string?))
. ->* .
@ -93,24 +94,19 @@
#:listen-ip
[listen-ip "127.0.0.1"]
#:port
[port 8000]
[port-arg 8000]
#:ssl-cert
[ssl-cert #f]
#:ssl-key
[ssl-key #f])
(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 confirm-ch (make-async-channel 1))
(define shutdown-server
(serve #:confirmation-channel confirm-ch
#:dispatch (dispatcher sema)
#:listen-ip listen-ip
#:port port
#:port port-arg
#:tcp@ (if ssl?
(let ()
(define-unit-binding ssl-tcp@
@ -121,15 +117,20 @@
ssl-tcp@)
tcp@)))
(define serve-res (async-channel-get confirm-ch))
(if serve-res
(if (exn? serve-res)
(begin
(when banner? (eprintf "There was an error starting the Web server.\n"))
(match serve-res
[(and (? exn?) (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))]
[(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-arg))]
[_
(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
((send-url) (string-append server-url launch-path) #t))
(when banner?

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

@ -14,6 +14,7 @@
web-server/private/mime-types
web-server/servlet/setup
web-server/servlet-dispatch
unstable/contract
(prefix-in lift: web-server/dispatchers/dispatch-lift)
(prefix-in fsmap: web-server/dispatchers/filesystem-map)
(prefix-in sequencer: web-server/dispatchers/dispatch-sequencer)
@ -43,7 +44,7 @@
#:quit? boolean?
#:banner? boolean?
#:listen-ip (or/c false/c string?)
#:port number?
#:port tcp-listen-port?
#:ssl? boolean?
#:ssl-cert (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/async-channel
racket/contract
unstable/contract
web-server/dispatchers/dispatch
web-server/private/dispatch-server-sig
web-server/private/dispatch-server-unit
@ -17,7 +18,7 @@
(->* (#:dispatch dispatcher/c)
(#:confirmation-channel (or/c false/c async-channel?)
#:tcp@ (unit/c (import) (export tcp^))
#:port number?
#:port tcp-listen-port?
#:listen-ip (or/c false/c string?)
#:max-waiting number?
#:initial-connection-timeout number?)
@ -26,7 +27,7 @@
(->* (#:dispatch dispatcher/c)
(#:confirmation-channel (or/c false/c async-channel?)
#:tcp@ (unit/c (import) (export tcp^))
#:ports (listof number?)
#:ports (listof tcp-listen-port?)
#:listen-ip (or/c false/c string?)
#:max-waiting number?
#:initial-connection-timeout number?)
@ -35,7 +36,7 @@
(->* (#:dispatch dispatcher/c)
(#:confirmation-channel (or/c false/c async-channel?)
#: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?
#:initial-connection-timeout number?)
(-> void))]