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

Abstracting path filtering

Browse Source 
svn: r6357
This commit is contained in:
Jay McCarthy 2007-05-28 17:51:28 +00:00
parent 3adb445691
commit b8b0e29437
3 changed files with 25 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/web-server/dispatchers/dispatch-filter.ss Normal file
View File

@ -0,0 +1,14 @@
(module dispatch-filter mzscheme
(require (lib "contract.ss"))
(require "dispatch.ss"
"../private/util.ss")
(provide/contract
[interface-version dispatcher-interface-version?]
[make (regexp? dispatcher? . -> . dispatcher?)])
(define interface-version 'v1)
(define ((make regex inner) conn req)
(define-values (uri method path) (decompose-request req))
(if (regexp-match regex path)
(inner conn req)
(next-dispatcher))))

11
collects/web-server/prototype-web-server/dispatch-servlets2.ss
View File

@ -65,19 +65,10 @@
[responders-file-not-found [responders-file-not-found
(gen-file-not-found-responder "not-found.html")]) (gen-file-not-found-responder "not-found.html")])
;; dispatch: connection request -> void ;; dispatch : connection request -> void
(define (dispatch conn req) (define (dispatch conn req)
(define-values (uri method path) (decompose-request req))
(myprint "dispatch~n")
(if (regexp-match #rx"^/servlets" path)
(begin
(adjust-connection-timeout! conn timeouts-servlet-connection) (adjust-connection-timeout! conn timeouts-servlet-connection)
;; more here - make timeouts proportional to size of bindings ;; more here - make timeouts proportional to size of bindings
(servlet-content-producer conn req))
(next-dispatcher)))
;; servlet-content-producer: connection request -> void
(define (servlet-content-producer conn req)
(myprint "servlet-content-producer~n") (myprint "servlet-content-producer~n")
(let ([meth (request-method req)]) (let ([meth (request-method req)])
(if (eq? meth 'head) (if (eq? meth 'head)

5
collects/web-server/prototype-web-server/run.ss
View File

@ -6,6 +6,7 @@
(prefix http: (lib "request.ss" "web-server" "private")) (prefix http: (lib "request.ss" "web-server" "private"))
(lib "configuration-structures.ss" "web-server" "private") (lib "configuration-structures.ss" "web-server" "private")
(prefix files: (lib "dispatch-files.ss" "web-server" "dispatchers")) (prefix files: (lib "dispatch-files.ss" "web-server" "dispatchers"))
(prefix filter: (lib "dispatch-filter.ss" "web-server" "dispatchers"))
(prefix sequencer: (lib "dispatch-sequencer.ss" "web-server" "dispatchers"))) (prefix sequencer: (lib "dispatch-sequencer.ss" "web-server" "dispatchers")))
(require "hardcoded-configuration.ss" (require "hardcoded-configuration.ss"
(prefix servlets2: "dispatch-servlets2.ss")) (prefix servlets2: "dispatch-servlets2.ss"))
@ -18,11 +19,13 @@
(define read-request http:read-request) (define read-request http:read-request)
(define dispatch (define dispatch
(sequencer:make (sequencer:make
(filter:make
#rx"^/servlets"
(servlets2:make #:servlet-root (paths-servlet (host-paths host-info)) (servlets2:make #:servlet-root (paths-servlet (host-paths host-info))
#:timeouts-servlet-connection (timeouts-servlet-connection (host-timeouts host-info)) #:timeouts-servlet-connection (timeouts-servlet-connection (host-timeouts host-info))
#:responders-servlet-loading (responders-servlet-loading (host-responders host-info)) #:responders-servlet-loading (responders-servlet-loading (host-responders host-info))
#:responders-servlet (responders-servlet (host-responders host-info)) #:responders-servlet (responders-servlet (host-responders host-info))
#:responders-file-not-found (responders-file-not-found (host-responders host-info))) #:responders-file-not-found (responders-file-not-found (host-responders host-info))))
(files:make #:htdocs-path (paths-htdocs (host-paths host-info)) (files:make #:htdocs-path (paths-htdocs (host-paths host-info))
#:mime-types-path (paths-mime-types (host-paths host-info)) #:mime-types-path (paths-mime-types (host-paths host-info))
#:indices (host-indices host-info) #:indices (host-indices host-info)