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.

3 files changed, 895 insertions, 73 deletions

diff --git a/doc/ref/web.texi b/doc/ref/web.texi
index e892453e3..0f69089d0 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.
-@c Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc.
+@c 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
 
-@deffn {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.
+@deffn {Scheme Procedure} http-get uri arg...
+@deffnx {Scheme Procedure} http-head uri arg...
+@deffnx {Scheme Procedure} http-post uri arg...
+@deffnx {Scheme Procedure} http-put uri arg...
+@deffnx {Scheme Procedure} http-delete uri arg...
+@deffnx {Scheme Procedure} http-trace uri arg...
+@deffnx {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.
+
+@table @code
+@item #:body #f
+@item #:port (open-socket-for-uri @var{uri})]
+@item #:version '(1 . 1)
+@item #:keep-alive? #f
+@item #:headers '()
+@item #:decode-body? #t
+@item #:streaming? #f
+@end 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
+@var{body} 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
+@code{PUT} 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.
-@end deffn
 
-@deffn {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
-@var{decode-body?} 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
+@var{streaming?} 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
-@email{guile-user@@gnu.org}.
-
 
 @node Web Server
 @subsection Web Server
diff --git a/module/web/client.scm b/module/web/client.scm
index d3502cc52..ce93cd841 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/test-suite/tests/web-client.test b/test-suite/tests/web-client.test
new file mode 100644
index 000000000..3133b73c8
--- /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:bug-guile@gnu.org\">
+</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 &amp; GNU inquiries &amp; questions to 
+      <a href=\"mailto:gnu@gnu.org\"><em>gnu@gnu.org</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:bug-guile@gnu.org\"><em>bug-guile@gnu.org</em></a>, send 
+      other questions to <a href=\"mailto:gnu@gnu.org\"><em>gnu@gnu.org</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"))