Abstracting HTTP code to sub-module
svn: r12415
This commit is contained in:
Jay McCarthy
parent
a2b5ebb64c
commit
d0a5616cb0
|
|
@ -6,7 +6,7 @@
|
|||
net/url
|
||||
mzlib/list
|
||||
xml/xml
|
||||
web-server/private/request-structs
|
||||
web-server/http
|
||||
web-server/private/util
|
||||
web-server/dispatchers/dispatch
|
||||
(prefix-in files: web-server/dispatchers/dispatch-files)
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
make-temporary-file)
|
||||
net/url
|
||||
mzlib/list
|
||||
web-server/private/request-structs
|
||||
web-server/http
|
||||
web-server/dispatchers/dispatch
|
||||
(prefix-in host: web-server/dispatchers/dispatch-host))
|
||||
(provide dispatch-host-tests)
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
mzlib/etc
|
||||
mzlib/list
|
||||
web-server/dispatchers/dispatch
|
||||
web-server/private/request-structs
|
||||
web-server/http
|
||||
web-server/configuration/namespace
|
||||
web-server/servlet/setup
|
||||
(prefix-in servlets: web-server/dispatchers/dispatch-servlets)
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
net/url
|
||||
mzlib/list
|
||||
mzlib/serialize
|
||||
web-server/private/request-structs
|
||||
web-server/http
|
||||
web-server/dispatchers/dispatch
|
||||
(prefix-in passwords: web-server/dispatchers/dispatch-passwords)
|
||||
"../util.ss")
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
(planet "sxml.ss" ("lizorkin" "sxml.plt" 2 0))
|
||||
mzlib/etc
|
||||
mzlib/list
|
||||
web-server/private/request-structs
|
||||
web-server/http
|
||||
web-server/private/cache-table
|
||||
web-server/private/web-server-structs
|
||||
web-server/configuration/namespace
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
||||
(planet "sxml.ss" ("lizorkin" "sxml.plt" 2 0))
|
||||
mzlib/list
|
||||
web-server/private/request-structs
|
||||
web-server/http
|
||||
"../util.ss")
|
||||
(provide test-add-two-numbers
|
||||
test-double-counters
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
#lang scheme/base
|
||||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
||||
(only-in mzlib/file make-temporary-file)
|
||||
web-server/private/mime-types
|
||||
web-server/private/response-structs)
|
||||
web-server/http
|
||||
web-server/private/mime-types)
|
||||
(provide mime-types-tests)
|
||||
|
||||
(define test-file (make-temporary-file))
|
||||
|
|
|
|||
|
|
@ -3,10 +3,10 @@
|
|||
(planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
||||
web-server/private/connection-manager
|
||||
web-server/private/timer
|
||||
web-server/private/request-structs)
|
||||
web-server/http)
|
||||
(provide request-tests)
|
||||
|
||||
(require/expose web-server/private/request
|
||||
(require/expose web-server/http/request
|
||||
(read-bindings&post-data/raw))
|
||||
|
||||
;; mock connection object for test on post body parsing
|
||||
|
|
|
|||
|
|
@ -4,12 +4,11 @@
|
|||
xml/xml
|
||||
(only-in mzlib/file
|
||||
make-temporary-file)
|
||||
web-server/private/response
|
||||
web-server/private/request-structs
|
||||
web-server/private/response-structs
|
||||
web-server/http
|
||||
web-server/http/response
|
||||
"../util.ss")
|
||||
|
||||
(require/expose web-server/private/response
|
||||
(require/expose web-server/http/response
|
||||
(convert-http-ranges
|
||||
make-content-length-header
|
||||
make-content-range-header
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
#lang scheme/base
|
||||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
||||
web-server/private/request-structs
|
||||
web-server/servlet/basic-auth)
|
||||
web-server/http)
|
||||
(provide basic-auth-tests)
|
||||
|
||||
(define basic-auth-tests
|
||||
|
|
|
|||
|
|
@ -2,8 +2,8 @@
|
|||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
||||
mzlib/list
|
||||
net/url
|
||||
web-server/private/request-structs
|
||||
web-server/servlet/bindings)
|
||||
web-server/http
|
||||
web-server/http/bindings)
|
||||
(provide bindings-tests)
|
||||
|
||||
(define bs `([foo . 3] [foos . 1] [foos . 2]))
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
#lang scheme/base
|
||||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
||||
web-server/private/response-structs
|
||||
web-server/private/request-structs
|
||||
web-server/http
|
||||
web-server/servlet/helpers)
|
||||
(provide helpers-tests)
|
||||
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
web-server/private/connection-manager
|
||||
(only-in (planet "ssax.ss" ("lizorkin" "ssax.plt" 2 0))
|
||||
ssax:xml->sxml)
|
||||
web-server/private/request-structs
|
||||
web-server/http
|
||||
web-server/private/web-server-structs
|
||||
net/url
|
||||
mzlib/pretty
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
#lang scheme/base
|
||||
(require mzlib/contract
|
||||
net/url)
|
||||
(require "../private/response-structs.ss"
|
||||
"../private/request-structs.ss"
|
||||
(require web-server/http/response-structs
|
||||
web-server/http/request-structs
|
||||
"../private/util.ss")
|
||||
|
||||
; configuration-table = (make-configuration-table nat nat num host-table (listof (cons str host-table)))
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
mzlib/list
|
||||
mzlib/pretty)
|
||||
(require "configuration-table-structs.ss"
|
||||
"../servlet/bindings.ss")
|
||||
web-server/http/bindings)
|
||||
(define configuration-table-sexpr? list?)
|
||||
|
||||
(provide/contract
|
||||
|
|
|
|||
|
|
@ -2,8 +2,8 @@
|
|||
(require mzlib/contract
|
||||
mzlib/list
|
||||
net/url)
|
||||
(require "../private/response-structs.ss"
|
||||
"../private/request-structs.ss")
|
||||
(require web-server/http/response-structs
|
||||
web-server/http/request-structs)
|
||||
|
||||
(define (format-stack-trace trace)
|
||||
`(pre
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#lang scheme/base
|
||||
(require web-server/private/request-structs
|
||||
(require web-server/http
|
||||
net/url)
|
||||
(define interface-version 'stateless)
|
||||
(provide start interface-version)
|
||||
|
|
|
|||
|
|
@ -6,10 +6,8 @@
|
|||
|
||||
(require "dispatch.ss"
|
||||
"../private/util.ss"
|
||||
"../private/request-structs.ss"
|
||||
"../private/response-structs.ss"
|
||||
"../servlet/helpers.ss"
|
||||
"../private/response.ss"
|
||||
web-server/http
|
||||
web-server/http/response
|
||||
"../dispatchers/filesystem-map.ss")
|
||||
|
||||
(provide/contract
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
(require mzlib/contract
|
||||
net/url)
|
||||
(require "dispatch.ss"
|
||||
"../private/request-structs.ss"
|
||||
web-server/http
|
||||
"../private/util.ss")
|
||||
(provide/contract
|
||||
[interface-version dispatcher-interface-version/c]
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
(require mzlib/contract
|
||||
mzlib/plt-match
|
||||
net/url
|
||||
"../private/request-structs.ss"
|
||||
web-server/http
|
||||
"../private/util.ss"
|
||||
"dispatch.ss")
|
||||
(provide/contract
|
||||
|
|
|
|||
|
|
@ -1,9 +1,8 @@
|
|||
#lang scheme/base
|
||||
(require mzlib/contract)
|
||||
(require "dispatch.ss"
|
||||
"../private/response.ss"
|
||||
"../private/request-structs.ss"
|
||||
"../private/response-structs.ss")
|
||||
web-server/http
|
||||
web-server/http/response)
|
||||
(provide/contract
|
||||
[interface-version dispatcher-interface-version/c]
|
||||
[make ((request? . -> . response?) . -> . dispatcher/c)])
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
mzlib/plt-match
|
||||
scheme/contract)
|
||||
(require "dispatch.ss"
|
||||
"../private/request-structs.ss")
|
||||
web-server/http)
|
||||
(define format-req/c (request? . -> . string?))
|
||||
|
||||
(provide/contract
|
||||
|
|
|
|||
|
|
@ -5,10 +5,8 @@
|
|||
(require "dispatch.ss"
|
||||
"../private/util.ss"
|
||||
"../configuration/responders.ss"
|
||||
"../private/request-structs.ss"
|
||||
"../private/response-structs.ss"
|
||||
"../servlet/basic-auth.ss"
|
||||
"../private/response.ss")
|
||||
web-server/http
|
||||
web-server/http/response)
|
||||
|
||||
(define denied?/c (request? . -> . (or/c false/c string?)))
|
||||
(define authorized?/c (string? (or/c false/c bytes?) (or/c false/c bytes?) . -> . (or/c false/c string?)))
|
||||
|
|
|
|||
|
|
@ -3,9 +3,8 @@
|
|||
net/url)
|
||||
(require "dispatch.ss"
|
||||
"../private/util.ss"
|
||||
"../private/response.ss"
|
||||
"../private/request-structs.ss"
|
||||
"../private/response-structs.ss")
|
||||
web-server/http
|
||||
web-server/http/response)
|
||||
(provide/contract
|
||||
[interface-version dispatcher-interface-version/c]
|
||||
[make (string? (request? . -> . response?) . -> . dispatcher/c)])
|
||||
|
|
|
|||
|
|
@ -2,9 +2,8 @@
|
|||
(require scheme/contract)
|
||||
(require web-server/servlet/setup
|
||||
web-server/managers/manager
|
||||
web-server/private/response
|
||||
web-server/private/response-structs
|
||||
web-server/private/request-structs
|
||||
web-server/http
|
||||
web-server/http/response
|
||||
net/url
|
||||
web-server/dispatchers/dispatch
|
||||
web-server/dispatchers/filesystem-map
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#lang scheme/base
|
||||
(require scheme/contract)
|
||||
(require "../private/connection-manager.ss"
|
||||
"../private/request-structs.ss")
|
||||
web-server/http)
|
||||
|
||||
(define dispatcher/c
|
||||
(connection? request? . -> . void))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#lang scheme
|
||||
(require web-server/private/request-structs
|
||||
(require web-server/http
|
||||
"lib.ss")
|
||||
|
||||
(define (next-name i)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#lang scheme
|
||||
(require web-server/private/request-structs
|
||||
(require web-server/http
|
||||
xml)
|
||||
|
||||
; Combinators
|
||||
|
|
|
|||
9
collects/web-server/http.ss
Normal file
9
collects/web-server/http.ss
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
#lang scheme
|
||||
(require web-server/http/basic-auth
|
||||
web-server/http/request-structs
|
||||
web-server/http/response-structs
|
||||
web-server/http/redirect)
|
||||
(provide (all-from-out web-server/http/basic-auth
|
||||
web-server/http/request-structs
|
||||
web-server/http/response-structs
|
||||
web-server/http/redirect))
|
||||
|
|
@ -1,8 +1,8 @@
|
|||
#lang scheme/base
|
||||
(require mzlib/contract
|
||||
mzlib/plt-match
|
||||
net/base64)
|
||||
(require "../private/request-structs.ss")
|
||||
net/base64
|
||||
web-server/http/request-structs)
|
||||
|
||||
(define (extract-user-pass headers)
|
||||
(match (headers-assq* #"Authorization" headers)
|
||||
|
|
@ -1,9 +1,9 @@
|
|||
#lang scheme/base
|
||||
(require mzlib/list
|
||||
mzlib/contract
|
||||
mzlib/plt-match)
|
||||
(require "../private/util.ss"
|
||||
"../private/request-structs.ss")
|
||||
mzlib/plt-match
|
||||
web-server/private/util
|
||||
web-server/http/request-structs)
|
||||
|
||||
(define (request-headers request)
|
||||
(map (match-lambda
|
||||
32
collects/web-server/http/redirect.ss
Normal file
32
collects/web-server/http/redirect.ss
Normal file
|
|
@ -0,0 +1,32 @@
|
|||
#lang scheme/base
|
||||
(require scheme/contract)
|
||||
(require web-server/http/response-structs
|
||||
web-server/http/request-structs)
|
||||
|
||||
; redirection-status = (make-redirection-status nat str)
|
||||
(define-struct redirection-status (code message))
|
||||
|
||||
(define permanently (make-redirection-status 301 "Moved Permanently"))
|
||||
(define temporarily (make-redirection-status 302 "Moved Temporarily"))
|
||||
(define see-other (make-redirection-status 303 "See Other"))
|
||||
|
||||
; : str [redirection-status] -> response
|
||||
(define(redirect-to
|
||||
uri
|
||||
[perm/temp temporarily]
|
||||
#:headers [headers (list)])
|
||||
(make-response/full (redirection-status-code perm/temp)
|
||||
(redirection-status-message perm/temp)
|
||||
(current-seconds) #"text/html"
|
||||
(list* (make-header #"Location" (string->bytes/utf-8 uri))
|
||||
headers)
|
||||
(list)))
|
||||
|
||||
(provide/contract
|
||||
[redirect-to
|
||||
(->* (string?) (redirection-status? #:headers (listof header?))
|
||||
response/full?)]
|
||||
[redirection-status? (any/c . -> . boolean?)]
|
||||
[permanently redirection-status?]
|
||||
[temporarily redirection-status?]
|
||||
[see-other redirection-status?])
|
||||
|
|
@ -3,10 +3,10 @@
|
|||
mzlib/plt-match
|
||||
net/url
|
||||
mzlib/list
|
||||
net/uri-codec)
|
||||
(require "util.ss"
|
||||
"connection-manager.ss"
|
||||
"../private/request-structs.ss")
|
||||
net/uri-codec
|
||||
web-server/private/util
|
||||
web-server/private/connection-manager
|
||||
web-server/http/request-structs)
|
||||
|
||||
(provide/contract
|
||||
[rename ext:read-request read-request
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
#lang scheme/base
|
||||
(require mzlib/contract
|
||||
xml/xml
|
||||
"request-structs.ss")
|
||||
web-server/http/request-structs)
|
||||
|
||||
(define TEXT/HTML-MIME-TYPE #"text/html; charset=utf-8")
|
||||
|
||||
|
|
@ -7,10 +7,10 @@
|
|||
(only-in srfi/1/list fold filter-map)
|
||||
(only-in srfi/13/string string-join)
|
||||
xml/xml
|
||||
"connection-manager.ss"
|
||||
"../private/request-structs.ss"
|
||||
"../private/response-structs.ss"
|
||||
"util.ss")
|
||||
web-server/private/connection-manager
|
||||
web-server/http/request-structs
|
||||
web-server/http/response-structs
|
||||
web-server/private/util)
|
||||
|
||||
(provide/contract
|
||||
[rename ext:output-response output-response (connection? response? . -> . void)]
|
||||
|
|
@ -49,8 +49,7 @@
|
|||
|
||||
;; Notes:
|
||||
;; 1. close? is a boolean which corresponds roughly to the protocol version.
|
||||
;; #t |-> 1.0 and #f |-> 1.1. See function close-connection? in
|
||||
;; private/request.ss
|
||||
;; #t |-> 1.0 and #f |-> 1.1. See function close-connection?
|
||||
;;
|
||||
;; 2. In the case of a chunked response when close? = #f, then the response
|
||||
;; must be compliant with http 1.0. In this case the chunked response is
|
||||
|
|
@ -1,8 +1,6 @@
|
|||
#lang scheme
|
||||
(require net/url
|
||||
"../private/request-structs.ss"
|
||||
"../private/response-structs.ss"
|
||||
"../servlet/helpers.ss"
|
||||
web-server/http
|
||||
"abort-resume.ss"
|
||||
"web.ss"
|
||||
"web-cells.ss"
|
||||
|
|
@ -10,13 +8,11 @@
|
|||
"file-box.ss"
|
||||
"web-extras.ss")
|
||||
(provide (except-out (all-from-out scheme) #%module-begin)
|
||||
(all-from-out net/url)
|
||||
(all-from-out "../private/request-structs.ss")
|
||||
(all-from-out "../private/response-structs.ss")
|
||||
(all-from-out "../servlet/helpers.ss")
|
||||
(all-from-out "abort-resume.ss")
|
||||
(all-from-out "web.ss")
|
||||
(all-from-out "web-cells.ss")
|
||||
(all-from-out "web-param.ss")
|
||||
(all-from-out "file-box.ss")
|
||||
(all-from-out "web-extras.ss"))
|
||||
(all-from-out net/url
|
||||
web-server/http
|
||||
"abort-resume.ss"
|
||||
"web.ss"
|
||||
"web-cells.ss"
|
||||
"web-param.ss"
|
||||
"file-box.ss"
|
||||
"web-extras.ss"))
|
||||
|
|
|
|||
|
|
@ -1,10 +1,8 @@
|
|||
#lang scheme/base
|
||||
(require net/url
|
||||
scheme/contract
|
||||
(for-template "web.ss")
|
||||
"web.ss"
|
||||
web-server/private/request-structs
|
||||
"../servlet/helpers.ss")
|
||||
web-server/http)
|
||||
(provide/contract
|
||||
[redirect/get (-> request?)])
|
||||
|
||||
|
|
|
|||
|
|
@ -2,11 +2,9 @@
|
|||
(require net/url
|
||||
scheme/contract
|
||||
scheme/serialize
|
||||
web-server/private/request-structs
|
||||
web-server/private/response-structs
|
||||
web-server/http
|
||||
web-server/private/define-closure
|
||||
web-server/private/servlet
|
||||
"../private/request-structs.ss"
|
||||
web-server/private/servlet
|
||||
"abort-resume.ss"
|
||||
"stuff-url.ss"
|
||||
"../private/url-param.ss")
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
mzlib/plt-match
|
||||
mzlib/string)
|
||||
(require "util.ss"
|
||||
"response-structs.ss")
|
||||
web-server/http)
|
||||
(provide/contract
|
||||
[read-mime-types (path-string? . -> . hash?)]
|
||||
[make-path->mime-type (path-string? . -> . (path? . -> . bytes?))])
|
||||
|
|
|
|||
|
|
@ -1,8 +1,7 @@
|
|||
#lang scheme/base
|
||||
(require scheme/contract)
|
||||
(require "../managers/manager.ss"
|
||||
"../private/request-structs.ss"
|
||||
"../private/response-structs.ss")
|
||||
web-server/http)
|
||||
|
||||
(define servlet-prompt (make-continuation-prompt-tag 'servlet))
|
||||
(define-struct (exn:fail:servlet:instance exn:fail) ())
|
||||
|
|
|
|||
|
|
@ -245,8 +245,7 @@ a URL that refreshes the password file, servlet cache, etc.}
|
|||
@elem{defines a dispatcher constructor
|
||||
that performs HTTP Basic authentication filtering.}]{
|
||||
|
||||
@(require (for-label web-server/private/request-structs
|
||||
web-server/private/response-structs
|
||||
@(require (for-label web-server/http
|
||||
net/url
|
||||
web-server/configuration/responders))
|
||||
|
||||
|
|
|
|||
272
collects/web-server/scribblings/http.scrbl
Normal file
272
collects/web-server/scribblings/http.scrbl
Normal file
|
|
@ -0,0 +1,272 @@
|
|||
#lang scribble/doc
|
||||
@(require "web-server.ss")
|
||||
|
||||
@title[#:tag "http"
|
||||
#:style 'toc]{HTTP}
|
||||
|
||||
@defmodule[web-server/http]
|
||||
|
||||
The @web-server implements many HTTP RFCs that are provided by this module.
|
||||
|
||||
@local-table-of-contents[]
|
||||
|
||||
@; ------------------------------------------------------------
|
||||
@section[#:tag "request-structs.ss"]{Requests}
|
||||
@(require (for-label web-server/http/request-structs))
|
||||
|
||||
@defmodule[web-server/http/request-structs]
|
||||
|
||||
@defstruct[header ([field bytes?]
|
||||
[value bytes?])]{
|
||||
Represents a header of @scheme[field] to @scheme[value].
|
||||
}
|
||||
|
||||
@defproc[(headers-assq [id bytes?] [heads (listof header?)])
|
||||
(or/c false/c header?)]{
|
||||
Returns the header with a field equal to @scheme[id] from @scheme[heads] or @scheme[#f].
|
||||
}
|
||||
|
||||
@defproc[(headers-assq* [id bytes?] [heads (listof header?)])
|
||||
(or/c false/c header?)]{
|
||||
Returns the header with a field case-insensitively equal to @scheme[id] from @scheme[heads] or @scheme[#f].
|
||||
|
||||
You almost @bold{always} want to use this, rather than @scheme[headers-assq] because Web browsers may send headers with arbitrary casing.
|
||||
}
|
||||
|
||||
@defstruct[binding ([id bytes?])]{Represents a binding of @scheme[id].}
|
||||
|
||||
@defstruct[(binding:form binding) ([value bytes?])]{
|
||||
Represents a form binding of @scheme[id] to @scheme[value].
|
||||
}
|
||||
|
||||
@defstruct[(binding:file binding) ([filename bytes?]
|
||||
[content bytes?])]{
|
||||
Represents the uploading of the file @scheme[filename] with the id @scheme[id]
|
||||
and the content @scheme[content].
|
||||
}
|
||||
|
||||
@defproc[(bindings-assq [id bytes?]
|
||||
[binds (listof binding?)])
|
||||
(or/c false/c binding?)]{
|
||||
Returns the binding with an id equal to @scheme[id] from @scheme[binds] or @scheme[#f].
|
||||
}
|
||||
|
||||
@defstruct[request ([method symbol?]
|
||||
[uri url?]
|
||||
[headers/raw (listof header?)]
|
||||
[bindings/raw (listof binding?)]
|
||||
[post-data/raw (or/c false/c bytes?)]
|
||||
[host-ip string?]
|
||||
[host-port number?]
|
||||
[client-ip string?])]{
|
||||
An HTTP @scheme[method] request to @scheme[uri] from @scheme[client-ip]
|
||||
to the server at @scheme[host-ip]:@scheme[host-port] with @scheme[headers/raw]
|
||||
headers, @scheme[bindings/raw] GET and POST queries and @scheme[post-data/raw]
|
||||
POST data.
|
||||
|
||||
You are @bold{unlikely to need to construct} a request struct.
|
||||
}
|
||||
|
||||
Here is an example typical of what you will find in many applications:
|
||||
@schemeblock[
|
||||
(define (get-number req)
|
||||
(match
|
||||
(bindings-assq
|
||||
#"number"
|
||||
(request-bindings/raw req))
|
||||
[(? binding:form? b)
|
||||
(string->number
|
||||
(bytes->string/utf-8
|
||||
(binding:form-value b)))]
|
||||
[_
|
||||
(get-number (request-number))]))
|
||||
]
|
||||
|
||||
@; ------------------------------------------------------------
|
||||
@section[#:tag "bindings.ss"]{Bindings}
|
||||
@(require (for-label web-server/http/bindings))
|
||||
|
||||
@defmodule[web-server/http/bindings]
|
||||
|
||||
These functions, while convenient, could introduce subtle bugs into your
|
||||
application. Examples: that they are case-insensitive could introduce
|
||||
a bug; if the data submitted is not in UTF-8 format, then the conversion
|
||||
to a string will fail; if an attacker submits a form field as if it were
|
||||
a file, when it is not, then the @scheme[request-bindings] will hold a
|
||||
@scheme[bytes?] object and your program will error; and, for file uploads
|
||||
you lose the filename. @bold{Therefore, we recommend against their use, but
|
||||
they are provided for compatibility with old code.}
|
||||
|
||||
@defproc[(request-bindings [req request?])
|
||||
(listof (or/c (cons/c symbol? string?)
|
||||
(cons/c symbol? bytes?)))]{
|
||||
Translates the @scheme[request-bindings/raw] of @scheme[req] by
|
||||
interpreting @scheme[bytes?] as @scheme[string?]s, except in the case
|
||||
of @scheme[binding:file] bindings, which are left as is. Ids are then
|
||||
translated into lowercase symbols.
|
||||
}
|
||||
|
||||
@defproc[(request-headers [req request?])
|
||||
(listof (cons/c symbol? string?))]{
|
||||
Translates the @scheme[request-headers/raw] of @scheme[req] by
|
||||
interpreting @scheme[bytes?] as @scheme[string?]s. Ids are then
|
||||
translated into lowercase symbols.
|
||||
}
|
||||
|
||||
@defproc[(extract-binding/single [id symbol?]
|
||||
[binds (listof (cons/c symbol? string?))])
|
||||
string?]{
|
||||
Returns the single binding associated with @scheme[id] in the a-list @scheme[binds]
|
||||
if there is exactly one binding. Otherwise raises @scheme[exn:fail].
|
||||
}
|
||||
|
||||
@defproc[(extract-bindings [id symbol?]
|
||||
[binds (listof (cons/c symbol? string?))])
|
||||
(listof string?)]{
|
||||
Returns a list of all the bindings of @scheme[id] in the a-list @scheme[binds].
|
||||
}
|
||||
|
||||
@defproc[(exists-binding? [id symbol?]
|
||||
[binds (listof (cons/c symbol? string))])
|
||||
boolean?]{
|
||||
Returns @scheme[#t] if @scheme[binds] contains a binding for @scheme[id].
|
||||
Otherwise, @scheme[#f].
|
||||
}
|
||||
|
||||
Here is an example typical of what you will find in many applications:
|
||||
@schemeblock[
|
||||
(define (get-number req)
|
||||
(string->number
|
||||
(extract-binding/single
|
||||
'number
|
||||
(request-bindings req))))
|
||||
]
|
||||
|
||||
@; ------------------------------------------------------------
|
||||
@section[#:tag "response-structs.ss"]{Responses}
|
||||
@(require (for-label web-server/http/response-structs))
|
||||
|
||||
@defmodule[web-server/http/response-structs]
|
||||
|
||||
@defstruct[response/basic
|
||||
([code number?]
|
||||
[message string?]
|
||||
[seconds number?]
|
||||
[mime bytes?]
|
||||
[headers (listof header?)])]{
|
||||
A basic HTTP response containing no body. @scheme[code] is the response code,
|
||||
@scheme[message] the message, @scheme[seconds] the generation time, @scheme[mime]
|
||||
the MIME type of the file, and @scheme[extras] are the extra headers, in addition
|
||||
to those produced by the server.
|
||||
|
||||
Example:
|
||||
@schemeblock[
|
||||
(make-response/basic
|
||||
301 "Moved Permanently"
|
||||
(current-seconds) TEXT/HTML-MIME-TYPE
|
||||
(list (make-header #"Location"
|
||||
#"http://www.plt-scheme.org/downloads")))
|
||||
]
|
||||
}
|
||||
|
||||
@defstruct[(response/full response/basic)
|
||||
([body (listof (or/c string? bytes?))])]{
|
||||
As with @scheme[response/basic], except with @scheme[body] as the response
|
||||
body.
|
||||
|
||||
Example:
|
||||
@schemeblock[
|
||||
(make-response/full
|
||||
301 "Moved Permanently"
|
||||
(current-seconds) TEXT/HTML-MIME-TYPE
|
||||
(list (make-header #"Location"
|
||||
#"http://www.plt-scheme.org/downloads"))
|
||||
(list #"<html><body><p>"
|
||||
#"Please go to <a href=\""
|
||||
#"http://www.plt-scheme.org/downloads"
|
||||
#"\">here</a> instead."
|
||||
#"</p></body></html>"))
|
||||
]
|
||||
}
|
||||
|
||||
@defstruct[(response/incremental response/basic)
|
||||
([generator ((() (listof (or/c bytes? string?)) . ->* . any) . -> . any)])]{
|
||||
As with @scheme[response/basic], except with @scheme[generator] as a function that is
|
||||
called to generate the response body, by being given an @scheme[output-response] function
|
||||
that outputs the content it is called with.
|
||||
|
||||
Here is a short example:
|
||||
@schemeblock[
|
||||
(make-response/incremental
|
||||
200 "OK" (current-seconds)
|
||||
#"application/octet-stream"
|
||||
(list (make-header #"Content-Disposition"
|
||||
#"attachement; filename=\"file\""))
|
||||
(lambda (send/bytes)
|
||||
(send/bytes #"Some content")
|
||||
(send/bytes)
|
||||
(send/bytes #"Even" #"more" #"content!")
|
||||
(send/bytes "Now we're done")))
|
||||
]
|
||||
}
|
||||
|
||||
@defproc[(response? [v any/c])
|
||||
boolean?]{
|
||||
Checks if @scheme[v] is a valid response. A response is either:
|
||||
@itemize[
|
||||
@item{A @scheme[response/basic] structure.}
|
||||
@item{A value matching the contract @scheme[(cons/c (or/c bytes? string?) (listof (or/c bytes? string?)))].}
|
||||
@item{A value matching @scheme[xexpr?].}
|
||||
]
|
||||
}
|
||||
|
||||
@defthing[TEXT/HTML-MIME-TYPE bytes?]{Equivalent to @scheme[#"text/html; charset=utf-8"].}
|
||||
|
||||
@warning{If you include a Content-Length header in a response that is inaccurate, there @bold{will be an error} in
|
||||
transmission that the server @bold{will not catch}.}
|
||||
|
||||
|
||||
@; ------------------------------------------------------------
|
||||
@section[#:tag "redirect.ss"]{Redirect}
|
||||
@(require (for-label web-server/http/redirect))
|
||||
|
||||
@defmodule[web-server/http/redirect]
|
||||
|
||||
@defproc[(redirect-to [uri string?]
|
||||
[perm/temp redirection-status? temporarily]
|
||||
[#:headers headers (listof header?) (list)])
|
||||
response?]{
|
||||
Generates an HTTP response that redirects the browser to @scheme[uri],
|
||||
while including the @scheme[headers] in the response.
|
||||
|
||||
Example:
|
||||
@scheme[(redirect-to "http://www.add-three-numbers.com" permanently)]
|
||||
}
|
||||
|
||||
@defproc[(redirection-status? [v any/c])
|
||||
boolean?]{
|
||||
Determines if @scheme[v] is one of the following values.
|
||||
}
|
||||
|
||||
@defthing[permanently redirection-status?]{A @scheme[redirection-status?] for permanent redirections.}
|
||||
|
||||
@defthing[temporarily redirection-status?]{A @scheme[redirection-status?] for temporary redirections.}
|
||||
|
||||
@defthing[see-other redirection-status?]{A @scheme[redirection-status?] for "see-other" redirections.}
|
||||
|
||||
@; ------------------------------------------------------------
|
||||
@section[#:tag "basic-auth.ss"]{Basic Authentication}
|
||||
@(require (for-label web-server/http/basic-auth))
|
||||
|
||||
@defmodule[web-server/http/basic-auth]
|
||||
|
||||
An implementation of HTTP Basic Authentication.
|
||||
|
||||
@defproc[(extract-user-pass [heads (listof header?)])
|
||||
(or/c false/c (cons/c bytes? bytes?))]{
|
||||
Returns a pair of the username and password from the authentication
|
||||
header in @scheme[heads] if they are present, or @scheme[#f].
|
||||
|
||||
Example:
|
||||
@scheme[(extract-user-pass (request-headers/raw req))] might return @scheme[(cons #"aladin" #"open sesame")].
|
||||
}
|
||||
|
|
@ -123,230 +123,6 @@ Equivalent to @scheme[(((request? . -> . any/c)) (expiration-handler/c) . opt->
|
|||
This is what @scheme[send/suspend/dispatch] gives to its function argument.
|
||||
}
|
||||
|
||||
@; ------------------------------------------------------------
|
||||
@section[#:tag "request-structs.ss"]{HTTP Requests}
|
||||
@(require (for-label web-server/private/request-structs))
|
||||
|
||||
@defmodule[web-server/private/request-structs]
|
||||
|
||||
@filepath{private/request-structs.ss} provides a number of structures and functions
|
||||
related to HTTP request data structures.
|
||||
|
||||
@defstruct[header ([field bytes?]
|
||||
[value bytes?])]{
|
||||
Represents a header of @scheme[field] to @scheme[value].
|
||||
}
|
||||
|
||||
@defproc[(headers-assq [id bytes?] [heads (listof header?)])
|
||||
(or/c false/c header?)]{
|
||||
Returns the header with a field equal to @scheme[id] from @scheme[heads] or @scheme[#f].
|
||||
}
|
||||
|
||||
@defproc[(headers-assq* [id bytes?] [heads (listof header?)])
|
||||
(or/c false/c header?)]{
|
||||
Returns the header with a field case-insensitively equal to @scheme[id] from @scheme[heads] or @scheme[#f].
|
||||
|
||||
You almost @bold{always} want to use this, rather than @scheme[headers-assq] because Web browsers may send headers with arbitrary casing.
|
||||
}
|
||||
|
||||
@defstruct[binding ([id bytes?])]{Represents a binding of @scheme[id].}
|
||||
|
||||
@defstruct[(binding:form binding) ([value bytes?])]{
|
||||
Represents a form binding of @scheme[id] to @scheme[value].
|
||||
}
|
||||
|
||||
@defstruct[(binding:file binding) ([filename bytes?]
|
||||
[content bytes?])]{
|
||||
Represents the uploading of the file @scheme[filename] with the id @scheme[id]
|
||||
and the content @scheme[content].
|
||||
}
|
||||
|
||||
@defproc[(bindings-assq [id bytes?]
|
||||
[binds (listof binding?)])
|
||||
(or/c false/c binding?)]{
|
||||
Returns the binding with an id equal to @scheme[id] from @scheme[binds] or @scheme[#f].
|
||||
}
|
||||
|
||||
@defstruct[request ([method symbol?]
|
||||
[uri url?]
|
||||
[headers/raw (listof header?)]
|
||||
[bindings/raw (listof binding?)]
|
||||
[post-data/raw (or/c false/c bytes?)]
|
||||
[host-ip string?]
|
||||
[host-port number?]
|
||||
[client-ip string?])]{
|
||||
An HTTP @scheme[method] request to @scheme[uri] from @scheme[client-ip]
|
||||
to the server at @scheme[host-ip]:@scheme[host-port] with @scheme[headers/raw]
|
||||
headers, @scheme[bindings/raw] GET and POST queries and @scheme[post-data/raw]
|
||||
POST data.
|
||||
|
||||
You are @bold{unlikely to need to construct} a request struct.
|
||||
}
|
||||
|
||||
Here is an example typical of what you will find in many applications:
|
||||
@schemeblock[
|
||||
(define (get-number req)
|
||||
(match
|
||||
(bindings-assq
|
||||
#"number"
|
||||
(request-bindings/raw req))
|
||||
[(? binding:form? b)
|
||||
(string->number
|
||||
(bytes->string/utf-8
|
||||
(binding:form-value b)))]
|
||||
[_
|
||||
(get-number (request-number))]))
|
||||
]
|
||||
|
||||
@; ------------------------------------------------------------
|
||||
@section[#:tag "bindings.ss"]{Request Bindings}
|
||||
@(require (for-label web-server/servlet/bindings))
|
||||
|
||||
@defmodule[web-server/servlet/bindings]
|
||||
|
||||
@filepath{servlet/bindings.ss} provides a number of helper functions
|
||||
for accessing request bindings.
|
||||
|
||||
These functions, while convenient, could introduce subtle bugs into your
|
||||
application. Examples: that they are case-insensitive could introduce
|
||||
a bug; if the data submitted is not in UTF-8 format, then the conversion
|
||||
to a string will fail; if an attacker submits a form field as if it were
|
||||
a file, when it is not, then the @scheme[request-bindings] will hold a
|
||||
@scheme[bytes?] object and your program will error; and, for file uploads
|
||||
you lose the filename. @bold{Therefore, we recommend against their use, but
|
||||
they are provided for compatibility with old code.}
|
||||
|
||||
@defproc[(request-bindings [req request?])
|
||||
(listof (or/c (cons/c symbol? string?)
|
||||
(cons/c symbol? bytes?)))]{
|
||||
Translates the @scheme[request-bindings/raw] of @scheme[req] by
|
||||
interpreting @scheme[bytes?] as @scheme[string?]s, except in the case
|
||||
of @scheme[binding:file] bindings, which are left as is. Ids are then
|
||||
translated into lowercase symbols.
|
||||
}
|
||||
|
||||
@defproc[(request-headers [req request?])
|
||||
(listof (cons/c symbol? string?))]{
|
||||
Translates the @scheme[request-headers/raw] of @scheme[req] by
|
||||
interpreting @scheme[bytes?] as @scheme[string?]s. Ids are then
|
||||
translated into lowercase symbols.
|
||||
}
|
||||
|
||||
@defproc[(extract-binding/single [id symbol?]
|
||||
[binds (listof (cons/c symbol? string?))])
|
||||
string?]{
|
||||
Returns the single binding associated with @scheme[id] in the a-list @scheme[binds]
|
||||
if there is exactly one binding. Otherwise raises @scheme[exn:fail].
|
||||
}
|
||||
|
||||
@defproc[(extract-bindings [id symbol?]
|
||||
[binds (listof (cons/c symbol? string?))])
|
||||
(listof string?)]{
|
||||
Returns a list of all the bindings of @scheme[id] in the a-list @scheme[binds].
|
||||
}
|
||||
|
||||
@defproc[(exists-binding? [id symbol?]
|
||||
[binds (listof (cons/c symbol? string))])
|
||||
boolean?]{
|
||||
Returns @scheme[#t] if @scheme[binds] contains a binding for @scheme[id].
|
||||
Otherwise, @scheme[#f].
|
||||
}
|
||||
|
||||
Here is an example typical of what you will find in many applications:
|
||||
@schemeblock[
|
||||
(define (get-number req)
|
||||
(string->number
|
||||
(extract-binding/single
|
||||
'number
|
||||
(request-bindings req))))
|
||||
]
|
||||
|
||||
@; ------------------------------------------------------------
|
||||
@section[#:tag "response-structs.ss"]{HTTP Responses}
|
||||
@(require (for-label web-server/private/response-structs))
|
||||
|
||||
@defmodule[web-server/private/response-structs]
|
||||
|
||||
@filepath{private/response-structs.ss} provides structures and functions related to
|
||||
HTTP responses.
|
||||
|
||||
@defstruct[response/basic
|
||||
([code number?]
|
||||
[message string?]
|
||||
[seconds number?]
|
||||
[mime bytes?]
|
||||
[headers (listof header?)])]{
|
||||
A basic HTTP response containing no body. @scheme[code] is the response code,
|
||||
@scheme[message] the message, @scheme[seconds] the generation time, @scheme[mime]
|
||||
the MIME type of the file, and @scheme[extras] are the extra headers, in addition
|
||||
to those produced by the server.
|
||||
|
||||
Example:
|
||||
@schemeblock[
|
||||
(make-response/basic
|
||||
301 "Moved Permanently"
|
||||
(current-seconds) TEXT/HTML-MIME-TYPE
|
||||
(list (make-header #"Location"
|
||||
#"http://www.plt-scheme.org/downloads")))
|
||||
]
|
||||
}
|
||||
|
||||
@defstruct[(response/full response/basic)
|
||||
([body (listof (or/c string? bytes?))])]{
|
||||
As with @scheme[response/basic], except with @scheme[body] as the response
|
||||
body.
|
||||
|
||||
Example:
|
||||
@schemeblock[
|
||||
(make-response/full
|
||||
301 "Moved Permanently"
|
||||
(current-seconds) TEXT/HTML-MIME-TYPE
|
||||
(list (make-header #"Location"
|
||||
#"http://www.plt-scheme.org/downloads"))
|
||||
(list #"<html><body><p>"
|
||||
#"Please go to <a href=\""
|
||||
#"http://www.plt-scheme.org/downloads"
|
||||
#"\">here</a> instead."
|
||||
#"</p></body></html>"))
|
||||
]
|
||||
}
|
||||
|
||||
@defstruct[(response/incremental response/basic)
|
||||
([generator ((() (listof (or/c bytes? string?)) . ->* . any) . -> . any)])]{
|
||||
As with @scheme[response/basic], except with @scheme[generator] as a function that is
|
||||
called to generate the response body, by being given an @scheme[output-response] function
|
||||
that outputs the content it is called with.
|
||||
|
||||
Here is a short example:
|
||||
@schemeblock[
|
||||
(make-response/incremental
|
||||
200 "OK" (current-seconds)
|
||||
#"application/octet-stream"
|
||||
(list (make-header #"Content-Disposition"
|
||||
#"attachement; filename=\"file\""))
|
||||
(lambda (send/bytes)
|
||||
(send/bytes #"Some content")
|
||||
(send/bytes)
|
||||
(send/bytes #"Even" #"more" #"content!")
|
||||
(send/bytes "Now we're done")))
|
||||
]
|
||||
}
|
||||
|
||||
@defproc[(response? [v any/c])
|
||||
boolean?]{
|
||||
Checks if @scheme[v] is a valid response. A response is either:
|
||||
@itemize[
|
||||
@item{A @scheme[response/basic] structure.}
|
||||
@item{A value matching the contract @scheme[(cons/c (or/c bytes? string?) (listof (or/c bytes? string?)))].}
|
||||
@item{A value matching @scheme[xexpr?].}
|
||||
]
|
||||
}
|
||||
|
||||
@defthing[TEXT/HTML-MIME-TYPE bytes?]{Equivalent to @scheme[#"text/html; charset=utf-8"].}
|
||||
|
||||
@warning{If you include a Content-Length header in a response that is inaccurate, there @bold{will be an error} in
|
||||
transmission that the server @bold{will not catch}.}
|
||||
|
||||
@; ------------------------------------------------------------
|
||||
@section[#:tag "web.ss"]{Web}
|
||||
@(require (for-label web-server/servlet/web))
|
||||
|
|
@ -502,31 +278,6 @@ functions of interest for the servlet developer.}
|
|||
|
||||
@defmodule[web-server/servlet/helpers]
|
||||
|
||||
@filepath{servlet/helpers.ss} provides functions built on
|
||||
@filepath{servlet/web.ss} that are useful in many servlets.
|
||||
|
||||
@defproc[(redirect-to [uri string?]
|
||||
[perm/temp redirection-status? temporarily]
|
||||
[#:headers headers (listof header?) (list)])
|
||||
response?]{
|
||||
Generates an HTTP response that redirects the browser to @scheme[uri],
|
||||
while including the @scheme[headers] in the response.
|
||||
|
||||
Example:
|
||||
@scheme[(redirect-to "http://www.add-three-numbers.com" permanently)]
|
||||
}
|
||||
|
||||
@defproc[(redirection-status? [v any/c])
|
||||
boolean?]{
|
||||
Determines if @scheme[v] is one of the following values.
|
||||
}
|
||||
|
||||
@defthing[permanently redirection-status?]{A @scheme[redirection-status?] for permanent redirections.}
|
||||
|
||||
@defthing[temporarily redirection-status?]{A @scheme[redirection-status?] for temporary redirections.}
|
||||
|
||||
@defthing[see-other redirection-status?]{A @scheme[redirection-status?] for "see-other" redirections.}
|
||||
|
||||
@defproc[(with-errors-to-browser [send/finish-or-back (response? . -> . request?)]
|
||||
[thunk (-> any)])
|
||||
any]{
|
||||
|
|
@ -542,24 +293,6 @@ functions of interest for the servlet developer.}
|
|||
]
|
||||
}
|
||||
|
||||
@; ------------------------------------------------------------
|
||||
@section[#:tag "basic-auth.ss"]{Basic Authentication}
|
||||
@(require (for-label web-server/servlet/basic-auth))
|
||||
|
||||
@defmodule[web-server/servlet/basic-auth]
|
||||
|
||||
@filepath{servlet/basic-auth.ss} provides a function for helping with
|
||||
implementation of HTTP Basic Authentication.
|
||||
|
||||
@defproc[(extract-user-pass [heads (listof header?)])
|
||||
(or/c false/c (cons/c bytes? bytes?))]{
|
||||
Returns a pair of the username and password from the authentication
|
||||
header in @scheme[heads] if they are present, or @scheme[#f].
|
||||
|
||||
Example:
|
||||
@scheme[(extract-user-pass (request-headers/raw req))] might return @scheme[(cons #"aladin" #"open sesame")].
|
||||
}
|
||||
|
||||
@; ------------------------------------------------------------
|
||||
@section[#:tag "web-cells.ss"]{Web Cells}
|
||||
@(require (for-label web-server/servlet/web-cells))
|
||||
|
|
|
|||
|
|
@ -12,6 +12,8 @@ develop Web applications in Scheme.
|
|||
|
||||
@include-section["running.scrbl"]
|
||||
|
||||
@include-section["http.scrbl"]
|
||||
|
||||
@include-section["servlet.scrbl"]
|
||||
@include-section["lang.scrbl"]
|
||||
|
||||
|
|
|
|||
|
|
@ -10,8 +10,7 @@
|
|||
web-server/private/servlet
|
||||
web-server/configuration/namespace
|
||||
web-server/private/cache-table
|
||||
web-server/private/request-structs
|
||||
web-server/private/response-structs
|
||||
web-server/http
|
||||
web-server/private/util
|
||||
web-server/configuration/responders
|
||||
web-server/dispatchers/dispatch
|
||||
|
|
|
|||
|
|
@ -1,17 +1,13 @@
|
|||
#lang scheme/base
|
||||
(require "servlet/helpers.ss"
|
||||
"servlet/web-cells.ss"
|
||||
"servlet/bindings.ss"
|
||||
"servlet/basic-auth.ss"
|
||||
"servlet/web.ss"
|
||||
"servlet/servlet-structs.ss"
|
||||
"private/response-structs.ss"
|
||||
"private/request-structs.ss")
|
||||
(provide (all-from-out "servlet/web.ss")
|
||||
(all-from-out "servlet/web-cells.ss")
|
||||
(all-from-out "servlet/helpers.ss")
|
||||
(all-from-out "servlet/bindings.ss")
|
||||
(all-from-out "servlet/basic-auth.ss")
|
||||
(all-from-out "servlet/servlet-structs.ss")
|
||||
(all-from-out "private/response-structs.ss")
|
||||
(all-from-out "private/request-structs.ss"))
|
||||
(require web-server/servlet/helpers
|
||||
web-server/servlet/web-cells
|
||||
web-server/http/bindings
|
||||
web-server/http
|
||||
web-server/servlet/servlet-structs
|
||||
web-server/servlet/web)
|
||||
(provide (all-from-out web-server/servlet/helpers
|
||||
web-server/servlet/web-cells
|
||||
web-server/http/bindings
|
||||
web-server/http
|
||||
web-server/servlet/servlet-structs
|
||||
web-server/servlet/web))
|
||||
|
|
@ -1,27 +1,7 @@
|
|||
#lang scheme/base
|
||||
(require scheme/contract)
|
||||
(require "../private/util.ss"
|
||||
"../private/request-structs.ss"
|
||||
"../private/response-structs.ss")
|
||||
|
||||
; redirection-status = (make-redirection-status nat str)
|
||||
(define-struct redirection-status (code message))
|
||||
|
||||
(define permanently (make-redirection-status 301 "Moved Permanently"))
|
||||
(define temporarily (make-redirection-status 302 "Moved Temporarily"))
|
||||
(define see-other (make-redirection-status 303 "See Other"))
|
||||
|
||||
; : str [redirection-status] -> response
|
||||
(define(redirect-to
|
||||
uri
|
||||
[perm/temp temporarily]
|
||||
#:headers [headers (list)])
|
||||
(make-response/full (redirection-status-code perm/temp)
|
||||
(redirection-status-message perm/temp)
|
||||
(current-seconds) #"text/html"
|
||||
(list* (make-header #"Location" (string->bytes/utf-8 uri))
|
||||
headers)
|
||||
(list)))
|
||||
web-server/http)
|
||||
|
||||
(define (with-errors-to-browser send/finish-or-back thunk)
|
||||
(with-handlers ([exn? (lambda (exn)
|
||||
|
|
@ -33,13 +13,6 @@
|
|||
(thunk)))
|
||||
|
||||
(provide/contract
|
||||
[redirect-to
|
||||
(->* (string?) (redirection-status? #:headers (listof header?))
|
||||
response/full?)]
|
||||
[redirection-status? (any/c . -> . boolean?)]
|
||||
[permanently redirection-status?]
|
||||
[temporarily redirection-status?]
|
||||
[see-other redirection-status?]
|
||||
[with-errors-to-browser
|
||||
((response? . -> . request?)
|
||||
(-> any)
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
#lang scheme/base
|
||||
(require scheme/contract)
|
||||
(require "../private/request-structs.ss"
|
||||
"../private/response-structs.ss")
|
||||
(require scheme/contract
|
||||
web-server/http)
|
||||
|
||||
(define k-url?
|
||||
string?)
|
||||
|
|
|
|||
|
|
@ -6,8 +6,7 @@
|
|||
web-server/managers/none
|
||||
(only-in web-server/lang/web
|
||||
initialize-servlet)
|
||||
web-server/private/response-structs
|
||||
web-server/private/request-structs
|
||||
web-server/http
|
||||
web-server/servlet/web
|
||||
web-server/configuration/namespace
|
||||
web-server/private/web-server-structs
|
||||
|
|
@ -78,8 +77,7 @@
|
|||
|
||||
(define common-module-specs
|
||||
'(web-server/private/servlet
|
||||
web-server/private/request-structs
|
||||
web-server/private/response-structs))
|
||||
web-server/http))
|
||||
|
||||
(define servlet-module-specs
|
||||
'(web-server/servlet/web
|
||||
|
|
|
|||
|
|
@ -3,11 +3,9 @@
|
|||
(require "../managers/manager.ss"
|
||||
"../private/util.ss"
|
||||
"../private/servlet.ss"
|
||||
"../servlet/helpers.ss"
|
||||
"../servlet/web-cells.ss"
|
||||
"../servlet/servlet-structs.ss"
|
||||
"../private/response-structs.ss"
|
||||
"../private/request-structs.ss")
|
||||
web-server/http)
|
||||
|
||||
(provide servlet-prompt)
|
||||
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@
|
|||
"private/mime-types.ss"
|
||||
"configuration/configuration-table-structs.ss"
|
||||
"private/cache-table.ss"
|
||||
(prefix-in http: "private/request.ss"))
|
||||
(prefix-in http: web-server/http/request))
|
||||
(require "dispatchers/dispatch.ss"
|
||||
web-server/servlet/setup
|
||||
(prefix-in fsmap: "dispatchers/filesystem-map.ss")
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@
|
|||
"web-config-sig.ss"
|
||||
"web-server-sig.ss"
|
||||
"web-server-unit.ss"
|
||||
(prefix-in http: "private/request.ss"))
|
||||
(prefix-in http: web-server/http/request))
|
||||
(provide/contract
|
||||
[serve
|
||||
(->* (#:dispatch dispatcher/c)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user