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

abstracting

Browse Source 
svn: r13467
This commit is contained in:
Jay McCarthy 2009-02-06 17:25:47 +00:00
parent 5d3a76489f
commit 5b5571843d
2 changed files with 99 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -131,7 +131,7 @@ If you want to use @scheme[serve/servlet] in a start up script for a Web server,
The server listens on @scheme[listen-ip] and port @scheme[port].
If @scheme[ssl?] is true, then the server runs in HTTPS mode with @filepath{<server-root-path>/server-cert.pem}
and @filepath{<server-root-path>/private-key.pem} as the certificates and private keys
and @filepath{<server-root-path>/private-key.pem} as the certificates and private keys.
The servlet is loaded with @scheme[manager]
as its continuation manager. (The default manager limits the amount of memory to 64 MB and
@ -180,5 +180,29 @@ If you want to use @scheme[serve/servlet] in a start up script for a Web server,
The modules specified by @scheme[servlet-namespace] are shared with other servlets.
}
@defproc[(serve/launch/wait
[make-dispatcher (semaphore? . -> . dispatcher/c)]
[#:launch-path launch-path (or/c false/c string?) #f]
[#:banner? banner? boolean? #f]
[#:listen-ip listen-ip (or/c false/c string?) "127.0.0.1"]
[#:port port number? 8000]
[#:ssl-keys ssl-keys (or/c false/c (cons/c path-string? path-string?)) #f])
void]{
The other interesting part of @scheme[serve/servlet] is its ability to start up a server and immediately
launch a browser at it. This is provided by @scheme[serve/launch/wait].
It starts a server using the result of @scheme[make-dispatcher] as the dispatcher. @scheme[make-dispatcher] is supplied
a semaphore that if posted, will cause the server to quit.
If @scheme[launch-path] is not false, then a browser is launch with that path appended to the URL to the server itself.
If @scheme[banner?] is true, then a banner is printed informing the user of the server's URL.
The server listens on @scheme[listen-ip] and port @scheme[port].
If @scheme[ssl-keys] is not false, then the server runs in HTTPS mode with @scheme[(car ssl-keys)]
and @scheme[(cdr ssl-keys)] as paths to the certificate and private key.
}
}

111
collects/web-server/servlet-env.ss
View File

@ -50,7 +50,15 @@
#:stateless? boolean?
#:manager manager?)
. ->* .
dispatcher/c)]
dispatcher/c)]
[serve/launch/wait (((semaphore? . -> . dispatcher/c))
(#:launch-path (or/c false/c string?)
#:banner? boolean?
#:listen-ip (or/c false/c string?)
#:port number?
#:ssl-keys (or/c false/c (cons/c path-string? path-string?)))
. ->* .
void)]
[serve/servlet (((request? . -> . response/c))
(#:command-line? boolean?
#:launch-browser? boolean?
@ -120,6 +128,56 @@
(set-box! servlet-box servlet)
servlet))))))
(define (serve/launch/wait
dispatcher
#:launch-path
[launch-path #f]
#:banner?
[banner? #t]
#:listen-ip
[listen-ip "127.0.0.1"]
#:port
[port 8000]
#:ssl-keys
[ssl-keys #f])
(define ssl? (pair? ssl-keys))
(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 shutdown-server
(serve #:dispatch (dispatcher sema)
#:listen-ip listen-ip
#:port port
#:tcp@ (if ssl?
(let ()
(define-unit-binding ssl-tcp@
(make-ssl-tcp@
(car ssl-keys) (cdr ssl-keys)
#f #f #f #f #f)
(import) (export tcp^))
ssl-tcp@)
tcp@)))
(when launch-path
((send-url) (string-append server-url launch-path) #t))
(when banner?
(printf "Your Web application is running at ~a.\n"
(if launch-path
(string-append server-url launch-path)
server-url))
(printf "Click 'Stop' at any time to terminate the Web Server.\n"))
(let ([bye (lambda ()
(when banner? (printf "\nWeb Server stopped.\n"))
(shutdown-server))])
(with-handlers ([exn:break? (lambda (exn) (bye))])
(semaphore-wait/enable-break sema)
;; We can get here if a /quit url is visited
(bye))))
(define (serve/servlet
start
#:command-line?
@ -177,16 +235,7 @@
[log-file #f]
#:log-format
[log-format 'apache-default])
(define standalone-url
(string-append (if ssl? "https" "http")
"://localhost"
(if (and (not ssl?) (= the-port 80))
"" (format ":~a" the-port))
servlet-path))
(define make-servlet-namespace
(make-make-servlet-namespace #:to-be-copied-module-specs servlet-namespace))
(define sema (make-semaphore 0))
(define dispatcher
(define (dispatcher sema)
(dispatcher-sequence
(and log-file (log:make #:format (log:log-format->format log-format)
#:log-path log-file))
@ -205,7 +254,8 @@
(fsmap:make-url->valid-path
(fsmap:make-url->path servlets-root)))
(make-default-path->servlet
#:make-servlet-namespace make-servlet-namespace))])
#:make-servlet-namespace
(make-make-servlet-namespace #:to-be-copied-module-specs servlet-namespace)))])
(servlets:make url->servlet))
(map (lambda (extra-files-path)
(files:make
@ -218,29 +268,14 @@
#:path->mime-type (make-path->mime-type mime-types-path)
#:indices (list "index.html" "index.htm"))
(lift:make file-not-found-responder)))
(define shutdown-server
(serve #:dispatch dispatcher
#:listen-ip listen-ip
#:port the-port
#:tcp@ (if ssl?
(let ()
(define-unit-binding ssl-tcp@
(make-ssl-tcp@
(build-path server-root-path "server-cert.pem")
(build-path server-root-path "private-key.pem")
#f #f #f #f #f)
(import) (export tcp^))
ssl-tcp@)
tcp@)))
(when launch-browser?
((send-url) standalone-url #t))
(when banner?
(printf "Your Web application is running at ~a.\n" standalone-url)
(printf "Click 'Stop' at any time to terminate the Web Server.\n"))
(let ([bye (lambda ()
(when banner? (printf "\nWeb Server stopped.\n"))
(shutdown-server))])
(with-handlers ([exn:break? (lambda (exn) (bye))])
(semaphore-wait/enable-break sema)
;; We can get here if a /quit url is visited
(bye))))
(serve/launch/wait
dispatcher
#:launch-path (if launch-browser? servlet-path #f)
#:banner? banner?
#:listen-ip listen-ip
#:port the-port
#:ssl-keys
(if ssl?
(cons (build-path server-root-path "server-cert.pem")
(build-path server-root-path "private-key.pem"))
#f)))