mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-28 16:00:22 +02:00
docstrings in (web request) and (web response)
* module/web/request.scm: * module/web/response.scm: Add docstrings.
This commit is contained in:
parent
92c5c0b67c
commit
cc1e26c2cd
2 changed files with 63 additions and 1 deletions
|
@ -156,6 +156,8 @@
|
||||||
(define* (build-request #:key (method 'GET) uri (version '(1 . 1))
|
(define* (build-request #:key (method 'GET) uri (version '(1 . 1))
|
||||||
(headers '()) port (meta '())
|
(headers '()) port (meta '())
|
||||||
(validate-headers? #t))
|
(validate-headers? #t))
|
||||||
|
"Construct an HTTP request object. If @var{validate-headers?} is true,
|
||||||
|
the headers are each run through their respective validators."
|
||||||
(cond
|
(cond
|
||||||
((not (and (pair? version)
|
((not (and (pair? version)
|
||||||
(non-negative-integer? (car version))
|
(non-negative-integer? (car version))
|
||||||
|
@ -173,6 +175,13 @@
|
||||||
(make-request method uri version headers meta port))
|
(make-request method uri version headers meta port))
|
||||||
|
|
||||||
(define* (read-request port #:optional (meta '()))
|
(define* (read-request port #:optional (meta '()))
|
||||||
|
"Read an HTTP request from @var{port}, optionally attaching the given
|
||||||
|
metadata, @var{meta}.
|
||||||
|
|
||||||
|
As a side effect, sets the encoding on @var{port} to
|
||||||
|
ISO-8859-1 (latin-1), so that reading one character reads one byte. See
|
||||||
|
the discussion of character sets in \"HTTP Requests\" in the manual, for
|
||||||
|
more information."
|
||||||
(set-port-encoding! port "ISO-8859-1")
|
(set-port-encoding! port "ISO-8859-1")
|
||||||
(call-with-values (lambda () (read-request-line port))
|
(call-with-values (lambda () (read-request-line port))
|
||||||
(lambda (method uri version)
|
(lambda (method uri version)
|
||||||
|
@ -180,6 +189,10 @@
|
||||||
|
|
||||||
;; FIXME: really return a new request?
|
;; FIXME: really return a new request?
|
||||||
(define (write-request r port)
|
(define (write-request r port)
|
||||||
|
"Write the given HTTP request to @var{port}.
|
||||||
|
|
||||||
|
Returns a new request, whose @code{request-port} will continue writing
|
||||||
|
on @var{port}, perhaps using some transfer encoding."
|
||||||
(write-request-line (request-method r) (request-uri r)
|
(write-request-line (request-method r) (request-uri r)
|
||||||
(request-version r) port)
|
(request-version r) port)
|
||||||
(write-headers (request-headers r) port)
|
(write-headers (request-headers r) port)
|
||||||
|
@ -193,6 +206,12 @@
|
||||||
;; per char because we are in latin-1 encoding.
|
;; per char because we are in latin-1 encoding.
|
||||||
;;
|
;;
|
||||||
(define (read-request-body/latin-1 r)
|
(define (read-request-body/latin-1 r)
|
||||||
|
"Reads the request body from @var{r}, as a string.
|
||||||
|
|
||||||
|
Assumes that the request port has ISO-8859-1 encoding, so that the
|
||||||
|
number of characters to read is the same as the
|
||||||
|
@code{request-content-length}. Returns @code{#f} if there was no request
|
||||||
|
body."
|
||||||
(cond
|
(cond
|
||||||
((request-content-length r) =>
|
((request-content-length r) =>
|
||||||
(lambda (nbytes)
|
(lambda (nbytes)
|
||||||
|
@ -216,9 +235,13 @@
|
||||||
;; and that the latin-1 encoding is what is expected by the server.
|
;; and that the latin-1 encoding is what is expected by the server.
|
||||||
;;
|
;;
|
||||||
(define (write-request-body/latin-1 r body)
|
(define (write-request-body/latin-1 r body)
|
||||||
|
"Write @var{body}, a string encodable in ISO-8859-1, to the port
|
||||||
|
corresponding to the HTTP request @var{r}."
|
||||||
(display body (request-port r)))
|
(display body (request-port r)))
|
||||||
|
|
||||||
(define (read-request-body/bytevector r)
|
(define (read-request-body/bytevector r)
|
||||||
|
"Reads the request body from @var{r}, as a bytevector. Returns
|
||||||
|
@code{#f} if there was no request body."
|
||||||
(let ((nbytes (request-content-length r)))
|
(let ((nbytes (request-content-length r)))
|
||||||
(and nbytes
|
(and nbytes
|
||||||
(let ((bv (get-bytevector-n (request-port r) nbytes)))
|
(let ((bv (get-bytevector-n (request-port r) nbytes)))
|
||||||
|
@ -228,6 +251,8 @@
|
||||||
(bytevector-length bv) nbytes))))))
|
(bytevector-length bv) nbytes))))))
|
||||||
|
|
||||||
(define (write-request-body/bytevector r bv)
|
(define (write-request-body/bytevector r bv)
|
||||||
|
"Write @var{body}, a bytevector, to the port corresponding to the HTTP
|
||||||
|
request @var{r}."
|
||||||
(put-bytevector (request-port r) bv))
|
(put-bytevector (request-port r) bv))
|
||||||
|
|
||||||
(define-syntax define-request-accessor
|
(define-syntax define-request-accessor
|
||||||
|
|
|
@ -95,9 +95,13 @@
|
||||||
|
|
||||||
(define* (build-response #:key (version '(1 . 1)) (code 200) reason-phrase
|
(define* (build-response #:key (version '(1 . 1)) (code 200) reason-phrase
|
||||||
(headers '()) port)
|
(headers '()) port)
|
||||||
|
"Construct an HTTP response object. If @var{validate-headers?} is true,
|
||||||
|
the headers are each run through their respective validators."
|
||||||
(make-response version code reason-phrase headers port))
|
(make-response version code reason-phrase headers port))
|
||||||
|
|
||||||
(define (extend-response r k v . additional)
|
(define (extend-response r k v . additional)
|
||||||
|
"Extend an HTTP response by setting additional HTTP headers @var{k},
|
||||||
|
@var{v}. Returns a new HTTP response."
|
||||||
(let ((r (build-response #:version (response-version r)
|
(let ((r (build-response #:version (response-version r)
|
||||||
#:code (response-code r)
|
#:code (response-code r)
|
||||||
#:reason-phrase (%response-reason-phrase r)
|
#:reason-phrase (%response-reason-phrase r)
|
||||||
|
@ -156,22 +160,43 @@
|
||||||
"(Unknown)"))
|
"(Unknown)"))
|
||||||
|
|
||||||
(define (response-reason-phrase response)
|
(define (response-reason-phrase response)
|
||||||
|
"Return the reason phrase given in @var{response}, or the standard
|
||||||
|
reason phrase for the response's code."
|
||||||
(or (%response-reason-phrase response)
|
(or (%response-reason-phrase response)
|
||||||
(code->reason-phrase (response-code response))))
|
(code->reason-phrase (response-code response))))
|
||||||
|
|
||||||
(define (read-response port)
|
(define (read-response port)
|
||||||
|
"Read an HTTP response from @var{port}, optionally attaching the given
|
||||||
|
metadata, @var{meta}.
|
||||||
|
|
||||||
|
As a side effect, sets the encoding on @var{port} to
|
||||||
|
ISO-8859-1 (latin-1), so that reading one character reads one byte. See
|
||||||
|
the discussion of character sets in \"HTTP Responses\" in the manual,
|
||||||
|
for more information."
|
||||||
(set-port-encoding! port "ISO-8859-1")
|
(set-port-encoding! port "ISO-8859-1")
|
||||||
(call-with-values (lambda () (read-response-line port))
|
(call-with-values (lambda () (read-response-line port))
|
||||||
(lambda (version code reason-phrase)
|
(lambda (version code reason-phrase)
|
||||||
(make-response version code reason-phrase (read-headers port) port))))
|
(make-response version code reason-phrase (read-headers port) port))))
|
||||||
|
|
||||||
(define (adapt-response-version response version)
|
(define (adapt-response-version response version)
|
||||||
|
"Adapt the given response to a different HTTP version. Returns a new
|
||||||
|
HTTP response.
|
||||||
|
|
||||||
|
The idea is that many applications might just build a response for the
|
||||||
|
default HTTP version, and this method could handle a number of
|
||||||
|
programmatic transformations to respond to older HTTP versions (0.9 and
|
||||||
|
1.0). But currently this function is a bit heavy-handed, just updating
|
||||||
|
the version field."
|
||||||
(build-response #:code (response-code response)
|
(build-response #:code (response-code response)
|
||||||
#:version version
|
#:version version
|
||||||
#:headers (response-headers response)
|
#:headers (response-headers response)
|
||||||
#:port (response-port response)))
|
#:port (response-port response)))
|
||||||
|
|
||||||
(define (write-response r port)
|
(define (write-response r port)
|
||||||
|
"Write the given HTTP response to @var{port}.
|
||||||
|
|
||||||
|
Returns a new response, whose @code{response-port} will continue writing
|
||||||
|
on @var{port}, perhaps using some transfer encoding."
|
||||||
(write-response-line (response-version r) (response-code r)
|
(write-response-line (response-version r) (response-code r)
|
||||||
(response-reason-phrase r) port)
|
(response-reason-phrase r) port)
|
||||||
(write-headers (response-headers r) port)
|
(write-headers (response-headers r) port)
|
||||||
|
@ -185,6 +210,12 @@
|
||||||
;; per char because we are in latin-1 encoding.
|
;; per char because we are in latin-1 encoding.
|
||||||
;;
|
;;
|
||||||
(define (read-response-body/latin-1 r)
|
(define (read-response-body/latin-1 r)
|
||||||
|
"Reads the response body from @var{r}, as a string.
|
||||||
|
|
||||||
|
Assumes that the response port has ISO-8859-1 encoding, so that the
|
||||||
|
number of characters to read is the same as the
|
||||||
|
@code{response-content-length}. Returns @code{#f} if there was no
|
||||||
|
response body."
|
||||||
(cond
|
(cond
|
||||||
((response-content-length r) =>
|
((response-content-length r) =>
|
||||||
(lambda (nbytes)
|
(lambda (nbytes)
|
||||||
|
@ -205,12 +236,16 @@
|
||||||
(else #f)))
|
(else #f)))
|
||||||
|
|
||||||
;; Likewise, assumes that body can be written in the latin-1 encoding,
|
;; Likewise, assumes that body can be written in the latin-1 encoding,
|
||||||
;; and that the latin-1 encoding is what is expected by the server.
|
;; and that the latin-1 encoding is what is expected by the client.
|
||||||
;;
|
;;
|
||||||
(define (write-response-body/latin-1 r body)
|
(define (write-response-body/latin-1 r body)
|
||||||
|
"Write @var{body}, a string encodable in ISO-8859-1, to the port
|
||||||
|
corresponding to the HTTP response @var{r}."
|
||||||
(display body (response-port r)))
|
(display body (response-port r)))
|
||||||
|
|
||||||
(define (read-response-body/bytevector r)
|
(define (read-response-body/bytevector r)
|
||||||
|
"Reads the response body from @var{r}, as a bytevector. Returns
|
||||||
|
@code{#f} if there was no response body."
|
||||||
(let ((nbytes (response-content-length r)))
|
(let ((nbytes (response-content-length r)))
|
||||||
(and nbytes
|
(and nbytes
|
||||||
(let ((bv (get-bytevector-n (response-port r) nbytes)))
|
(let ((bv (get-bytevector-n (response-port r) nbytes)))
|
||||||
|
@ -220,6 +255,8 @@
|
||||||
(bytevector-length bv) nbytes))))))
|
(bytevector-length bv) nbytes))))))
|
||||||
|
|
||||||
(define (write-response-body/bytevector r bv)
|
(define (write-response-body/bytevector r bv)
|
||||||
|
"Write @var{body}, a bytevector, to the port corresponding to the HTTP
|
||||||
|
response @var{r}."
|
||||||
(put-bytevector (response-port r) bv))
|
(put-bytevector (response-port r) bv))
|
||||||
|
|
||||||
(define-syntax define-response-accessor
|
(define-syntax define-response-accessor
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue