1 ;;;; web-client.test --- HTTP client -*- mode: scheme; coding: utf-8; -*-
3 ;;;; Copyright (C) 2013 Free Software Foundation, Inc.
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.
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.
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
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))
29 (define get-request-headers:www.gnu.org/software/guile/
30 "GET /software/guile/ HTTP/1.1
36 (define get-response-headers:www.gnu.org/software/guile/
38 Date: Fri, 11 Jan 2013 10:59:11 GMT
41 Cache-Control: max-age=0
42 Expires: Fri, 11 Jan 2013 10:59:11 GMT
46 Content-Type: text/html
51 (define get-response-body:www.gnu.org/software/guile/
52 "<!DOCTYPE html PUBLIC \"-//IETF//DTD HTML 2.0//EN\">
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\">
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 -->
65 <!-- Text black on white, unvisited links blue, visited links navy,
68 <body bgcolor=\"#ffffff\" text=\"#000000\" link=\"#1f00ff\" alink=\"#ff0000\" vlink=\"#000080\">
70 <table cellpadding=\"10\">
73 \t<a href=\"/software/guile/\">
74 \t <img src=\"/software/guile/graphics/guile-banner.small.png\" alt=\"Guile\">
77 <td valign=\"bottom\">
78 \t<h4 align=\"right\">The GNU extension language</h4>
79 \t<h4 align=\"right\">About Guile</h4>
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. -->
92 <td class=\"sidebar\">
93 \t<table cellpadding=\"4\">
95 \t <!-- Global Nav -->
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 />
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 />
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 />
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 />
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 />
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 />
138 \t <!-- Global Nav End -->
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>
153 <td class=\"rhs-body\">
156 <a name=\"whatisit\"><h3 align=\"left\">What is Guile? What can it do for you?</h3></a>
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>.
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
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>.
181 <h3>Guile is a programming language</h3>
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.
196 <h3>Guile is an extension language platform</h3>
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
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.
212 <h3>Guile gives your programs more power</h3>
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.
225 <a name=\"get\"><h2 align=\"center\">How do I get Guile?</h2></a>
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>.
234 See the <a href=\"download.html\">Download</a> page for additional ways of
245 <div class=\"copyright\">
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.
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>.
260 Copyright (C) 2012 Free Software Foundation, Inc.
264 Verbatim copying and distribution of this entire web page is
265 permitted in any medium, provided this notice is preserved.<P>
268 <!-- timestamp start -->
269 $Date: 2012/11/30 00:16:15 $ $Author: civodul $
270 <!-- timestamp end -->
279 (define head-request-headers:www.gnu.org/software/guile/
280 "HEAD /software/guile/ HTTP/1.1
286 (define head-response-headers:www.gnu.org/software/guile/
288 Date: Fri, 11 Jan 2013 11:03:14 GMT
289 Server: Apache/2.2.14
291 Cache-Control: max-age=0
292 Expires: Fri, 11 Jan 2013 11:03:14 GMT
293 Vary: Accept-Encoding
296 Content-Type: text/html
301 ;; Unfortunately, POST to http://www.gnu.org/software/guile/ succeeds!
302 (define post-request-headers:www.apache.org/
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
316 Content-Type: text/html; charset=iso-8859-1
320 (define post-response-body:www.apache.org/
321 "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">
323 <title>405 Method Not Allowed</title>
325 <h1>Method Not Allowed</h1>
326 <p>The requested method POST is not allowed for the URL /.</p>
328 <address>Apache/2.4.3 (Unix) OpenSSL/1.0.0g Server at www.apache.org Port 80</address>
332 (define put-request-headers:www.apache.org/
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
346 Content-Type: text/html; charset=iso-8859-1
350 (define put-response-body:www.apache.org/
351 "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">
353 <title>405 Method Not Allowed</title>
355 <h1>Method Not Allowed</h1>
356 <p>The requested method PUT is not allowed for the URL /.</p>
358 <address>Apache/2.4.3 (Unix) OpenSSL/1.0.0g Server at www.apache.org Port 80</address>
362 (define delete-request-headers:www.apache.org/
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
376 Content-Type: text/html; charset=iso-8859-1
382 (define delete-response-body:www.apache.org/
383 "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">
385 <title>405 Method Not Allowed</title>
387 <h1>Method Not Allowed</h1>
388 <p>The requested method DELETE is not allowed for the URL /.</p>
390 <address>Apache/2.4.3 (Unix) OpenSSL/1.0.0g Server at www.apache.org Port 80</address>
394 (define options-request-headers:www.apache.org/
401 (define options-response-headers:www.apache.org/
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
410 Content-Type: text/html; charset=utf-8
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/
420 Host: www.apache.org\r
425 (define trace-response-headers:www.apache.org/
427 Date: Fri, 11 Jan 2013 12:36:13 GMT\r
428 Server: Apache/2.4.3 (Unix) OpenSSL/1.0.0g\r
430 Transfer-Encoding: chunked\r
431 Content-Type: message/http\r
435 (define trace-response-body:www.apache.org/
438 Host: www.apache.org\r
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))))
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))))
457 (define* (run-with-http-transcript
458 expected-request expected-request-body request-body-encoding
459 response response-body response-body-encoding
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)
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))
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
485 (pass-if "request bodies equal"
486 (equal? (or actual-body #vu8())
487 (string->bytevector expected-request-body
488 request-body-encoding)))))
491 (error "Port closed for reading"))
492 (let ((c (read-char response-port)))
495 (let ((u8 (get-u8 response-body-port)))
498 (integer->char u8))))))
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)
506 (define* (check-transaction method uri
507 request-headers request-body request-body-encoding
508 response-headers response-body response-body-encoding
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
516 (call-with-values (lambda ()
517 (proc uri #:port port))
518 (lambda (response body)
519 (pass-if "response equal"
522 (call-with-input-string response-headers read-response)))
523 (pass-if "response body equal"
524 (equal? (or body "") response-body-comparison))))))))
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"
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"
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"
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"
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"
561 "OPTIONS" "http://www.apache.org/"
562 options-request-headers:www.apache.org/ "" "utf-8"
563 options-response-headers:www.apache.org/ "" "utf-8"
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"
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/