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

* Added #:log-file to `serve/servlet' (always using the

Browse Source 
'apache-default format for now)
* Using a convenient `dispatcher-sequence' as a `sequencer:make'
  wrapper

svn: r12535
This commit is contained in:
Eli Barzilay 2008-11-20 12:11:37 +00:00
parent 44ae506526
commit 631a8be60c
1 changed files with 30 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -26,7 +26,8 @@
(prefix-in sequencer: web-server/dispatchers/dispatch-sequencer) (prefix-in sequencer: web-server/dispatchers/dispatch-sequencer)
(prefix-in files: web-server/dispatchers/dispatch-files) (prefix-in files: web-server/dispatchers/dispatch-files)
(prefix-in filter: web-server/dispatchers/dispatch-filter) (prefix-in filter: web-server/dispatchers/dispatch-filter)
(prefix-in servlets: web-server/dispatchers/dispatch-servlets)) (prefix-in servlets: web-server/dispatchers/dispatch-servlets)
(prefix-in log: web-server/dispatchers/dispatch-log))
(define send-url (make-parameter net:send-url)) (define send-url (make-parameter net:send-url))
@ -58,9 +59,19 @@
#:file-not-found-responder (request? . -> . response?) #:file-not-found-responder (request? . -> . response?)
#:mime-types-path path? #:mime-types-path path?
#:servlet-path string? #:servlet-path string?
#:servlet-regexp regexp?) #:servlet-regexp regexp?
#:log-file (or/c false/c path?))
. ->* . . ->* .
void)]) void)])
;; utility for conveniently chaining dispatchers
(define (dispatcher-sequence . dispatchers)
(let loop ([ds dispatchers] [r '()])
(cond [(null? ds) (apply sequencer:make (reverse r))]
[(not (car ds)) (loop (cdr ds) r)]
[(list? (car ds)) (loop (append (car ds) (cdr ds)) r)]
[else (loop (cdr ds) (cons (car ds) r))])))
(define (serve/servlet (define (serve/servlet
start start
#:command-line? #:command-line?
@ -114,7 +125,10 @@
p p
(build-path (build-path
(directory-part default-configuration-table-path) (directory-part default-configuration-table-path)
"mime.types")))]) "mime.types")))]
#:log-file
[log-file #f])
(define standalone-url (define standalone-url
(string-append (if ssl? "https" "http") (string-append (if ssl? "https" "http")
"://localhost" "://localhost"
@ -126,10 +140,13 @@
(define sema (make-semaphore 0)) (define sema (make-semaphore 0))
(define servlet-box (box #f)) (define servlet-box (box #f))
(define dispatcher (define dispatcher
(sequencer:make (dispatcher-sequence
(if quit? (and log-file (log:make #:format (log:log-format->format
(filter:make #rx"^/quit$" (quit-server sema)) ;; 'parenthesized-default
(lambda _ (next-dispatcher))) ;; 'extended
'apache-default)
#:log-path log-file))
(and quit? (filter:make #rx"^/quit$" (quit-server sema)))
(filter:make (filter:make
servlet-regexp servlet-regexp
(servlets:make (servlets:make
@ -155,13 +172,12 @@
(make-default-path->servlet (make-default-path->servlet
#:make-servlet-namespace make-servlet-namespace))]) #:make-servlet-namespace make-servlet-namespace))])
(servlets:make url->servlet)) (servlets:make url->servlet))
(apply sequencer:make (map (lambda (extra-files-path)
(map (lambda (extra-files-path) (files:make
(files:make #:url->path (fsmap:make-url->path extra-files-path)
#:url->path (fsmap:make-url->path extra-files-path) #:path->mime-type (make-path->mime-type mime-types-path)
#:path->mime-type (make-path->mime-type mime-types-path) #:indices (list "index.html" "index.htm")))
#:indices (list "index.html" "index.htm"))) extra-files-paths)
extra-files-paths))
(files:make (files:make
#:url->path (fsmap:make-url->path (build-path server-root-path "htdocs")) #:url->path (fsmap:make-url->path (build-path server-root-path "htdocs"))
#:path->mime-type (make-path->mime-type mime-types-path) #:path->mime-type (make-path->mime-type mime-types-path)