[bpt/guile.git] / test-suite / tests / web-client.test

;;;; 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"))
Commit	Line	Data
990b11c5 AW	1	;;;; web-client.test --- HTTP client -- mode: scheme; coding: utf-8; --
	2	;;;;
	3	;;;; Copyright (C) 2013 Free Software Foundation, Inc.
	4	;;;;
	5	;;;; This library is free software; you can redistribute it and/or
	6	;;;; modify it under the terms of the GNU Lesser General Public
	7	;;;; License as published by the Free Software Foundation; either
	8	;;;; version 3 of the License, or (at your option) any later version.
	9	;;;;
	10	;;;; This library is distributed in the hope that it will be useful,
	11	;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	12	;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	13	;;;; Lesser General Public License for more details.
	14	;;;;
	15	;;;; You should have received a copy of the GNU Lesser General Public
	16	;;;; License along with this library; if not, write to the Free Software
	17	;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
	18
	19
	20	(define-module (test-suite web-client)
	21	#:use-module (web client)
	22	#:use-module (web request)
	23	#:use-module (web response)
	24	#:use-module (ice-9 iconv)
	25	#:use-module (ice-9 binary-ports)
	26	#:use-module (test-suite lib))
	27
	28
	29	(define get-request-headers:www.gnu.org/software/guile/
	30	"GET /software/guile/ HTTP/1.1
	31	Host: www.gnu.org
	32	Connection: close
	33
	34	")
	35
	36	(define get-response-headers:www.gnu.org/software/guile/
	37	"HTTP/1.1 200 OK
	38	Date: Fri, 11 Jan 2013 10:59:11 GMT
	39	Server: Apache/2.2.14
	40	Accept-Ranges: bytes
	41	Cache-Control: max-age=0
	42	Expires: Fri, 11 Jan 2013 10:59:11 GMT
	43	Vary: Accept-Encoding
	44	Content-Length: 8077
	45	Connection: close
	46	Content-Type: text/html
	47	Content-Language: en
	48
	49	")
	50
	51	(define get-response-body:www.gnu.org/software/guile/
	52	"<!DOCTYPE html PUBLIC \"-//IETF//DTD HTML 2.0//EN\">
	53	<html>
	54	<head>
	55	<title>GNU Guile (About Guile)</title>
	56	<link rel=\"stylesheet\" type=\"text/css\" href=\"/gnu.css\">
	57	<link rel=\"stylesheet\" type=\"text/css\" href=\"/software/guile/guile.css\">
	58	<link rev=\"made\" href=\"mailto:bug-guile@gnu.org\">
	59	</head>
	60
	61	<!-- If you edit these html pages directly, you're not doing yourself any
	62	favors - these pages get updated programaticly from a pair of files. Edit
	63	the files under the template directory instead -->
	64
65	<!-- Text black on white, unvisited links blue, visited links navy,
66	active links red -->
67
68	<body bgcolor=\"#ffffff\" text=\"#000000\" link=\"#1f00ff\" alink=\"#ff0000\" vlink=\"#000080\">
69	<a name=\"top\"></a>
70	<table cellpadding=\"10\">
71	<tr>
72	<td>
73	\t<a href=\"/software/guile/\">
74	\t <img src=\"/software/guile/graphics/guile-banner.small.png\" alt=\"Guile\">
75	\t</a>
76	</td>
77	<td valign=\"bottom\">
78	\t<h4 align=\"right\">The GNU extension language</h4>
79	\t<h4 align=\"right\">About Guile</h4>
80	</td>
81	</tr>
82	</table>
83	<br />
84	<table border=\"0\">
85
86	<!-- Table with 2 columns. One along the left (navbar) and one along the
87	\t right (body). On the main page, the left links to anchors on the right,
88	\t or to other pages. The left has 2 sections. Top is global navigation,
89	\t the bottom is local nav. -->
90
91	<tr>
92	<td class=\"sidebar\">
93	\t<table cellpadding=\"4\">
94	\t <tr>
95	\t <!-- Global Nav -->
96
97	\t <td nowrap=\"\">
98	\t <p><b>About Guile</b><br />
99	\t\t<a href=\"/software/guile/guile.html\">What is Guile?</a><br />
100	\t\t<a href=\"/software/guile/news.html\">News</a><br />
101	\t\t<a href=\"/software/guile/community.html\">Community</a><br />
102	\t </p>
103	\t
104	\t <p><b>Documentation</b><br />
105	\t\t<a href=\"/software/guile/docs/docs.html\">Manuals</a><br />
106	\t\t<a href=\"/software/guile/docs/faq/guile-faq.html\">FAQ's</a><br />
107	\t </p>
108
109	\t <p><b>Download</b><br />
110	\t\t<a href=\"/software/guile/download.html#releases\">Releases</a><br />
111	\t\t<a href=\"/software/guile/download.html#git\">Repository</a><br />
112	\t\t<a href=\"/software/guile/download.html#snapshots\">Snapshots</a><br />
113	\t </p>
114
115	\t <p><b>Projects</b><br />
116	\t\t<a href=\"/software/guile/gnu-guile-projects.html#Core\">Core</a><br />
117	\t\t<a href=\"/software/guile/gnu-guile-projects.html#GUI\">GUI</a><br />
118	\t\t<a href=\"/software/guile/gnu-guile-projects.html#File-Formats\">File Formats</a><br />
119	\t\t<a href=\"/software/guile/gnu-guile-projects.html#Networking\">Networking</a><br />
120	\t\t<a href=\"/software/guile/gnu-guile-projects.html#Tools\">Tools</a><br />
121	\t\t<a href=\"/software/guile/gnu-guile-projects.html#Applications\">Applications</a><br />
122	\t </p>
123	\t
124	\t <p><b>Development</b><br />
125	\t\t<a href=\"http://savannah.gnu.org/projects/guile/\">Project summary</a><br />
126	\t\t<a href=\"/software/guile/developers.html\">Helping out</a><br />
127	\t\t<a href=\"/software/guile/ideas.html\">Cool ideas</a><br />
128	\t </p>
129
130	\t <p><b>Resources</b><br>
131	\t\t<a href=\"/software/guile/resources.html#guile_resources\">Guile Resources</a><br />
132	\t\t<a href=\"/software/guile/resources.html##scheme_resources\">Scheme Resources</a><br />
133	\t </p>
134	\t </td>
135	\t </tr>
136	\t <tr>
137
138	\t <!-- Global Nav End -->
139	\t
140	<tr>
141	<td>
142	<p><a href=\"http://www.gnu.org/\">GNU Project home page</a></p>
143	<p><a href=\"#whatisit\">What is Guile?</a></p>
144	<p><a href=\"#get\">Getting Guile</a></p>
145	</td>
146	</tr>
147
148
149	\t </tr>
150	\t</table>
151	</td>
152
153	<td class=\"rhs-body\">
154
155	\t
156	<a name=\"whatisit\"><h3 align=\"left\">What is Guile? What can it do for you?</h3></a>
157	<p>
158	Guile is the <em>GNU Ubiquitous Intelligent Language for Extensions</em>,
159	the official extension language for the
160	<a href=\"http://www.gnu.org/\">GNU operating system</a>.
161	</p>
162
163	<p>
164	Guile is a library designed to help programmers create flexible
165	applications. Using Guile in an application allows the application's
166	functionality to be <em>extended</em> by users or other programmers with
167	plug-ins, modules, or scripts. Guile provides what might be described as
168	\"practical software freedom,\" making it possible for users to customize an
169	application to meet their needs without digging into the application's
170	internals.
171	</p>
172
173	<p>
174	There is a long list of proven applications that employ extension languages.
175	Successful and long-lived examples of Free Software projects that use
176	Guile are <a href=\"http://www.texmacs.org/\">TeXmacs</a>,
177	<a href=\"http://lilypond.org/\">LilyPond</a>, and
178	<a href=\"http://www.gnucash.org/\">GnuCash</a>.
179	</p>
180
181	<h3>Guile is a programming language</h3>
182
183	<p>
184	Guile is an interpreter and compiler for
185	the <a href=\"http://schemers.org/\">Scheme</a> programming language, a clean
186	and elegant dialect of Lisp. Guile is up to date with recent Scheme
187	standards, supporting the
188	<a href=\"http://www.schemers.org/Documents/Standards/R5RS/\">Revised<sup>5</sup></a>
189	and most of the <a href=\"http://www.r6rs.org/\">Revised<sup>6</sup></a> language
190	reports (including hygienic macros), as well as many
191	<a href=\"http://srfi.schemers.org/\">SRFIs</a>. It also comes with a library
192	of modules that offer additional features, like an HTTP server and client,
193	XML parsing, and object-oriented programming.
194	</p>
195
196	<h3>Guile is an extension language platform</h3>
197
198	<p>
199	Guile is an efficient virtual machine that executes a portable instruction
200	set generated by its optimizing compiler, and integrates very easily with C
201	and C++ application code. In addition to Scheme, Guile includes compiler
202	front-ends for
203	<a href=\"http://www.ecma-international.org/publications/standards/Ecma-262.htm\">ECMAScript</a>
204	and <a href=\"http://www.emacswiki.org/cgi-bin/wiki?EmacsLisp\">Emacs Lisp</a>
205	(support for <a href=\"http://www.lua.org/\">Lua</a> is underway), which means
206	your application can be extended in the language (or languages) most
207	appropriate for your user base. And Guile's tools for parsing and compiling
208	are exposed as part of its standard module set, so support for additional
209	languages can be added without writing a single line of C.
210	</p>
211
212	<h3>Guile gives your programs more power</h3>
213
214	<p>
215	Using Guile with your program makes it more usable. Users don't
216	need to learn the plumbing of your application to customize it; they just
217	need to understand Guile, and the access you've provided. They can easily
218	trade and share features by downloading and creating scripts, instead of
219	trading complex patches and recompiling their applications. They don't need
220	to coordinate with you or anyone else. Using Guile, your application has a
221	full-featured scripting language right from the beginning, so you can focus
222	on the novel and attention-getting parts of your application.
223	</p>
224
225	<a name=\"get\"><h2 align=\"center\">How do I get Guile?</h2></a>
226
227	<ul>
228	<li>The current <em>stable</em> release is
229	<a href=\"ftp://ftp.gnu.org/gnu/guile/guile-2.0.7.tar.gz\">2.0.7</a>.
230	</li>
231	</ul>
232
233	<p>
234	See the <a href=\"download.html\">Download</a> page for additional ways of
235	getting Guile.
236	</p>
237
238
239
240	</td>
241	</tr>
242	</table>
243
244	<br />
245	<div class=\"copyright\">
246
247	<p>
248	Please send FSF & GNU inquiries & questions to
249	<a href=\"mailto:gnu@gnu.org\"><em>gnu@gnu.org</em></a>. There are also
250	<a href=\"/home.html#ContactInfo\">other ways to contact</a> the FSF.
251	</p>
252
253	<p>
254	Please send comments on these web pages to
255	<a href=\"mailto:bug-guile@gnu.org\"><em>bug-guile@gnu.org</em></a>, send
256	other questions to <a href=\"mailto:gnu@gnu.org\"><em>gnu@gnu.org</em></a>.
257	</p>
258
259	<p>
260	Copyright (C) 2012 Free Software Foundation, Inc.
261	</p>
262
263	<p>
264	Verbatim copying and distribution of this entire web page is
265	permitted in any medium, provided this notice is preserved.<P>
266	Updated:
267
268	<!-- timestamp start -->
269	$Date: 2012/11/30 00:16:15 $ $Author: civodul $
270	<!-- timestamp end -->
271	</p>
272
273	</div>
274
275	</body>
276	</html>
277	")
278
279	(define head-request-headers:www.gnu.org/software/guile/
280	"HEAD /software/guile/ HTTP/1.1
281	Host: www.gnu.org
282	Connection: close
283
284	")
285
286	(define head-response-headers:www.gnu.org/software/guile/
287	"HTTP/1.1 200 OK
288	Date: Fri, 11 Jan 2013 11:03:14 GMT
289	Server: Apache/2.2.14
290	Accept-Ranges: bytes
291	Cache-Control: max-age=0
292	Expires: Fri, 11 Jan 2013 11:03:14 GMT
293	Vary: Accept-Encoding
294	Content-Length: 8077
295	Connection: close
296	Content-Type: text/html
297	Content-Language: en
298
299	")
300
301	;; Unfortunately, POST to http://www.gnu.org/software/guile/ succeeds!
302	(define post-request-headers:www.apache.org/
303	"POST / HTTP/1.1
304	Host: www.apache.org
305	Connection: close
306
307	")
308
309	(define post-response-headers:www.apache.org/
310	"HTTP/1.1 405 Method Not Allowed
311	Date: Fri, 11 Jan 2013 11:04:34 GMT
312	Server: Apache/2.4.3 (Unix) OpenSSL/1.0.0g
313	Allow: TRACE
314	Content-Length: 314
315	Connection: close
316	Content-Type: text/html; charset=iso-8859-1
317
318	")
319
320	(define post-response-body:www.apache.org/
321	"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">
322	<html><head>
323	<title>405 Method Not Allowed</title>
324	</head><body>
325	<h1>Method Not Allowed</h1>
326	<p>The requested method POST is not allowed for the URL /.</p>
327	<hr>
328	<address>Apache/2.4.3 (Unix) OpenSSL/1.0.0g Server at www.apache.org Port 80</address>
329	</body></html>
330	")
331
332	(define put-request-headers:www.apache.org/
333	"PUT / HTTP/1.1
334	Host: www.apache.org
335	Connection: close
336
337	")
338
339	(define put-response-headers:www.apache.org/
340	"HTTP/1.1 405 Method Not Allowed
341	Date: Fri, 11 Jan 2013 11:04:34 GMT
342	Server: Apache/2.4.3 (Unix) OpenSSL/1.0.0g
343	Allow: TRACE
344	Content-Length: 313
345	Connection: close
346	Content-Type: text/html; charset=iso-8859-1
347
348	")
349
350	(define put-response-body:www.apache.org/
351	"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">
352	<html><head>
353	<title>405 Method Not Allowed</title>
354	</head><body>
355	<h1>Method Not Allowed</h1>
356	<p>The requested method PUT is not allowed for the URL /.</p>
357	<hr>
358	<address>Apache/2.4.3 (Unix) OpenSSL/1.0.0g Server at www.apache.org Port 80</address>
359	</body></html>
360	")
361
362	(define delete-request-headers:www.apache.org/
363	"DELETE / HTTP/1.1
364	Host: www.apache.org
365	Connection: close
366
367	")
368
369	(define delete-response-headers:www.apache.org/
370	"HTTP/1.1 405 Method Not Allowed
371	Date: Fri, 11 Jan 2013 11:07:19 GMT
372	Server: Apache/2.4.3 (Unix) OpenSSL/1.0.0g
373	Allow: TRACE
374	Content-Length: 316
375	Connection: close
376	Content-Type: text/html; charset=iso-8859-1
377
378	")
379
380
381
382	(define delete-response-body:www.apache.org/
383	"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">
384	<html><head>
385	<title>405 Method Not Allowed</title>
386	</head><body>
387	<h1>Method Not Allowed</h1>
388	<p>The requested method DELETE is not allowed for the URL /.</p>
389	<hr>
390	<address>Apache/2.4.3 (Unix) OpenSSL/1.0.0g Server at www.apache.org Port 80</address>
391	</body></html>
392	")
393
394	(define options-request-headers:www.apache.org/
395	"OPTIONS / HTTP/1.1
396	Host: www.apache.org
397	Connection: close
398
399	")
400
401	(define options-response-headers:www.apache.org/
402	"HTTP/1.1 200 OK
403	Date: Fri, 11 Jan 2013 11:08:31 GMT
404	Server: Apache/2.4.3 (Unix) OpenSSL/1.0.0g
405	Allow: OPTIONS,GET,HEAD,POST,TRACE
406	Cache-Control: max-age=3600
407	Expires: Fri, 11 Jan 2013 12:08:31 GMT
408	Content-Length: 0
409	Connection: close
410	Content-Type: text/html; charset=utf-8
411
412	")
413
414	;; This depends on the exact request that we send. I copied this off
415	;; the console with an "nc" session, so it doesn't include the CR bytes.
416	;; But that's OK -- we just have to decode the body as an HTTP request
417	;; and check that it's the same.
418	(define trace-request-headers:www.apache.org/
419	"TRACE / HTTP/1.1\r
420	Host: www.apache.org\r
421	Connection: close\r
422	\r
423	")
424
425	(define trace-response-headers:www.apache.org/
426	"HTTP/1.1 200 OK\r
427	Date: Fri, 11 Jan 2013 12:36:13 GMT\r
428	Server: Apache/2.4.3 (Unix) OpenSSL/1.0.0g\r
429	Connection: close\r
430	Transfer-Encoding: chunked\r
431	Content-Type: message/http\r
432	\r
433	")
434
435	(define trace-response-body:www.apache.org/
436	"3d\r
437	TRACE / HTTP/1.1\r
438	Host: www.apache.org\r
439	Connection: close\r
440	\r
441	\r
442	0\r
443	\r
444	")
445
446	(define (requests-equal? r1 r2)
447	(and (equal? (request-method r1) (request-method r2))
448	(equal? (request-uri r1) (request-uri r2))
449	(equal? (request-version r1) (request-version r2))
450	(equal? (request-headers r1) (request-headers r2))))
451
452	(define (responses-equal? r1 r2)
453	(and (equal? (response-code r1) (response-code r2))
454	(equal? (response-version r1) (response-version r2))
455	(equal? (response-headers r1) (response-headers r2))))
456
457	(define* (run-with-http-transcript
458	expected-request expected-request-body request-body-encoding
459	response response-body response-body-encoding
460	proc)
461	(let ((reading? #f)
462	(writing? #t)
463	(response-port (open-input-string response))
464	(response-body-port (open-bytevector-input-port
465	(string->bytevector response-body
466	response-body-encoding))))
467	(call-with-values (lambda () (open-bytevector-output-port))
468	(lambda (request-port get-bytevector)
469	(define (put-char c)
470	(unless writing?
471	(error "Port closed for writing"))
472	(put-u8 request-port (char->integer c)))
473	(define (put-string s)
474	(string-for-each put-char s))
475	(define (flush)
476	(set! writing? #f)
477	(set! reading? #t)
478	(let* ((p (open-bytevector-input-port (get-bytevector)))
479	(actual-request (read-request p))
480	(actual-body (read-request-body actual-request)))
481	(pass-if "requests equal"
482	(requests-equal? actual-request
483	(call-with-input-string expected-request
484	read-request)))
485	(pass-if "request bodies equal"
486	(equal? (or actual-body #vu8())
487	(string->bytevector expected-request-body
488	request-body-encoding)))))
489	(define (get-char)
490	(unless reading?
491	(error "Port closed for reading"))
492	(let ((c (read-char response-port)))
493	(if (char? c)
494	c
495	(let ((u8 (get-u8 response-body-port)))
496	(if (eof-object? u8)
497	u8
498	(integer->char u8))))))
499	(define (close)
500	(when writing?
501	(unless (eof-object? (get-u8 response-body-port))
502	(error "Failed to consume all of body"))))
503	(proc (make-soft-port (vector put-char put-string flush get-char close)
504	"rw"))))))
505
506	(define* (check-transaction method uri
507	request-headers request-body request-body-encoding
508	response-headers response-body response-body-encoding
509	proc
510	#:key (response-body-comparison response-body))
511	(with-test-prefix (string-append method " " uri)
512	(run-with-http-transcript
513	request-headers request-body request-body-encoding
514	response-headers response-body response-body-encoding
515	(lambda (port)
516	(call-with-values (lambda ()
517	(proc uri #:port port))
518	(lambda (response body)
519	(pass-if "response equal"
520	(responses-equal?
521	response
522	(call-with-input-string response-headers read-response)))
523	(pass-if "response body equal"
524	(equal? (or body "") response-body-comparison))))))))
525
526	(check-transaction
527	"GET" "http://www.gnu.org/software/guile/"
528	get-request-headers:www.gnu.org/software/guile/ "" "iso-8859-1"
529	get-response-headers:www.gnu.org/software/guile/
530	get-response-body:www.gnu.org/software/guile/ "iso-8859-1"
531	http-get)
532
533	(check-transaction
534	"HEAD" "http://www.gnu.org/software/guile/"
535	head-request-headers:www.gnu.org/software/guile/ "" "iso-8859-1"
536	head-response-headers:www.gnu.org/software/guile/ "" "iso-8859-1"
537	http-head)
538
539	(check-transaction
540	"POST" "http://www.apache.org/"
541	post-request-headers:www.apache.org/ "" "iso-8859-1"
542	post-response-headers:www.apache.org/
543	post-response-body:www.apache.org/ "iso-8859-1"
544	http-post)
545
546	(check-transaction
547	"PUT" "http://www.apache.org/"
548	put-request-headers:www.apache.org/ "" "iso-8859-1"
549	put-response-headers:www.apache.org/
550	put-response-body:www.apache.org/ "iso-8859-1"
551	http-put)
552
553	(check-transaction
554	"DELETE" "http://www.apache.org/"
555	delete-request-headers:www.apache.org/ "" "iso-8859-1"
556	delete-response-headers:www.apache.org/
557	delete-response-body:www.apache.org/ "iso-8859-1"
558	http-delete)
559
560	(check-transaction
561	"OPTIONS" "http://www.apache.org/"
562	options-request-headers:www.apache.org/ "" "utf-8"
563	options-response-headers:www.apache.org/ "" "utf-8"
564	http-options)
565
566	(check-transaction
567	"TRACE" "http://www.apache.org/"
568	trace-request-headers:www.apache.org/ "" "iso-8859-1"
569	trace-response-headers:www.apache.org/
570	trace-response-body:www.apache.org/ "iso-8859-1"
571	http-trace
572	#:response-body-comparison
573	;; The body will be message/http, which is logically a sequence of
574	;; bytes, not characters. It happens that iso-8859-1 can encode our
575	;; body and is compatible with the headers as well.
576	(string->bytevector trace-request-headers:www.apache.org/
577	"iso-8859-1"))