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 ,@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 + ,@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@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) + ,@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)) +