[bknr-cvs] r2487 - in branches/trunk-reorg/thirdparty/drakma-0.11.3: . doc
hhubner at common-lisp.net
hhubner at common-lisp.net
Wed Feb 13 19:41:11 UTC 2008
Author: hhubner
Date: Wed Feb 13 14:41:09 2008
New Revision: 2487
Added:
branches/trunk-reorg/thirdparty/drakma-0.11.3/
branches/trunk-reorg/thirdparty/drakma-0.11.3/CHANGELOG.txt (contents, props changed)
branches/trunk-reorg/thirdparty/drakma-0.11.3/cookies.lisp (contents, props changed)
branches/trunk-reorg/thirdparty/drakma-0.11.3/doc/
branches/trunk-reorg/thirdparty/drakma-0.11.3/doc/index.html (contents, props changed)
branches/trunk-reorg/thirdparty/drakma-0.11.3/drakma.asd (contents, props changed)
branches/trunk-reorg/thirdparty/drakma-0.11.3/packages.lisp (contents, props changed)
branches/trunk-reorg/thirdparty/drakma-0.11.3/read.lisp (contents, props changed)
branches/trunk-reorg/thirdparty/drakma-0.11.3/request.lisp (contents, props changed)
branches/trunk-reorg/thirdparty/drakma-0.11.3/specials.lisp (contents, props changed)
branches/trunk-reorg/thirdparty/drakma-0.11.3/util.lisp (contents, props changed)
Log:
Add drakma
Added: branches/trunk-reorg/thirdparty/drakma-0.11.3/CHANGELOG.txt
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/drakma-0.11.3/CHANGELOG.txt Wed Feb 13 14:41:09 2008
@@ -0,0 +1,147 @@
+Version 0.11.3
+2008-01-14
+The previous change is only needed for Windows
+
+Version 0.11.2
+2008-01-14
+Disable WRITE-TIMEOUT for LW5.0 if SSL is used (reported by Nico de Jager)
+
+Version 0.11.1
+2007-10-11
+Make Drakma work with AllegroCL's "modern" mode (patch by Ross Jekel)
+Needs at least Chunga 0.4.1 and FLEXI-STREAMS 0.13.1
+
+Version 0.11.0
+2007-10-01
+Added *TEXT-CONTENT-TYPES* and *BODY-FORMAT-FUNCTION* (suggested by Peter Eddy)
+
+Version 0.10.2
+2007-09-29
+Fixed bug introduced in latest change... (reported by Ross Jekel)
+
+Version 0.10.1
+2007-09-25
+Use parameters in URI if they weren't used up for the content body (suggested by Jan Rychter)
+
+Version 0.10.0
+2007-09-18
+Added support for "HttpOnly" cookie attribute (due to a bug report by Alexey Goldin)
+
+Version 0.9.1
+2007-07-12
+Improved CL+SSL support (patch by David Lichteblau)
+
+Version 0.9.0
+2007-06-30
+Added reason phrase to return values (patch by Holger Dürer)
+
+Version 0.8.0
+2007-06-25
+In cookie dates, accept time zones different from "GMT" (reported by Didier Verna)
+Added *ignore-unparseable-cookie-dates-p*
+
+Version 0.7.1
+2007-06-17
+Allow streams or functions as file designators (suggested by Andrei Stebakov)
+
+Version 0.7.0
+2007-04-07
+Switched from trivial-sockets to usocket (patch by Erik Huelsmann)
+
+Version 0.6.2
+2007-03-09
+Fixed release dates (thanks to Jeffrey Cunningham)
+
+Version 0.6.1
+2007-03-08
+Changed SPLIT-STRING so that it doesn't rely on unspecified behaviour (reported by Jianshi Huang)
+
+Version 0.6.0
+2007-02-08
+Make sure stream is closed in case of early errors (thanks to Chris Dean for test data)
+Robustified cookie parsing
+Send all outgoing cookies in one fell swoop (for Sun's buggy web server)
+Deal with empty Location headers
+Deal with corrupted Content-Type headers
+
+Version 0.5.5
+2007-02-05
+Fixed socket leak in case of redirects (bug report by Chris Dean)
+
+Version 0.5.4
+2006-12-01
+Workaround for servers which send headers after 100 status line (provided by Donavon Keithley)
+
+Version 0.5.3
+2006-10-11
+Set stream element type for binary streams as needed for CLISP (reported by Magnus Henoch)
+
+Version 0.5.2
+2006-10-08
+Adhere to user-provided content length if FORM-DATA is true
+
+Version 0.5.1
+2006-10-07
+Take Content-Encoding header into account (due to a bug report by Gregory Tod)
+
+Version 0.5.0
+2006-09-25
+Fixed bug where body sometimes wasn't read (reported by Ivan Toshkov)
+Added AUTO-REFERER feature (thanks to Colin Simmonds)
+
+Version 0.4.4
+2006-09-24
+Treat "localhost" special for cookies (reported by Ivan Toshkov)
+
+Version 0.4.3
+2006-09-24
+Circumvent CL+SSL for AllegroCL (suggested by David Lichteblau)
+
+Version 0.4.2
+2006-09-07
+Fixed :OPTIONS* method
+
+Version 0.4.1
+2006-09-07
+Added more methods including :OPTIONS* pseudo method (suggested by Ralf Mattes)
+Always (except for POST) add parameters to URI query
+Always read body (unless there's no chunking and no content length)
+
+Version 0.4.0
+2006-09-05
+Added file uploads
+Added multipart/form-data
+Added enforced computation of request bodies in RAM
+Use LF line endings in default external format
+
+Version 0.3.1
+2006-09-04
+Don't use underlying streams of flexi streams anymore
+Returned streams now have element type OCTET when FORCE-BINARY is true
+Better default "User-Agent" header for some Lisps
+Added info about mailing lists
+Added note about Gentoo
+
+Version 0.3.0
+2006-09-02
+Added client-side chunked encoding and various ways to send the content
+
+Version 0.2.0
+2006-09-01
+Completely re-factored for portability, chunking code is in Chunga now
+
+Version 0.1.3
+2006-08-30
+REQUIRE "comm" before WITH-STREAM-INPUT-BUFFER is used
+
+Version 0.1.2
+2006-08-27
+Notes about SSL and listener font
+
+Version 0.1.1
+2006-08-27
+Note about CL-BASE64 and KMRCL
+
+Version 0.1.0
+2006-08-27
+First public release
Added: branches/trunk-reorg/thirdparty/drakma-0.11.3/cookies.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/drakma-0.11.3/cookies.lisp Wed Feb 13 14:41:09 2008
@@ -0,0 +1,309 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: DRAKMA; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/drakma/cookies.lisp,v 1.15 2008/01/14 01:57:01 edi Exp $
+
+;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package :drakma)
+
+(defclass cookie ()
+ ((name :initarg :name
+ :initform (error "A cookie must have a name.")
+ :accessor cookie-name
+ :documentation "The name of the cookie.")
+ (value :initarg :value
+ :initform ""
+ :accessor cookie-value
+ :documentation "The cookie's value.")
+ (domain :initarg :domain
+ :initform (error "A cookie must have a domain.")
+ :accessor cookie-domain
+ :documentation "The domain the cookie is valid for.")
+ (path :initarg :path
+ :initform "/"
+ :accessor cookie-path
+ :documentation "The path prefix the cookie is valid for.")
+ (expires :initarg :expires
+ :initform nil
+ :accessor cookie-expires
+ :documentation "When the cookie expires. A Lisp
+universal time or NIL.")
+ (securep :initarg :securep
+ :initform nil
+ :accessor cookie-securep
+ :documentation "Whether the cookie must only be
+transmitted over secure connections.")
+ (http-only-p :initarg :http-only-p
+ :initform nil
+ :accessor cookie-http-only-p
+ :documentation "Whether the cookie should not be
+accessible from Javascript.
+
+This is a Microsoft extension that has been implemented in Firefox as
+well. See <http://msdn2.microsoft.com/en-us/library/ms533046.aspx>."))
+ (:documentation "Elements of this class represent HTTP cookies."))
+
+(defun render-cookie-date (time)
+ "Returns a string representation of the universal time TIME
+which can be used for cookie headers."
+ (multiple-value-bind (second minute hour date month year weekday)
+ (decode-universal-time time 0)
+ (format nil "~A, ~2,'0d-~2,'0d-~4,'0d ~2,'0d:~2,'0d:~2,'0d GMT"
+ (aref #("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun") weekday)
+ date month year hour minute second)))
+
+(defmethod print-object ((cookie cookie) stream)
+ "Prints a representation of COOKIE similar to a `Set-Cookie' header."
+ (print-unreadable-object (cookie stream :type t)
+ (with-slots (name value expires path domain securep http-only-p)
+ cookie
+ (format stream "~A~@[=~A~]~@[; expires=~A~]~@[; path=~A~]~@[; domain=~A~]~@[; secure~]~@[; HttpOnly~]"
+ name (and (plusp (length value)) value)
+ (and expires (render-cookie-date expires))
+ path domain securep http-only-p))))
+
+(defun normalize-cookie-domain (domain)
+ "Adds a dot at the beginning of the string DOMAIN unless there
+is already one."
+ (cond ((starts-with-p domain ".") domain)
+ (t (format nil ".~A" domain))))
+
+(defun valid-cookie-domain-p (domain)
+ "Checks if the string DOMAIN contains enough dots to be
+acceptable."
+ (or (string-equal domain "localhost")
+ (> (count #\. (normalize-cookie-domain domain) :test #'char=) 1)))
+
+(defun cookie-domain-matches (domain uri)
+ "Checks if the domain DOMAIN \(a string) matches the \(PURI) URI URI."
+ (ends-with-p (normalize-cookie-domain (uri-host uri))
+ (normalize-cookie-domain domain)))
+
+(defun send-cookie-p (cookie uri force-ssl)
+ "Checks if the cookie COOKIE should be sent to the server
+depending on the \(PURI) URI URI and the value of FORCE-SSL \(as
+in HTTP-REQUEST)."
+ (and ;; check domain
+ (cookie-domain-matches (cookie-domain cookie) uri)
+ ;; check path
+ (starts-with-p (uri-path uri) (cookie-path cookie))
+ ;; check expiry date
+ (let ((expires (cookie-expires cookie)))
+ (or (null expires)
+ (> expires (get-universal-time))))
+ ;; check if connection must be secure
+ (or (null (cookie-securep cookie))
+ force-ssl
+ (eq (uri-scheme uri) :https))))
+
+(defun check-cookie (cookie)
+ "Checks if the slots of the COOKIE object COOKIE have valid
+values and raises a corresponding error otherwise."
+ (with-slots (name value domain path expires)
+ cookie
+ (unless (and (stringp name) (plusp (length name)))
+ (error "Cookie name ~S must be a non-empty string." name))
+ (unless (stringp value)
+ (error "Cookie value ~S must be a non-empty string." value))
+ (unless (valid-cookie-domain-p domain)
+ (error "Invalid cookie domain ~S." domain))
+ (unless (and (stringp path) (plusp (length path)))
+ (error "Cookie path ~S must be a non-empty string." path))
+ (unless (or (null expires)
+ (and (integerp expires)
+ (plusp expires)))
+ (error "Cookie expiry ~S should have been NIL or a universal time." expires))))
+
+(defmethod initialize-instance :after ((cookie cookie) &rest initargs)
+ "Check cookie validity after creation."
+ (declare (ignore initargs))
+ (check-cookie cookie))
+
+(defmethod (setf cookie-name) :after (new-value (cookie cookie))
+ "Check cookie validity after name change."
+ (declare (ignore new-value))
+ (check-cookie cookie))
+
+(defmethod (setf cookie-value) :after (new-value (cookie cookie))
+ "Check cookie validity after value change."
+ (declare (ignore new-value))
+ (check-cookie cookie))
+
+(defmethod (setf cookie-domain) :after (new-value (cookie cookie))
+ "Check cookie validity after domain change."
+ (declare (ignore new-value))
+ (check-cookie cookie))
+
+(defmethod (setf cookie-path) :after (new-value (cookie cookie))
+ "Check cookie validity after path change."
+ (declare (ignore new-value))
+ (check-cookie cookie))
+
+(defmethod (setf cookie-expires) :after (new-value (cookie cookie))
+ "Check cookie validity after expiry change."
+ (declare (ignore new-value))
+ (check-cookie cookie))
+
+(defun cookie= (cookie1 cookie2)
+ "Returns true if the cookies COOKIE1 and COOKIE2 are equal.
+Two cookies are considered to be equal if name and path are
+equal."
+ (and (string= (cookie-name cookie1) (cookie-name cookie2))
+ (string= (cookie-path cookie1) (cookie-path cookie2))))
+
+(defclass cookie-jar ()
+ ((cookies :initarg :cookies
+ :initform nil
+ :accessor cookie-jar-cookies
+ :documentation "A list of the cookies in this cookie jar."))
+ (:documentation "A COOKIE-JAR object is a collection of cookies."))
+
+(defmethod print-object ((cookie-jar cookie-jar) stream)
+ "Print a cookie jar, showing the number of cookies it contains."
+ (print-unreadable-object (cookie-jar stream :type t :identity t)
+ (format stream "(with ~A cookie~:P)" (length (cookie-jar-cookies cookie-jar)))))
+
+(defun parse-cookie-date (string)
+ "Parses a cookie expiry date and returns it as a Lisp universal
+time. Currently understands the following formats:
+
+ \"Wed, 06-Feb-2008 21:01:38 GMT\"
+ \"Wed, 06-Feb-08 21:01:38 GMT\"
+ \"Tue Feb 13 08:00:00 2007 GMT\"
+ \"Wednesday, 07-February-2027 08:55:23 GMT\"
+ \"Wed, 07-02-2017 10:34:45 GMT\"
+
+Instead of \"GMT\" time zone abbreviations like \"CEST\" and UTC
+offsets like \"GMT-01:30\" are also allowed."
+ ;; it seems like everybody and their sister invents their own format
+ ;; for this, so (as there's no real standard for it) we'll have to
+ ;; make this function more flexible once we come across something
+ ;; new; as an alternative we could use net-telent-date, but it also
+ ;; fails to parse some of the stuff you encounter in the wild; or we
+ ;; could try to employ CL-PPCRE, but that'd add a new dependency
+ ;; without making this code much cleaner
+ (handler-case
+ (let* ((last-space-pos (or (position #\Space string :test #'char= :from-end t)
+ (error "Can't parse cookie date ~S, no space found." string)))
+ (time-zone-string (subseq string (1+ last-space-pos)))
+ (time-zone (interpret-as-time-zone time-zone-string))
+ second minute hour day month year)
+ (dolist (part (rest (split-string (subseq string 0 last-space-pos))))
+ (when (and day month)
+ (cond ((every #'digit-char-p part)
+ (when year
+ (error "Can't parse cookie date ~S, confused by ~S part." string part))
+ (setq year (parse-integer part)))
+ ((= (count #\: part :test #'char=) 2)
+ (let ((h-m-s (mapcar #'safe-parse-integer (split-string part ":"))))
+ (setq hour (first h-m-s)
+ minute (second h-m-s)
+ second (third h-m-s))))
+ (t (error "Can't parse cookie date ~S, confused by ~S part." string part))))
+ (cond ((null day)
+ (unless (setq day (safe-parse-integer part))
+ (setq month (interpret-as-month part))))
+ ((null month)
+ (setq month (interpret-as-month part)))))
+ (unless (and second minute hour day month year)
+ (error "Can't parse cookie date ~S, component missing." string))
+ (when (< year 100)
+ (setq year (+ year 2000)))
+ (encode-universal-time second minute hour day month year time-zone))
+ (error (condition)
+ (cond (*ignore-unparseable-cookie-dates-p*
+ (warn "~A" condition)
+ nil)
+ (t (error condition))))))
+
+(defun parse-set-cookie (string)
+ "Parses the `Set-Cookie' header line STRING and returns a list
+of three-element lists where each one contains the name of the
+cookie, the value of the cookie, and an attribute/value list for
+the optional cookie parameters."
+ (with-input-from-string (stream string)
+ (loop with *current-error-message* = (format nil "While parsing cookie header ~S:" string)
+ for first = t then nil
+ for next = (and (skip-whitespace stream)
+ (or first (assert-char stream #\,))
+ (skip-whitespace stream)
+ (skip-more-commas stream))
+ for name/value = (and next (read-name-value-pair stream
+ :cookie-syntax t))
+ for parameters = (and name/value (read-name-value-pairs stream
+ :value-required-p nil
+ :cookie-syntax t))
+ while name/value
+ collect (list (car name/value) (cdr name/value) parameters))))
+
+(defun get-cookies (headers uri)
+ "Returns a list of COOKIE objects corresponding to the
+`Set-Cookie' header as found in HEADERS \(an alist as returned by
+HTTP-REQUEST). Collects only cookies which match the domain of
+the \(PURI) URI URI."
+ (loop with set-cookie-header = (header-value :set-cookie headers)
+ with parsed-cookies = (and set-cookie-header (parse-set-cookie set-cookie-header))
+ for (name value parameters) in parsed-cookies
+ for expires = (parameter-value "expires" parameters)
+ for domain = (or (parameter-value "domain" parameters) (uri-host uri))
+ when (and (valid-cookie-domain-p domain)
+ (cookie-domain-matches domain uri))
+ collect (make-instance 'cookie
+ :name name
+ :value value
+ :path (or (parameter-value "path" parameters)
+ (uri-path uri)
+ "/")
+ :expires (and expires
+ (plusp (length expires))
+ (parse-cookie-date expires))
+ :domain domain
+ :securep (not (not (parameter-present-p "secure" parameters)))
+ :http-only-p (not (not (parameter-present-p "HttpOnly" parameters))))))
+
+(defun update-cookies (new-cookies cookie-jar)
+ "Updates the cookies in COOKIE-JAR by replacing those which are
+equal to a cookie in \(the list) NEW-COOKIES with the corresponding
+`new' cookie and adding those which are really new."
+ (setf (cookie-jar-cookies cookie-jar)
+ (let ((updated-cookies
+ (loop for old-cookie in (cookie-jar-cookies cookie-jar)
+ collect (or (find old-cookie new-cookies :test #'cookie=)
+ old-cookie))))
+ (union updated-cookies
+ (set-difference new-cookies updated-cookies))))
+ cookie-jar)
+
+(defun delete-old-cookies (cookie-jar)
+ "Removes all cookies from COOKIE-JAR which have either expired
+or which don't have an expiry date."
+ (setf (cookie-jar-cookies cookie-jar)
+ (loop with now = (get-universal-time)
+ for cookie in (cookie-jar-cookies cookie-jar)
+ for expires = (cookie-expires cookie)
+ unless (or (null expires) (< expires now))
+ collect cookie))
+ cookie-jar)
Added: branches/trunk-reorg/thirdparty/drakma-0.11.3/doc/index.html
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/drakma-0.11.3/doc/index.html Wed Feb 13 14:41:09 2008
@@ -0,0 +1,1472 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<html>
+
+<head>
+ <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
+ <title>DRAKMA - A Common Lisp web client</title>
+ <style type="text/css">
+ pre { padding:5px; background-color:#e0e0e0 }
+ h3, h4 { text-decoration: underline; }
+ a { text-decoration: none; padding: 1px 2px 1px 2px; }
+ a:visited { text-decoration: none; padding: 1px 2px 1px 2px; }
+ a:hover { text-decoration: none; padding: 1px 1px 1px 1px; border: 1px solid #000000; }
+ a:focus { text-decoration: none; padding: 1px 2px 1px 2px; border: none; }
+ a.none { text-decoration: none; padding: 0; }
+ a.none:visited { text-decoration: none; padding: 0; }
+ a.none:hover { text-decoration: none; border: none; padding: 0; }
+ a.none:focus { text-decoration: none; border: none; padding: 0; }
+ a.noborder { text-decoration: none; padding: 0; }
+ a.noborder:visited { text-decoration: none; padding: 0; }
+ a.noborder:hover { text-decoration: none; border: none; padding: 0; }
+ a.noborder:focus { text-decoration: none; border: none; padding: 0; }
+ pre.none { padding:5px; background-color:#ffffff }
+ </style>
+</head>
+
+<body bgcolor=white>
+
+<h2>DRAKMA - A Common Lisp web client</h2>
+
+<blockquote>
+<br> <br><h3><a name=abstract class=none>Abstract</a></h3>
+
+Drakma is a fully-featured web client (implemented in Common Lisp)
+that knows how to handle <a href="#chunked">HTTP/1.1
+chunking</a>, <a href="#keep-alive">persistent
+connections</a>, <a href="#re-use">re-usable
+sockets</a>, <a href="#force-ssl">SSL</a>, <a href="#cont">continuable
+uploads</a>, <a href="#form-data">file uploads</a>, <a href="#cookie-jar-param">cookies</a>, and other
+things. And it's probably a result of
+my <a href="http://en.wikipedia.org/wiki/Not_Invented_Here">NIH
+syndrome</a>...
+<p>
+Drakma was developed and tested
+with <a href="http://www.lispworks.com/">LispWorks</a>, but it should
+also work with a couple of other Common Lisp implementations depending
+on the <a href="#download">supporting libraries</a>. Some tests
+with <a href="http://www.sbcl.org/">SBCL</a> seem to confirm this.
+<p>
+The code comes with
+a <a
+href="http://www.opensource.org/licenses/bsd-license.php">BSD-style
+license</a> so you can basically do with it whatever you want.
+
+<p>
+<font color=red>Download shortcut:</font> <a href="http://weitz.de/files/drakma.tar.gz">http://weitz.de/files/drakma.tar.gz</a>.
+</blockquote>
+
+<br> <br><h3><a class=none name="contents">Contents</a></h3>
+<ol>
+ <li><a href="#example">Examples</a>
+ <li><a href="#download">Download and installation</a>
+ <li><a href="#mail">Support and mailing lists</a>
+ <li><a href="#dictionary">The Drakma dictionary</a>
+ <ol>
+ <li><a href="#request">The request</a>
+ <ol>
+ <li><a href="#http-request"><code>http-request</code></a>
+ <li><a href="#*drakma-default-external-format*"><code>*drakma-default-external-format*</code></a>
+ <li><a href="#*text-content-types*"><code>*text-content-types*</code></a>
+ <li><a href="#*body-format-function*"><code>*body-format-function*</code></a>
+ <li><a href="#*header-stream*"><code>*header-stream*</code></a>
+ </ol>
+ <li><a href="#cookies">Cookies</a>
+ <ol>
+ <li><a href="#cookie"><code>cookie</code></a>
+ <li><a href="#cookie-name"><code>cookie-name</code></a>
+ <li><a href="#cookie-value"><code>cookie-value</code></a>
+ <li><a href="#cookie-domain"><code>cookie-domain</code></a>
+ <li><a href="#cookie-path"><code>cookie-path</code></a>
+ <li><a href="#cookie-expires"><code>cookie-expires</code></a>
+ <li><a href="#cookie-securep"><code>cookie-securep</code></a>
+ <li><a href="#cookie-http-only-p"><code>cookie-http-only-p</code></a>
+ <li><a href="#cookie-jar"><code>cookie-jar</code></a>
+ <li><a href="#cookie-jar-cookies"><code>cookie-jar-cookies</code></a>
+ <li><a href="#cookie="><code>cookie=</code></a>
+ <li><a href="#delete-old-cookies"><code>delete-old-cookies</code></a>
+ <li><a href="#*ignore-unparseable-cookie-dates-p*"><code>*ignore-unparseable-cookie-dates-p*</code></a>
+ </ol>
+ <li><a href="#headers">Headers</a>
+ <ol>
+ <li><a href="#header-value"><code>header-value</code></a>
+ <li><a href="#split-tokens"><code>split-tokens</code></a>
+ <li><a href="#read-tokens-and-parameters"><code>read-tokens-and-parameters</code></a>
+ <li><a href="#parameter-present-p"><code>parameter-present-p</code></a>
+ <li><a href="#parameter-value"><code>parameter-value</code></a>
+ <li><a href="#get-content-type"><code>get-content-type</code></a>
+ </ol>
+ </ol>
+ <li><a href="#prob">Potential problems</a>
+ <li><a href="#ack">Acknowledgements</a>
+</ol>
+
+<br> <br><h3><a class=none name="example">Examples</a></h3>
+
+Here's an example session with Drakma 0.3.0 which demonstrates
+some of its features. (Some linebreaks were added or removed to
+enhance legibility.) Note that this doesn't necessarily reflect the
+current versions of Drakma and Hunchentoot. The examples should work
+nevertheless - kind of...
+
+<pre>
+<font color=orange>;; create a log file of this sessions</font>
+<font color=red>CL-USER 1 ></font> (<a class=noborder href="http://www.lispworks.com/documentation/HyperSpec/Body/f_dribbl.htm">dribble</a> "/tmp/drakma_dribble")
+; Loading C:\Program Files\LispWorks\lib\5-0-0-0\load-on-demand\ccl\dribble.ofasl on demand...
+
+<font color=orange>;; load Drakma</font>
+<font color=red>CL-USER 2 ></font> (<a class=noborder href="http://www.cliki.net/asdf">asdf</a>:oos 'asdf:load-op :drakma)
+; loading system definition from c:\home\lisp\drakma\drakma.asd into
+; #<The ASDF0 package, 0/16 internal, 0/16 external>
+; Loading text file c:\home\lisp\drakma\drakma.asd
+; registering #<SYSTEM :DRAKMA 21D6D24F> as DRAKMA
+;; Creating system COMMON-LISP-USER::DRAKMA
+; loading system definition from c:\home\lisp\<a class=noborder href="http://globalia.net/donlope/fz/songs/Chunga's_Revenge.html">chunga</a>\chunga.asd into
+; #<The ASDF0 package, 0/16 internal, 0/16 external>
+; Loading text file c:\home\lisp\chunga\chunga.asd
+; registering #<SYSTEM :CHUNGA 200B12A3> as CHUNGA
+;; Creating system COMMON-LISP-USER::CHUNGA
+; loading system definition from c:\home\lisp\flexi-streams\flexi-streams.asd into
+; #<The ASDF0 package, 0/16 internal, 0/16 external>
+; Loading text file c:\home\lisp\flexi-streams\flexi-streams.asd
+; registering #<SYSTEM :FLEXI-STREAMS 200E8017> as FLEXI-STREAMS
+;; Creating system COMMON-LISP-USER::FLEXI-STREAMS
+; loading system definition from c:\home\lisp\trivial-gray-streams\trivial-gray-streams.asd into
+; #<The ASDF0 package, 0/16 internal, 0/16 external>
+; Loading text file c:\home\lisp\trivial-gray-streams\trivial-gray-streams.asd
+; registering #<SYSTEM :TRIVIAL-GRAY-STREAMS 21D6741F> as TRIVIAL-GRAY-STREAMS
+;; Creating system COMMON-LISP-USER::TRIVIAL-GRAY-STREAMS
+; loading system definition from c:\home\lisp\cl-base64-3.3.2\cl-base64.asd into
+; #<The ASDF0 package, 0/16 internal, 0/16 external>
+; Loading text file c:\home\lisp\cl-base64-3.3.2\cl-base64.asd
+; registering #<SYSTEM CL-BASE64 21D6D277> as CL-BASE64
+;; Creating system COMMON-LISP-USER::CL-BASE64
+; registering #<SYSTEM CL-BASE64-TESTS 2009701B> as CL-BASE64-TESTS
+;; Creating system COMMON-LISP-USER::CL-BASE64-TESTS
+; loading system definition from c:\home\lisp\puri-1.5\puri.asd into
+; #<The ASDF0 package, 0/16 internal, 0/16 external>
+; Loading text file c:\home\lisp\puri-1.5\puri.asd
+; registering #<SYSTEM PURI 21D6B093> as PURI
+;; Creating system COMMON-LISP-USER::PURI
+; registering #<SYSTEM PURI-TESTS 200CFEEF> as PURI-TESTS
+;; Creating system COMMON-LISP-USER::PURI-TESTS
+; Loading fasl file c:\home\lisp\trivial-gray-streams\package.ofasl
+; Loading fasl file c:\home\lisp\trivial-gray-streams\mixin.ofasl
+; Loading fasl file c:\home\lisp\flexi-streams\packages.ofasl
+; Loading fasl file c:\home\lisp\flexi-streams\ascii.ofasl
+; Loading fasl file c:\home\lisp\flexi-streams\iso-8859.ofasl
+; Loading fasl file c:\home\lisp\flexi-streams\code-pages.ofasl
+; Loading fasl file c:\home\lisp\flexi-streams\specials.ofasl
+; Loading fasl file c:\home\lisp\flexi-streams\util.ofasl
+; Loading fasl file c:\home\lisp\flexi-streams\external-format.ofasl
+; Loading fasl file c:\home\lisp\flexi-streams\in-memory.ofasl
+; Loading fasl file c:\home\lisp\flexi-streams\stream.ofasl
+; Loading fasl file c:\home\lisp\flexi-streams\output.ofasl
+; Loading fasl file c:\home\lisp\flexi-streams\input.ofasl
+; Loading fasl file c:\home\lisp\flexi-streams\strings.ofasl
+; Loading fasl file c:\home\lisp\chunga\packages.ofasl
+; Loading fasl file c:\home\lisp\chunga\specials.ofasl
+; Loading fasl file c:\home\lisp\chunga\util.ofasl
+; Loading fasl file c:\home\lisp\chunga\read.ofasl
+; Loading fasl file c:\home\lisp\chunga\streams.ofasl
+; Loading fasl file c:\home\lisp\chunga\input.ofasl
+; Loading fasl file c:\home\lisp\chunga\output.ofasl
+; Loading fasl file c:\home\lisp\cl-base64-3.3.2\package.ofasl
+; Loading fasl file c:\home\lisp\cl-base64-3.3.2\encode.ofasl
+; Loading fasl file c:\home\lisp\cl-base64-3.3.2\decode.ofasl
+; Loading fasl file c:\home\lisp\puri-1.5\src.ofasl
+; Loading fasl file c:\home\lisp\drakma\packages.ofasl
+; Loading fasl file c:\home\lisp\drakma\specials.ofasl
+; Loading fasl file c:\home\lisp\drakma\util.ofasl
+; Loading c:\Program Files\LispWorks\lib\5-0-0-0\load-on-demand\processes\comm-defsys.lisp on demand...
+;; Creating system COMM
+
+; Loading text file c:\Program Files\LispWorks\lib\5-0-0-0\load-on-demand\processes\comm-pkg.lisp
+; Loading fasl file c:\Program Files\LispWorks\lib\5-0-0-0\load-on-demand\processes\sockets.ofasl
+; Loading fasl file c:\Program Files\LispWorks\lib\5-0-0-0\load-on-demand\processes\ssl-constants.ofasl
+; Loading fasl file c:\Program Files\LispWorks\lib\5-0-0-0\load-on-demand\processes\ssl-foreign-types.ofasl
+; Loading fasl file c:\Program Files\LispWorks\lib\5-0-0-0\load-on-demand\processes\ssl.ofasl
+; Loading fasl file c:\Program Files\LispWorks\lib\5-0-0-0\load-on-demand\processes\ssl-certs.ofasl
+; Loading fasl file c:\Program Files\LispWorks\lib\5-0-0-0\patches\comm\0001\0001.ofasl
+; Loaded public patch COMM 1.1
+
+; Loading fasl file c:\Program Files\LispWorks\lib\5-0-0-0\patches\comm\0001\0002.ofasl
+; Loaded public patch COMM 1.2
+
+; Loading fasl file c:\Program Files\LispWorks\lib\5-0-0-0\patches\comm\0001\0003.ofasl
+; Loaded public patch COMM 1.3
+
+; Loading fasl file c:\Program Files\LispWorks\lib\5-0-0-0\patches\comm\0001\0004.ofasl
+; Loaded public patch COMM 1.4
+
+; Loading fasl file c:\home\lisp\drakma\read.ofasl
+; Loading fasl file c:\home\lisp\drakma\cookies.ofasl
+; Loading fasl file c:\home\lisp\drakma\request.ofasl
+NIL
+
+<font color=orange>;; create a package to work in</font>
+<font color=red>CL-USER 3 ></font> (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/m_defpkg.htm" class=noborder>defpackage</a> :drakma-user (:use :cl :drakma))
+#<The DRAKMA-USER package, 0/16 internal, 0/16 external>
+
+<font color=orange>;; switch to this package</font>
+<font color=red>CL-USER 4 ></font> (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/m_in_pkg.htm" class=noborder>in-package</a> :drakma-user)
+#<The DRAKMA-USER package, 0/16 internal, 0/16 external>
+
+<font color=orange>;; log headers, so we can see what happens -
+;; output to <a class=noborder href="#*header-stream*"><code><font color=orange>*HEADER-STREAM*</font></code></a> will be shown in <font color=green>green</font> below</font>
+<font color=red>DRAKMA-USER 5 ></font> (setq <a class=noborder href="#*header-stream*">*header-stream*</a> <a href="http://www.lispworks.com/documentation/HyperSpec/Body/v_debug_.htm" class=noborder>*standard-output*</a>)
+#<Broadcast stream to (#<Echo Stream Input = #<EDITOR::RUBBER-STREAM #<EDITOR:BUFFER CAPI interactive-pane 2> 2198ECD7>,
+ Output = #<STREAM::LATIN-1-FILE-STREAM c:\tmp\drakma_dribble>>
+ #<EDITOR::RUBBER-STREAM #<EDITOR:BUFFER CAPI interactive-pane 2> 2198ECD7>)>
+
+<font color=orange>;; note how Drakma automatically follows the 301 redirect and how the fourth return value shows the <em>new</em> URI</font>
+<font color=red>DRAKMA-USER 6 ></font> (<a class=noborder href="#http-request">http-request</a> "<a href="http://lisp.org/" class=noborder>http://lisp.org/</a>")
+<font color=green>GET / HTTP/1.1
+Host: lisp.org
+User-Agent: Drakma/0.3.0 (LispWorks 5.0.0; Windows NT; Windows XP: 5.1 (build 2600) Service Pack 2; http://weitz.de/drakma/)
+Accept: */*
+Connection: close
+
+HTTP/1.1 301 Moved Permanently
+Date: Sat, 26 Aug 2006 15:46:31 GMT
+Connection: Close
+Server: <a href="http://opensource.franz.com/aserve/" class=noborder>AllegroServe</a>/1.2.37
+Transfer-Encoding: chunked
+LOCATION: /index.html
+
+GET /index.html HTTP/1.1
+Host: lisp.org
+User-Agent: Drakma/0.3.0 (LispWorks 5.0.0; Windows NT; Windows XP: 5.1 (build 2600) Service Pack 2; http://weitz.de/drakma/)
+Accept: */*
+Connection: close
+
+HTTP/1.1 200 OK
+Date: Sat, 26 Aug 2006 15:46:32 GMT
+Connection: Close
+Server: AllegroServe/1.2.37
+Content-Type: text/html
+Content-Length: 82
+LAST-MODIFIED: Mon, 16 Feb 2004 09:30:02 GMT</font>
+
+"<title>redirect...</title>
+<meta http-equiv=\"Refresh\" content=\"0; url=/alu/home\">
+"
+200
+((:DATE . "Sat, 26 Aug 2006 15:46:32 GMT")
+ (:CONNECTION . "Close")
+ (:SERVER . "AllegroServe/1.2.37")
+ (:CONTENT-TYPE . "text/html")
+ (:CONTENT-LENGTH . "82")
+ (:LAST-MODIFIED . "Mon, 16 Feb 2004 09:30:02 GMT"))
+#<URI http://lisp.org/index.html>
+#<FLEXI-STREAMS:FLEXI-IO-STREAM 201017D3>
+T
+
+<font color=orange>;; here, Drakma automatically interprets the 'charset=utf-8' part correctly -
+;; might look a bit different in your listener depending on the font you've chosen</font>
+<font color=red>DRAKMA-USER 7 ></font> (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_subseq.htm" class=noborder>subseq</a> (<a class=noborder href="#http-request">http-request</a> "<a href="http://www.cl.cam.ac.uk/~mgk25/ucs/examples/digraphs.txt" class=noborder>http://www.cl.cam.ac.uk/~mgk25/ucs/examples/digraphs.txt</a>") 0 298)
+<font color=green>GET /~mgk25/ucs/examples/digraphs.txt HTTP/1.1
+Host: www.cl.cam.ac.uk
+User-Agent: Drakma/0.3.0 (LispWorks 5.0.0; Windows NT; Windows XP: 5.1 (build 2600) Service Pack 2; http://weitz.de/drakma/)
+Accept: */*
+Connection: close
+
+HTTP/1.1 200 OK
+Date: Sat, 26 Aug 2006 16:02:56 GMT
+Server: Apache/1.3.37 (Unix) mod_ucam_webauth/1.2.2
+Last-Modified: Thu, 05 Jan 2006 20:49:55 GMT
+ETag: "17cd62-298-43bd8673"
+Accept-Ranges: bytes
+Content-Length: 664
+Connection: close
+Content-Type: text/plain; charset=utf-8</font>
+
+"Latin Digraphs and Ligatures in ISO10646-1
+
+A short table of ligatures and digraphs follows. Some of these may not be
+ligatures/digraphs in the technical sense, (for example, æ is a seperate
+letter in English), but visually they behave that way.
+
+AÆE : U+00C6
+aæe : U+00E6
+ſßs : U+00DF
+IIJJ : U+0132"
+
+<font color=orange>;; a vector of octets is returned for (non-text) binary data - a picture in this case</font>
+<font color=red>DRAKMA-USER 8 ></font> (<a class=noborder href="#http-request">http-request</a> "<a href="http://zappa.com/favicon.ico" class=noborder>http://zappa.com/favicon.ico</a>")
+<font color=green>GET /favicon.ico HTTP/1.1
+Host: zappa.com
+User-Agent: Drakma/0.3.0 (LispWorks 5.0.0; Windows NT; Windows XP: 5.1 (build 2600) Service Pack 2; http://weitz.de/drakma/)
+Accept: */*
+Connection: close
+
+HTTP/1.1 200 OK
+Date: Sat, 26 Aug 2006 16:02:59 GMT
+Server: Apache/2.0.46 (Red Hat)
+Last-Modified: Fri, 17 Mar 2006 08:11:07 GMT
+ETag: "3a4080-b6-59d5bcc0"
+Accept-Ranges: bytes
+Content-Length: 182
+Connection: close
+Content-Type: image/gif</font>
+
+#(71 73 70 56 57 97 17 0 17 0 179 1 0 150 151 153 255 255 255 37 37 36 112 114 115
+ 201 202 204 0 0 0 80 83 84 26 28 26 230 231 231 249 249 249 12 13 14 219 221 222
+ 18 21 22 239 240 241 52 52 54 64 66 66 33 249 4 1 0 0 1 0 44 0 0 0 0 17 0 17 0 0
+ 4 99 48 200 73 107 109 54 172 101 129 120 196 180 12 12 51 80 64 161 42 3 48 28
+ 170 106 72 141 16 223 120 113 166 121 95 0 14 95 239 33 236 41 98 10 129 114 185
+ 188 29 127 25 201 224 73 60 4 8 0 130 22 59 64 52 96 135 148 35 96 80 152 159 186
+ 192 64 183 112 0 200 61 65 0 1 192 76 214 185 113 102 241 88 26 90 8 81 18 8 94
+ 130 134 22 17 0 59)
+200
+((:DATE . "Sat, 26 Aug 2006 16:02:59 GMT")
+ (:SERVER . "Apache/2.0.46 (Red Hat)")
+ (:LAST-MODIFIED . "Fri, 17 Mar 2006 08:11:07 GMT")
+ (:ETAG . "\"3a4080-b6-59d5bcc0\"")
+ (:ACCEPT-RANGES . "bytes")
+ (:CONTENT-LENGTH . "182")
+ (:CONNECTION . "close")
+ (:CONTENT-TYPE . "image/gif"))
+#<URI http://zappa.com/favicon.ico>
+#<FLEXI-STREAMS:FLEXI-IO-STREAM 200D59BF>
+T
+
+<font color=orange>;; a secure connection (see <a class=noborder href="#download"><font color=orange>below</font></a>) -
+;; also note that the server uses <a class=noborder name="chunked" href="http://www.rfc.net/rfc2616.html#s3.6.1"><font color=orange>chunked transfer encoding</font></a> for its reply</font>
+<font color=red>DRAKMA-USER 9 ></font> (<a class=noborder href="http://weitz.de/cl-ppcre/">ppcre</a>:<a class=noborder href="http://weitz.de/cl-ppcre/#scan-to-strings">scan-to-strings</a> "(?s)You have.*your data."
+ (<a class=noborder href="#http-request">http-request</a> "<a href="https://www.fortify.net/cgi/ssl_2.pl" class=noborder>https://www.fortify.net/cgi/ssl_2.pl</a>"))
+<font color=green>GET /cgi/ssl_2.pl HTTP/1.1
+Host: www.fortify.net
+User-Agent: Drakma/0.3.0 (LispWorks 5.0.0; Windows NT; Windows XP: 5.1 (build 2600) Service Pack 2; http://weitz.de/drakma/)
+Accept: */*
+Connection: close
+
+HTTP/1.1 200 OK
+Date: Sat, 26 Aug 2006 16:10:06 GMT
+Server: Apache
+Connection: close
+Transfer-Encoding: chunked
+Content-Type: text/html</font>
+
+
+"You have connected to this web server using the DHE-RSA-AES256-SHA encryption cipher
+ with a key length of 256 bits.
+ <p>
+ This is a high-grade encryption connection, regarded by most experts as being suitable
+ for sending or receiving even the most sensitive or valuable information
+ across a network.
+ <p>
+ In a crude analogy, using this cipher is similar to sending or storing your data inside
+ a high quality safe - compared to an export-grade cipher which is similar to using
+ a paper envelope to protect your data."
+#()
+
+<font color=orange>;; using a different 'User-Agent' header</font>
+<font color=red>DRAKMA-USER 10 ></font> (<a class=noborder href="http://weitz.de/cl-ppcre/">ppcre</a>:<a class=noborder href="http://weitz.de/cl-ppcre/#regex-replace-all">regex-replace-all</a>
+ "<.*?>"
+ (<a class=noborder href="http://weitz.de/cl-ppcre/">ppcre</a>:<a class=noborder href="http://weitz.de/cl-ppcre/#scan-to-strings">scan-to-strings</a> "(?s)Your browser reports.*?</table>"
+ (<a class=noborder href="#http-request">http-request</a> "<a class=noborder href="http://bcheck.scanit.be/bcheck/">http://bcheck.scanit.be/bcheck/</a>"
+ :user-agent :explorer))
+ "")
+<font color=green>GET /bcheck/ HTTP/1.1
+Host: bcheck.scanit.be
+User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.1.4322; .NET CLR 2.0.50727)
+Accept: */*
+Connection: close
+
+HTTP/1.1 200 OK
+Date: Sat, 26 Aug 2006 16:21:50 GMT
+Server: Apache
+Connection: close
+Transfer-Encoding: chunked
+Content-Type: text/html</font>
+
+
+"Your browser reports to be:
+
+Browser name: MSIE
+Version: 6.0
+Platform: Windows NT 5.1
+"
+
+<font color=orange>;; sending parameters in a POST request and working with <a href="#cookie" class=noborder><font color=orange>cookies</font></a> -
+;; note how Drakma sends the cookie back in the second request</font>
+<font color=red>DRAKMA-USER 11 ></font> (let ((cookie-jar (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_mk_ins.htm" class=noborder>make-instance</a> '<a class=noborder href="#cookie-jar">cookie-jar</a>)))
+ (<a class=noborder href="#http-request">http-request</a> "<a class=noborder href="http://www.phpsecurepages.com/test/test.php">http://www.phpsecurepages.com/test/test.php</a>"
+ :method :post
+ :parameters '(("entered_login" . "test")
+ ("entered_password" . "test"))
+ :cookie-jar cookie-jar)
+ (<a class=noborder href="#http-request">http-request</a> "<a class=noborder href="http://www.phpsecurepages.com/test/test2.php">http://www.phpsecurepages.com/test/test2.php</a>"
+ :cookie-jar cookie-jar)
+ (<a class=noborder href="#cookie-jar-cookies">cookie-jar-cookies</a> cookie-jar))
+<font color=green>POST /test/test.php HTTP/1.1
+Host: www.phpsecurepages.com
+User-Agent: Drakma/0.3.0 (LispWorks 5.0.0; Windows NT; Windows XP: 5.1 (build 2600) Service Pack 2; http://weitz.de/drakma/)
+Accept: */*
+Content-Length: 40
+Content-Type: application/x-www-form-urlencoded
+Connection: close
+
+HTTP/1.1 200 OK
+Date: Sat, 26 Aug 2006 18:26:17 GMT
+Server: Apache/2.0.51 (Fedora)
+X-Powered-By: PHP/4.3.10
+Expires: Thu, 19 Nov 1981 08:52:00 GMT
+Cache-Control: no-store, no-cache, must-revalidate, post-check=0, pre-check=0
+Pragma: no-cache
+Set-Cookie: PHPSESSID=3ce33aa3e326ab4bf5da7feecc3248b4; path=/
+Connection: close
+Transfer-Encoding: chunked
+Content-Type: text/html
+
+
+GET /test/test2.php HTTP/1.1
+Host: www.phpsecurepages.com
+User-Agent: Drakma/0.3.0 (LispWorks 5.0.0; Windows NT; Windows XP: 5.1 (build 2600) Service Pack 2; http://weitz.de/drakma/)
+Accept: */*
+Cookie: PHPSESSID=3ce33aa3e326ab4bf5da7feecc3248b4
+Connection: close
+
+HTTP/1.1 200 OK
+Date: Sat, 26 Aug 2006 18:26:18 GMT
+Server: Apache/2.0.51 (Fedora)
+X-Powered-By: PHP/4.3.10
+Expires: Thu, 19 Nov 1981 08:52:00 GMT
+Cache-Control: no-store, no-cache, must-revalidate, post-check=0, pre-check=0
+Pragma: no-cache
+Connection: close
+Transfer-Encoding: chunked
+Content-Type: text/html</font>
+
+
+(#<<a href="#cookie" class=noborder>COOKIE</a> PHPSESSID=3ce33aa3e326ab4bf5da7feecc3248b4; path=/; domain=www.phpsecurepages.com>)
+
+<font color=orange>;; now we are going to <a name="re-use" class=noborder>re-use</a> a socket for the second connection to the same server
+;; this will also work with chunked encoding</font>
+<font color=red>DRAKMA-USER 12 ></font> (let ((stream (<a class=noborder href="http://www.lispworks.com/documentation/HyperSpec/Body/m_nth_va.htm">nth-value</a> 4 (<a class=noborder href="#http-request">http-request</a> "<a class=noborder href="http://www.lispworks.com/">http://www.lispworks.com/</a>" :close nil))))
+ (nth-value 2 (<a class=noborder href="#http-request">http-request</a> "<a class=noborder href="http://www.lispworks.com/success-stories/index.html">http://www.lispworks.com/success-stories/index.html</a>"
+ :stream stream)))
+<font color=green>GET / HTTP/1.1
+Host: www.lispworks.com
+User-Agent: Drakma/0.3.0 (LispWorks 5.0.0; Windows NT; Windows XP: 5.1 (build 2600) Service Pack 2; http://weitz.de/drakma/)
+Accept: */*
+
+HTTP/1.1 200 OK
+Date: Sat, 26 Aug 2006 18:34:20 GMT
+Server: Apache/1.3.37 Ben-SSL/1.57 (Unix)
+Last-Modified: Tue, 08 Aug 2006 18:20:49 GMT
+ETag: "28ee4f0-22db-44d8d601"
+Accept-Ranges: bytes
+Content-Length: 8923
+Content-Type: text/html
+
+GET /success-stories/index.html HTTP/1.1
+Host: www.lispworks.com
+User-Agent: Drakma/0.3.0 (LispWorks 5.0.0; Windows NT; Windows XP: 5.1 (build 2600) Service Pack 2; http://weitz.de/drakma/)
+Accept: */*
+Connection: close
+
+HTTP/1.1 200 OK
+Date: Sat, 26 Aug 2006 18:34:20 GMT
+Server: Apache/1.3.37 Ben-SSL/1.57 (Unix)
+Last-Modified: Tue, 08 Aug 2006 18:22:19 GMT
+ETag: "28f3f42-2325-44d8d65b"
+Accept-Ranges: bytes
+Content-Length: 8997
+Connection: close
+Content-Type: text/html</font>
+
+((:DATE . "Sat, 26 Aug 2006 18:34:20 GMT")
+ (:SERVER . "Apache/1.3.37 Ben-SSL/1.57 (Unix)")
+ (:LAST-MODIFIED . "Tue, 08 Aug 2006 18:22:19 GMT")
+ (:ETAG . "\"28f3f42-2325-44d8d65b\"")
+ (:ACCEPT-RANGES . "bytes")
+ (:CONTENT-LENGTH . "8997")
+ (:CONNECTION . "close")
+ (:CONTENT-TYPE . "text/html"))
+
+<font color=orange>;; testing basic authorization against a local <a href="http://weitz.de/hunchentoot/" class=noborder><font color=orange>Hunchentoot</font></a> server</font>
+<font color=red>DRAKMA-USER 13 ></font> (<a class=noborder href="http://www.lispworks.com/documentation/HyperSpec/Body/m_nth_va.htm">nth-value</a> 1 (<a class=noborder href="#http-request">http-request</a> "http://localhost:4242/<a class=noborder href="http://weitz.de/tbnl/#test">tbnl/test</a>/authorization.html"))
+<font color=green>GET /tbnl/test/authorization.html HTTP/1.1
+Host: localhost:4242
+User-Agent: Drakma/0.3.0 (LispWorks 5.0.0; Windows NT; Windows XP: 5.1 (build 2600) Service Pack 2; http://weitz.de/drakma/)
+Accept: */*
+Connection: close
+
+HTTP/1.1 401 Authorization Required
+Content-Length: 563
+Content-Type: text/html; charset=iso-8859-1
+Date: Sat, 26 Aug 2006 18:38:58 GMT
+Server: <a class=noborder href="http://weitz.de/hunchentoot/">Hunchentoot</a> 0.1.5 (<a href="http://weitz.de/tbnl/" class=noborder>TBNL</a> 0.10.0)
+Connection: Close
+WWW-Authenticate: Basic realm="TBNL"</font>
+
+401
+
+<font color=red>DRAKMA-USER 14 ></font> (<a class=noborder href="http://www.lispworks.com/documentation/HyperSpec/Body/m_nth_va.htm">nth-value</a> 1 (<a class=noborder href="#http-request">http-request</a> "http://localhost:4242/<a class=noborder href="http://weitz.de/tbnl/#test">tbnl/test</a>/authorization.html"
+ :basic-authorization '("nanook" "igloo")))
+<font color=green>GET /tbnl/test/authorization.html HTTP/1.1
+Host: localhost:4242
+User-Agent: Drakma/0.3.0 (LispWorks 5.0.0; Windows NT; Windows XP: 5.1 (build 2600) Service Pack 2; http://weitz.de/drakma/)
+Authorization: Basic bmFub29rOmlnbG9v
+Accept: */*
+Connection: close
+
+HTTP/1.1 200 OK
+Content-Length: 884
+Content-Type: text/html; charset=iso-8859-1
+Date: Sat, 26 Aug 2006 18:39:19 GMT
+Server: <a class=noborder href="http://weitz.de/hunchentoot/">Hunchentoot</a> 0.1.5 (<a href="http://weitz.de/tbnl/" class=noborder>TBNL</a> 0.10.0)
+Connection: Close</font>
+
+200
+
+<font color=orange>;; now we ask Drakma to return a stream and read from it directly</font>
+<font color=red>DRAKMA-USER 15 ></font> (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/s_let_l.htm" class=noborder>let</a> ((stream (<a class=noborder href="#http-request">http-request</a> "<a href="http://www.jalat.com/blogs/lisp?id=3" class=noborder>http://www.jalat.com/blogs/lisp?id=3</a>"
+ :want-stream t)))
+ (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/06_a.htm" class=noborder>loop</a> for i below 41
+ for line = (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_rd_lin.htm" class=noborder>read-line</a> stream)
+ when (> i 35)
+ do (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_wr_stg.htm" class=noborder>write-line</a> line))
+ (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_close.htm" class=noborder>close</a> stream)
+ (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/a_values.htm" class=noborder>values</a>))
+<font color=green>GET /blogs/lisp?id=3 HTTP/1.1
+Host: www.jalat.com
+User-Agent: Drakma/0.3.0 (LispWorks 5.0.0; Windows NT; Windows XP: 5.1 (build 2600) Service Pack 2; http://weitz.de/drakma/)
+Accept: */*
+Connection: close
+
+HTTP/1.1 200 OK
+Content-Length: 21453
+Content-Type: text/html; charset=iso-8859-1
+Date: Sat, 26 Aug 2006 19:53:37 GMT
+Server: <a href="http://weitz.de/hunchentoot/" class=noborder>Hunchentoot</a> 0.1.3 (<a href="http://weitz.de/tbnl/" class=noborder>TBNL</a> 0.9.7)
+Connection: Close</font>
+
+Bill Clementson has <a
+href="<a href="http://bc.tech.coop/blog/041111.html" class=noborder>http://bc.tech.coop/blog/041111.html</a>">written</a> about getting
+<a href="http://weitz.de/tbnl/" class=noborder>TBNL</a> up and running with <a href="http://httpd.apache.org/" class=noborder>apache</a> and <a href="http://www.fractalconcept.com/asp/html/mod_lisp.html" class=noborder>mod_lisp</a>. In this example I'm
+going to use <a href="<a href="http://weitz.de/hunchentoot/" class=noborder>http://weitz.de/hunchentoot/</a>">hunchentoot</a>, a
+pure lisp web server by (again) Edi Weitz.
+
+<font color=orange><a class=noborder name="cont">;; let's test a POST request without content length and with chunked transfer encoding -</a>
+;; we build the content in several steps using different types of data
+;; (note: doesn't work anymore, probably due to server changes)</font>
+<font color=red>DRAKMA-USER 16 ></font> (let ((temp-file (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_ensu_1.htm" class=noborder>ensure-directories-exist</a> #p"/tmp/quux.txt"))
+ (continuation (<a href="#http-request" class=noborder>http-request</a> "<a href="http://meme.b9.com/login.html" class=noborder>http://meme.b9.com/login.html</a>"
+ :method :post
+ :content :continuation)))
+ (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_funcal.htm" class=noborder>funcall</a> continuation "username=" t)
+ (funcall continuation (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_list_.htm" class=noborder>list</a> (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_char_c.htm" class=noborder>char-code</a> #\n) (char-code #\a)) t)
+ (funcall continuation (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/m_lambda.htm" class=noborder>lambda</a> (stream)
+ (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_wr_cha.htm" class=noborder>write-char</a> #\n stream)) t)
+ (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/m_w_open.htm" class=noborder>with-open-file</a> (out temp-file
+ :direction :output
+ :if-does-not-exist :create
+ :if-exists :supersede)
+ (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_wr_stg.htm" class=noborder>write-string</a> "ook" out))
+ (funcall continuation temp-file t)
+ (<a href="http://weitz.de/cl-ppcre/" class=noborder>ppcre</a>:<a href="http://weitz.de/cl-ppcre/#scan-to-strings" class=noborder>scan-to-strings</a> "(?i)[a-z ]+nanook[a-z .]+"
+ (funcall continuation "&password=igloo")))
+<font color=green>POST /login.html HTTP/1.1
+Host: meme.b9.com
+User-Agent: Drakma/0.3.0 (LispWorks 5.0.0; Windows NT; Windows XP: 5.1 (build 2600) Service Pack 2; http://weitz.de/drakma/)
+Accept: */*
+Connection: close
+Content-Type: application/x-www-form-urlencoded
+Transfer-Encoding: chunked
+
+HTTP/1.0 200 OK
+Date: Sat, 02 Sep 2006 00:25:24 GMT
+Connection: close
+Server: AllegroServe/1.2.45
+Content-Type: text/html
+Content-Length: 2922
+PRAGMA: no-cache
+CACHE-CONTROL: no-cache
+SET-COOKIE: meme=1834b91d26f9be983a0ed9ca; path=/</font>
+
+"The username nanook is not in our database."
+#()
+
+<font color=orange>;; finally, we send additional headers to ask for a <a href="http://www.rfc.net/rfc2616.html#s14.35" class=noborder><font color=orange>range</font></a></font>
+<font color=red>DRAKMA-USER 17 ></font> (<a href="http://weitz.de/cl-ppcre/" class=noborder>ppcre</a>:<a class=noborder href="http://weitz.de/cl-ppcre/#regex-replace-all">regex-replace-all</a>
+ "<.*?>"
+ (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/22_c.htm" class=noborder>format</a> nil "~A~A"
+ (<a class=noborder href="#http-request">http-request</a> "<a href="http://users.cableaz.com/~lantz/pages/hunchentoot.html" class=noborder>http://users.cableaz.com/~lantz/pages/hunchentoot.html</a>"
+ :additional-headers '(("<a href="http://www.rfc.net/rfc2616.html#s14.35" class=noborder>Range</a>" . "bytes=959-999")))
+ (<a class=noborder href="#http-request">http-request</a> "<a href="http://users.cableaz.com/~lantz/pages/hunchentoot.html" class=noborder>http://users.cableaz.com/~lantz/pages/hunchentoot.html</a>"
+ :additional-headers '(("<a href="http://www.rfc.net/rfc2616.html#s14.35" class=noborder>Range</a>" . "bytes=1165-1201"))))
+ "")
+<font color=green>GET /~lantz/pages/hunchentoot.html HTTP/1.1
+Host: users.cableaz.com
+User-Agent: Drakma/0.3.0 (LispWorks 5.0.0; Windows NT; Windows XP: 5.1 (build 2600) Service Pack 2; http://weitz.de/drakma/)
+Accept: */*
+Connection: close
+Range: bytes=959-999
+
+HTTP/1.1 206 Partial Content
+Date: Sat, 26 Aug 2006 19:07:44 GMT
+Server: Apache/2.0.16 (Unix)
+Last-Modified: Sun, 24 Apr 2005 04:08:45 GMT
+ETag: "35298d-2fea-d8f4cd40"
+Accept-Ranges: bytes
+Content-Length: 41
+Content-Range: bytes 959-999/12266
+Content-Type: text/html; charset=ISO-8859-1
+Connection: close
+
+GET /~lantz/pages/hunchentoot.html HTTP/1.1
+Host: users.cableaz.com
+User-Agent: Drakma/0.3.0 (LispWorks 5.0.0; Windows NT; Windows XP: 5.1 (build 2600) Service Pack 2; http://weitz.de/drakma/)
+Accept: */*
+Connection: close
+Range: bytes=1165-1201
+
+HTTP/1.1 206 Partial Content
+Date: Sat, 26 Aug 2006 19:07:45 GMT
+Server: Apache/2.0.16 (Unix)
+Last-Modified: Sun, 24 Apr 2005 04:08:45 GMT
+ETag: "35298d-2fea-d8f4cd40"
+Accept-Ranges: bytes
+Content-Length: 37
+Content-Range: bytes 1165-1201/12266
+Content-Type: text/html; charset=ISO-8859-1
+Connection: close</font>
+
+"<a href="http://weitz.de/drakma/" class=noborder>DRAKMA</a> (Queen of Cosmic Greed)
+<a href="http://weitz.de/hunchentoot/" class=noborder>HUNCHENTOOT</a> (The Giant Spider)"
+</pre>
+
+<br> <br><h3><a class=none name="download">Download and installation</a></h3>
+
+Drakma together with this documentation can be downloaded
+from <a
+href="http://weitz.de/files/drakma.tar.gz">http://weitz.de/files/drakma.tar.gz</a>.
+The current version is 0.11.3. Drakma can be installed
+via <a href="http://www.cliki.net/asdf">ASDF</a> and depends on the
+open source
+libraries <a href="http://www.cliki.net/cl-base64">CL-BASE64</a> (use
+3.3.2 or higher to avoid an unneeded dependency
+on <a
+href="http://www.cliki.net/kmrcl">KMRCL</a>), <a
+href="http://www.cliki.net/Puri">Puri</a>, and <a href="http://weitz.de/chunga/">Chunga</a>. If
+you're <em>not</em> using LispWorks, you'll also
+need <a
+href="http://www.cliki.net/usocket">usocket</a> (0.3.2 or newer)
+and (except for <a href="http://franz.com/products/allegrocl/">AllegroCL</a>) <a href="http://common-lisp.net/project/cl-plus-ssl/">CL+SSL</a>.
+Try to use the <b>newest</b> versions of all these libraries - use the CVS
+versions if in doubt. Installation
+via <a href="http://www.cliki.net/asdf-install">asdf-install</a>
+should also be possible, and
+there's a port for <a href="http://www.gentoo.org/proj/en/common-lisp/index.xml">Gentoo
+Linux</a> thanks to Matthew Kennedy.
+<p>
+For <a
+href="http://en.wikipedia.org/wiki/Secure_Sockets_Layer">SSL</a>, you
+will need to
+have <a
+href="http://www.lispworks.com/documentation/lw50/LWUG/html/lwuser-344.htm">the
+corresponding C libraries</a> as well. You'll usually have them
+already unless you're on Windows.
+<p>
+Luís Oliveira maintains a <a href="http://darcs.net/">darcs</a>
+repository of Drakma
+at <a
+href="http://common-lisp.net/~loliveira/ediware/">http://common-lisp.net/~loliveira/ediware/</a>.
+<p>
+A <a href="http://www.selenic.com/mercurial/wiki/">Mercurial</a>
+repository of older versions is available
+at <a
+href="http://arcanes.fr.eu.org/~pierre/2007/02/weitz/">http://arcanes.fr.eu.org/~pierre/2007/02/weitz/</a>
+thanks to Pierre Thierry.
+
+<br> <br><h3><a name="mail" class=none>Support and mailing lists</a></h3>
+
+For questions, bug reports, feature requests, improvements, or patches
+please use the <a
+href="http://common-lisp.net/mailman/listinfo/drakma-devel">drakma-devel
+mailing list</a>. If you want to be notified about future releases
+subscribe to the <a
+href="http://common-lisp.net/mailman/listinfo/drakma-announce">drakma-announce
+mailing list</a>. These mailing lists were made available thanks to
+the services of <a href="http://common-lisp.net/">common-lisp.net</a>.
+<p>
+If you want to send patches, please <a href="http://weitz.de/patches.html">read this first</a>.
+
+
+<br> <br><h3><a class=none name="dictionary">The Drakma dictionary</a></h3>
+
+<h4><a name="request" class=none>The request</a></h4>
+
+The <a href="#http-request"><code>HTTP-REQUEST</code></a> function is
+the heart of Drakma. It is used to send requests to web servers and
+will either return the message body of the server's reply or (if the
+user so wishes) a stream one can read from. The wealth of keyword
+parameters might look a bit intimidating first, but you will rarely
+need more than two or three of them - the default behaviour of Drakma
+is (hopefully) designed to do The Right Thing[TM] in most cases.
+<p>
+You can use
+the <a href="#*header-stream*"><code>*HEADER-STREAM*</code></a>
+variable to debug requests handled by Drakma in a way similar
+to <a href="http://livehttpheaders.mozdev.org/">LiveHTTPHeaders</a>.
+
+<!-- Entry for HTTP-REQUEST -->
+
+<p><br><table border=0><tr><td colspan=4 valign=top>[Function]</td></tr><tr><td valign=top style="white-space:nowrap"><a class=none name='http-request'><b>http-request</b></a> </td><td valign=top><i><a class=none href="#uri">uri</a> </i></td><td valign=top><tt>&key</tt> </td><td><i><a class=none href="#protocol">protocol</a> <a class=none href="#method">method</a> <a class=none href="#force-ssl">force-ssl</a> <a class=none href="#parameters">parameters</a> <a class=none href="#form-data">form-data</a> <a class=none href="#content">content</a> <a class=none href="#content-length">content-length</a> <a class=none href="#content-type">content-type</a> <a class=none href="#cookie-jar-param">cookie-jar</a> <a class=none href="#basic-authorization">basic-authorization</a> <a class=none href="#user-agent">user-agent</a> <a class=none href="#accept">accept</a> <a class=none href="#proxy">proxy</a> <a class=none href="#proxy-basic-authorization">proxy-basic-authorization</a> <a class=none href="#additional-headers">additional-headers</a> <a class=none href="#redirect">redirect</a> <a class=none href="#redirect-methods">redirect-methods</a> <a class=none href="#auto-referer">auto-referer</a> <a class=none href="#keep-alive">keep-alive</a> <a class=none href="#close">close</a> <a class=none href="#external-format-out">external-format-out</a> <a class=none href="#external-format-in">external-format-in</a> <a class=none href="#force-binary">force-binary</a> <a class=none href="#want-stream">want-stream</a> <a class=none href="#stream">stream</a> <a class=none href="#connection-timeout">connection-timeout</a> <a class=none href="#read-timeout">read-timeout</a> <a class=none href="#write-timeout">write-timeout</a></i></td></tr><tr><td colspan=2></td><td colspan=2 valign=top> => <i>body-or-stream, status-code, headers, uri, stream, <a class=none href="#must-close">must-close</a>, reason-phrase</i></td></tr></table>
+<blockquote><br>
+
+Sends an <a href="http://www.rfc.net/rfc2616.html">HTTP</a> request to a web server and returns its reply.
+<a class=none name="uri"><code><i>uri</i></code></a> is where the
+request is sent to, and it is either a string denoting
+a <a
+href="http://en.wikipedia.org/wiki/Uniform_Resource_Identifier">uniform
+resource identifier</a> or
+a <a href="http://www.cliki.net/Puri"><code>PURI:URI</code></a>
+object. The scheme of <code><i>uri</i></code> must be 'http' or
+'https'. The function returns <em>seven</em> values - the body of the
+reply (but see below), the status code as an integer,
+an <a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_a.htm#alist">alist</a>
+of the headers sent by the server where for each element
+the <a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_c.htm#car">car</a>
+(the name of the header) is a keyword and
+the <a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_c.htm#cdr">cdr</a>
+(the value of the header) is a string, the URI the reply comes from
+(which might be different from the URI the request was sent to in case
+of <a href="#redirect">redirects</a>), the stream the reply was read
+from,
+a <a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_g.htm#generalized_boolean">generalized
+boolean</a> which denotes whether the stream should be closed (and
+which you can usually ignore), and finally the reason phrase from the
+status line as a string.
+<p>
+<a class=none name="protocol"><code><i>protocol</i></code></a> is the HTTP protocol which is going to be used in the
+<a href="http://www.rfc.net/rfc2616.html#s5.1">request line</a>, it must be one of the keywords <code>:HTTP/1.0</code> or
+<code>:HTTP/1.1</code> (the default). <a class=none
+name="method"><code><i>method</i></code></a> is the method used in the
+request line,
+a <a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/t_kwd.htm">keyword</a>
+(like <code>:GET</code> or <code>:HEAD</code>) denoting a
+valid <a href="http://rfc.net/rfc2616.html">HTTP/1.1</a>
+or <a href="http://www.webdav.org/">WebDAV</a> request method.
+Additionally, you can also use the pseudo method <code>:OPTIONS*</code> which is like
+<code>:OPTIONS</code> but means that an "<code>OPTIONS *</code>"
+request line will be sent, i.e. the URI's path and query parts will be
+ignored.
+<p>
+If <a class=none
+name="force-ssl"><code><i>force-ssl</i></code></a> is true,
+<a href="http://en.wikipedia.org/wiki/Secure_Sockets_Layer">SSL</a>
+will be <a href="http://www.lispworks.com/documentation/lw50/LWRM/html/lwref-24.htm">attached</a> to the socket stream which connects Drakma with the
+web server. Usually, you don't have to provide this argument, as SSL
+will be attached anyway if the scheme of <code><i>uri</i></code> is 'https'.
+<p>
+<a class=none name="parameters"><code><i>parameters</i></code></a> is
+an <a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_a.htm#alist">alist</a>
+of name/value pairs
+(the <a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_c.htm#car">car</a>
+and
+the <a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_c.htm#cdr">cdr</a>
+each being a string) which denotes the parameters which are added to
+the query part of the URI or (in the case of a POST request) comprise
+the request body. (But
+see <a href="#content"><code><i>content</i></code></a> below.) The
+name/value pairs
+are <a
+href="http://www.blooberry.com/indexdot/html/topics/urlencoding.htm">URL-encoded</a>
+using the external format <a class=none
+name="external-format-out"><code><i>external-format-out</i></code></a>
+before they are sent to the server, <em>unless</em> <a class=none
+name="form-data"><code><i>form-data</i></code></a> is true in which
+case the POST request body is sent
+as <a
+href="http://www.ietf.org/rfc/rfc2388.txt"><code>multipart/form-data</code></a>
+using
+<code><i>external-format-out</i></code>. The values of
+the <code><i>parameters</i></code> alist can also be pathnames, unary
+functions, open binary input streams, or lists where the first element
+is of one of the former types. These values denote files which should
+be sent as part of the request body, i.e. if such file designators are
+present in <code><i>parameters</i></code>, the content type of the
+request is <em>always</em> <code>multipart/form-data</code>. If the
+value denoting a file is a list, the part of the list behind the first
+element is treated as
+a <a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_p.htm#plist">plist</a>
+which can be used to optionally specify a content type (the default is
+"application/octet-stream") and/or a filename (the default is the
+result of
+applying <a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/f_namest.htm"><code>FILE-NAMESTRING</code></a>
+to the pathname) for the file. So, for example, a full file upload
+request could look like this:
+<pre>
+(http-request "http://www.whatever.com/file_upload/"
+ :method :post
+ <font color=orange>;; the following line is only needed if the receiving server doesn't accept
+ ;; chunked transfer encoding (like for example Apache 1.x)</font>
+ <a class=noborder href="#content-length2">:content-length</a> t
+ :parameters '(("file1" #p"/tmp/top_secret_stuff.doc" :content-type "application/msword" :filename "upload.doc")
+ ("file2" . #p"/tmp/portrait.jpg")
+ ("lname" . "Duck") ("fname" . "Donald")))
+</pre>
+<p>
+<code><i>external-format-out</i></code> (the default is the value of <a href="#*drakma-default-external-format*"><code>*DRAKMA-DEFAULT-EXTERNAL-FORMAT*</code></a>) must be the name of a <a href="http://weitz.de/flexi-streams/">FLEXI-STREAMS</a> <a href="http://weitz.de/flexi-streams/#external-formats">external
+format</a>.
+<p><a class=none name="content"><code><i>content</i></code></a>, if not <code>NIL</code>, is
+used as the request body - <code><i>parameters</i></code> is ignored
+in this case. <code><i>content</i></code> can be a string, a
+sequence of octets, a pathname, an open binary input stream, or a
+<a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_f.htm">function
+designator</a>. If <code><i>content</i></code> is a sequence, it will
+be directly sent to the server (using <code><i>external-format-out</i></code> in the case of strings). If <code><i>content</i></code> is a
+pathname, the binary contents of the corresponding file will be sent
+to the server. If <code><i>content</i></code> is a stream, everything
+that can be read from the stream
+until <a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/e_end_of.htm">EOF</a>
+will be sent to the server. If <code><i>content</i></code> is a
+function designator, the corresponding function will be called with
+one argument, the stream to the server, to which it should send data.
+<p>
+Finally, <code><i>content</i></code> can also be the
+keyword <code>:CONTINUATION</code> in which
+case <a href="#http-request"><code>HTTP-REQUEST</code></a> returns
+only one value - a "continuation" function. This function has one
+required argument and one optional argument. The first argument will
+be interpreted like <code><i>content</i></code> above (but it cannot
+be a keyword), i.e. it will be sent to the server according to its
+type. If the second argument is true, the continuation function can
+be called again to send more content, if it is <code>NIL</code>, the
+continuation function returns
+what <a href="#http-request"><code>HTTP-REQUEST</code></a> would have
+returned. See <a href="#cont">above</a> for an
+example on how to use a continuation function and different types of
+content.
+<p>
+If <code><i>content</i></code> is a sequence, Drakma will
+use <a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/f_length.htm"><code>LENGTH</code></a>
+to determine its length and will use the result for the
+'Content-Length' header sent to the server. You can overwrite this
+with the <a class=none
+name="content-length"><code><i>content-length</i></code></a> parameter
+(a non-negative integer) which you can also use for the cases where
+Drakma can't or won't determine the content length itself. You can
+also explicitly provide a <code><i>content-length</i></code> argument
+of <code>NIL</code> which will imply that no 'Content-Length' header
+will be sent even if Drakma could compute the value. If no
+'Content-Length' header is sent, Drakma will
+use <a href="http://weitz.de/chunga/">chunked encoding</a> to send the
+content body. Note that this will not work with some older web
+servers.
+<p>
+<a class=none name="content-length2">A non-<code>NIL</code> <code><i>content-length</i></code> argument</a>
+means that Drakma <em>must</em> build the request body in RAM and
+compute the content length even if it would have otherwise used
+chunked encoding - for example in the case of file uploads. A special
+case is the value <code>T</code>
+for <code><i>content-length</i></code> which means that Drakma should
+compute the content length after building the request body.
+<p>
+<a class=none name="content-type"><code><i>content-type</i></code></a> is the
+corresponding 'Content-Type' header to be sent and will be ignored
+unless <code><i>content</i></code> is provided as well.
+<p>
+Note that a
+query already contained in <code><i>uri</i></code> will always be sent
+with the request line anyway in addition to other parameters sent by
+Drakma.
+<p>
+<a class=none name="cookie-jar-param"><code><i>cookie-jar</i></code></a> is a <a href="#cookie-jar">cookie
+jar</a> containing cookies which will potentially be sent to the
+server (if the domain matches, if they haven't expired, etc.) - this
+cookie jar will be modified according to the 'Set-Cookie' header(s)
+sent back by the server.
+<p>
+<a class=none name="basic-authorization"><code><i>basic-authorization</i></code></a>, if not <code>NIL</code>,
+should be a list of two strings (username and password) which will be
+sent to the server for basic
+authorization. <a class=none name="user-agent"><code><i>user-agent</i></code></a>, if
+not <code>NIL</code>, denotes which 'User-Agent' header will be sent
+with the request. It can be one of the keywords <code>:DRAKMA</code>
+(the
+default), <code>:FIREFOX</code>, <code>:EXPLORER</code>, <code>:OPERA</code>,
+or
+<code>:SAFARI</code> which denote the current version of Drakma or, in
+the latter four cases, a fixed string corresponding to a more or less
+recent (as of August 2006) version of the corresponding browser. Or
+it can be a string which is used
+directly. <a class=none name="accept"><code><i>accept</i></code></a>, if not <code>NIL</code>, is the
+'Accept' header sent - the default is <code>"*/*"</code>.
+<p>
+If <a class=none name="proxy"><code><i>proxy</i></code></a> is not <code>NIL</code>, it should be a
+string denoting
+a <a href="http://en.wikipedia.org/wiki/Proxy_server">proxy server</a>
+through which the request should be sent. Or it can be a list of two
+values - a string denoting the proxy server and an integer denoting
+the port to use (which will default to 80 otherwise).
+<a class=none name="proxy-basic-authorization"><code><i>proxy-basic-authorization</i></code></a> is used like <code><i>basic-authorization</i></code>, but for
+the proxy, and only if <code><i>proxy</i></code> is true.
+<p>
+<a class=none name="additional-headers"><code><i>additional-headers</i></code></a> is a
+name/value <a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_a.htm#alist">alist</a>
+(like <code><i>parameters</i></code>) of additional HTTP headers which
+should be sent with the request.
+<p>
+If <a name="redirect" class=none><code><i>redirect</i></code></a> is
+not <code>NIL</code>, it must be a non-negative integer
+or <code>T</code>. If <code><i>redirect</i></code> is true, Drakma
+will follow redirects (return codes 301, 302, 303, or 307)
+unless <code><i>redirect</i></code> is <code>0</code>.
+If <code><i>redirect</i></code> is an integer, it will be decreased
+by <code>1</code> with each redirect. Drakma will only follow
+redirects if <code><i>method</i></code> is a member of the list <a name="redirect-methods" class=none><code><i>redirect-methods</i></code></a> the
+initial value of which is <code>(:GET :HEAD)</code>.
+Furthermore, if <a name="auto-referer"><code><i>auto-referer</i></code></a> is true when following redirects,
+Drakma will populate the 'Referer' (sic!) header with the URI that
+triggered the redirection, overwriting an existing 'Referer'
+header (in <a href="#additional-headers"><code><i>additional-headers</i></code></a>) if necessary.
+<p>
+If <a name="keep-alive" class=none><code><i>keep-alive</i></code></a> is <code>T</code>, the server will
+be asked to keep the connection alive, i.e. not to close it after the
+reply has been sent. (Note that
+this <a href="http://www.rfc.net/rfc2616.html#s8.1">not necessary</a>
+if both the client and the server use HTTP 1.1.)
+If <a class=none name="close"><code><i>close</i></code></a> is <code>T</code>, the server is
+explicitly asked to close the connection after the reply has been
+sent. <code><i>keep-alive</i></code> and <code><i>close</i></code>
+are obviously mutually
+exclusive. The default for <code><i>close</i></code> is <code>T</code>, the default for <code><i>keep-alive</i></code> is <code>NIL</code>.
+<p>
+<a href="#http-request"><code>HTTP-REQUEST</code></a> will always
+<a class=none name="close-stream">close the stream</a> to the server before it returns unless
+<code><i>want-stream</i></code> is true or if the headers exchanged
+between Drakma and the server determine that the connection will be
+kept alive - for example if both client and server used the
+HTTP 1.1 protocol and no
+explicit <code>"Connection: close"</code> header was sent. In
+these cases <em>you</em> will have to close the stream manually.
+<p>
+If the message body sent by the server has a
+text <a href="http://www.rfc.net/rfc2616.html#s14.17">content
+type</a>, Drakma will try to return it as a Lisp string.
+It'll first check if the 'Content-Type' header denotes an encoding
+(charset) to be used, or otherwise it will use the <a class=none
+name="external-format-in"><code><i>external-format-in</i></code></a>
+(the default is the value
+of <a href="#*drakma-default-external-format*"><code>*DRAKMA-DEFAULT-EXTERNAL-FORMAT*</code></a>)
+argument. The body is decoded
+using <a href="http://weitz.de/flexi-streams/">FLEXI-STREAMS</a>. If
+FLEXI-STREAMS doesn't know the external format, the body is returned
+as an array of octets. If the message body doesn't have a text
+content type or if
+<a class=none name="force-binary"><code><i>force-binary</i></code></a>
+is true, the body is always returned as an array of octets. (But
+see <a href="#*text-content-types*"><code>*TEXT-CONTENT-TYPES*</code></a>
+and <a href="#*body-format-function*"><code>*BODY-FORMAT-FUNCTION*</code></a>.)
+<p>
+If <a class=none
+name="want-stream"><code><i>want-stream</i></code></a> is true, the
+message body is <em>not</em> read and instead the (open) socket stream
+is returned as the first return value. If the sixth return value
+(<a class=none name="must-close"><code><i>must-close</i></code></a>)
+of <a href="#http-request"><code>HTTP-REQUEST</code></a> is true,
+Drakma deduced from the reply headers that the server will close the
+stream on its side, so you can't re-use it - you'll have to close it
+instead. Of course, no matter what the sixth return value is, it's
+alway your responsibility to <a href="#close-stream">close the stream</a> once you're done with
+it. The
+stream returned is a <a href="http://weitz.de/flexi-streams/">flexi
+stream</a> with a <a href="http://weitz.de/chunga/">chunked stream</a>
+as its underlying stream.
+<p>
+Drakma will usually
+create <a
+href="http://www.lispworks.com/documentation/lw50/LWRM/html/lwref-35.htm">a
+new socket connection</a> for each HTTP request. However, you can use
+the <a class=none name="stream"><code><i>stream</i></code></a> argument to provide an open socket stream which should be
+re-used instead. <code><i>stream</i></code> <em>must</em> be a stream returned by a previous invocation of
+<a href="#http-request"><code>HTTP-REQUEST</code></a> where the sixth return value wasn't true. Obviously, it
+must also be connected to the correct server and at the right position
+(i.e. the message body, if any, must have been read). Drakma will
+<em>never</em> attach SSL to a stream provided as the <code><i>stream</i></code> argument.
+<p>
+<a class=none name="connection-timeout"><code><i>connection-timeout</i></code></a> is the time (in seconds) Drakma
+will wait until it considers an attempt to connect to a server as a
+failure. <a class=none name="read-timeout"><code><i>read-timeout</i></code></a>
+and <a class=none name="write-timeout"><code><i>write-timeout</i></code></a> are the read and write timeouts
+(in seconds) for the socket stream to the server. All three timeout
+arguments can also be <code>NIL</code> (meaning no timeout), and they
+don't apply if an existing stream is re-used. All timeout keyword
+arguments are only available for
+LispWorks, <code><i>write-timeout</i></code> is only available for
+LispWorks 5.0 or higher.
+
+</blockquote>
+
+<!-- End of entry for HTTP-REQUEST -->
+
+
+
+<!-- Entry for *DRAKMA-DEFAULT-EXTERNAL-FORMAT* -->
+
+<p><br>[Special variable]<br><a class=none name='*drakma-default-external-format*'><b>*drakma-default-external-format*</b></a>
+<blockquote><br>
+
+The default value for the two external format keyword arguments of
+<a href="#http-request"><code>HTTP-REQUEST</code></a>. The value of
+this variable will be interpreted
+by <a href="http://weitz.de/flexi-streams/">FLEXI-STREAMS</a>. The
+initial value is the keyword <code>:LATIN-1</code>. (Note that Drakma
+binds <a
+href="http://weitz.de/flexi-streams/#*default-eol-style*"><code>*DEFAULT-EOL-STYLE*</code></a>
+to <code>:LF</code>.)
+
+</blockquote>
+
+<!-- End of entry for *DRAKMA-DEFAULT-EXTERNAL-FORMAT* -->
+
+
+<!-- Entry for *TEXT-CONTENT-TYPES* -->
+
+<p><br>[Special variable]<br><a class=none name='*text-content-types*'><b>*text-content-types*</b></a>
+<blockquote><br>
+
+A list of conses which are used by the default value of <a href="#*body-format-function*"><code>*BODY-FORMAT-FUNCTION*</code></a> to decide
+whether a 'Content-Type' header denotes text content. The car and cdr
+of each cons should each be a string or <code>NIL</code>. A content type matches
+one of these entries (and thus denotes text) if the type part is
+<a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_stgeq_.htm"><code>STRING-EQUAL</code></a>
+to the car or if the car is <code>NIL</code> and if the subtype part
+is <a href="http://www.lispworks.com/documentation/HyperSpec/Body/f_stgeq_.htm"><code>STRING-EQUAL</code></a>
+to the cdr or if the cdr is <code>NIL</code>.
+<p>
+The initial value of this variable is the list
+<pre>
+(("text" . nil))
+</pre>
+which means that every content type that starts with "text/" is
+regarded as text, no matter what the subtype is.
+
+</blockquote>
+
+<!-- End of entry for *TEXT-CONTENT-TYPES* -->
+
+<!-- Entry for *BODY-FORMAT-FUNCTION* -->
+
+<p><br>[Special variable]<br><a class=none name='*body-format-function*'><b>*body-format-function*</b></a>
+<blockquote><br>
+
+A function which determines whether the content body returned by the
+server is text and should be treated as such or not. The function is
+called after the request <a href="#headers">headers</a> have been read
+and it must accept two arguments, <code><i>headers</i></code>
+and <code><i>external-format-in</i></code>, where <code><i>headers</i></code> is like the
+third return value of <a href="#http-request"><code>HTTP-REQUEST</code></a> while <code><i>external-format-in</i></code> is the
+<a href="#http-request"><code>HTTP-REQUEST</code></a> argument of the
+same name. It should return <code>NIL</code> if the body should be
+regarded as binary content, or
+a <a href="http://weitz.de/flexi-streams/">FLEXI-STREAMS</a> external
+format (which will be used to read the body) otherwise.
+<p>
+This function will only be called if
+the <a href="#force-binary"><code><i>force-binary</i></code></a>
+argument to <a href="#http-request"><code>HTTP-REQUEST</code></a> is <code>NIL</code>.
+<p>
+The initial value of this variable is a function which uses
+<a href="#*text-content-types*"><code>*TEXT-CONTENT-TYPES*</code></a>
+to determine whether the body is text and then proceeds as described
+in the <a href="#http-request"><code>HTTP-REQUEST</code></a>
+documentation entry.
+
+</blockquote>
+
+<!-- End of entry for *BODY-FORMAT-FUNCTION* -->
+
+<!-- Entry for *HEADER-STREAM* -->
+
+<p><br>[Special variable]<br><a class=none name='*header-stream*'><b>*header-stream*</b></a>
+<blockquote><br>
+
+If this variable is not <code>NIL</code>, it should be bound to a
+stream to which incoming and outgoing headers will be written for
+debugging purposes.
+
+</blockquote>
+
+<!-- End of entry for *HEADER-STREAM* -->
+
+<h4><a name="cookies" class=none>Cookies</a></h4>
+
+<a href="#http-request"><code>HTTP-REQUEST</code></a> can deal
+with <a href="http://en.wikipedia.org/wiki/HTTP_cookie">cookies</a> if
+it gets a <a href="#cookie-jar"><em>cookie jar</em></a>, a collection
+of <a href="#cookie"><code>COOKIE</code></a> objects, as
+its <a href="#cookie-jar-param"><code><i>cookie-jar</i></code></a> argument. Cookies sent by the web
+server will be added to the cookie jar (or updated) if appropriate and
+cookies already in the cookie jar will be sent to the server together
+with the request.
+<p>
+Drakma will <em>never</em> remove cookies from a cookie jar
+automatically - you have to do it manually
+using <a
+href="#delete-old-cookies"><code>DELETE-OLD-COOKIES</code></a>.
+
+<!-- Entry for COOKIE -->
+
+<p><br>[Standard class]<br><a class=none name='cookie'><b>cookie</b></a>
+<blockquote><br>
+
+Elements of this class
+represent <a href="http://en.wikipedia.org/wiki/HTTP_cookie">HTTP
+cookies</a>. If you need to create your own cookies, you should
+use <a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/f_mk_ins.htm"><code>MAKE-INSTANCE</code></a>
+with the
+initargs <code>:NAME</code>, <code>:DOMAIN</code>, <code>:VALUE</code>, <code>:PATH</code>, <code>:EXPIRES</code>,
+<code>:SECUREP</code>, and <code>:HTTP-ONLY-P</code> all of which are
+optional except for the first two. The meaning of these initargs
+and <a href="#cookie-name">the corresponding accessors</a> should be
+pretty clear if one looks at
+the <a href="http://wp.netscape.com/newsref/std/cookie_spec.html">original
+cookie specification</a> (and
+at <a href="http://msdn2.microsoft.com/en-us/library/ms533046.aspx">this
+page</a> for the <code>HttpOnly</code> extension).
+
+<pre>
+<font color=red>DRAKMA-USER 18 ></font> (make-instance 'cookie :name "Foo"
+ :value "Bar"
+ :expires (+ (get-universal-time) 3600)
+ :domain ".weitz.de")
+#<COOKIE Foo=Bar; expires=Sat, 26-08-2006 23:14:27 GMT; path=/; domain=.weitz.de>
+</pre>
+
+</blockquote>
+
+<!-- End of entry for COOKIE -->
+
+
+<p><br>[Specialized accessors]<br><a name="cookie-name" class=none><b>cookie-name</b> <i>(cookie cookie)</i> => <i>name</i></a>
+<br><a class=none><tt>(setf (</tt><b>cookie-name</b> <i>(cookie cookie)</i><tt>)</tt> <i>name</i><tt>)</tt></a>
+<br><a name="cookie-value" class=none><b>cookie-value</b> <i>(cookie cookie)</i> => <i>value</i></a>
+<br><a class=none><tt>(setf (</tt><b>cookie-value</b> <i>(cookie cookie)</i><tt>)</tt> <i>value</i><tt>)</tt></a>
+<br><a name="cookie-domain" class=none><b>cookie-domain</b> <i>(cookie cookie)</i> => <i>domain</i></a>
+<br><a class=none><tt>(setf (</tt><b>cookie-domain</b> <i>(cookie cookie)</i><tt>)</tt> <i>domain</i><tt>)</tt></a>
+<br><a name="cookie-path" class=none><b>cookie-path</b> <i>(cookie cookie)</i> => <i>path</i></a>
+<br><a class=none><tt>(setf (</tt><b>cookie-path</b> <i>(cookie cookie)</i><tt>)</tt> <i>path</i><tt>)</tt></a>
+<br><a name="cookie-expires" class=none><b>cookie-expires</b> <i>(cookie cookie)</i> => <i>expiry</i></a>
+<br><a class=none><tt>(setf (</tt><b>cookie-expires</b> <i>(cookie cookie)</i><tt>)</tt> <i>expiry</i><tt>)</tt></a>
+<br><a name="cookie-securep" class=none><b>cookie-securep</b> <i>(cookie cookie)</i> => <i>securep</i></a>
+<br><a class=none><tt>(setf (</tt><b>cookie-securep</b> <i>(cookie cookie)</i><tt>)</tt> <i>securep</i><tt>)</tt></a>
+<br><a name="cookie-http-only-p" class=none><b>cookie-http-only-p</b> <i>(cookie cookie)</i> => <i>http-only-p</i></a>
+<br><a class=none><tt>(setf (</tt><b>cookie-http-only-p</b> <i>(cookie cookie)</i><tt>)</tt> <i>http-only-p</i><tt>)</tt></a>
+<blockquote><br>
+
+These
+are <a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_a.htm#accessor">accessors</a>
+to get and set the corresponding slots of
+a <a href="#cookie"><code>COOKIE</code></a> object. Note that <code><i>expiry</i></code> is a <a href="http://www.lispworks.com/documentation/HyperSpec/Body/25_adb.htm">universal time</a>
+and <code><i>securep</i></code> and <code><i>http-only-p</i></code> are <a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_g.htm#generalized_boolean">generalized
+booleans</a>. All other values are strings.
+
+</blockquote>
+
+<!-- Entry for COOKIE-JAR -->
+
+<p><br>[Standard class]<br><a class=none name='cookie-jar'><b>cookie-jar</b></a>
+<blockquote><br>
+
+An object of this class encapsulates a collection (a list, actually)
+of <a href="#cookie"><code>COOKIE</code></a> objects. You create a
+new cookie jar with
+<code>(MAKE-INSTANCE 'COOKIE-JAR)</code>
+where you can optionally provide a list
+of <a href="#cookie"><code>COOKIE</code></a> objects with
+the <code>:COOKIES</code> initarg. The cookies in a cookie jar are
+accessed
+with <a
+href="#cookie-jar-cookies"><code>COOKIE-JAR-COOKIES</code></a>.
+
+</blockquote>
+
+<!-- End of entry for COOKIE-JAR -->
+
+
+<!-- Entry for COOKIE-JAR-COOKIES -->
+
+<p><br>[Specialized accessor]<br><a name="cookie-jar-cookies" class=none><b>cookie-jar-cookies</b> <i>(cookie-jar cookie-jar)</i> => <i>list</i></a>
+<br><a class=none><tt>(setf (</tt><b>cookie-jar-cookies</b> <i>(cookie-jar cookie-jar)</i><tt>)</tt> <i>list</i><tt>)</tt></a>
+<blockquote><br>
+
+This <a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_a.htm#accessor">accessor</a>
+is used to get and set the cookies comprised in a cookie
+jar. <code><i>list</i></code> is a list
+of <a href="#cookie"><code>COOKIE</code></a> objects.
+<p>
+Note that <code><i>list</i></code> should not contain two cookies which are equal according to <a href="#cookie="><code>COOKIE=</code></a>.
+
+</blockquote>
+
+<!-- End of entry for COOKIE-JAR-COOKIES -->
+
+
+<!-- Entry for COOKIE= -->
+
+<p><br>[Function]<br><a class=none name='cookie='><b>cookie=</b> <i>cookie1 cookie2</i> => <i>result</i></a>
+<blockquote><br>
+
+Returns <a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_t.htm#true">true</a>
+if the cookies <code><i>cookie1</i></code>
+and <code><i>cookie2</i></code> are equal. Two cookies are considered
+to be equal if their <a href="#cookie-name">names</a> and <a href="#cookie-path">paths</a> are equal.
+
+</blockquote>
+
+<!-- End of entry for COOKIE= -->
+
+
+<!-- Entry for DELETE-OLD-COOKIES -->
+
+<p><br>[Function]<br><a class=none name='delete-old-cookies'><b>delete-old-cookies</b> <i>cookie-jar</i> => <i>cookie-jar</i></a>
+<blockquote><br>
+
+Removes all cookies from the <a href="#cookie-jar">cookie
+jar</a> <code><i>cookie-jar</i></code> which have either expired or
+which don't have an expiry date.
+
+</blockquote>
+
+<!-- End of entry for DELETE-OLD-COOKIES -->
+
+
+<!-- Entry for *IGNORE-UNPARSEABLE-COOKIE-DATES-P* -->
+
+<p><br>[Special variable]<br><a class=none name='*ignore-unparseable-cookie-dates-p*'><b>*ignore-unparseable-cookie-dates-p*</b></a>
+<blockquote><br>
+
+Whether Drakma is allowed to treat <code>Expires</code> dates in
+cookie headers as non-existent if it can't parse them. If the value
+of this variable is <code>NIL</code> (which is the default), an error
+will be signalled instead.
+<p>
+Note that Drakma tries hard to parse every date representation its
+author has so far seen in the wild. As everybody and their sister
+seems to invent their own format, this feels like an uphill battle,
+though. Nevertheless, if you're confronted with something Drakma
+can't parse, report it to the <a href="#mail">mailing list</a> and set
+this variable to a true value only as a temporary workaround.
+
+</blockquote>
+
+<!-- End of entry for *IGNORE-UNPARSEABLE-COOKIE-DATES-P* -->
+
+<h4><a name="headers" class=none>Headers</a></h4>
+
+This section assembles a couple of convenience functions which can be
+used to access information returned as the third
+value (<code><i>headers</i></code>)
+of <a href="#http-request"><code>HTTP-REQUEST</code></a>.
+<p>
+Note that if the header
+sends <a href="http://www.rfc.net/rfc2616.html#s4.2">multiple headers
+with the same name</a>, these are comprised into one entry by
+<a href="#http-request"><code>HTTP-REQUEST</code></a> where the values
+are separated by commas.
+
+<!-- Entry for HEADER-VALUE -->
+
+<p><br>[Function]<br><a class=none name='header-value'><b>header-value</b> <i>name headers</i> => <i>value</i></a>
+<blockquote><br>
+
+If <code><i>headers</i></code> is an <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_a.htm#alist">alist</a> of headers as returned by <a href="#http-request"><code>HTTP-REQUEST</code></a>
+and <code><i>name</i></code> is a keyword naming a header, this function returns the
+corresponding value of this header (or <code>NIL</code> if it's not in
+<code><i>headers</i></code>).
+<pre>
+<font color=red>DRAKMA-USER 19 ></font> (setq <a href="#*header-stream*" class=noborder>*header-stream*</a> nil)
+NIL
+<font color=red>DRAKMA-USER 20 ></font> (header-value :server
+ (<a class=noborder href="http://www.lispworks.com/documentation/HyperSpec/Body/m_nth_va.htm">nth-value</a> 2 (<a class=noborder href="#http-request">http-request</a> "<a href="http://www.jalat.com/blogs/lisp?id=5" class=noborder>http://www.jalat.com/blogs/lisp?id=5</a>")))
+"<a href="http://weitz.de/" class=noborder>Hunchentoot</a> 0.1.3 (<a href="http://weitz.de/tbnl/" class=noborder>TBNL</a> 0.9.7)"
+</pre>
+
+</blockquote>
+
+<!-- End of entry for HEADER-VALUE -->
+
+<!-- Entry for SPLIT-TOKENS -->
+
+<p><br>[Function]<br><a class=none name='split-tokens'><b>split-tokens</b> <i>string</i> => <i>string-list</i></a>
+<blockquote><br>
+
+Splits the string <code><i>string</i></code> into a list of substrings separated
+by commas and optional whitespace. Empty substrings are
+ignored.
+<pre>
+<font color=red>DRAKMA-USER 21 ></font> (split-tokens "chunked, identity")
+("chunked" "identity")
+</pre>
+
+</blockquote>
+
+<!-- End of entry for SPLIT-TOKENS -->
+
+
+<!-- Entry for READ-TOKENS-AND-PARAMETERS -->
+
+<p><br>[Function]<br><a class=none name='read-tokens-and-parameters'><b>read-tokens-and-parameters</b> <i>string <tt>&key</tt> value-required-p</i> => <i>list</i></a>
+<blockquote><br>
+
+Reads a comma-separated list
+of <a href="http://www.rfc.net/rfc2616.html#s2.2">tokens</a> from the
+string <code><i>string</i></code>. Each token can be followed by an
+optional, semicolon-separated list
+of <a href="http://www.rfc.net/rfc2616.html#s3.6">attribute/value
+pairs</a> where the attributes are tokens followed by
+a <code>#\=</code> character and a token or
+a <a href="http://www.rfc.net/rfc2616.html#s2.2">quoted string</a>.
+Returned is a list where each element is either a string (for a simple
+token) or
+a <a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_c.htm#cons">cons</a>
+of a string (the token) and
+an <a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_a.htm#alist">alist</a>
+(the attribute/value pairs). If <code><i>value-required-p</i></code>
+is <code>NIL</code> (the default is <code>T</code>), the value part
+(including the <code>#\=</code> character) of each attribute/value
+pair is optional.
+<p>
+An example of an HTTP header which uses a syntax which can be parsed
+with this function is the 'Transfer-Encoding' header.
+<pre>
+<font color=red>DRAKMA-USER 21 ></font> (read-tokens-and-parameters "iso-8859-5, unicode-1-1;q=0.8")
+("iso-8859-5" ("unicode-1-1" ("q" . "0.8")))
+</pre>
+
+</blockquote>
+
+<!-- End of entry for READ-TOKENS-AND-PARAMETERS -->
+
+<!-- Entry for PARAMETER-PRESENT-P -->
+
+<p><br>[Function]<br><a class=none name='parameter-present-p'><b>parameter-present-p</b> <i>name parameters</i> => <i>generalized-boolean</i></a>
+<blockquote><br>
+
+If <code><i>parameters</i></code> is
+an <a
+href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_a.htm#alist">alist</a>
+of parameters (i.e. of attribute/value pairs) as returned by, for
+example, <a href="#read-tokens-and-parameters"><code>READ-TOKENS-AND-PARAMETERS</code></a> and <code><i>name</i></code> is a string naming a
+parameter, this function returns the full parameter (name and value) -
+or <code>NIL</code> if it's not in <code><i>parameters</i></code>.
+<pre>
+<font color=red>DRAKMA-USER 23 ></font> (parameter-present-p "frob" '(("charset" . "latin-1") ("frob" . "quux")))
+("frob" . "quux")
+
+<font color=red>DRAKMA-USER 24 ></font> (parameter-present-p "foo" '(("charset" . "latin-1") ("frob" . "quux")))
+NIL
+</pre>
+</blockquote>
+
+<!-- End of entry for PARAMETER-PRESENT-P -->
+
+
+<!-- Entry for PARAMETER-VALUE -->
+
+<p><br>[Function]<br><a class=none name='parameter-value'><b>parameter-value</b> <i>name parameters</i> => <i>value</i></a>
+<blockquote><br>
+
+If <code><i>parameters</i></code> is an <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_a.htm#alist">alist</a> of parameters (i.e. of attribute/value pairs) as returned by, for
+example, <a href="#read-tokens-and-parameters"><code>READ-TOKENS-AND-PARAMETERS</code></a> and <code><i>name</i></code> is a string naming a
+parameter, this function returns the value of this parameter - or
+<code>NIL</code> if it's not in <code><i>parameters</i></code>.
+<pre>
+<font color=red>DRAKMA-USER 25 ></font> (parameter-value "frob" '(("charset" . "latin-1") ("frob" . "quux")))
+"quux"
+
+<font color=red>DRAKMA-USER 26 ></font> (parameter-value "foo" '(("charset" . "latin-1") ("frob" . "quux")))
+NIL
+</pre>
+</blockquote>
+
+<!-- End of entry for PARAMETER-VALUE -->
+
+<!-- Entry for GET-CONTENT-TYPE -->
+
+<p><br>[Function]<br><a class=none name='get-content-type'><b>get-content-type</b> <i>headers</i> => <i>type, subtype, parameters</i></a>
+<blockquote><br>
+
+Reads and parses a 'Content-Type' header and returns it as
+three values - the type, the subtype, and an <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_a.htm#alist">alist</a> (possibly
+empty) of name/value pairs for the optional parameters. <code><i>headers</i></code>
+is supposed to be an <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_a.htm#alist">alist</a> of HTTP headers as returned by
+<a href="#http-request"><code>HTTP-REQUEST</code></a>. Returns <code>NIL</code> if there is no 'Content-Type' header amongst
+<code><i>headers</i></code>.
+<pre>
+<font color=red>DRAKMA-USER 27 ></font> (get-content-type
+ (<a class=noborder href="http://www.lispworks.com/documentation/HyperSpec/Body/m_nth_va.htm">nth-value</a> 2 (<a href="#http-request" class=noborder>http-request</a> "<a href="http://weitz.de/" class=noborder>http://weitz.de/</a>")))
+"text"
+"html"
+(("charset" . "iso-8859-1"))
+</pre>
+</blockquote>
+
+<!-- End of entry for GET-CONTENT-TYPE -->
+
+<br> <br><h3><a class=none name="prob">Potential problems</a></h3>
+
+Some web servers (notably <a href="http://paulgraham.com/">Paul Graham</a>'s
+<a
+href="http://paulgraham.com/arc.html">Arc</a> <a
+href="http://common-lisp.net/pipermail/drakma-devel/2007-April/000116.html">web
+server</a>
+and <a
+href="http://common-lisp.net/pipermail/drakma-devel/2007-May/000135.html">some
+very old ones</a>) use wrong line endings when sending the HTTP
+headers. By default, Drakma won't be able to understand them, but
+see <a
+href="http://weitz.de/chunga/">Chunga</a>'s <a
+href="http://weitz.de/chunga/#*accept-bogus-eols*"><code>*ACCEPT-BOGUS-EOLS*</code></a>.
+
+
+<br> <br><h3><a class=none name="ack">Acknowledgements</a></h3>
+
+Initial versions of Drakma used code
+from <a href="http://www.cliki.net/ACL-COMPAT">ACL-COMPAT</a>,
+specifically the chunking code from Jochen Schmidt. (This has been replaced by <a href="http://weitz.de/chunga/">Chunga</a>.)
+The API of
+Drakma's <a href="#http-request"><code>HTTP-REQUEST</code></a> was
+inspired by John
+Foderaro's <a
+href="http://opensource.franz.com/aserve/aserve-dist/doc/aserve.html#f-do-http-request"><code>DO-HTTP-REQUEST</code></a>.
+And greetings to Bob Hutchinson who
+already <a
+href="http://recursive.ca/hutch/index.php?p=278">anticipated this
+library in 2005</a>... :)
+
+<p>
+This documentation was prepared with <a href="http://weitz.de/documentation-template/">DOCUMENTATION-TEMPLATE</a>.
+</p>
+<p>
+$Header: /usr/local/cvsrep/drakma/doc/index.html,v 1.83 2008/01/14 18:51:40 edi Exp $
+<p><a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a>
+
+</body>
+</html>
Added: branches/trunk-reorg/thirdparty/drakma-0.11.3/drakma.asd
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/drakma-0.11.3/drakma.asd Wed Feb 13 14:41:09 2008
@@ -0,0 +1,60 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/drakma/drakma.asd,v 1.46 2008/01/14 18:51:38 edi Exp $
+
+;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package :cl-user)
+
+#+:lispworks
+(unless (find-symbol "STREAM-WRITE-TIMEOUT" :stream)
+ (pushnew :lw-does-not-have-write-timeout *features*))
+
+(defpackage :drakma-asd
+ (:use :cl :asdf))
+
+(in-package :drakma-asd)
+
+(defvar *drakma-version-string* "0.11.3"
+ "Drakma's version number as a string.")
+
+;; we export its name so we can import it later
+(export '*drakma-version-string*)
+
+(defsystem :drakma
+ :serial t
+ :version #.*drakma-version-string*
+ :components ((:file "packages")
+ (:file "specials")
+ (:file "util")
+ (:file "read")
+ (:file "cookies")
+ (:file "request"))
+ :depends-on (:puri
+ :cl-base64
+ :chunga
+ #-:lispworks :usocket
+ #-(or :lispworks :allegro) :cl+ssl))
Added: branches/trunk-reorg/thirdparty/drakma-0.11.3/packages.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/drakma-0.11.3/packages.lisp Wed Feb 13 14:41:09 2008
@@ -0,0 +1,59 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/drakma/packages.lisp,v 1.22 2008/01/14 01:57:01 edi Exp $
+
+;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package :cl-user)
+
+(defpackage :drakma
+ (:use :cl :puri :flexi-streams :chunga)
+ ;; the variable defined in the ASDF system definition
+ (:import-from :drakma-asd :*drakma-version-string*)
+ (:export :*body-format-function*
+ :*drakma-default-external-format*
+ :*header-stream*
+ :*ignore-unparseable-cookie-dates-p*
+ :*text-content-types*
+ :cookie
+ :cookie-domain
+ :cookie-expires
+ :cookie-http-only-p
+ :cookie-jar
+ :cookie-jar-cookies
+ :cookie-name
+ :cookie-path
+ :cookie-securep
+ :cookie-value
+ :cookie=
+ :delete-old-cookies
+ :get-content-type
+ :header-value
+ :http-request
+ :parameter-present-p
+ :parameter-value
+ :read-tokens-and-parameters
+ :split-tokens))
Added: branches/trunk-reorg/thirdparty/drakma-0.11.3/read.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/drakma-0.11.3/read.lisp Wed Feb 13 14:41:09 2008
@@ -0,0 +1,127 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: DRAKMA; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/drakma/read.lisp,v 1.15 2008/01/14 01:57:01 edi Exp $
+
+;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package :drakma)
+
+(defmacro ignore-eof (&body body)
+ "This macro is similar to IGNORE-ERRORS but it only ignores
+conditions of type END-OF-FILE."
+ `(handler-case
+ (progn , at body)
+ (end-of-file () nil)))
+
+(defun read-status-line (stream &optional log-stream)
+ "Reads one line from STREAM \(using Chunga's READ-LINE*) and
+interprets it as a HTTP status line. Returns a list of two or
+three values - the protocol \(HTTP version) as a keyword, the
+status code as an integer, and optionally the reason phrase."
+ (let* ((*current-error-message* "While reading status line:")
+ (line (read-line* stream log-stream))
+ (first-space-pos (or (position #\Space line :test #'char=)
+ (error "No space in status line ~S." line)))
+ (second-space-pos (position #\Space line
+ :test #'char=
+ :start (1+ first-space-pos))))
+ (list (cond ((string-equal line "HTTP/1.0" :end1 first-space-pos) :http/1.0)
+ ((string-equal line "HTTP/1.1" :end1 first-space-pos) :http/1.1)
+ (t (error "Unknown protocol in ~S." line)))
+ (or (ignore-errors (parse-integer line
+ :start (1+ first-space-pos)
+ :end second-space-pos))
+ (error "Status code in ~S is not an integer." line))
+ (and second-space-pos (subseq line (1+ second-space-pos))))))
+
+(defun get-content-type (headers)
+ "Reads and parses a `Content-Type' header and returns it as
+three values - the type, the subtype, and an alist \(possibly
+empty) of name/value pairs for the optional parameters. HEADERS
+is supposed to be an alist of headers as returned by
+HTTP-REQUEST. Returns NIL if there is no such header amongst
+HEADERS."
+ (when-let (content-type (header-value :content-type headers))
+ (with-input-from-string (stream content-type)
+ (let* ((*current-error-message* "Corrupted Content-Type header:")
+ (type (read-token stream))
+ (subtype (and (assert-char stream #\/)
+ (read-token stream)))
+ (parameters (read-name-value-pairs stream)))
+ (values type subtype parameters)))))
+
+(defun read-token-and-parameters (stream)
+ "Reads and returns \(as a two-element list) from STREAM a token
+and an optional list of parameters \(attribute/value pairs)
+following the token."
+ (skip-whitespace stream)
+ (list (read-token stream)
+ (read-name-value-pairs stream)))
+
+(defun skip-more-commas (stream)
+ "Reads and consumes from STREAM any number of commas and
+whitespace. Returns the following character or NIL in case of
+END-OF-FILE."
+ (loop while (eql (ignore-eof (peek-char nil stream)) #\,)
+ do (read-char stream) (skip-whitespace stream))
+ (skip-whitespace stream))
+
+(defun read-tokens-and-parameters (string &key (value-required-p t))
+ "Reads a comma-separated list of tokens from the string STRING.
+Each token can be followed by an optional, semicolon-separated
+list of attribute/value pairs where the attributes are tokens
+followed by a #\\= character and a token or a quoted string.
+Returned is a list where each element is either a string \(for a
+simple token) or a cons of a string \(the token) and an alist
+\(the attribute/value pairs). If VALUE-REQUIRED-P is NIL, the
+value part \(including the #\\= character) of each attribute/value
+pair is optional."
+ (with-input-from-string (stream string)
+ (loop with *current-error-message* = (format nil "While parsing ~S:" string)
+ for first = t then nil
+ for next = (and (skip-whitespace stream)
+ (or first (assert-char stream #\,))
+ (skip-whitespace stream)
+ (skip-more-commas stream))
+ for token = (and next (read-token stream))
+ for parameters = (and token
+ (read-name-value-pairs stream
+ :value-required-p value-required-p))
+ while token
+ collect (if parameters (cons token parameters) token))))
+
+(defun split-tokens (string)
+ "Splits the string STRING into a list of substrings separated
+by commas and optional whitespace. Empty substrings are
+ignored."
+ (loop for old-position = -1 then position
+ for position = (and old-position
+ (position #\, string :test #'char= :start (1+ old-position)))
+ for substring = (and old-position
+ (trim-whitespace (subseq string (1+ old-position) position)))
+ while old-position
+ when (plusp (length substring))
+ collect substring))
Added: branches/trunk-reorg/thirdparty/drakma-0.11.3/request.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/drakma-0.11.3/request.lisp Wed Feb 13 14:41:09 2008
@@ -0,0 +1,666 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: DRAKMA; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/drakma/request.lisp,v 1.54 2008/01/14 18:51:38 edi Exp $
+
+;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package :drakma)
+
+(defun determine-body-format (headers external-format-in)
+ "The default function used by Drakma to determine how the content
+body is to be read. See the docstring of *BODY-FORMAT-FUNCTION* for
+more info."
+ (handler-case
+ (let ((transfer-encodings (header-value :transfer-encoding headers))
+ (content-encodings (header-value :content-encoding headers)))
+ (when transfer-encodings
+ (setq transfer-encodings (split-tokens transfer-encodings)))
+ (when content-encodings
+ (setq content-encodings (split-tokens content-encodings)))
+ (multiple-value-bind (type subtype params)
+ (get-content-type headers)
+ (when (and (text-content-type-p type subtype)
+ (null (set-difference transfer-encodings
+ '("chunked" "identity")
+ :test #'equalp))
+ (null (set-difference content-encodings
+ '("identity")
+ :test #'equalp)))
+ (let* ((charset (parameter-value "charset" params))
+ (name (cond (charset (as-keyword charset))
+ (t external-format-in))))
+ (make-external-format name :eol-style :lf)))))
+ (error (condition)
+ (warn "Problems determining charset \(falling back to binary):~%~A"
+ condition))))
+
+(defun send-content (content stream &optional external-format-out)
+ "Sends CONTENT to the stream STREAM as part of the request body
+depending on the type of CONTENT."
+ (when content
+ (cond ((stringp content)
+ (setf (flexi-stream-external-format stream) external-format-out)
+ (write-string content stream)
+ (setf (flexi-stream-external-format stream) +latin-1+))
+ ((or (arrayp content) (listp content))
+ (write-sequence content stream))
+ ((and (streamp content)
+ (input-stream-p content)
+ (open-stream-p content)
+ (subtypep (stream-element-type content) 'octet))
+ (let ((buf (make-array +buffer-size+ :element-type 'octet)))
+ (loop
+ (let ((pos (read-sequence buf content)))
+ (when (zerop pos) (return))
+ (write-sequence buf stream :end pos)))))
+ ((pathnamep content)
+ (with-open-file (from content :element-type 'octet)
+ ;; calls itself with a stream now
+ (send-content from stream)))
+ ((or (functionp content)
+ (and (symbolp content)
+ (fboundp content)))
+ (funcall content stream))
+ (t (error "Don't know how to send content ~S to server." content)))))
+
+(defun make-form-data-function (parameters boundary)
+ "Creates and returns a closure which can be used as an argument for
+SEND-CONTENT to send PARAMETERS as a `multipart/form-data' request
+body using the boundary BOUNDARY."
+ (lambda (stream)
+ (flet ((crlf ()
+ "Sends carriage return and linefeed to STREAM."
+ (write-char #\Return stream)
+ (write-char #\Linefeed stream)))
+ (dolist (name/value parameters)
+ (destructuring-bind (name . value)
+ name/value
+ (when (or (pathnamep value)
+ (streamp value)
+ (functionp value))
+ (setq value (list value)))
+ (format stream "--~A" boundary)
+ (crlf)
+ (format stream "Content-Disposition: form-data; name=\"~A\"" name)
+ (cond ((stringp value)
+ (crlf) (crlf)
+ (format stream "~A" value))
+ ((listp value)
+ (let* ((file-source (first value))
+ (filename (or (if (functionp file-source) "user-closure")
+ (if (streamp file-source) "user-stream")
+ (getf (rest value) :filename)
+ (file-namestring file-source)))
+ (content-type (or (getf (rest value) :content-type)
+ "application/octet-stream")))
+ (format stream "; filename=\"~A\"" filename)
+ (crlf)
+ (format stream "Content-Type: ~A" content-type)
+ (crlf) (crlf)
+ ;; use SEND-CONTENT to send file as binary data
+ (send-content file-source stream)))
+ (t (error "Don't know what to do with ~S in multipart/form-data body." value)))
+ (crlf)))
+ (format stream "--~A--" boundary)
+ (crlf))))
+
+(defun read-body (stream headers must-close textp)
+ "Reads the message body from the HTTP stream STREAM using the
+information contained in HEADERS \(as produced by HTTP-REQUEST). If
+TEXTP is true, the body is assumed to be of content type `text' and
+will be returned as a string. Otherwise an array of octets \(or NIL
+for an empty body) is returned. Returns the optional `trailer' HTTP
+headers of the chunked stream \(if any) as a second value."
+ (let ((content-length (ignore-errors
+ (parse-integer (header-value :content-length headers))))
+ (element-type (if textp
+ #+:lispworks 'lw:simple-char #-:lispworks 'character
+ 'octet))
+ (chunkedp (chunked-stream-input-chunking-p (flexi-stream-stream stream))))
+ (multiple-value-prog1
+ (values (cond ((eql content-length 0) nil)
+ (content-length
+ (when chunkedp
+ ;; see RFC 2616, section 4.4
+ (error "Got Content-Length header although input chunking is on."))
+ (let ((result (make-array content-length
+ :element-type element-type
+ :fill-pointer t)))
+ (setf (fill-pointer result)
+ (read-sequence result stream))
+ result))
+ ((or chunkedp must-close)
+ ;; no content length, read until EOF (or end of chunking)
+ (let ((buffer (make-array +buffer-size+
+ :element-type element-type))
+ (result (make-array 0
+ :element-type element-type
+ :adjustable t)))
+ (loop for index = 0 then (+ index pos)
+ for pos = (read-sequence buffer stream)
+ do (adjust-array result (+ index pos))
+ (replace result buffer :start1 index :end2 pos)
+ while (= pos +buffer-size+))
+ result)))
+ (chunked-input-stream-trailers stream)))))
+
+(defun http-request (uri &rest args
+ &key (protocol :http/1.1)
+ (method :get)
+ force-ssl
+ parameters
+ content
+ (content-type "application/x-www-form-urlencoded")
+ (content-length nil content-length-provided-p)
+ form-data
+ cookie-jar
+ basic-authorization
+ (user-agent :drakma)
+ (accept "*/*")
+ proxy
+ proxy-basic-authorization
+ additional-headers
+ (redirect 5)
+ (redirect-methods '(:get :head))
+ auto-referer
+ keep-alive
+ (close t)
+ (external-format-out *drakma-default-external-format*)
+ (external-format-in *drakma-default-external-format*)
+ force-binary
+ want-stream
+ stream
+ #+:lispworks (connection-timeout 20)
+ #+:lispworks (read-timeout 20)
+ #+(and :lispworks (not :lw-does-not-have-write-timeout))
+ (write-timeout 20 write-timeout-provided-p))
+ "Sends an HTTP request to a web server and returns its reply. URI
+is where the request is sent to, and it is either a string denoting a
+uniform resource identifier or a PURI:URI object. The scheme of URI
+must be `http' or `https'. The function returns SEVEN values - the
+body of the reply \(but see below), the status code as an integer, an
+alist of the headers sent by the server where for each element the car
+\(the name of the header) is a keyword and the cdr \(the value of the
+header) is a string, the URI the reply comes from \(which might be
+different from the URI the request was sent to in case of redirects),
+the stream the reply was read from, a generalized boolean which
+denotes whether the stream should be closed \(and which you can
+usually ignore), and finally the reason phrase from the status line as
+a string.
+
+PROTOCOL is the HTTP protocol which is going to be used in the
+request line, it must be one of the keywords :HTTP/1.0 or
+:HTTP/1.1. METHOD is the method used in the request line, a
+keyword \(like :GET or :HEAD) denoting a valid HTTP/1.1 or WebDAV
+request method. Additionally, you can also use the pseudo
+method :OPTIONS* which is like :OPTIONS but means that an
+\"OPTIONS *\" request line will be sent, i.e. the URI's path and
+query parts will be ignored.
+
+If FORCE-SSL is true, SSL will be attached to the socket stream
+which connects Drakma with the web server. Usually, you don't
+have to provide this argument, as SSL will be attached anyway if
+the scheme of URI is `https'.
+
+PARAMETERS is an alist of name/value pairs \(the car and the cdr each
+being a string) which denotes the parameters which are added to the
+query part of the URL or \(in the case of a POST request) comprise the
+body of the request. (But see CONTENT below.) The name/value pairs
+are URL-encoded using the FLEXI-STREAMS external format
+EXTERNAL-FORMAT-OUT before they are sent to the server unless
+FORM-DATA is true in which case the POST request body is sent as
+`multipart/form-data' using EXTERNAL-FORMAT-OUT. The values of the
+PARAMETERS alist can also be pathnames, open binary input streams,
+unary functions, or lists where the first element is of one of the
+former types. These values denote files which should be sent as part
+of the request body, i.e. if files are present in PARAMETERS, the
+content type of the request is always `multipart/form-data'. If the
+value is a list, the part of the list behind the first element is
+treated as a plist which can be used to specify a content type and/or
+a filename for the file, i.e. such a value could look like, e.g.,
+\(#p\"/tmp/my_file.doc\" :content-type \"application/msword\"
+:filename \"upload.doc\").
+
+CONTENT, if not NIL, is used as the request body - PARAMETERS is
+ignored in this case. CONTENT can be a string, a sequence of
+octets, a pathname, an open binary input stream, or a function
+designator. If CONTENT is a sequence, it will be directly sent
+to the server \(using EXTERNAL-FORMAT-OUT in the case of
+strings). If CONTENT is a pathname, the binary contents of the
+corresponding file will be sent to the server. If CONTENT is a
+stream, everything that can be read from the stream until EOF
+will be sent to the server. If CONTENT is a function designator,
+the corresponding function will be called with one argument, the
+stream to the server, to which it should send data.
+
+Finally, CONTENT can also be the keyword :CONTINUATION in which case
+HTTP-REQUEST returns only one value - a `continuation' function. This
+function has one required argument and one optional argument. The
+first argument will be interpreted like CONTENT above \(but it cannot
+be a keyword), i.e. it will be sent to the server according to its
+type. If the second argument is true, the continuation function can
+be called again to send more content, if it is NIL the continuation
+function returns what HTTP-REQUEST would have returned.
+
+If CONTENT is a sequence, Drakma will use LENGTH to determine its
+length and will use the result for the `Content-Length' header sent to
+the server. You can overwrite this with the CONTENT-LENGTH parameter
+\(a non-negative integer) which you can also use for the cases where
+Drakma can't or won't determine the content length itself. You can
+also explicitly provide a CONTENT-LENGTH argument of NIL which will
+imply that no `Content-Length' header will be sent in any case. If no
+`Content-Length' header is sent, Drakma will use chunked encoding to
+send the content body. Note that this will not work with older web
+servers.
+
+A non-NIL CONTENT-LENGTH argument means that Drakma /must/ build the
+request body in RAM and compute the content length even if it would
+have otherwise used chunked encoding, for example in the case of file
+uploads. A special case is the value T for CONTENT-LENGTH which means
+that Drakma should compute the content length after building the
+request body.
+
+CONTENT-TYPE is the corresponding `Content-Type' header to be sent and
+will be ignored unless CONTENT is provided as well.
+
+Note that a query already contained in URI will always be sent with
+the request line anyway in addition to other parameters sent by
+Drakma.
+
+COOKIE-JAR is a cookie jar containing cookies which will
+potentially be sent to the server \(if the domain matches, if
+they haven't expired, etc.) - this cookie jar will be modified
+according to the `Set-Cookie' header\(s) sent back by the server.
+
+BASIC-AUTHORIZATION, if not NIL, should be a list of two strings
+\(username and password) which will be sent to the server for
+basic authorization. USER-AGENT, if not NIL, denotes which
+`User-Agent' header will be sent with the request. It can be one
+of the keywords :DRAKMA, :FIREFOX, :EXPLORER, :OPERA, or :SAFARI
+which denote the current version of Drakma or, in the latter four
+cases, a fixed string corresponding to a more or less recent \(as
+of August 2006) version of the corresponding browser. Or it can
+be a string which is used directly. ACCEPT, if not NIL, is the
+`Accept' header sent.
+
+If PROXY is not NIL, it should be a string denoting a proxy
+server through which the request should be sent. Or it can be a
+list of two values - a string denoting the proxy server and an
+integer denoting the port to use \(which will default to 80
+otherwise). PROXY-BASIC-AUTHORIZATION is used like
+BASIC-AUTHORIZATION, but for the proxy, and only if PROXY is
+true.
+
+ADDITIONAL-HEADERS is a name/value alist \(like PARAMETERS) of
+additional HTTP headers which should be sent with the request.
+
+If REDIRECT is not NIL, it must be a non-negative integer or T.
+If REDIRECT is true, Drakma will follow redirects \(return codes
+301, 302, 303, or 307) unless REDIRECT is 0. If REDIRECT is an
+integer, it will be decreased by 1 with each redirect.
+Furthermore, if AUTO-REFERER is true when following redirects,
+Drakma will populate the `Referer' header with the URI that
+triggered the redirection, overwriting an existing `Referer'
+header (in ADDITIONAL-HEADERS) if necessary.
+
+If KEEP-ALIVE is T, the server will be asked to keep the
+connection alive, i.e. not to close it after the reply has been
+sent. \(Note that this not necessary if both the client and the
+server use HTTP 1.1.) If CLOSE is T, the server is explicitly
+asked to close the connection after the reply has been sent.
+KEEP-ALIVE and CLOSE are obviously mutually exclusive.
+
+If the message body sent by the server has a text content type,
+Drakma will try to return it as a Lisp string. It'll first check
+if the `Content-Type' header denotes an encoding to be used, or
+otherwise it will use the EXTERNAL-FORMAT-IN argument. The body
+is decoded using FLEXI-STREAMS. If FLEXI-STREAMS doesn't know
+the external format, the body is returned as an array of octets.
+
+If the message body doesn't have a text content type or if
+FORCE-BINARY is true, the body is always returned as an array of
+octets.
+
+If WANT-STREAM is true, the message body is NOT read and instead the
+\(open) socket stream is returned as the first return value. If the
+sixth value of HTTP-REQUEST is true, the stream should be closed \(and
+not be re-used) after the body has been read. The stream returned is
+a flexi stream \(see http://weitz.de/flexi-streams/) with a chunked
+stream \(see http://weitz.de/chunga/) as its underlying stream. If
+you want to read binary data from this stream, read from the
+underlying stream which you can get with FLEXI-STREAM-STREAM.
+
+Drakma will usually create a new socket connection for each HTTP
+request. However, you can use the STREAM argument to provide an
+open socket stream which should be re-used. STREAM MUST be a
+stream returned by a previous invocation of HTTP-REQUEST where
+the sixth return value wasn't true. Obviously, it must also be
+connected to the correct server and at the right position
+\(i.e. the message body, if any, must have been read). Drakma
+will NEVER attach SSL to a stream provided as the STREAM
+argument.
+
+CONNECTION-TIMEOUT is the time \(in seconds) Drakma will wait until it
+considers an attempt to connect to a server as a failure.
+READ-TIMEOUT and WRITE-TIMEOUT are the read and write timeouts \(in
+seconds) for the socket stream to the server. All three timeout
+arguments can also be NIL \(meaning no timeout), and they don't apply
+if an existing stream is re-used. All timeout keyword arguments are
+only available for LispWorks, WRITE-TIMEOUT is only available for
+LispWorks 5.0 or higher."
+ (unless (member protocol '(:http/1.0 :http/1.1) :test #'eq)
+ (error "Don't know how to handle protocol ~S." protocol))
+ (setq uri (cond ((uri-p uri) (copy-uri uri))
+ (t (parse-uri uri))))
+ (unless (member method +known-methods+ :test #'eq)
+ (error "Don't know how to handle method ~S." method))
+ (unless (member (uri-scheme uri) '(:http :https) :test #'eq)
+ (error "Don't know how to handle scheme ~S." (uri-scheme uri)))
+ (when (and close keep-alive)
+ (error "CLOSE and KEEP-ALIVE must not be both true."))
+ (when (and (eq content :continuation) content-length)
+ (error "CONTENT-LENGTH must be NIL if CONTENT is :CONTINUATION."))
+ (when (and form-data (not (eq method :post)))
+ (error "FORM-DATA makes only sense with POST requests."))
+ ;; convert PROXY argument to canonical form
+ (when proxy
+ (when (atom proxy)
+ (setq proxy (list proxy 80))))
+ ;; make sure we don't get :CRLF on Windows
+ (let ((*default-eol-style* :lf)
+ (file-parameters-p (find-if-not #'stringp parameters :key #'cdr))
+ parameters-used-p)
+ (when (and file-parameters-p (not (eq method :post)))
+ (error "Don't know how to handle parameters in ~S, as this is not a POST request."
+ parameters))
+ (when (eq method :post)
+ ;; create content body for POST unless it was provided
+ (unless content
+ ;; mark PARAMETERS argument as used up, so we don't use it
+ ;; again below
+ (setq parameters-used-p t)
+ (cond ((or form-data file-parameters-p)
+ (let ((boundary (format nil "----------~A" (make-random-string))))
+ (setq content (make-form-data-function parameters boundary)
+ content-type (format nil "multipart/form-data; boundary=~A" boundary)))
+ (unless (or file-parameters-p content-length-provided-p)
+ (setq content-length (or content-length t))))
+ (t
+ (setq content (alist-to-url-encoded-string parameters external-format-out)
+ content-type "application/x-www-form-urlencoded")))))
+ (let (http-stream must-close done)
+ (unwind-protect
+ (progn
+ (let ((host (or (and proxy (first proxy))
+ (uri-host uri)))
+ (port (cond (proxy (second proxy))
+ ((uri-port uri))
+ (t (default-port uri))))
+ (use-ssl (or force-ssl
+ (eq (uri-scheme uri) :https))))
+ #+(and :lispworks5.0 :mswindows
+ (not :lw-does-not-have-write-timeout))
+ (when use-ssl
+ (when (and write-timeout write-timeout-provided-p)
+ (warn "Disabling WRITE-TIMEOUT because it doesn't mix well with SSL."))
+ (setq write-timeout nil))
+ (setq http-stream (or stream
+ #+:lispworks
+ (comm:open-tcp-stream host port
+ :element-type 'octet
+ :timeout connection-timeout
+ :read-timeout read-timeout
+ #-:lw-does-not-have-write-timeout
+ #-:lw-does-not-have-write-timeout
+ :write-timeout write-timeout
+ :errorp t)
+ #-:lispworks
+ (usocket:socket-stream
+ (usocket:socket-connect host port :element-type 'octet))))
+ (when (and use-ssl
+ ;; don't attach SSL to existing streams
+ (not stream))
+ #+:lispworks
+ (comm:attach-ssl http-stream :ssl-side :client)
+ #-:lispworks
+ (setq http-stream
+ #+:allegro
+ (socket:make-ssl-client-stream http-stream)
+ #-:allegro
+ (let ((s http-stream))
+ (cl+ssl:make-ssl-client-stream
+ (cl+ssl:stream-fd s)
+ :close-callback (lambda () (close s)))))))
+ (cond (stream
+ (setf (flexi-stream-element-type http-stream)
+ #+:lispworks 'lw:simple-char #-:lispworks 'character
+ (flexi-stream-external-format http-stream) +latin-1+))
+ (t
+ (setq http-stream
+ (make-flexi-stream (make-chunked-stream http-stream)
+ :external-format +latin-1+))))
+ (labels ((write-http-line (fmt &rest args)
+ (when *header-stream*
+ (format *header-stream* "~?~%" fmt args))
+ (format http-stream "~?~C~C" fmt args #\Return #\Linefeed))
+ (write-header (name value-fmt &rest value-args)
+ (write-http-line "~A: ~?" name value-fmt value-args)))
+ (when (and (not parameters-used-p)
+ parameters)
+ (setf (uri-query uri)
+ ;; append parameters to existing query of URI
+ (format nil "~@[~A~]~:*~:[~;&~]~A"
+ (uri-query uri)
+ (alist-to-url-encoded-string parameters external-format-out))))
+ (when (eq method :options*)
+ ;; special pseudo-method
+ (setf method :options
+ (uri-path uri) "*"
+ (uri-query uri) nil))
+ (write-http-line "~A ~A ~A"
+ (string-upcase method)
+ (cond (proxy (render-uri uri nil))
+ (t (format nil "~A~@[?~A~]"
+ (or (uri-path uri) "/")
+ (uri-query uri))))
+ (string-upcase protocol))
+ (write-header "Host" "~A~@[:~A~]" (uri-host uri) (non-default-port uri))
+ (when user-agent
+ (write-header "User-Agent" (user-agent-string user-agent)))
+ (when basic-authorization
+ (write-header "Authorization" "Basic ~A"
+ (base64:string-to-base64-string
+ (format nil "~A:~A"
+ (first basic-authorization)
+ (second basic-authorization)))))
+ (when (and proxy proxy-basic-authorization)
+ (write-header "Proxy-Authorization" "Basic ~A"
+ (base64:string-to-base64-string
+ (format nil "~A:~A"
+ (first proxy-basic-authorization)
+ (second proxy-basic-authorization)))))
+ (when accept
+ (write-header "Accept" "~A" accept))
+ (when cookie-jar
+ ;; write all cookies in one fell swoop, so even Sun's
+ ;; web server has a change to get it
+ (when-let (cookies (loop for cookie in (cookie-jar-cookies cookie-jar)
+ when (send-cookie-p cookie uri force-ssl)
+ collect (cookie-name cookie) and
+ collect (cookie-value cookie)))
+ (write-header "Cookie" "~{~A=~A~^; ~}" cookies)))
+ (when keep-alive
+ (write-header "Connection" "Keep-Alive"))
+ (when close
+ (setq must-close close)
+ (write-header "Connection" "close"))
+ (loop for (name . value) in additional-headers
+ do (write-header name "~A" value))
+ (when content
+ (when content-type
+ (write-header "Content-Type" "~A" content-type))
+ (when (and content-length
+ (not (or (arrayp content)
+ (listp content)
+ (eq content :continuation))))
+ ;; CONTENT-LENGTH forces us to compute request body
+ ;; in RAM
+ (setq content
+ (with-output-to-sequence (bin-out)
+ (let ((out (make-flexi-stream bin-out :external-format +latin-1+)))
+ (send-content content out)))))
+ (when (and (or (not content-length-provided-p)
+ (eq content-length t))
+ (or (arrayp content) (listp content)))
+ (setq content-length (length content)))
+ (cond (content-length
+ (write-header "Content-Length" "~D" content-length))
+ (t
+ (write-header "Transfer-Encoding" "chunked"))))
+ ;; end of request headers
+ (when *header-stream*
+ (terpri *header-stream*))
+ (format http-stream "~C~C" #\Return #\Linefeed)
+ (force-output http-stream)
+ (when (and content (null content-length))
+ (setf (chunked-stream-output-chunking-p
+ (flexi-stream-stream http-stream)) t))
+ (labels ((finish-request (content &optional continuep)
+ (send-content content http-stream external-format-out)
+ (when continuep
+ (force-output http-stream)
+ (return-from finish-request))
+ (setf (chunked-stream-output-chunking-p
+ (flexi-stream-stream http-stream)) nil)
+ (finish-output http-stream)
+ (multiple-value-bind (server-protocol status-code status-text)
+ ;; loop until status is NOT 100
+ (loop for (server-protocol status-code status-text)
+ = (read-status-line http-stream *header-stream*)
+ when (= status-code 100)
+ ;; ignore headers sent until non-100 status is seen
+ do (read-http-headers http-stream *header-stream*)
+ until (/= status-code 100)
+ finally (return (values server-protocol status-code status-text)))
+ (let ((headers (read-http-headers http-stream *header-stream*))
+ body external-format-body)
+ (let ((connections (header-value :connection headers)))
+ (when connections
+ (setq connections (split-tokens connections)))
+ (when (or (member "close" connections :test #'string-equal)
+ (not (or (and (eq protocol :http/1.1)
+ (eq server-protocol :http/1.1))
+ (member "Keep-Alive" connections
+ :test #'string-equal))))
+ (setq must-close t)))
+ (when cookie-jar
+ (update-cookies (get-cookies headers uri) cookie-jar))
+ (when (and redirect
+ (member status-code +redirect-codes+)
+ (member method redirect-methods))
+ (unless (or (eq redirect t)
+ (and (integerp redirect)
+ (plusp redirect)))
+ (cerror "Continue anyway."
+ "Status code was ~A, but ~
+~:[REDIRECT is ~S~;redirection limit has been exceeded~]."
+ status-code (integerp redirect) redirect))
+ (when auto-referer
+ (setq additional-headers (set-referer uri additional-headers)))
+ (let* ((location (header-value :location headers))
+ (new-uri (merge-uris (cond ((or (null location)
+ (zerop (length location)))
+ (warn "Empty `Location' header, assuming \"/\".")
+ "/")
+ (t location))
+ uri))
+ ;; can we re-use the stream?
+ (old-server-p (and (string= (uri-host new-uri)
+ (uri-host uri))
+ (eql (uri-port new-uri)
+ (uri-port uri))
+ (eq (uri-scheme new-uri)
+ (uri-scheme uri)))))
+ (unless old-server-p
+ (setq must-close t
+ want-stream nil))
+ ;; try to re-use the stream, but only
+ ;; if the user hasn't opted for a
+ ;; connection which is always secure
+ (let ((re-use-stream (and old-server-p
+ (not must-close)
+ (not force-ssl))))
+ ;; close stream if we can't re-use it
+ (unless re-use-stream
+ (ignore-errors (close http-stream)))
+ (setq done t)
+ (return-from http-request
+ (apply #'http-request new-uri
+ :redirect (cond ((integerp redirect) (1- redirect))
+ (t redirect))
+ :stream (and re-use-stream http-stream)
+ :additional-headers additional-headers
+ args)))))
+ (let ((transfer-encodings (header-value :transfer-encoding headers)))
+ (when transfer-encodings
+ (setq transfer-encodings (split-tokens transfer-encodings)))
+ (when (member "chunked" transfer-encodings :test #'equalp)
+ (setf (chunked-stream-input-chunking-p
+ (flexi-stream-stream http-stream)) t)))
+ (when (setq external-format-body
+ (and (not force-binary)
+ (funcall *body-format-function*
+ headers external-format-in)))
+ (setf (flexi-stream-external-format http-stream)
+ external-format-body))
+ (when force-binary
+ (setf (flexi-stream-element-type http-stream) 'octet))
+ (unless (or want-stream (eq method :head))
+ (let (trailers)
+ (multiple-value-setq (body trailers)
+ (read-body http-stream headers must-close external-format-body))
+ (when trailers
+ (warn "Adding trailers from chunked encoding to HTTP headers.")
+ (setq headers (nconc headers trailers)))))
+ (setq done t)
+ (values (cond (want-stream http-stream)
+ (t body))
+ status-code
+ headers
+ uri
+ http-stream
+ must-close
+ status-text)))))
+ (when (eq content :continuation)
+ (return-from http-request #'finish-request))
+ (finish-request content))))
+ ;; the cleanup form of the UNWIND-PROTECT above
+ (when (and http-stream
+ (or (not done)
+ (and must-close
+ (not want-stream)))
+ (not (eq content :continuation)))
+ (ignore-errors (close http-stream)))))))
Added: branches/trunk-reorg/thirdparty/drakma-0.11.3/specials.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/drakma-0.11.3/specials.lisp Wed Feb 13 14:41:09 2008
@@ -0,0 +1,208 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: DRAKMA; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/drakma/specials.lisp,v 1.19 2008/01/14 01:57:02 edi Exp $
+
+;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package :drakma)
+
+(defmacro define-constant (name value &optional doc)
+ "A version of DEFCONSTANT for, cough, /strict/ CL implementations."
+ ;; See <http://www.sbcl.org/manual/Defining-Constants.html>
+ `(defconstant ,name (if (boundp ',name) (symbol-value ',name) ,value)
+ ,@(when doc (list doc))))
+
+(define-constant +latin-1+ (make-external-format :latin-1 :eol-style :lf)
+ "Default external format when reading headers.")
+
+(define-constant +redirect-codes+ '(301 302 303 307)
+ "A list of all HTTP return codes that redirect us to another URI.")
+
+(define-constant +known-methods+ '(:copy
+ :delete
+ :delete
+ :get
+ :head
+ :lock
+ :mkcol
+ :move
+ :options
+ :options*
+ :post
+ :propfind
+ :proppatch
+ :put
+ :trace
+ :unlock)
+ "The HTTP methods \(including WebDAV methods) Drakma knows.")
+
+(defconstant +buffer-size+ 8192)
+
+(defvar *drakma-default-external-format* ':latin-1
+ "The default value for the external format keyword arguments of
+HTTP-REQUEST.")
+
+(defvar *header-stream* nil
+ "If this variable is not NIL, it should be bound to a stream to
+which incoming and outgoing headers will be written for debugging
+purposes.")
+
+(defvar *ignore-unparseable-cookie-dates-p* nil
+ "Whether Drakma is allowed to treat `Expires' dates in cookie
+headers as non-existent if it can't parse them. If the value of this
+variable is NIL \(which is the default), an error will be signalled
+instead.")
+
+(defvar *text-content-types* '(("text" . nil))
+ "A list of conses which are used by DETERMINE-BODY-FORMAT to decide
+whether a `Content-Type' header denotes text content. The car and cdr
+of each cons should each be a string or NIL. A content type matches
+one of these entries \(and thus denotes text) if the type part is
+STRING-EQUAL to the car or if the car is NIL and if the subtype part
+is STRING-EQUAL to the cdr or if the cdr is NIL.")
+
+(defvar *body-format-function* 'determine-body-format
+ "A function which determines whether the content body returned by
+the server is text and should be treated as such or not. The function
+is called after the request headers have been read and it must accept
+two arguments, HEADERS and EXTERNAL-FORMAT-IN where HEADERS is like
+the third return value of HTTP-REQUEST while EXTERNAL-FORMAT-IN is the
+HTTP-REQUEST argument of the same name. It should return NIL if the
+body should be regarded as binary content, or a FLEXI-STREAMS external
+format \(which will be used to read the body) otherwise.
+
+This function will only be called if the FORCE-BINARY argument to
+HTTP-REQUEST was NIL.")
+
+(defvar *time-zone-map*
+ ;; list taken from
+ ;; <http://www.timeanddate.com/library/abbreviations/timezones/>
+ '(("A" . -1)
+ ("ACDT" . -10.5)
+ ("ACST" . -9.5)
+ ("ADT" . 3)
+ ("AEDT" . -11)
+ ("AEST" . -10)
+ ("AKDT" . 8)
+ ("AKST" . 9)
+ ("AST" . 4)
+ ("AWDT" . -9)
+ ("AWST" . -8)
+ ("B" . -2)
+ ("BST" . -1)
+ ("C" . -3)
+ ("CDT" . 5)
+ ("CEDT" . -2)
+ ("CEST" . -2)
+ ("CET" . -1)
+ ("CST" . -10.5)
+ ("CST" . -9.5)
+ ("CST" . 6)
+ ("CXT" . -7)
+ ("D" . -4)
+ ("E" . -5)
+ ("EDT" . 4)
+ ("EEDT" . -3)
+ ("EEST" . -3)
+ ("EET" . -2)
+ ("EST" . -11)
+ ("EST" . -10)
+ ("EST" . 5)
+ ("F" . -6)
+ ("G" . -7)
+ ("GMT" . 0)
+ ("H" . -8)
+ ("HAA" . 3)
+ ("HAC" . 5)
+ ("HADT" . 9)
+ ("HAE" . 4)
+ ("HAP" . 7)
+ ("HAR" . 6)
+ ("HAST" . 10)
+ ("HAT" . 2.5)
+ ("HAY" . 8)
+ ("HNA" . 4)
+ ("HNC" . 6)
+ ("HNE" . 5)
+ ("HNP" . 8)
+ ("HNR" . 7)
+ ("HNT" . 3.5)
+ ("HNY" . 9)
+ ("I" . -9)
+ ("IST" . -1)
+ ("K" . -10)
+ ("L" . -11)
+ ("M" . -12)
+ ("MDT" . 6)
+ ("MESZ" . -2)
+ ("MEZ" . -1)
+ ("MST" . 7)
+ ("N" . 1)
+ ("NDT" . 2.5)
+ ("NFT" . -11.5)
+ ("NST" . 3.5)
+ ("O" . 2)
+ ("P" . 3)
+ ("PDT" . 7)
+ ("PST" . 8)
+ ("Q" . 4)
+ ("R" . 5)
+ ("S" . 6)
+ ("T" . 7)
+ ("U" . 8)
+ ("UTC" . 0)
+ ("V" . 9)
+ ("W" . 10)
+ ("WEDT" . -1)
+ ("WEST" . -1)
+ ("WET" . 0)
+ ("WST" . -9)
+ ("WST" . -8)
+ ("X" . 11)
+ ("Y" . 12)
+ ("Z" . 0))
+ "An alist which maps time zone abbreviations to Common Lisp
+timezones.")
+
+;; stuff for Nikodemus Siivola's HYPERDOC
+;; see <http://common-lisp.net/project/hyperdoc/>
+;; and <http://www.cliki.net/hyperdoc>
+;; also used by LW-ADD-ONS
+
+(defvar *hyperdoc-base-uri* "http://weitz.de/drakma/")
+
+(let ((exported-symbols-alist
+ (loop for symbol being the external-symbols of :drakma
+ collect (cons symbol
+ (concatenate 'string
+ "#"
+ (string-downcase symbol))))))
+ (defun hyperdoc-lookup (symbol type)
+ (declare (ignore type))
+ (cdr (assoc symbol
+ exported-symbols-alist
+ :test #'eq))))
+
Added: branches/trunk-reorg/thirdparty/drakma-0.11.3/util.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/drakma-0.11.3/util.lisp Wed Feb 13 14:41:09 2008
@@ -0,0 +1,287 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: DRAKMA; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/drakma/util.lisp,v 1.35 2008/01/14 01:57:02 edi Exp $
+
+;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package :drakma)
+
+#+:lispworks
+(require "comm")
+
+#+:lispworks
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (import 'lw:when-let))
+
+#-:lispworks
+(defmacro when-let ((var expr) &body body)
+ "Evaluates EXPR, binds it to VAR, and executes BODY if VAR has
+a true value."
+ `(let ((,var ,expr))
+ (when ,var
+ , at body)))
+
+#+:lispworks
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (import 'lw:with-unique-names))
+
+#-:lispworks
+(defmacro with-unique-names ((&rest bindings) &body body)
+ "Syntax: WITH-UNIQUE-NAMES ( { var | (var x) }* ) declaration* form*
+
+Executes a series of forms with each VAR bound to a fresh,
+uninterned symbol. The uninterned symbol is as if returned by a call
+to GENSYM with the string denoted by X - or, if X is not supplied, the
+string denoted by VAR - as argument.
+
+The variable bindings created are lexical unless special declarations
+are specified. The scopes of the name bindings and declarations do not
+include the Xs.
+
+The forms are evaluated in order, and the values of all but the last
+are discarded \(that is, the body is an implicit PROGN)."
+ ;; reference implementation posted to comp.lang.lisp as
+ ;; <cy3bshuf30f.fsf at ljosa.com> by Vebjorn Ljosa - see also
+ ;; <http://www.cliki.net/Common%20Lisp%20Utilities>
+ `(let ,(mapcar #'(lambda (binding)
+ (check-type binding (or cons symbol))
+ (if (consp binding)
+ (destructuring-bind (var x) binding
+ (check-type var symbol)
+ `(,var (gensym ,(etypecase x
+ (symbol (symbol-name x))
+ (character (string x))
+ (string x)))))
+ `(,binding (gensym ,(symbol-name binding)))))
+ bindings)
+ , at body))
+
+(defun ends-with-p (seq suffix &key (test #'char-equal))
+ "Returns true if the sequence SEQ ends with the sequence
+SUFFIX. Individual elements are compared with TEST."
+ (let ((mismatch (mismatch seq suffix :from-end t :test test)))
+ (or (null mismatch)
+ (= mismatch (- (length seq) (length suffix))))))
+
+(defun starts-with-p (seq prefix &key (test #'char-equal))
+ "Returns true if the sequence SEQ starts with the sequence
+PREFIX whereby the elements are compared using TEST."
+ (let ((mismatch (mismatch seq prefix :test test)))
+ (or (null mismatch)
+ (= mismatch (length prefix)))))
+
+(defun url-encode (string external-format)
+ "Returns a URL-encoded version of the string STRING using the
+LispWorks external format EXTERNAL-FORMAT."
+ (with-output-to-string (out)
+ (loop for octet across (string-to-octets (or string "")
+ :external-format external-format)
+ for char = (code-char octet)
+ do (cond ((or (char<= #\0 char #\9)
+ (char<= #\a char #\z)
+ (char<= #\A char #\Z)
+ (find char "$-_.!*'()," :test #'char=))
+ (write-char char out))
+ ((char= char #\Space)
+ (write-char #\+ out))
+ (t (format out "%~2,'0x" (char-code char)))))))
+
+(defun alist-to-url-encoded-string (alist external-format)
+ "ALIST is supposed to be an alist of name/value pairs where both
+names and values are strings. This function returns a string where
+this list is represented as for the content type
+`application/x-www-form-urlencoded', i.e. the values are URL-encoded
+using the external format EXTERNAL-FORMAT, the pairs are joined with a
+#\\& character, and each name is separated from its value with a #\\=
+character."
+ (with-output-to-string (out)
+ (loop for first = t then nil
+ for (name . value) in alist
+ unless first do (write-char #\& out)
+ do (format out "~A=~A"
+ (url-encode name external-format)
+ (url-encode value external-format)))))
+
+(defun default-port (uri)
+ "Returns the default port number for the \(PURI) URI URI.
+Works only with the http and https schemes."
+ (ecase (uri-scheme uri)
+ (:http 80)
+ (:https 443)))
+
+(defun non-default-port (uri)
+ "If the \(PURI) URI specifies an explicit port number which is
+different from the default port its scheme, this port number is
+returned, otherwise NIL."
+ (when-let (port (uri-port uri))
+ (when (/= port (default-port uri))
+ port)))
+
+(defun user-agent-string (token)
+ "Returns a corresponding user agent string if TOKEN is one of
+the keywords :DRAKMA, :FIREFOX, :EXPLORER, :OPERA, or :SAFARI.
+Returns TOKEN itself otherwise."
+ (case token
+ (:drakma
+ (format nil "Drakma/~A (~A~@[ ~A~]; ~A;~@[ ~A;~] http://weitz.de/drakma/)"
+ *drakma-version-string*
+ (or (lisp-implementation-type) "Common Lisp")
+ (or (lisp-implementation-version) "")
+ (or #-:clisp (software-type)
+ #+(or :win32 :mswindows) "Windows"
+ #-(or :win32 :mswindows) "Unix")
+ (or #-:clisp (software-version))))
+ (:firefox
+ "Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.0.6) Gecko/20060728 Firefox/1.5.0.6")
+ (:explorer
+ "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.1.4322; .NET CLR 2.0.50727)")
+ (:opera
+ "Opera/9.01 (Windows NT 5.1; U; en)")
+ (:safari
+ "Mozilla/5.0 (Macintosh; U; Intel Mac OS X; en) AppleWebKit/418.8 (KHTML, like Gecko) Safari/419.3")
+ (otherwise token)))
+
+(defun header-value (name headers)
+ "If HEADERS is an alist of headers as returned by HTTP-REQUEST
+and NAME is a keyword naming a header, this function returns the
+corresponding value of this header \(or NIL if it's not in
+HEADERS)."
+ (cdr (assoc name headers :test #'eq)))
+
+(defun parameter-present-p (name parameters)
+ "If PARAMETERS is an alist of parameters as returned by, for
+example, READ-TOKENS-AND-PARAMETERS and NAME is a string naming a
+parameter, this function returns the full parameter \(name and
+value) - or NIL if it's not in PARAMETERS."
+ (assoc name parameters :test #'string-equal))
+
+(defun parameter-value (name parameters)
+ "If PARAMETERS is an alist of parameters as returned by, for
+example, READ-TOKENS-AND-PARAMETERS and NAME is a string naming a
+parameter, this function returns the value of this parameter - or
+NIL if it's not in PARAMETERS."
+ (cdr (parameter-present-p name parameters)))
+
+(defun make-random-string (&optional (length 50))
+ "Generates and returns a random string length LENGTH. The
+string will consist solely of decimal digits and ASCII letters."
+ (with-output-to-string (s)
+ (dotimes (i length)
+ (write-char (ecase (random 5)
+ ((0 1) (code-char (+ #.(char-code #\a) (random 26))))
+ ((2 3) (code-char (+ #.(char-code #\A) (random 26))))
+ ((4) (code-char (+ #.(char-code #\0) (random 10)))))
+ s))))
+
+(defun split-string (string &optional (separators " ,-"))
+ "Splits STRING into a list of substrings \(which is returned)
+separated by the characters in the sequence SEPARATORS. Empty
+substrings aren't collected."
+ (flet ((make-collector ()
+ (make-array 0
+ :adjustable t
+ :fill-pointer t
+ :element-type #+:lispworks 'lw:simple-char
+ #-:lispworks 'character)))
+ (loop with collector = (make-collector)
+ for char across string
+ for counter downfrom (1- (length string))
+ when (find char separators :test #'char=)
+ when (plusp (length collector))
+ collect collector
+ and do (setq collector (make-collector)) end
+ else
+ do (vector-push-extend char collector)
+ and when (zerop counter)
+ collect collector)))
+
+(defun safe-parse-integer (string)
+ "Like PARSE-INTEGER, but returns NIL instead of signalling an error."
+ (ignore-errors (parse-integer string)))
+
+(defun interpret-as-month (string)
+ "Tries to interpret STRING as a string denoting a month and returns
+the corresponding number of the month. Accepts three-letter
+abbreviations like \"Feb\" and full month names likes \"February\".
+Finally, the function also accepts strings representing integers from
+one to twelve."
+ (or (when-let (pos (position (subseq string 0 (min 3 (length string)))
+ '("Jan" "Feb" "Mar" "Apr" "May" "Jun"
+ "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")
+ :test #'string=))
+ (1+ pos))
+ (when-let (num (safe-parse-integer string))
+ (when (<= 1 num 12)
+ num))))
+
+(defun interpret-as-time-zone (string)
+ "Tries to interpret STRING as a time zone abbreviation which can
+either be something like \"PST\" or \"GMT\" with an offset like
+\"GMT-02:00\"."
+ (when-let (zone (cdr (assoc string *time-zone-map* :test #'string=)))
+ (return-from interpret-as-time-zone zone))
+ (unless (and (= (length string) 9)
+ (starts-with-p string "GMT")
+ (find (char string 3) "+-" :test #'char=)
+ (char= (char string 6) #\:)
+ (every (lambda (pos)
+ (digit-char-p (char string pos)))
+ '(4 5 7 8)))
+ (error "Can't interpret ~S as a time zone." string))
+ (let ((hours (parse-integer string :start 4 :end 6))
+ (minutes (parse-integer string :start 7 :end 9)))
+ (* (if (char= (char string 3) #\+) -1 1)
+ (+ hours (/ minutes 60)))))
+
+(defun set-referer (referer-uri &optional alist)
+ "Returns a fresh copy of the HTTP header list ALIST with the
+`Referer' header set to REFERER-URI. If REFERER-URI is NIL, the
+result will be a list of headers without a `Referer' header."
+ (let ((alist-sans-referer (remove "Referer" alist :key #'car :test #'string=)))
+ (cond (referer-uri (acons "Referer" referer-uri alist-sans-referer))
+ (t alist-sans-referer))))
+
+(defun text-content-type-p (type subtype)
+ "Returns a true value iff the combination of TYPE and SUBTYPE
+matches an entry of *TEXT-CONTENT-TYPES*. See docstring of
+*TEXT-CONTENT-TYPES* for more info."
+ (loop for (candidate-type . candidate-subtype) in *text-content-types*
+ thereis (and (or (null candidate-type)
+ (string-equal type candidate-type))
+ (or (null candidate-subtype)
+ (string-equal subtype candidate-subtype)))))
+
+(defun as-keyword (string)
+ "Converts the string STRING to a keyword where all characters are
+uppercase or lowercase, taking into account the current readtable
+case."
+ (intern (funcall
+ (if (eq (readtable-case *readtable*) :upcase)
+ #'string-upcase
+ #'string-downcase)
+ string)
+ :keyword))
+
More information about the Bknr-cvs
mailing list