[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-25-g990b11
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-25-g990b11c |
|
Date: |
Fri, 11 Jan 2013 14:40:18 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=990b11c53f8da2a6c14e1190bc4e76939db32d07
The branch, stable-2.0 has been updated
via 990b11c53f8da2a6c14e1190bc4e76939db32d07 (commit)
via 2ac3c0a590ec93f40b2c1ce34bd24b83f1ae1a5d (commit)
via 67e5ab8ac64dffe814e1ea3b08eeab679899b924 (commit)
via 8cb9a30c17827bc875516b2abedee36a05f886e0 (commit)
via f05bb8494c9636cd7a44aaf7d4e08f4b66004b6e (commit)
from b194b59fa10574868f7b1663a1f2d447baa18c5e (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 990b11c53f8da2a6c14e1190bc4e76939db32d07
Author: Andy Wingo <address@hidden>
Date: Fri Jan 11 11:15:28 2013 +0100
Add http-post, http-put, et cetera
* module/web/client.scm (ensure-uri): New helper.
(open-socket-for-uri): Accept a URI as a string or as a URI object.
(extend-request, sanitize-request): New helpers, like the
corresponding functions in (web server).
(decode-response-body): Add a reference to the HTTP/1.1 spec, and
use (ice-9 iconv).
(request): New helper, factoring all aspects of sending an HTTP
request and getting a response.
(http-get): Redefine in terms of http-get. Deprecate the
#:extra-headers argument in favor of #:headers. Allow a body. Add a
#:streaming? argument, subsuming the functionality of http-get*.
(http-get*): Deprecate.
(http-head, http-post, http-put, http-delete, http-trace)
(http-options): Define interfaces for all HTTP verbs.
* test-suite/tests/web-client.test: Add tests.
* doc/ref/web.texi: Update documentation.
Thanks to Gregory Benison for the initial patch.
commit 2ac3c0a590ec93f40b2c1ce34bd24b83f1ae1a5d
Author: Andy Wingo <address@hidden>
Date: Fri Jan 11 11:30:29 2013 +0100
read-response-body always returns bytevector or #f
* module/web/response.scm (read-response-body): Fix to always return
either a bytevector or #f. Previously, reading a 0-length body could
return the EOF object.
commit 67e5ab8ac64dffe814e1ea3b08eeab679899b924
Author: Andy Wingo <address@hidden>
Date: Fri Jan 11 11:10:43 2013 +0100
remove (web http) TODO list
* module/web/http.scm: Remove outdated TODO list.
commit 8cb9a30c17827bc875516b2abedee36a05f886e0
Author: Andy Wingo <address@hidden>
Date: Fri Jan 11 11:10:24 2013 +0100
(web server) uses (ice-9 iconv)
* module/web/server.scm (sanitize-response): Use the procedures
from (ice-9 iconv) to encode the response.
commit f05bb8494c9636cd7a44aaf7d4e08f4b66004b6e
Author: Andy Wingo <address@hidden>
Date: Thu Jan 10 22:50:27 2013 +0100
add bytevector->string and string->bytevector in new (ice-9 iconv) module
* module/Makefile.am:
* module/ice-9/iconv.scm: New module implementing procedures to encode
and decode representations of strings as bytes.
* test-suite/Makefile.am:
* test-suite/tests/iconv.test: Add tests.
* doc/ref/api-data.texi: Add docs.
-----------------------------------------------------------------------
Summary of changes:
doc/ref/api-data.texi | 80 +++++-
doc/ref/web.texi | 66 ++++--
module/Makefile.am | 3 +-
module/ice-9/iconv.scm | 82 ++++++
module/web/client.scm | 325 ++++++++++++++++++----
module/web/http.scm | 7 -
module/web/response.scm | 10 +-
module/web/server.scm | 40 +---
test-suite/Makefile.am | 3 +-
test-suite/tests/iconv.test | 115 ++++++++
test-suite/tests/web-client.test | 577 ++++++++++++++++++++++++++++++++++++++
11 files changed, 1183 insertions(+), 125 deletions(-)
create mode 100644 module/ice-9/iconv.scm
create mode 100644 test-suite/tests/iconv.test
create mode 100644 test-suite/tests/web-client.test
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index 6d8de2b..3bd38d2 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006,
2007, 2008, 2009, 2010, 2011, 2012
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006,
2007, 2008, 2009, 2010, 2011, 2012, 2013
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@@ -2881,6 +2881,7 @@ Guile provides all procedures of SRFI-13 and a few more.
* Reversing and Appending Strings:: Appending strings to form a new string.
* Mapping Folding and Unfolding:: Iterating over strings.
* Miscellaneous String Operations:: Replicating, insertion, parsing, ...
+* Representing Strings as Bytes:: Encoding and decoding strings.
* Conversion to/from C::
* String Internals:: The storage strategy for strings.
@end menu
@@ -4163,6 +4164,70 @@ a predicate, if it is a character, it is tested for
equality and if it
is a character set, it is tested for membership.
@end deffn
address@hidden Representing Strings as Bytes
address@hidden Representing Strings as Bytes
+
+Out in the cold world outside of Guile, not all strings are treated in
+the same way. Out there there are only bytes, and there are many ways
+of representing a strings (sequences of characters) as binary data
+(sequences of bytes).
+
+As a user, usually you don't have to think about this very much. When
+you type on your keyboard, your system encodes your keystrokes as bytes
+according to the locale that you have configured on your computer.
+Guile uses the locale to decode those bytes back into characters --
+hopefully the same characters that you typed in.
+
+All is not so clear when dealing with a system with multiple users, such
+as a web server. Your web server might get a request from one user for
+data encoded in the ISO-8859-1 character set, and then another request
+from a different user for UTF-8 data.
+
address@hidden iconv
address@hidden character encoding
+Guile provides an @dfn{iconv} module for converting between strings and
+sequences of bytes. @xref{Bytevectors}, for more on how Guile
+represents raw byte sequences. This module gets its name from the
+common @sc{unix} command of the same name.
+
+Unlike the rest of the procedures in this section, you have to load the
address@hidden module before having access to these procedures:
+
address@hidden
+(use-modules (ice-9 iconv))
address@hidden example
+
address@hidden string->bytevector string encoding [#:conversion-strategy='error]
+Encode @var{string} as a sequence of bytes.
+
+The string will be encoded in the character set specified by the
address@hidden string. If the string has characters that cannot be
+represented in the encoding, by default this procedure raises an
address@hidden, though the @code{#:conversion-strategy} keyword
+can specify other behaviors.
+
+The return value is a bytevector. @xref{Bytevectors}, for more on
+bytevectors. @xref{Ports}, for more on character encodings and
+conversion strategies.
address@hidden deffn
+
address@hidden bytevector->string bytevector encoding
+Decode @var{bytevector} into a string.
+
+The bytes will be decoded from the character set by the @var{encoding}
+string. If the bytes do not form a valid encoding, by default this
+procedure raises an @code{decoding-error}, though that may be overridden
+with the @code{#:conversion-strategy} keyword. @xref{Ports}, for more
+on character encodings and conversion strategies.
address@hidden deffn
+
address@hidden call-with-output-encoded-string encoding proc
[#:conversion-strategy='error]
+Like @code{call-with-output-string}, but instead of returning a string,
+returns a encoding of the string according to @var{encoding}, as a
+bytevector. This procedure can be more efficient than collecting a
+string and then converting it via @code{string->bytevector}.
address@hidden deffn
+
@node Conversion to/from C
@subsubsection Conversion to/from C
@@ -4172,9 +4237,9 @@ important.
In C, a string is just a sequence of bytes, and the character encoding
describes the relation between these bytes and the actual characters
-that make up the string. For Scheme strings, character encoding is
-not an issue (most of the time), since in Scheme you never get to see
-the bytes, only the characters.
+that make up the string. For Scheme strings, character encoding is not
+an issue (most of the time), since in Scheme you usually treat strings
+as character sequences, not byte sequences.
Converting to C and converting from C each have their own challenges.
@@ -4305,6 +4370,9 @@ into @var{encoding}.
If @var{lenp} is @code{NULL}, this function will return a null-terminated C
string. It will throw an error if the string contains a null
character.
+
+The Scheme interface to this function is @code{encode-string}, from the
address@hidden iconv} module. @xref{Representing Strings as Bytes}.
@end deftypefn
@deftypefn {C Function} SCM scm_from_stringn (const char *str, size_t len,
const char *encoding, scm_t_string_failed_conversion_handler handler)
@@ -4313,6 +4381,9 @@ length in bytes of the C string is input as @var{len}.
The encoding of the C
string is passed as the ASCII, null-terminated C string @code{encoding}.
The @var{handler} parameters suggests a strategy for dealing with
unconvertable characters.
+
+The Scheme interface to this function is @code{decode-string}.
address@hidden Strings as Bytes}.
@end deftypefn
The following conversion functions are provided as a convenience for the
@@ -4810,6 +4881,7 @@ the host's native endianness.
Bytevector contents can also be interpreted as Unicode strings encoded
in one of the most commonly available encoding formats.
address@hidden Strings as Bytes}, for a more generic interface.
@lisp
(utf8->string (u8-list->bytevector '(99 97 102 101)))
diff --git a/doc/ref/web.texi b/doc/ref/web.texi
index e892453..0f69089 100644
--- a/doc/ref/web.texi
+++ b/doc/ref/web.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc.
address@hidden Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation,
Inc.
@c See the file guile.texi for copying conditions.
@node Web
@@ -1388,23 +1388,59 @@ the lower-level HTTP, request, and response modules.
Return an open input/output port for a connection to URI.
@end deffn
address@hidden {Scheme Procedure} http-get uri [#:port=(open-socket-for-uri
uri)] [#:version='(1 . 1)] [#:keep-alive?=#f] [#:extra-headers='()]
[#:decode-body?=#t]
-Connect to the server corresponding to @var{uri} and ask for the
-resource, using the @code{GET} method. If you already have a port open,
-pass it as @var{port}. The port will be closed at the end of the
-request unless @var{keep-alive?} is true. Any extra headers in the
-alist @var{extra-headers} will be added to the request.
address@hidden {Scheme Procedure} http-get uri arg...
address@hidden {Scheme Procedure} http-head uri arg...
address@hidden {Scheme Procedure} http-post uri arg...
address@hidden {Scheme Procedure} http-put uri arg...
address@hidden {Scheme Procedure} http-delete uri arg...
address@hidden {Scheme Procedure} http-trace uri arg...
address@hidden {Scheme Procedure} http-options uri arg...
+
+Connect to the server corresponding to @var{uri} and make a request over
+HTTP, using the appropriate method (@code{GET}, @code{HEAD}, etc.).
+
+All of these procedures have the same prototype: a URI followed by an
+optional sequence of keyword arguments. These keyword arguments allow
+you to modify the requests in various ways, for example attaching a body
+to the request, or setting specific headers. The following table lists
+the keyword arguments and their default values.
+
address@hidden @code
address@hidden #:body #f
address@hidden #:port (open-socket-for-uri @var{uri})]
address@hidden #:version '(1 . 1)
address@hidden #:keep-alive? #f
address@hidden #:headers '()
address@hidden #:decode-body? #t
address@hidden #:streaming? #f
address@hidden table
+
+If you already have a port open, pass it as @var{port}. Otherwise, a
+connection will be opened to the server corresponding to @var{uri}. Any
+extra headers in the alist @var{headers} will be added to the request.
+
+If @var{body} is not #f, a message body will also be sent with the HTTP
+request. If @var{body} is a string, it is encoded according to the
+content-type in @var{headers}, defaulting to UTF-8. Otherwise
address@hidden should be a bytevector, or @code{#f} for no body. Although a
+message body may be sent with any request, usually only @code{POST} and
address@hidden requests have bodies.
If @var{decode-body?} is true, as is the default, the body of the
response will be decoded to string, if it is a textual content-type.
Otherwise it will be returned as a bytevector.
address@hidden deffn
address@hidden {Scheme Procedure} http-get* uri [#:port=(open-socket-for-uri
uri)] [#:version='(1 . 1)] [#:keep-alive?=#f] [#:extra-headers='()]
[#:decode-body?=#t]
-Like @code{http-get}, but return an input port from which to read. When
address@hidden is true, as is the default, the returned port has its
-encoding set appropriately if the data at @var{uri} is textual. Closing the
-returned port closes @var{port}, unless @var{keep-alive?} is true.
+However, if @var{streaming?} is true, instead of eagerly reading the
+response body from the server, this function only reads off the headers.
+The response body will be returned as a port on which the data may be
+read.
+
+Unless @var{keep-alive?} is true, the port will be closed after the full
+response body has been read.
+
+Returns two values: the response read from the server, and the response
+body as a string, bytevector, #f value, or as a port (if
address@hidden is true).
@end deffn
@code{http-get} is useful for making one-off requests to web sites. If
@@ -1415,10 +1451,6 @@ fetcher, similar in structure to the web server
(@pxref{Web Server}).
Another option, good but not as performant, would be to use threads,
possibly via par-map or futures.
-More helper procedures for the other common HTTP verbs would be a good
-addition to this module. Send your code to
address@hidden@@gnu.org}.
-
@node Web Server
@subsection Web Server
diff --git a/module/Makefile.am b/module/Makefile.am
index 3d3eae3..472bc48 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -1,6 +1,6 @@
## Process this file with automake to produce Makefile.in.
##
-## Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+## Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation,
Inc.
##
## This file is part of GUILE.
##
@@ -210,6 +210,7 @@ ICE_9_SOURCES = \
ice-9/getopt-long.scm \
ice-9/hcons.scm \
ice-9/i18n.scm \
+ ice-9/iconv.scm \
ice-9/lineio.scm \
ice-9/ls.scm \
ice-9/mapping.scm \
diff --git a/module/ice-9/iconv.scm b/module/ice-9/iconv.scm
new file mode 100644
index 0000000..40d5954
--- /dev/null
+++ b/module/ice-9/iconv.scm
@@ -0,0 +1,82 @@
+;;; Encoding and decoding byte representations of strings
+
+;; Copyright (C) 2013 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
+
+;;; Code:
+
+(define-module (ice-9 iconv)
+ #:use-module (rnrs bytevectors)
+ #:use-module (ice-9 binary-ports)
+ #:use-module ((ice-9 rdelim) #:select (read-delimited))
+ #:export (string->bytevector
+ bytevector->string
+ call-with-encoded-output-string))
+
+;; Like call-with-output-string, but actually closes the port.
+(define (call-with-output-string* proc)
+ (let ((port (open-output-string)))
+ (proc port)
+ (let ((str (get-output-string port)))
+ (close-port port)
+ str)))
+
+(define (call-with-output-bytevector* proc)
+ (call-with-values (lambda () (open-bytevector-output-port))
+ (lambda (port get-bytevector)
+ (proc port)
+ (let ((bv (get-bytevector)))
+ (close-port port)
+ bv))))
+
+(define* (call-with-encoded-output-string encoding proc
+ #:key (conversion-strategy 'error))
+ (if (string-ci=? encoding "utf-8")
+ ;; I don't know why, but this appears to be faster; at least for
+ ;; serving examples/debug-sxml.scm (1464 reqs/s versus 850
+ ;; reqs/s).
+ (string->utf8 (call-with-output-string* proc))
+ (call-with-output-bytevector*
+ (lambda (port)
+ (set-port-encoding! port encoding)
+ (if conversion-strategy
+ (set-port-conversion-strategy! port conversion-strategy))
+ (proc port)))))
+
+;; TODO: Provide C implementations that call scm_from_stringn and
+;; friends?
+
+(define* (string->bytevector str encoding #:key (conversion-strategy 'error))
+ (if (string-ci=? encoding "utf-8")
+ (string->utf8 str)
+ (call-with-encoded-output-string
+ encoding
+ (lambda (port)
+ (display str port))
+ #:conversion-strategy conversion-strategy)))
+
+(define* (bytevector->string bv encoding #:key (conversion-strategy 'error))
+ (if (string-ci=? encoding "utf-8")
+ (utf8->string bv)
+ (let ((p (open-bytevector-input-port bv)))
+ (set-port-encoding! p encoding)
+ (if conversion-strategy
+ (set-port-conversion-strategy! p conversion-strategy))
+ (let ((res (read-delimited "" p)))
+ (close-port p)
+ (if (eof-object? res)
+ ""
+ res)))))
diff --git a/module/web/client.scm b/module/web/client.scm
index d3502cc..ce93cd8 100644
--- a/module/web/client.scm
+++ b/module/web/client.scm
@@ -1,6 +1,6 @@
;;; Web client
-;; Copyright (C) 2011, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2012, 2013 Free Software Foundation, Inc.
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -34,6 +34,7 @@
(define-module (web client)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 binary-ports)
+ #:use-module (ice-9 iconv)
#:use-module (ice-9 rdelim)
#:use-module (web request)
#:use-module (web response)
@@ -41,10 +42,23 @@
#:use-module (srfi srfi-1)
#:export (open-socket-for-uri
http-get
- http-get*))
+ http-get*
+ http-head
+ http-post
+ http-put
+ http-delete
+ http-trace
+ http-options))
-(define (open-socket-for-uri uri)
+(define (ensure-uri uri-or-string)
+ (cond
+ ((string? uri-or-string) (string->uri uri-or-string))
+ ((uri? uri-or-string) uri-or-string)
+ (else (error "Invalid URI" uri-or-string))))
+
+(define (open-socket-for-uri uri-or-string)
"Return an open input/output port for a connection to URI."
+ (define uri (ensure-uri uri-or-string))
(define addresses
(let ((port (uri-port uri)))
(delete-duplicates
@@ -78,17 +92,79 @@
(apply throw args)
(loop (cdr addresses))))))))
-(define (decode-string bv encoding)
- (if (string-ci=? encoding "utf-8")
- (utf8->string bv)
- (let ((p (open-bytevector-input-port bv)))
- (set-port-encoding! p encoding)
- (let ((res (read-delimited "" p)))
- (close-port p)
- res))))
+(define (extend-request r k v . additional)
+ (let ((r (build-request (request-uri r) #:version (request-version r)
+ #:headers
+ (assoc-set! (copy-tree (request-headers r))
+ k v)
+ #:port (request-port r))))
+ (if (null? additional)
+ r
+ (apply extend-request r additional))))
+
+;; -> request body
+(define (sanitize-request request body)
+ "\"Sanitize\" the given request and body, ensuring that they are
+complete and coherent. This method is most useful for methods that send
+data to the server, like POST, but can be used for any method. Return
+two values: a request and a bytevector, possibly the same ones that were
+passed as arguments.
+
+If BODY is a string, encodes the string to a bytevector, in an encoding
+appropriate for REQUEST. Adds a âcontent-lengthâ and âcontent-typeâ
+header, as necessary.
+
+If BODY is a procedure, it is called with a port as an argument, and the
+output collected as a bytevector. In the future we might try to instead
+use a compressing, chunk-encoded port, and call this procedure later.
+Authors are advised not to rely on the procedure being called at any
+particular time.
+
+Note that we rely on the request itself already having been validated,
+as is the case by default with a request returned by `build-request'."
+ (cond
+ ((not body)
+ (let ((length (request-content-length request)))
+ (if length
+ (unless (zero? length)
+ (error "content-length, but no body"))
+ (when (assq 'transfer-encoding (request-headers request))
+ (error "transfer-encoding not allowed with no body")))
+ (values request #vu8())))
+ ((string? body)
+ (let* ((type (request-content-type request '(text/plain)))
+ (declared-charset (assq-ref (cdr type) 'charset))
+ (charset (or declared-charset "utf-8")))
+ (sanitize-request
+ (if declared-charset
+ request
+ (extend-request request 'content-type
+ `(,@type (charset . ,charset))))
+ (string->bytevector body charset))))
+ ((procedure? body)
+ (let* ((type (request-content-type request
+ '(text/plain)))
+ (declared-charset (assq-ref (cdr type) 'charset))
+ (charset (or declared-charset "utf-8")))
+ (sanitize-request
+ (if declared-charset
+ request
+ (extend-request request 'content-type
+ `(,@type (charset . ,charset))))
+ (call-with-encoded-output-string charset body))))
+ ((not (bytevector? body))
+ (error "unexpected body type"))
+ (else
+ (values (let ((rlen (request-content-length request))
+ (blen (bytevector-length body)))
+ (cond
+ (rlen (if (= rlen blen)
+ request
+ (error "bad content-length" rlen blen)))
+ ((zero? blen) request)
+ (else (extend-request request 'content-length blen))))
+ body))))
-;; Logically the inverse of (web server)'s `sanitize-response'.
-;;
(define (decode-response-body response body)
;; `body' is either #f or a bytevector.
(cond
@@ -103,59 +179,196 @@
=> (lambda (type)
(cond
((text-content-type? (car type))
- (decode-string body (or (assq-ref (cdr type) 'charset)
- "iso-8859-1")))
+ ;; RFC 2616 3.7.1: "When no explicit charset parameter is
+ ;; provided by the sender, media subtypes of the "text"
+ ;; type are defined to have a default charset value of
+ ;; "ISO-8859-1" when received via HTTP."
+ (bytevector->string body (or (assq-ref (cdr type) 'charset)
+ "iso-8859-1")))
(else body))))
(else body))))
(else
(error "unexpected body type" body))))
-(define* (http-get uri #:key (port (open-socket-for-uri uri))
- (version '(1 . 1)) (keep-alive? #f) (extra-headers '())
- (decode-body? #t))
+;; We could expose this to user code if there is demand.
+(define* (request uri #:key
+ (body #f)
+ (port (open-socket-for-uri uri))
+ (method "GET")
+ (version '(1 . 1))
+ (keep-alive? #f)
+ (headers '())
+ (decode-body? #t)
+ (streaming? #f)
+ (request
+ (build-request
+ (ensure-uri uri)
+ #:method method
+ #:version version
+ #:headers (if keep-alive?
+ headers
+ (cons '(connection close) headers))
+ #:port port)))
+ (call-with-values (lambda () (sanitize-request request body))
+ (lambda (request body)
+ (let ((request (write-request request port)))
+ (when body
+ (write-request-body request body))
+ (force-output (request-port request))
+ (let ((response (read-response port)))
+ (cond
+ ((equal? (request-method request) "HEAD")
+ (unless keep-alive?
+ (close-port port))
+ (values response #f))
+ (streaming?
+ (values response
+ (response-body-port response
+ #:keep-alive? keep-alive?
+ #:decode? decode-body?)))
+ (else
+ (let ((body (read-response-body response)))
+ (unless keep-alive?
+ (close-port port))
+ (values response
+ (if decode-body?
+ (decode-response-body response body)
+ body))))))))))
+
+(define* (http-get uri #:key
+ (body #f)
+ (port (open-socket-for-uri uri))
+ (version '(1 . 1)) (keep-alive? #f)
+ ;; #:headers is the new name of #:extra-headers.
+ (extra-headers #f) (headers (or extra-headers '()))
+ (decode-body? #t) (streaming? #f))
"Connect to the server corresponding to URI and ask for the
resource, using the âGETâ method. If you already have a port open,
pass it as PORT. The port will be closed at the end of the
request unless KEEP-ALIVE? is true. Any extra headers in the
-alist EXTRA-HEADERS will be added to the request.
+alist HEADERS will be added to the request.
+
+If BODY is not #f, a message body will also be sent with the HTTP
+request. If BODY is a string, it is encoded according to the
+content-type in HEADERS, defaulting to UTF-8. Otherwise BODY should be
+a bytevector, or #f for no body. Although it's allowed to send a
+message body along with any request, usually only POST and PUT requests
+have bodies. See âhttp-putâ and âhttp-postâ documentation, for more.
If DECODE-BODY? is true, as is the default, the body of the
response will be decoded to string, if it is a textual content-type.
-Otherwise it will be returned as a bytevector."
- (let ((req (build-request uri #:version version
- #:headers (if keep-alive?
- extra-headers
- (cons '(connection close)
- extra-headers)))))
- (write-request req port)
- (force-output port)
- (let* ((res (read-response port))
- (body (read-response-body res)))
- (if (not keep-alive?)
- (close-port port))
- (values res
- (if decode-body?
- (decode-response-body res body)
- body)))))
-
-(define* (http-get* uri #:key (port (open-socket-for-uri uri))
- (version '(1 . 1)) (keep-alive? #f) (extra-headers '())
+Otherwise it will be returned as a bytevector.
+
+However, if STREAMING? is true, instead of eagerly reading the response
+body from the server, this function only reads off the headers. The
+response body will be returned as a port on which the data may be read.
+Unless KEEP-ALIVE? is true, the port will be closed after the full
+response body has been read.
+
+Returns two values: the response read from the server, and the response
+body as a string, bytevector, #f value, or as a port (if STREAMING? is
+true)."
+ (when extra-headers
+ (issue-deprecation-warning
+ "The #:extra-headers argument to http-get has been renamed to #:headers. "
+ "Please update your code."))
+ (request uri #:method "GET" #:body body
+ #:port port #:version version #:keep-alive? keep-alive?
+ #:headers headers #:decode-body? decode-body?
+ #:streaming? streaming?))
+
+(define* (http-get* uri #:key
+ (body #f)
+ (port (open-socket-for-uri uri))
+ (version '(1 . 1)) (keep-alive? #f)
+ ;; #:headers is the new name of #:extra-headers.
+ (extra-headers #f) (headers (or extra-headers '()))
(decode-body? #t))
- "Like âhttp-getâ, but return an input port from which to read. When
-DECODE-BODY? is true, as is the default, the returned port has its
-encoding set appropriately if the data at URI is textual. Closing the
-returned port closes PORT, unless KEEP-ALIVE? is true."
- (let ((req (build-request uri #:version version
- #:headers (if keep-alive?
- extra-headers
- (cons '(connection close)
- extra-headers)))))
- (write-request req port)
- (force-output port)
- (unless keep-alive?
- (shutdown port 1))
- (let* ((res (read-response port))
- (body (response-body-port res
- #:keep-alive? keep-alive?
- #:decode? decode-body?)))
- (values res body))))
+ "Deprecated in favor of (http-get #:streaming? #t)."
+ (when extra-headers
+ (issue-deprecation-warning
+ "`http-get*' has been deprecated. "
+ "Instead, use `http-get' with the #:streaming? #t keyword argument."))
+ (http-get uri #:body body
+ #:port port #:version version #:keep-alive? keep-alive?
+ #:headers headers #:decode-body? #t #:streaming? #t))
+
+(define-syntax-rule (define-http-verb http-verb method doc)
+ (define* (http-verb uri #:key
+ (body #f)
+ (port (open-socket-for-uri uri))
+ (version '(1 . 1))
+ (keep-alive? #f)
+ (headers '())
+ (decode-body? #t)
+ (streaming? #f))
+ doc
+ (request uri
+ #:body body #:method method
+ #:port port #:version version #:keep-alive? keep-alive?
+ #:headers headers #:decode-body? decode-body?
+ #:streaming? streaming?)))
+
+(define-http-verb http-head
+ "HEAD"
+ "Fetch message headers for the given URI using the HTTP \"HEAD\"
+method.
+
+This function is similar to âhttp-getâ, except it uses the \"HEAD\"
+method. See âhttp-getâ for full documentation on the various keyword
+arguments that are accepted by this function.
+
+Returns two values: the resulting response, and #f. Responses to HEAD
+requests do not have a body. The second value is only returned so that
+other procedures can treat all of the http-foo verbs identically.")
+
+(define-http-verb http-post
+ "POST"
+ "Post data to the given URI using the HTTP \"POST\" method.
+
+This function is similar to âhttp-getâ, except it uses the \"POST\"
+method. See âhttp-getâ for full documentation on the various keyword
+arguments that are accepted by this function.
+
+Returns two values: the resulting response, and the response body.")
+
+(define-http-verb http-put
+ "PUT"
+ "Put data at the given URI using the HTTP \"PUT\" method.
+
+This function is similar to âhttp-getâ, except it uses the \"PUT\"
+method. See âhttp-getâ for full documentation on the various keyword
+arguments that are accepted by this function.
+
+Returns two values: the resulting response, and the response body.")
+
+(define-http-verb http-delete
+ "DELETE"
+ "Delete data at the given URI using the HTTP \"DELETE\" method.
+
+This function is similar to âhttp-getâ, except it uses the \"DELETE\"
+method. See âhttp-getâ for full documentation on the various keyword
+arguments that are accepted by this function.
+
+Returns two values: the resulting response, and the response body.")
+
+(define-http-verb http-trace
+ "TRACE"
+ "Send an HTTP \"TRACE\" request.
+
+This function is similar to âhttp-getâ, except it uses the \"TRACE\"
+method. See âhttp-getâ for full documentation on the various keyword
+arguments that are accepted by this function.
+
+Returns two values: the resulting response, and the response body.")
+
+(define-http-verb http-options
+ "OPTIONS"
+ "Query characteristics of an HTTP resource using the HTTP \"OPTIONS\"
+method.
+
+This function is similar to âhttp-getâ, except it uses the \"OPTIONS\"
+method. See âhttp-getâ for full documentation on the various keyword
+arguments that are accepted by this function.
+
+Returns two values: the resulting response, and the response body.")
diff --git a/module/web/http.scm b/module/web/http.scm
index 976f0fb..c79d57d 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -69,13 +69,6 @@
make-chunked-output-port))
-;;; TODO
-;;;
-;;; Look at quality lists with more insight.
-;;; Think about `accept' a bit more.
-;;;
-
-
(define (string->header name)
"Parse NAME to a symbolic header name."
(string->symbol (string-downcase name)))
diff --git a/module/web/response.scm b/module/web/response.scm
index 5ca7274..7e14f4d 100644
--- a/module/web/response.scm
+++ b/module/web/response.scm
@@ -1,6 +1,6 @@
;;; HTTP response objects
-;; Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -294,7 +294,13 @@ response port."
(define (read-response-body r)
"Reads the response body from R, as a bytevector. Returns
â#fâ if there was no response body."
- (and=> (response-body-port r #:decode? #f) get-bytevector-all))
+ (let ((body (and=> (response-body-port r #:decode? #f)
+ get-bytevector-all)))
+ ;; Reading a body of length 0 will result in get-bytevector-all
+ ;; returning the EOF object.
+ (if (eof-object? body)
+ #vu8()
+ body)))
(define (write-response-body r bv)
"Write BV, a bytevector, to the port corresponding to the HTTP
diff --git a/module/web/server.scm b/module/web/server.scm
index 23f344e..54ab9e3 100644
--- a/module/web/server.scm
+++ b/module/web/server.scm
@@ -1,6 +1,6 @@
;;; Web server
-;; Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -80,6 +80,7 @@
#:use-module (web response)
#:use-module (system repl error-handling)
#:use-module (ice-9 control)
+ #:use-module (ice-9 iconv)
#:export (define-server-impl
lookup-server-impl
open-server
@@ -162,41 +163,6 @@ values."
#:on-error (if (batch-mode?) 'backtrace 'debug)
#:post-error (lambda _ (values #f #f #f))))
-;; like call-with-output-string, but actually closes the port (doh)
-(define (call-with-output-string* proc)
- (let ((port (open-output-string)))
- (proc port)
- (let ((str (get-output-string port)))
- (close-port port)
- str)))
-
-(define (call-with-output-bytevector* proc)
- (call-with-values
- (lambda ()
- (open-bytevector-output-port))
- (lambda (port get-bytevector)
- (proc port)
- (let ((bv (get-bytevector)))
- (close-port port)
- bv))))
-
-(define (call-with-encoded-output-string charset proc)
- (if (string-ci=? charset "utf-8")
- ;; I don't know why, but this appears to be faster; at least for
- ;; examples/debug-sxml.scm (1464 reqs/s versus 850 reqs/s).
- (string->utf8 (call-with-output-string* proc))
- (call-with-output-bytevector*
- (lambda (port)
- (set-port-encoding! port charset)
- (proc port)))))
-
-(define (encode-string str charset)
- (if (string-ci=? charset "utf-8")
- (string->utf8 str)
- (call-with-encoded-output-string charset
- (lambda (port)
- (display str port)))))
-
(define (extend-response r k v . additional)
(let ((r (build-response #:version (response-version r)
#:code (response-code r)
@@ -249,7 +215,7 @@ on the procedure being called at any particular time."
response
(extend-response response 'content-type
`(,@type (charset . ,charset))))
- (encode-string body charset))))
+ (string->bytevector body charset))))
((procedure? body)
(let* ((type (response-content-type response
'(text/plain)))
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index a843fcd..880e1e2 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -1,7 +1,7 @@
## Process this file with automake to produce Makefile.in.
##
## Copyright 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
-## 2010, 2011, 2012 Software Foundation, Inc.
+## 2010, 2011, 2012, 2013 Software Foundation, Inc.
##
## This file is part of GUILE.
##
@@ -62,6 +62,7 @@ SCM_TESTS = tests/00-initial-env.test \
tests/hash.test \
tests/hooks.test \
tests/i18n.test \
+ tests/iconv.test \
tests/import.test \
tests/interp.test \
tests/keywords.test \
diff --git a/test-suite/tests/iconv.test b/test-suite/tests/iconv.test
new file mode 100644
index 0000000..e6ee90d
--- /dev/null
+++ b/test-suite/tests/iconv.test
@@ -0,0 +1,115 @@
+;;;; iconv.test --- Exercise the iconv API. -*- coding: utf-8; mode: scheme;
-*-
+;;;;
+;;;; Copyright (C) 2013 Free Software Foundation, Inc.
+;;;; Andy Wingo
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
+
+(define-module (test-suite iconv)
+ #:use-module (ice-9 iconv)
+ #:use-module (rnrs bytevectors)
+ #:use-module (test-suite lib))
+
+
+(define exception:encoding-error
+ '(encoding-error . ""))
+
+(define exception:decoding-error
+ '(decoding-error . ""))
+
+
+(with-test-prefix "ascii string"
+ (let ((s "Hello, World!"))
+ ;; For ASCII, all of these encodings should be the same.
+
+ (pass-if "to ascii bytevector"
+ (equal? (string->bytevector s "ASCII")
+ #vu8(72 101 108 108 111 44 32 87 111 114 108 100 33)))
+
+ (pass-if "to ascii bytevector (length check)"
+ (equal? (string-length s)
+ (bytevector-length (string->bytevector s "ascii"))))
+
+ (pass-if "from ascii bytevector"
+ (equal? s
+ (bytevector->string (string->bytevector s "ascii") "ascii")))
+
+ (pass-if "to utf-8 bytevector"
+ (equal? (string->bytevector s "ASCII")
+ (string->bytevector s "utf-8")))
+
+ (pass-if "to UTF-8 bytevector (testing encoding case sensitivity)"
+ (equal? (string->bytevector s "ascii")
+ (string->bytevector s "UTF-8")))
+
+ (pass-if "from utf-8 bytevector"
+ (equal? s
+ (bytevector->string (string->bytevector s "utf-8") "utf-8")))
+
+ (pass-if "to latin1 bytevector"
+ (equal? (string->bytevector s "ASCII")
+ (string->bytevector s "latin1")))
+
+ (pass-if "from latin1 bytevector"
+ (equal? s
+ (bytevector->string (string->bytevector s "utf-8") "utf-8")))))
+
+(with-test-prefix "narrow non-ascii string"
+ (let ((s "été"))
+ (pass-if "to latin1 bytevector"
+ (equal? (string->bytevector s "latin1")
+ #vu8(233 116 233)))
+
+ (pass-if "to latin1 bytevector (length check)"
+ (equal? (string-length s)
+ (bytevector-length (string->bytevector s "latin1"))))
+
+ (pass-if "from latin1 bytevector"
+ (equal? s
+ (bytevector->string (string->bytevector s "latin1") "latin1")))
+
+ (pass-if "to utf-8 bytevector"
+ (equal? (string->bytevector s "utf-8")
+ #vu8(195 169 116 195 169)))
+
+ (pass-if "from utf-8 bytevector"
+ (equal? s
+ (bytevector->string (string->bytevector s "utf-8") "utf-8")))
+
+ (pass-if-exception "encode latin1 as ascii" exception:encoding-error
+ (string->bytevector s "ascii"))
+
+ (pass-if-exception "misparse latin1 as utf8" exception:decoding-error
+ (bytevector->string (string->bytevector s "latin1") "utf-8"))
+
+ (pass-if-exception "misparse latin1 as ascii" exception:decoding-error
+ (bytevector->string (string->bytevector s "latin1") "ascii"))))
+
+
+(with-test-prefix "wide non-ascii string"
+ (let ((s "ΧÎÎΣ"))
+ (pass-if "to utf-8 bytevector"
+ (equal? (string->bytevector s "utf-8")
+ #vu8(206 167 206 145 206 159 206 163) ))
+
+ (pass-if "from utf-8 bytevector"
+ (equal? s
+ (bytevector->string (string->bytevector s "utf-8") "utf-8")))
+
+ (pass-if-exception "encode as ascii" exception:encoding-error
+ (string->bytevector s "ascii"))
+
+ (pass-if-exception "encode as latin1" exception:encoding-error
+ (string->bytevector s "latin1"))))
diff --git a/test-suite/tests/web-client.test b/test-suite/tests/web-client.test
new file mode 100644
index 0000000..3133b73
--- /dev/null
+++ b/test-suite/tests/web-client.test
@@ -0,0 +1,577 @@
+;;;; web-client.test --- HTTP client -*- mode: scheme; coding: utf-8; -*-
+;;;;
+;;;; Copyright (C) 2013 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
+
+
+(define-module (test-suite web-client)
+ #:use-module (web client)
+ #:use-module (web request)
+ #:use-module (web response)
+ #:use-module (ice-9 iconv)
+ #:use-module (ice-9 binary-ports)
+ #:use-module (test-suite lib))
+
+
+(define get-request-headers:www.gnu.org/software/guile/
+ "GET /software/guile/ HTTP/1.1
+Host: www.gnu.org
+Connection: close
+
+")
+
+(define get-response-headers:www.gnu.org/software/guile/
+ "HTTP/1.1 200 OK
+Date: Fri, 11 Jan 2013 10:59:11 GMT
+Server: Apache/2.2.14
+Accept-Ranges: bytes
+Cache-Control: max-age=0
+Expires: Fri, 11 Jan 2013 10:59:11 GMT
+Vary: Accept-Encoding
+Content-Length: 8077
+Connection: close
+Content-Type: text/html
+Content-Language: en
+
+")
+
+(define get-response-body:www.gnu.org/software/guile/
+ "<!DOCTYPE html PUBLIC \"-//IETF//DTD HTML 2.0//EN\">
+<html>
+<head>
+ <title>GNU Guile (About Guile)</title>
+ <link rel=\"stylesheet\" type=\"text/css\" href=\"/gnu.css\">
+ <link rel=\"stylesheet\" type=\"text/css\"
href=\"/software/guile/guile.css\">
+ <link rev=\"made\" href=\"mailto:address@hidden";>
+</head>
+
+<!-- If you edit these html pages directly, you're not doing yourself any
+ favors - these pages get updated programaticly from a pair of files. Edit
+ the files under the template directory instead -->
+
+<!-- Text black on white, unvisited links blue, visited links navy,
+ active links red -->
+
+<body bgcolor=\"#ffffff\" text=\"#000000\" link=\"#1f00ff\" alink=\"#ff0000\"
vlink=\"#000080\">
+ <a name=\"top\"></a>
+ <table cellpadding=\"10\">
+ <tr>
+ <td>
+\t<a href=\"/software/guile/\">
+\t <img src=\"/software/guile/graphics/guile-banner.small.png\" alt=\"Guile\">
+\t</a>
+ </td>
+ <td valign=\"bottom\">
+\t<h4 align=\"right\">The GNU extension language</h4>
+\t<h4 align=\"right\">About Guile</h4>
+ </td>
+ </tr>
+ </table>
+ <br />
+ <table border=\"0\">
+
+ <!-- Table with 2 columns. One along the left (navbar) and one along the
+\t right (body). On the main page, the left links to anchors on the right,
+\t or to other pages. The left has 2 sections. Top is global navigation,
+\t the bottom is local nav. -->
+
+ <tr>
+ <td class=\"sidebar\">
+\t<table cellpadding=\"4\">
+\t <tr>
+\t <!-- Global Nav -->
+
+\t <td nowrap=\"\">
+\t <p><b>About Guile</b><br />
+\t\t<a href=\"/software/guile/guile.html\">What is Guile?</a><br />
+\t\t<a href=\"/software/guile/news.html\">News</a><br />
+\t\t<a href=\"/software/guile/community.html\">Community</a><br />
+\t </p>
+\t
+\t <p><b>Documentation</b><br />
+\t\t<a href=\"/software/guile/docs/docs.html\">Manuals</a><br />
+\t\t<a href=\"/software/guile/docs/faq/guile-faq.html\">FAQ's</a><br />
+\t </p>
+
+\t <p><b>Download</b><br />
+\t\t<a href=\"/software/guile/download.html#releases\">Releases</a><br />
+\t\t<a href=\"/software/guile/download.html#git\">Repository</a><br />
+\t\t<a href=\"/software/guile/download.html#snapshots\">Snapshots</a><br />
+\t </p>
+
+\t <p><b>Projects</b><br />
+\t\t<a href=\"/software/guile/gnu-guile-projects.html#Core\">Core</a><br />
+\t\t<a href=\"/software/guile/gnu-guile-projects.html#GUI\">GUI</a><br />
+\t\t<a href=\"/software/guile/gnu-guile-projects.html#File-Formats\">File
Formats</a><br />
+\t\t<a
href=\"/software/guile/gnu-guile-projects.html#Networking\">Networking</a><br />
+\t\t<a href=\"/software/guile/gnu-guile-projects.html#Tools\">Tools</a><br />
+\t\t<a
href=\"/software/guile/gnu-guile-projects.html#Applications\">Applications</a><br
/>
+\t </p>
+\t
+\t <p><b>Development</b><br />
+\t\t<a href=\"http://savannah.gnu.org/projects/guile/\";>Project summary</a><br
/>
+\t\t<a href=\"/software/guile/developers.html\">Helping out</a><br />
+\t\t<a href=\"/software/guile/ideas.html\">Cool ideas</a><br />
+\t </p>
+
+\t <p><b>Resources</b><br>
+\t\t<a href=\"/software/guile/resources.html#guile_resources\">Guile
Resources</a><br />
+\t\t<a href=\"/software/guile/resources.html##scheme_resources\">Scheme
Resources</a><br />
+\t </p>
+\t </td>
+\t </tr>
+\t <tr>
+
+\t <!-- Global Nav End -->
+\t
+ <tr>
+ <td>
+ <p><a href=\"http://www.gnu.org/\";>GNU Project home page</a></p>
+ <p><a href=\"#whatisit\">What is Guile?</a></p>
+ <p><a href=\"#get\">Getting Guile</a></p>
+ </td>
+ </tr>
+
+
+\t </tr>
+\t</table>
+ </td>
+
+ <td class=\"rhs-body\">
+
+\t
+ <a name=\"whatisit\"><h3 align=\"left\">What is Guile? What can it do for
you?</h3></a>
+ <p>
+ Guile is the <em>GNU Ubiquitous Intelligent Language for Extensions</em>,
+ the official extension language for the
+ <a href=\"http://www.gnu.org/\";>GNU operating system</a>.
+ </p>
+
+ <p>
+ Guile is a library designed to help programmers create flexible
+ applications. Using Guile in an application allows the application's
+ functionality to be <em>extended</em> by users or other programmers with
+ plug-ins, modules, or scripts. Guile provides what might be described as
+ \"practical software freedom,\" making it possible for users to customize
an
+ application to meet their needs without digging into the application's
+ internals.
+ </p>
+
+ <p>
+ There is a long list of proven applications that employ extension
languages.
+ Successful and long-lived examples of Free Software projects that use
+ Guile are <a href=\"http://www.texmacs.org/\";>TeXmacs</a>,
+ <a href=\"http://lilypond.org/\";>LilyPond</a>, and
+ <a href=\"http://www.gnucash.org/\";>GnuCash</a>.
+ </p>
+
+ <h3>Guile is a programming language</h3>
+
+ <p>
+ Guile is an interpreter and compiler for
+ the <a href=\"http://schemers.org/\";>Scheme</a> programming language, a
clean
+ and elegant dialect of Lisp. Guile is up to date with recent Scheme
+ standards, supporting the
+ <a
href=\"http://www.schemers.org/Documents/Standards/R5RS/\";>Revised<sup>5</sup></a>
+ and most of the <a href=\"http://www.r6rs.org/\";>Revised<sup>6</sup></a>
language
+ reports (including hygienic macros), as well as many
+ <a href=\"http://srfi.schemers.org/\";>SRFIs</a>. It also comes with a
library
+ of modules that offer additional features, like an HTTP server and client,
+ XML parsing, and object-oriented programming.
+ </p>
+
+ <h3>Guile is an extension language platform</h3>
+
+ <p>
+ Guile is an efficient virtual machine that executes a portable instruction
+ set generated by its optimizing compiler, and integrates very easily with C
+ and C++ application code. In addition to Scheme, Guile includes compiler
+ front-ends for
+ <a
href=\"http://www.ecma-international.org/publications/standards/Ecma-262.htm\";>ECMAScript</a>
+ and <a href=\"http://www.emacswiki.org/cgi-bin/wiki?EmacsLisp\";>Emacs
Lisp</a>
+ (support for <a href=\"http://www.lua.org/\";>Lua</a> is underway), which
means
+ your application can be extended in the language (or languages) most
+ appropriate for your user base. And Guile's tools for parsing and
compiling
+ are exposed as part of its standard module set, so support for additional
+ languages can be added without writing a single line of C.
+ </p>
+
+ <h3>Guile gives your programs more power</h3>
+
+ <p>
+ Using Guile with your program makes it more usable. Users don't
+ need to learn the plumbing of your application to customize it; they just
+ need to understand Guile, and the access you've provided. They can easily
+ trade and share features by downloading and creating scripts, instead of
+ trading complex patches and recompiling their applications. They don't
need
+ to coordinate with you or anyone else. Using Guile, your application has a
+ full-featured scripting language right from the beginning, so you can focus
+ on the novel and attention-getting parts of your application.
+ </p>
+
+ <a name=\"get\"><h2 align=\"center\">How do I get Guile?</h2></a>
+
+ <ul>
+ <li>The current <em>stable</em> release is
+ <a href=\"ftp://ftp.gnu.org/gnu/guile/guile-2.0.7.tar.gz\";>2.0.7</a>.
+ </li>
+ </ul>
+
+ <p>
+ See the <a href=\"download.html\">Download</a> page for additional ways of
+ getting Guile.
+ </p>
+
+
+
+ </td>
+ </tr>
+ </table>
+
+ <br />
+ <div class=\"copyright\">
+
+ <p>
+ Please send FSF & GNU inquiries & questions to
+ <a href=\"mailto:address@hidden";><em>address@hidden</em></a>. There are
also
+ <a href=\"/home.html#ContactInfo\">other ways to contact</a> the FSF.
+ </p>
+
+ <p>
+ Please send comments on these web pages to
+ <a href=\"mailto:address@hidden";><em>address@hidden</em></a>, send
+ other questions to <a
href=\"mailto:address@hidden";><em>address@hidden</em></a>.
+ </p>
+
+ <p>
+ Copyright (C) 2012 Free Software Foundation, Inc.
+ </p>
+
+ <p>
+ Verbatim copying and distribution of this entire web page is
+ permitted in any medium, provided this notice is preserved.<P>
+ Updated:
+
+ <!-- timestamp start -->
+ $Date: 2012/11/30 00:16:15 $ $Author: civodul $
+ <!-- timestamp end -->
+ </p>
+
+ </div>
+
+</body>
+</html>
+")
+
+(define head-request-headers:www.gnu.org/software/guile/
+ "HEAD /software/guile/ HTTP/1.1
+Host: www.gnu.org
+Connection: close
+
+")
+
+(define head-response-headers:www.gnu.org/software/guile/
+ "HTTP/1.1 200 OK
+Date: Fri, 11 Jan 2013 11:03:14 GMT
+Server: Apache/2.2.14
+Accept-Ranges: bytes
+Cache-Control: max-age=0
+Expires: Fri, 11 Jan 2013 11:03:14 GMT
+Vary: Accept-Encoding
+Content-Length: 8077
+Connection: close
+Content-Type: text/html
+Content-Language: en
+
+")
+
+;; Unfortunately, POST to http://www.gnu.org/software/guile/ succeeds!
+(define post-request-headers:www.apache.org/
+ "POST / HTTP/1.1
+Host: www.apache.org
+Connection: close
+
+")
+
+(define post-response-headers:www.apache.org/
+ "HTTP/1.1 405 Method Not Allowed
+Date: Fri, 11 Jan 2013 11:04:34 GMT
+Server: Apache/2.4.3 (Unix) OpenSSL/1.0.0g
+Allow: TRACE
+Content-Length: 314
+Connection: close
+Content-Type: text/html; charset=iso-8859-1
+
+")
+
+(define post-response-body:www.apache.org/
+"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">
+<html><head>
+<title>405 Method Not Allowed</title>
+</head><body>
+<h1>Method Not Allowed</h1>
+<p>The requested method POST is not allowed for the URL /.</p>
+<hr>
+<address>Apache/2.4.3 (Unix) OpenSSL/1.0.0g Server at www.apache.org Port
80</address>
+</body></html>
+")
+
+(define put-request-headers:www.apache.org/
+ "PUT / HTTP/1.1
+Host: www.apache.org
+Connection: close
+
+")
+
+(define put-response-headers:www.apache.org/
+ "HTTP/1.1 405 Method Not Allowed
+Date: Fri, 11 Jan 2013 11:04:34 GMT
+Server: Apache/2.4.3 (Unix) OpenSSL/1.0.0g
+Allow: TRACE
+Content-Length: 313
+Connection: close
+Content-Type: text/html; charset=iso-8859-1
+
+")
+
+(define put-response-body:www.apache.org/
+ "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">
+<html><head>
+<title>405 Method Not Allowed</title>
+</head><body>
+<h1>Method Not Allowed</h1>
+<p>The requested method PUT is not allowed for the URL /.</p>
+<hr>
+<address>Apache/2.4.3 (Unix) OpenSSL/1.0.0g Server at www.apache.org Port
80</address>
+</body></html>
+")
+
+(define delete-request-headers:www.apache.org/
+ "DELETE / HTTP/1.1
+Host: www.apache.org
+Connection: close
+
+")
+
+(define delete-response-headers:www.apache.org/
+ "HTTP/1.1 405 Method Not Allowed
+Date: Fri, 11 Jan 2013 11:07:19 GMT
+Server: Apache/2.4.3 (Unix) OpenSSL/1.0.0g
+Allow: TRACE
+Content-Length: 316
+Connection: close
+Content-Type: text/html; charset=iso-8859-1
+
+")
+
+
+
+(define delete-response-body:www.apache.org/
+ "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">
+<html><head>
+<title>405 Method Not Allowed</title>
+</head><body>
+<h1>Method Not Allowed</h1>
+<p>The requested method DELETE is not allowed for the URL /.</p>
+<hr>
+<address>Apache/2.4.3 (Unix) OpenSSL/1.0.0g Server at www.apache.org Port
80</address>
+</body></html>
+")
+
+(define options-request-headers:www.apache.org/
+ "OPTIONS / HTTP/1.1
+Host: www.apache.org
+Connection: close
+
+")
+
+(define options-response-headers:www.apache.org/
+ "HTTP/1.1 200 OK
+Date: Fri, 11 Jan 2013 11:08:31 GMT
+Server: Apache/2.4.3 (Unix) OpenSSL/1.0.0g
+Allow: OPTIONS,GET,HEAD,POST,TRACE
+Cache-Control: max-age=3600
+Expires: Fri, 11 Jan 2013 12:08:31 GMT
+Content-Length: 0
+Connection: close
+Content-Type: text/html; charset=utf-8
+
+")
+
+;; This depends on the exact request that we send. I copied this off
+;; the console with an "nc" session, so it doesn't include the CR bytes.
+;; But that's OK -- we just have to decode the body as an HTTP request
+;; and check that it's the same.
+(define trace-request-headers:www.apache.org/
+ "TRACE / HTTP/1.1\r
+Host: www.apache.org\r
+Connection: close\r
+\r
+")
+
+(define trace-response-headers:www.apache.org/
+ "HTTP/1.1 200 OK\r
+Date: Fri, 11 Jan 2013 12:36:13 GMT\r
+Server: Apache/2.4.3 (Unix) OpenSSL/1.0.0g\r
+Connection: close\r
+Transfer-Encoding: chunked\r
+Content-Type: message/http\r
+\r
+")
+
+(define trace-response-body:www.apache.org/
+ "3d\r
+TRACE / HTTP/1.1\r
+Host: www.apache.org\r
+Connection: close\r
+\r
+\r
+0\r
+\r
+")
+
+(define (requests-equal? r1 r2)
+ (and (equal? (request-method r1) (request-method r2))
+ (equal? (request-uri r1) (request-uri r2))
+ (equal? (request-version r1) (request-version r2))
+ (equal? (request-headers r1) (request-headers r2))))
+
+(define (responses-equal? r1 r2)
+ (and (equal? (response-code r1) (response-code r2))
+ (equal? (response-version r1) (response-version r2))
+ (equal? (response-headers r1) (response-headers r2))))
+
+(define* (run-with-http-transcript
+ expected-request expected-request-body request-body-encoding
+ response response-body response-body-encoding
+ proc)
+ (let ((reading? #f)
+ (writing? #t)
+ (response-port (open-input-string response))
+ (response-body-port (open-bytevector-input-port
+ (string->bytevector response-body
+ response-body-encoding))))
+ (call-with-values (lambda () (open-bytevector-output-port))
+ (lambda (request-port get-bytevector)
+ (define (put-char c)
+ (unless writing?
+ (error "Port closed for writing"))
+ (put-u8 request-port (char->integer c)))
+ (define (put-string s)
+ (string-for-each put-char s))
+ (define (flush)
+ (set! writing? #f)
+ (set! reading? #t)
+ (let* ((p (open-bytevector-input-port (get-bytevector)))
+ (actual-request (read-request p))
+ (actual-body (read-request-body actual-request)))
+ (pass-if "requests equal"
+ (requests-equal? actual-request
+ (call-with-input-string expected-request
+ read-request)))
+ (pass-if "request bodies equal"
+ (equal? (or actual-body #vu8())
+ (string->bytevector expected-request-body
+ request-body-encoding)))))
+ (define (get-char)
+ (unless reading?
+ (error "Port closed for reading"))
+ (let ((c (read-char response-port)))
+ (if (char? c)
+ c
+ (let ((u8 (get-u8 response-body-port)))
+ (if (eof-object? u8)
+ u8
+ (integer->char u8))))))
+ (define (close)
+ (when writing?
+ (unless (eof-object? (get-u8 response-body-port))
+ (error "Failed to consume all of body"))))
+ (proc (make-soft-port (vector put-char put-string flush get-char close)
+ "rw"))))))
+
+(define* (check-transaction method uri
+ request-headers request-body request-body-encoding
+ response-headers response-body
response-body-encoding
+ proc
+ #:key (response-body-comparison response-body))
+ (with-test-prefix (string-append method " " uri)
+ (run-with-http-transcript
+ request-headers request-body request-body-encoding
+ response-headers response-body response-body-encoding
+ (lambda (port)
+ (call-with-values (lambda ()
+ (proc uri #:port port))
+ (lambda (response body)
+ (pass-if "response equal"
+ (responses-equal?
+ response
+ (call-with-input-string response-headers read-response)))
+ (pass-if "response body equal"
+ (equal? (or body "") response-body-comparison))))))))
+
+(check-transaction
+ "GET" "http://www.gnu.org/software/guile/";
+ get-request-headers:www.gnu.org/software/guile/ "" "iso-8859-1"
+ get-response-headers:www.gnu.org/software/guile/
+ get-response-body:www.gnu.org/software/guile/ "iso-8859-1"
+ http-get)
+
+(check-transaction
+ "HEAD" "http://www.gnu.org/software/guile/";
+ head-request-headers:www.gnu.org/software/guile/ "" "iso-8859-1"
+ head-response-headers:www.gnu.org/software/guile/ "" "iso-8859-1"
+ http-head)
+
+(check-transaction
+ "POST" "http://www.apache.org/";
+ post-request-headers:www.apache.org/ "" "iso-8859-1"
+ post-response-headers:www.apache.org/
+ post-response-body:www.apache.org/ "iso-8859-1"
+ http-post)
+
+(check-transaction
+ "PUT" "http://www.apache.org/";
+ put-request-headers:www.apache.org/ "" "iso-8859-1"
+ put-response-headers:www.apache.org/
+ put-response-body:www.apache.org/ "iso-8859-1"
+ http-put)
+
+(check-transaction
+ "DELETE" "http://www.apache.org/";
+ delete-request-headers:www.apache.org/ "" "iso-8859-1"
+ delete-response-headers:www.apache.org/
+ delete-response-body:www.apache.org/ "iso-8859-1"
+ http-delete)
+
+(check-transaction
+ "OPTIONS" "http://www.apache.org/";
+ options-request-headers:www.apache.org/ "" "utf-8"
+ options-response-headers:www.apache.org/ "" "utf-8"
+ http-options)
+
+(check-transaction
+ "TRACE" "http://www.apache.org/";
+ trace-request-headers:www.apache.org/ "" "iso-8859-1"
+ trace-response-headers:www.apache.org/
+ trace-response-body:www.apache.org/ "iso-8859-1"
+ http-trace
+ #:response-body-comparison
+ ;; The body will be message/http, which is logically a sequence of
+ ;; bytes, not characters. It happens that iso-8859-1 can encode our
+ ;; body and is compatible with the headers as well.
+ (string->bytevector trace-request-headers:www.apache.org/
+ "iso-8859-1"))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-25-g990b11c,
Andy Wingo <=