├── .pre-release.sh ├── CHANGELOG ├── README.md ├── conditions.lisp ├── cookies.lisp ├── docs ├── Makefile ├── clixdoc.xsl ├── index.html └── index.xml ├── drakma-test.asd ├── drakma.asd ├── encoding.lisp ├── packages.lisp ├── read.lisp ├── request.lisp ├── specials.lisp ├── test └── drakma-test.lisp └── util.lisp /.pre-release.sh: -------------------------------------------------------------------------------- 1 | cd doc; make 2 | -------------------------------------------------------------------------------- /CHANGELOG: -------------------------------------------------------------------------------- 1 | Version 2.0.8 2 | 2021-07-17 3 | 4 | Version 2.0.7 5 | 2019-10-23 6 | Don't pass :TLSEXT-HOST-NAME on older LispWorks. 7 | 8 | Version 2.0.6 9 | 2019-09-27 10 | Pass :TLSEXT-HOST-NAME option when ATTACH-SSL on LispWorks (Xiangyu He) 11 | 12 | Version 2.0.5 13 | 2019-04-07 14 | 15 | Version 2.0.4 16 | 2017-08-28 17 | Support all :VERIFY options with cl+ssl. (Anton Vodonosov) 18 | 19 | Version 2.0.3 20 | 2016-12-19 21 | Allegro CL Express SSL fix (Chris Riesbeck) 22 | Use force-ssl, verify and other SSL settings when using proxy (lsxvdqe) 23 | verify, ca-path, ca-directory and max-depth for CL+SSL (lsxvdqe) 24 | Using host from :additional-headers when specified (Azamat S. Kalimoulline) 25 | 26 | Version 2.0.2 27 | 2015-10-08 28 | Support SNI with cl+ssl. (Paul M. Rodriguez) 29 | 30 | Version 2.0.1 31 | 2015-07-10 32 | Revert "Use quri instead of puri" (Hans Hübner) 33 | Merge pull request #56 from tmccombs/test-op (Hans Hübner) 34 | Add test-op to ASDF for drakma and drakma-test systems. (Thayne McCombs) 35 | 36 | Version 2.0.0 37 | 2015-07-10 38 | Use quri instead of puri for URIs. (Thayne McCombs) 39 | 40 | Version 1.3.15 41 | 2015-07-07 42 | Refactor time zone parsing into regular expression (Hans Huebner) 43 | Update README.md (Hans Hübner) 44 | make-ssl-stream: declare additional variables ignorable (Mark David) 45 | 46 | Version 1.3.14 47 | 2015-03-14 48 | Update documentation (Hans Huebner) 49 | Add DECODE-CONTENT option (Thayne McCombs) 50 | 51 | Version 1.3.13 52 | 2015-03-11 53 | Workaround for ABCL streams bug More information here: http://abcl.org/trac/ticket/377 (Elias Martenson) 54 | Fix code to generate version number in HTML docs (Hans Huebner) 55 | 56 | Version 1.3.12 57 | 2015-01-15 58 | Preserve octet element-type with :force-binary t. (Jan Moringen) 59 | 60 | Version 1.3.11 61 | 2014-11-28 62 | Update support info (Hans Huebner) 63 | Do not escape URI twice. (Orivej Desh) 64 | 65 | Version 1.3.10 66 | 2014-09-16 67 | Implement gzip and deflate decoding for responses. (Thayne McCombs) 68 | Fix error in example (reported by David Vázquez Púa, closes #44) (Hans Huebner) 69 | 70 | Version 1.3.9 71 | 2014-05-01 72 | Added SSL/TLS support for mocl (Wukix Inc) 73 | reindent and refactor cond into if (Hans Huebner) 74 | 75 | Version 1.3.8 76 | 2014-02-25 77 | Determine version number from asdf package (Hans Huebner) 78 | Silence warning on LispWorks (Hans Huebner) 79 | All symbols from puri are prefixed with puri:. (Kilian Sprotte) 80 | 81 | Version 1.3.7 82 | 2013-11-21 83 | Dummy without any functional changes 84 | 85 | Version 1.3.6 86 | Documentation fixes (thanks to sarvid and stassats for the report) 87 | 88 | Version 1.3.5 89 | Ignore incoming Content-Length header when chunking is on 90 | Make POST requests use external-format-out for multipart/form-data. (Raymond Wiker) 91 | Fixed the link to the SBCL documentation pertaining to "defining constants" (Aaron France) 92 | Added *NO-PROXY-DOMAINS* special variable (Aaron France) 93 | 94 | Version 1.3.4 95 | Add *default-http-proxy* special variable (Tomas Zellerin) 96 | 97 | Version 1.3.3 98 | Change handling of empty and missing Location headers (Paul M. Rodriguez) 99 | 100 | Version 1.3.2 101 | Redirect to GET only for POST requests (Vsevolod Dyomkin) 102 | 103 | Version 1.3.1 104 | 2013-03-23 105 | When redirecting from POST to GET, clear the FORM-DATA flag 106 | Add trivial test suite (Anton Vodonosov) 107 | 108 | Version 1.3.0 109 | 2012-12-28 110 | Redirect HTTP 302 and 303 using GET (Orivej Desh) 111 | Add URL-ENCODER keyword argument 112 | Move documentation to XML format and update docstrings 113 | 114 | Version 1.2.9 115 | 2012-10-18 116 | Fix bug with Content-Length computation (Manabu Takayama) 117 | Add REAL-HOST keyword argument (Orivej Desh) 118 | 119 | Version 1.2.8 120 | 2012-09-12 121 | fix the computation of request's Content-Length (Manabu Takayama) 122 | 123 | Version 1.2.7 124 | 2012-08-16 125 | Support :REPORT method (Cyrus Harmon) 126 | Make PRESERVE-URI work better - PURI:URI mangles paths with encoded &'s. 127 | 128 | Version 1.2.6 129 | 2012-03-03 130 | Enable timeouts for more implementations (Francisco Vides Fernández) 131 | Export URL-ENCODE (suggested by Rob Blackwell) 132 | Fix incorrect range header syntax 133 | 134 | Version 1.2.5 135 | 2012-01-30 136 | use cl-ppcre:split instead of split-string to fix bug with GET 137 | parameter handling (thanks to Rob Blackwell) 138 | use :nodelay :if-supported (Anton Vodonosov) 139 | Allow specification of client certificate (all platforms) 140 | Add arguments that allow validation of server certificate 141 | 142 | Version 1.2.4 143 | 2011-08-31 144 | Make sure GET parameters are always URL-encoded 145 | Add :RANGE keyword argument (Hans Huebner) 146 | Better handling of optional filenames when uploading (Stas Boukarev) 147 | Don't funcall symbols that aren't FBOUNDP (Fare Rideau) 148 | Allow disabling of SSL when building (Marko Kocic) 149 | 150 | Version 1.2.3 151 | 2010-08-05 152 | Fix UPDATE-COOKIES (Vsevolod Dyomkin) 153 | Fix typo in documentation HTML (Walter Rader) 154 | 155 | Version 1.2.2 156 | 2010-07-10 157 | Make sure pathless URIs work (Hans Huebner, Manuel Odendahl) 158 | 159 | Version 1.2.1 160 | 2010-05-19 161 | Fix a couple of typos (thanks to Stelian Ionescu, Giovanni Gigante, and Zach Beane) 162 | 163 | Version 1.2.0 164 | 2010-05-19 165 | Introduced *REMOVE-DUPLICATE-COOKIES-P* (Ryan Davis) 166 | Enabled https through a proxy (Bill St. Clair and Dave Lambert) 167 | Bugfix for redirect of a request through a proxy (Bill St. Clair) 168 | Export PARSE-COOKIE-DATE 169 | Safer method to render URIs 170 | Allowed for GET/POST parameters without a value (seen on Lotus webservers) 171 | 172 | Version 1.1.0 173 | 2009-12-01 174 | Allowed additional headers to be function designators (suggested by Xiangjun Wu) 175 | Be more liberal when parsing cookies (thanks to Andrei Stebakov) 176 | Added HTTP method PATCH (thanks to Xiangjun Wu) 177 | Don't send GET parameters again when redirecting (reported by Eugene Ossintsev) 178 | Solidify feature expressions (thanks to Joshua Taylor) 179 | Make SEND-COOKIE-P work for pathless URIs (thanks to Tomo Matsumoto) 180 | 181 | Version 1.0.0 182 | 2009-02-19 183 | Use the new ("binary") version of Chunga 184 | Added conditions types 185 | Some performance improvements 186 | Be more lenient about content length (thanks to Zach Beane and "pix") 187 | Added *ALLOW-DOTLESS-COOKIE-DOMAINS-P* (thanks to Daniel Janus) 188 | Fix generation of user agent header (bug caught by Chaitanya Gupta) 189 | Added DEADLINE parameter for CCL (thanks to Hans Huebner) 190 | Fixed bug where READ-BODY returned NIL although TEXTP was true (thanks to Hans Huebner) 191 | 192 | Version 0.11.5 193 | 2008-03-21 194 | Added workaround for CLISP (thanks to Anton Vodonosov) 195 | 196 | Version 0.11.4 197 | 2008-02-13 198 | Improved error detection in MAKE-FORM-DATA-FUNCTION (suggested by Daniel Janus) 199 | 200 | Version 0.11.3 201 | 2008-01-14 202 | The previous change is only needed for Windows 203 | 204 | Version 0.11.2 205 | 2008-01-14 206 | Disable WRITE-TIMEOUT for LW 5.0 if SSL is used (reported by Nico de Jager) 207 | 208 | Version 0.11.1 209 | 2007-10-11 210 | Make Drakma work with AllegroCL's "modern" mode (patch by Ross Jekel) 211 | Needs at least Chunga 0.4.1 and FLEXI-STREAMS 0.13.1 212 | 213 | Version 0.11.0 214 | 2007-10-01 215 | Added *TEXT-CONTENT-TYPES* and *BODY-FORMAT-FUNCTION* (suggested by Peter Eddy) 216 | 217 | Version 0.10.2 218 | 2007-09-29 219 | Fixed bug introduced in latest change... (reported by Ross Jekel) 220 | 221 | Version 0.10.1 222 | 2007-09-25 223 | Use parameters in URI if they weren't used up for the content body (suggested by Jan Rychter) 224 | 225 | Version 0.10.0 226 | 2007-09-18 227 | Added support for "HttpOnly" cookie attribute (due to a bug report by Alexey Goldin) 228 | 229 | Version 0.9.1 230 | 2007-07-12 231 | Improved CL+SSL support (patch by David Lichteblau) 232 | 233 | Version 0.9.0 234 | 2007-06-30 235 | Added reason phrase to return values (patch by Holger Duerer) 236 | 237 | Version 0.8.0 238 | 2007-06-25 239 | In cookie dates, accept time zones different from "GMT" (reported by Didier Verna) 240 | Added *ignore-unparseable-cookie-dates-p* 241 | 242 | Version 0.7.1 243 | 2007-06-17 244 | Allow streams or functions as file designators (suggested by Andrei Stebakov) 245 | 246 | Version 0.7.0 247 | 2007-04-07 248 | Switched from trivial-sockets to usocket (patch by Erik Huelsmann) 249 | 250 | Version 0.6.2 251 | 2007-03-09 252 | Fixed release dates (thanks to Jeffrey Cunningham) 253 | 254 | Version 0.6.1 255 | 2007-03-08 256 | Changed SPLIT-STRING so that it doesn't rely on unspecified behaviour (reported by Jianshi Huang) 257 | 258 | Version 0.6.0 259 | 2007-02-08 260 | Make sure stream is closed in case of early errors (thanks to Chris Dean for test data) 261 | Robustified cookie parsing 262 | Send all outgoing cookies in one fell swoop (for Sun's buggy web server) 263 | Deal with empty Location headers 264 | Deal with corrupted Content-Type headers 265 | 266 | Version 0.5.5 267 | 2007-02-05 268 | Fixed socket leak in case of redirects (bug report by Chris Dean) 269 | 270 | Version 0.5.4 271 | 2006-12-01 272 | Workaround for servers which send headers after 100 status line (provided by Donavon Keithley) 273 | 274 | Version 0.5.3 275 | 2006-10-11 276 | Set stream element type for binary streams as needed for CLISP (reported by Magnus Henoch) 277 | 278 | Version 0.5.2 279 | 2006-10-08 280 | Adhere to user-provided content length if FORM-DATA is true 281 | 282 | Version 0.5.1 283 | 2006-10-07 284 | Take Content-Encoding header into account (due to a bug report by Gregory Tod) 285 | 286 | Version 0.5.0 287 | 2006-09-25 288 | Fixed bug where body sometimes wasn't read (reported by Ivan Toshkov) 289 | Added AUTO-REFERER feature (thanks to Colin Simmonds) 290 | 291 | Version 0.4.4 292 | 2006-09-24 293 | Treat "localhost" special for cookies (reported by Ivan Toshkov) 294 | 295 | Version 0.4.3 296 | 2006-09-24 297 | Circumvent CL+SSL for AllegroCL (suggested by David Lichteblau) 298 | 299 | Version 0.4.2 300 | 2006-09-07 301 | Fixed :OPTIONS* method 302 | 303 | Version 0.4.1 304 | 2006-09-07 305 | Added more methods including :OPTIONS* pseudo method (suggested by Ralf Mattes) 306 | Always (except for POST) add parameters to URI query 307 | Always read body (unless there's no chunking and no content length) 308 | 309 | Version 0.4.0 310 | 2006-09-05 311 | Added file uploads 312 | Added multipart/form-data 313 | Added enforced computation of request bodies in RAM 314 | Use LF line endings in default external format 315 | 316 | Version 0.3.1 317 | 2006-09-04 318 | Don't use underlying streams of flexi streams anymore 319 | Returned streams now have element type OCTET when FORCE-BINARY is true 320 | Better default "User-Agent" header for some Lisps 321 | Added info about mailing lists 322 | Added note about Gentoo 323 | 324 | Version 0.3.0 325 | 2006-09-02 326 | Added client-side chunked encoding and various ways to send the content 327 | 328 | Version 0.2.0 329 | 2006-09-01 330 | Completely re-factored for portability, chunking code is in Chunga now 331 | 332 | Version 0.1.3 333 | 2006-08-30 334 | REQUIRE "comm" before WITH-STREAM-INPUT-BUFFER is used 335 | 336 | Version 0.1.2 337 | 2006-08-27 338 | Notes about SSL and listener font 339 | 340 | Version 0.1.1 341 | 2006-08-27 342 | Note about CL-BASE64 and KMRCL 343 | 344 | Version 0.1.0 345 | 2006-08-27 346 | First public release 347 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ------------------------------------------- 2 | DRAKMA - HTTP client written in Common Lisp 3 | ------------------------------------------- 4 | 5 | DRAKMA is a HTTP client written in Common Lisp. Please visit [the 6 | documentation site](http://edicl.github.io/drakma/) for more information. 7 | 8 | [![Gitter](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/edicl/drakma?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) 9 | -------------------------------------------------------------------------------- /conditions.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: ODD-STREAMS; Base: 10 -*- 2 | ;;; $Header: /usr/local/cvsrep/odd-streams/conditions.lisp,v 1.5 2007/12/31 01:08:45 edi Exp $ 3 | 4 | ;;; Copyright (c) 2008-2012, Dr. Edmund Weitz. All rights reserved. 5 | 6 | ;;; Redistribution and use in source and binary forms, with or without 7 | ;;; modification, are permitted provided that the following conditions 8 | ;;; are met: 9 | 10 | ;;; * Redistributions of source code must retain the above copyright 11 | ;;; notice, this list of conditions and the following disclaimer. 12 | 13 | ;;; * Redistributions in binary form must reproduce the above 14 | ;;; copyright notice, this list of conditions and the following 15 | ;;; disclaimer in the documentation and/or other materials 16 | ;;; provided with the distribution. 17 | 18 | ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED 19 | ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 20 | ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 21 | ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY 22 | ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE 24 | ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 25 | ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 26 | ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 27 | ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 28 | ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | 30 | (in-package :drakma) 31 | 32 | (define-condition drakma-condition (condition) 33 | () 34 | (:documentation "Superclass for all conditions related to Drakma.")) 35 | 36 | (define-condition drakma-error (drakma-condition error) 37 | () 38 | (:documentation "Superclass for all errors related to Drakma.")) 39 | 40 | (define-condition drakma-simple-error (drakma-error simple-condition) 41 | () 42 | (:documentation "Like DRAKMA-ERROR but with formatting capabilities.")) 43 | 44 | (define-condition drakma-warning (drakma-condition warning) 45 | () 46 | (:documentation "Superclass for all warnings related to Drakma.")) 47 | 48 | (define-condition drakma-simple-warning (drakma-warning simple-condition) 49 | () 50 | (:documentation "Like DRAKMA-WARNING but with formatting capabilities.")) 51 | 52 | (defun drakma-warn (format-control &rest format-arguments) 53 | "Signals a warning of type DRAKMA-SIMPLE-WARNING with the 54 | provided format control and arguments." 55 | (warn 'drakma-simple-warning 56 | :format-control format-control 57 | :format-arguments format-arguments)) 58 | 59 | (define-condition parameter-error (drakma-simple-error) 60 | () 61 | (:documentation "Signalled if a function was called with 62 | inconsistent or illegal parameters.")) 63 | 64 | (defun parameter-error (format-control &rest format-arguments) 65 | "Signals an error of type PARAMETER-ERROR with the provided 66 | format control and arguments." 67 | (error 'parameter-error 68 | :format-control format-control 69 | :format-arguments format-arguments)) 70 | 71 | (define-condition syntax-error (drakma-simple-error) 72 | () 73 | (:documentation "Signalled if Drakma encounters wrong or unknown 74 | syntax when reading the reply from the server.")) 75 | 76 | (defun syntax-error (format-control &rest format-arguments) 77 | "Signals an error of type SYNTAX-ERROR with the provided 78 | format control and arguments." 79 | (error 'syntax-error 80 | :format-control format-control 81 | :format-arguments format-arguments)) 82 | 83 | (define-condition cookie-error (drakma-simple-error) 84 | ((cookie :initarg :cookie 85 | :initform nil 86 | :reader cookie-error-cookie 87 | :documentation "The COOKIE object that caused this error. 88 | Can be NIL in case such an object couldn't be initialized.")) 89 | (:documentation "Signalled if someone tries to create a COOKIE object that's not valid.")) 90 | 91 | (defun cookie-error (cookie format-control &rest format-arguments) 92 | "Signals an error of type COOKIE-ERROR with the provided cookie 93 | \(can be NIL), format control and arguments." 94 | (error 'cookie-error 95 | :cookie cookie 96 | :format-control format-control 97 | :format-arguments format-arguments)) 98 | 99 | (define-condition cookie-date-parse-error (cookie-error) 100 | () 101 | (:documentation "Signalled if Drakma tries to parse the date of an 102 | incoming cookie header and can't interpret it.")) 103 | 104 | (defun cookie-date-parse-error (format-control &rest format-arguments) 105 | "Signals an error of type COOKIE-DATE-PARSE-ERROR with the provided 106 | format control and arguments." 107 | (error 'cookie-date-parse-error 108 | :format-control format-control 109 | :format-arguments format-arguments)) 110 | -------------------------------------------------------------------------------- /cookies.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: DRAKMA; Base: 10 -*- 2 | ;;; $Header: /usr/local/cvsrep/drakma/cookies.lisp,v 1.15 2008/01/14 01:57:01 edi Exp $ 3 | 4 | ;;; Copyright (c) 2006-2012, Dr. Edmund Weitz. All rights reserved. 5 | 6 | ;;; Redistribution and use in source and binary forms, with or without 7 | ;;; modification, are permitted provided that the following conditions 8 | ;;; are met: 9 | 10 | ;;; * Redistributions of source code must retain the above copyright 11 | ;;; notice, this list of conditions and the following disclaimer. 12 | 13 | ;;; * Redistributions in binary form must reproduce the above 14 | ;;; copyright notice, this list of conditions and the following 15 | ;;; disclaimer in the documentation and/or other materials 16 | ;;; provided with the distribution. 17 | 18 | ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED 19 | ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 20 | ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 21 | ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY 22 | ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE 24 | ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 25 | ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 26 | ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 27 | ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 28 | ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | 30 | (in-package :drakma) 31 | 32 | (defclass cookie () 33 | ((name :initarg :name 34 | :initform (cookie-error nil "A cookie must have a name.") 35 | :accessor cookie-name 36 | :documentation "The name of the cookie.") 37 | (value :initarg :value 38 | :initform "" 39 | :accessor cookie-value 40 | :documentation "The cookie's value.") 41 | (domain :initarg :domain 42 | :initform (cookie-error nil "A cookie must have a domain.") 43 | :accessor cookie-domain 44 | :documentation "The domain the cookie is valid for.") 45 | (path :initarg :path 46 | :initform "/" 47 | :accessor cookie-path 48 | :documentation "The path prefix the cookie is valid for.") 49 | (expires :initarg :expires 50 | :initform nil 51 | :accessor cookie-expires 52 | :documentation "When the cookie expires. A Lisp 53 | universal time or NIL.") 54 | (securep :initarg :securep 55 | :initform nil 56 | :accessor cookie-securep 57 | :documentation "Whether the cookie must only be 58 | transmitted over secure connections.") 59 | (http-only-p :initarg :http-only-p 60 | :initform nil 61 | :accessor cookie-http-only-p 62 | :documentation "Whether the cookie should not be 63 | accessible from Javascript. 64 | 65 | This is a Microsoft extension that has been implemented in Firefox as 66 | well. See .")) 67 | (:documentation "Instances of this class represent HTTP cookies. If 68 | you need to create your own cookies, you should use MAKE-INSTANCE with 69 | the initargs :NAME, :DOMAIN, :VALUE, :PATH, :EXPIRES, 70 | :SECUREP, and :HTTP-ONLY-P all of which are optional except for the 71 | first two. The meaning of these initargs and the corresponding 72 | accessors should be pretty clear if one looks at the original cookie 73 | specification 74 | (and at this 75 | page for the 76 | HttpOnly extension).")) 77 | 78 | (defun render-cookie-date (time) 79 | "Returns a string representation of the universal time TIME 80 | which can be used for cookie headers." 81 | (multiple-value-bind (second minute hour date month year weekday) 82 | (decode-universal-time time 0) 83 | (format nil "~A, ~2,'0d-~2,'0d-~4,'0d ~2,'0d:~2,'0d:~2,'0d GMT" 84 | (aref #("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun") weekday) 85 | date month year hour minute second))) 86 | 87 | (defmethod print-object ((cookie cookie) stream) 88 | "Prints a representation of COOKIE similar to a `Set-Cookie' header." 89 | (print-unreadable-object (cookie stream :type t) 90 | (with-slots (name value expires path domain securep http-only-p) 91 | cookie 92 | (format stream "~A~@[=~A~]~@[; expires=~A~]~@[; path=~A~]~@[; domain=~A~]~@[; secure~]~@[; HttpOnly~]" 93 | name (and (plusp (length value)) value) 94 | (and expires (render-cookie-date expires)) 95 | path domain securep http-only-p)))) 96 | 97 | (defun normalize-cookie-domain (domain) 98 | "Adds a dot at the beginning of the string DOMAIN unless there 99 | is already one." 100 | (cond ((starts-with-p domain ".") domain) 101 | (t (format nil ".~A" domain)))) 102 | 103 | (defun valid-cookie-domain-p (domain) 104 | "Checks if the string DOMAIN contains enough dots to be 105 | acceptable. If *ALLOW-DOTLESS-COOKIE-DOMAINS-P* is non-NIL, 106 | every domain name is considered acceptable." 107 | (or *allow-dotless-cookie-domains-p* 108 | (string-equal domain "localhost") 109 | (> (count #\. (normalize-cookie-domain domain) :test #'char=) 1))) 110 | 111 | (defun cookie-domain-matches (domain uri) 112 | "Checks if the domain DOMAIN \(a string) matches the \(PURI) URI URI." 113 | (ends-with-p (normalize-cookie-domain (puri:uri-host uri)) 114 | (normalize-cookie-domain domain))) 115 | 116 | (defun send-cookie-p (cookie uri force-ssl) 117 | "Checks if the cookie COOKIE should be sent to the server 118 | depending on the \(PURI) URI URI and the value of FORCE-SSL \(as 119 | in HTTP-REQUEST)." 120 | (and ;; check domain 121 | (cookie-domain-matches (cookie-domain cookie) uri) 122 | ;; check path 123 | (starts-with-p (or (puri:uri-path uri) "/") (cookie-path cookie)) 124 | ;; check expiry date 125 | (let ((expires (cookie-expires cookie))) 126 | (or (null expires) 127 | (> expires (get-universal-time)))) 128 | ;; check if connection must be secure 129 | (or (null (cookie-securep cookie)) 130 | force-ssl 131 | (eq (puri:uri-scheme uri) :https)))) 132 | 133 | (defun check-cookie (cookie) 134 | "Checks if the slots of the COOKIE object COOKIE have valid values 135 | and raises a corresponding error of type COOKIE-ERROR otherwise." 136 | (with-slots (name value domain path expires) 137 | cookie 138 | (unless (and (stringp name) (plusp (length name))) 139 | (cookie-error cookie "Cookie name ~S must be a non-empty string." name)) 140 | (unless (stringp value) 141 | (cookie-error cookie "Cookie value ~S must be a non-empty string." value)) 142 | (unless (valid-cookie-domain-p domain) 143 | (cookie-error cookie "Invalid cookie domain ~S." domain)) 144 | (unless (and (stringp path) (plusp (length path))) 145 | (cookie-error cookie "Cookie path ~S must be a non-empty string." path)) 146 | (unless (or (null expires) 147 | (and (integerp expires) 148 | (plusp expires))) 149 | (cookie-error cookie "Cookie expiry ~S should have been NIL or a universal time." expires)))) 150 | 151 | (defmethod initialize-instance :after ((cookie cookie) &rest initargs) 152 | "Check cookie validity after creation." 153 | (declare (ignore initargs)) 154 | (check-cookie cookie)) 155 | 156 | (defmethod (setf cookie-name) :after (new-value (cookie cookie)) 157 | "Check cookie validity after name change." 158 | (declare (ignore new-value)) 159 | (check-cookie cookie)) 160 | 161 | (defmethod (setf cookie-value) :after (new-value (cookie cookie)) 162 | "Check cookie validity after value change." 163 | (declare (ignore new-value)) 164 | (check-cookie cookie)) 165 | 166 | (defmethod (setf cookie-domain) :after (new-value (cookie cookie)) 167 | "Check cookie validity after domain change." 168 | (declare (ignore new-value)) 169 | (check-cookie cookie)) 170 | 171 | (defmethod (setf cookie-path) :after (new-value (cookie cookie)) 172 | "Check cookie validity after path change." 173 | (declare (ignore new-value)) 174 | (check-cookie cookie)) 175 | 176 | (defmethod (setf cookie-expires) :after (new-value (cookie cookie)) 177 | "Check cookie validity after expiry change." 178 | (declare (ignore new-value)) 179 | (check-cookie cookie)) 180 | 181 | (defun cookie= (cookie1 cookie2) 182 | "Returns true if the cookies COOKIE1 and COOKIE2 are equal. 183 | Two cookies are considered to be equal if name and path are 184 | equal." 185 | (and (string= (cookie-name cookie1) (cookie-name cookie2)) 186 | (string= (cookie-path cookie1) (cookie-path cookie2)))) 187 | 188 | (defclass cookie-jar () 189 | ((cookies :initarg :cookies 190 | :initform nil 191 | :accessor cookie-jar-cookies 192 | :documentation "A list of the cookies in this cookie jar.")) 193 | (:documentation "An object of this class encapsulates a 194 | collection (a list, actually) of COOKIE objects. You create a new 195 | cookie jar with (MAKE-INSTANCE 'COOKIE-JAR) where you can optionally 196 | provide a list of COOKIE objects with the :COOKIES initarg. The 197 | cookies in a cookie jar are accessed with COOKIE-JAR-COOKIES.")) 198 | 199 | (defmethod print-object ((cookie-jar cookie-jar) stream) 200 | "Print a cookie jar, showing the number of cookies it contains." 201 | (print-unreadable-object (cookie-jar stream :type t :identity t) 202 | (format stream "(with ~A cookie~:P)" (length (cookie-jar-cookies cookie-jar))))) 203 | 204 | (defun parse-cookie-date (string) 205 | "Parses a cookie expiry date and returns it as a Lisp universal 206 | time. Currently understands the following formats: 207 | 208 | \"Wed, 06-Feb-2008 21:01:38 GMT\" 209 | \"Wed, 06-Feb-08 21:01:38 GMT\" 210 | \"Tue Feb 13 08:00:00 2007 GMT\" 211 | \"Wednesday, 07-February-2027 08:55:23 GMT\" 212 | \"Wed, 07-02-2017 10:34:45 GMT\" 213 | 214 | Instead of \"GMT\" time zone abbreviations like \"CEST\" and UTC 215 | offsets like \"GMT-01:30\" are also allowed. 216 | 217 | While this function has \"cookie\" in its name, it might come in 218 | handy in other situations as well and it is thus exported as a 219 | convenience function. 220 | " 221 | ;; it seems like everybody and their sister invents their own format 222 | ;; for this, so (as there's no real standard for it) we'll have to 223 | ;; make this function more flexible once we come across something 224 | ;; new; as an alternative we could use net-telent-date, but it also 225 | ;; fails to parse some of the stuff you encounter in the wild; or we 226 | ;; could try to employ CL-PPCRE, but that'd add a new dependency 227 | ;; without making this code much cleaner 228 | (handler-case 229 | (let* ((last-space-pos 230 | (or (position #\Space string :test #'char= :from-end t) 231 | (cookie-date-parse-error "Can't parse cookie date ~S, no space found." string))) 232 | (time-zone-string (subseq string (1+ last-space-pos))) 233 | (time-zone (interpret-as-time-zone time-zone-string)) 234 | second minute hour day month year) 235 | (dolist (part (rest (cl-ppcre:split "[ ,-]" (subseq string 0 last-space-pos)))) 236 | (when (and day month) 237 | (cond ((every #'digit-char-p part) 238 | (when year 239 | (cookie-date-parse-error "Can't parse cookie date ~S, confused by ~S part." 240 | string part)) 241 | (setq year (parse-integer part))) 242 | ((= (count #\: part :test #'char=) 2) 243 | (let ((h-m-s (mapcar #'safe-parse-integer (cl-ppcre:split ":" part)))) 244 | (setq hour (first h-m-s) 245 | minute (second h-m-s) 246 | second (third h-m-s)))) 247 | (t (cookie-date-parse-error "Can't parse cookie date ~S, confused by ~S part." 248 | string part)))) 249 | (cond ((null day) 250 | (unless (setq day (safe-parse-integer part)) 251 | (setq month (interpret-as-month part)))) 252 | ((null month) 253 | (setq month (interpret-as-month part))))) 254 | (unless (and second minute hour day month year) 255 | (cookie-date-parse-error "Can't parse cookie date ~S, component missing." string)) 256 | (when (< year 100) 257 | (setq year (+ year 2000))) 258 | (encode-universal-time second minute hour day month year time-zone)) 259 | (cookie-date-parse-error (condition) 260 | (cond (*ignore-unparseable-cookie-dates-p* 261 | (drakma-warn "~A" condition) 262 | nil) 263 | (t (error condition)))))) 264 | 265 | (defun parse-set-cookie (string) 266 | "Parses the `Set-Cookie' header line STRING and returns a list 267 | of three-element lists where each one contains the name of the 268 | cookie, the value of the cookie, and an attribute/value list for 269 | the optional cookie parameters." 270 | (let ((*current-error-message* (format nil "While parsing cookie header ~S:" string)) 271 | result) 272 | (dolist (substring (split-set-cookie-string string)) 273 | (with-sequence-from-string (stream substring) 274 | (let* ((name/value (read-name-value-pair stream :cookie-syntax t)) 275 | (parameters (read-name-value-pairs stream :value-required-p nil :cookie-syntax t))) 276 | (push (list (car name/value) (cdr name/value) parameters) result)))) 277 | (nreverse result))) 278 | 279 | (defun get-cookies (headers uri) 280 | "Returns a list of COOKIE objects corresponding to the 281 | `Set-Cookie' header as found in HEADERS \(an alist as returned by 282 | HTTP-REQUEST). Collects only cookies which match the domain of 283 | the \(PURI) URI URI." 284 | (loop with set-cookie-header = (header-value :set-cookie headers) 285 | with parsed-cookies = (and set-cookie-header (parse-set-cookie set-cookie-header)) 286 | for (name value parameters) in parsed-cookies 287 | for expires = (parameter-value "expires" parameters) 288 | for domain = (or (parameter-value "domain" parameters) (puri:uri-host uri)) 289 | when (and (valid-cookie-domain-p domain) 290 | (cookie-domain-matches domain uri)) 291 | collect (make-instance 'cookie 292 | :name name 293 | :value value 294 | :path (or (parameter-value "path" parameters) 295 | (puri:uri-path uri) 296 | "/") 297 | :expires (and expires 298 | (plusp (length expires)) 299 | (parse-cookie-date expires)) 300 | :domain domain 301 | :securep (not (not (parameter-present-p "secure" parameters))) 302 | :http-only-p (not (not (parameter-present-p "HttpOnly" parameters)))) 303 | into new-cookies 304 | finally (return (ccase *remove-duplicate-cookies-p* 305 | ((nil) new-cookies) 306 | ((:keep-last t) (delete-duplicates new-cookies :test #'cookie=)) 307 | (:keep-first (delete-duplicates new-cookies :test #'cookie= 308 | :from-end T)))))) 309 | 310 | (defun update-cookies (new-cookies cookie-jar) 311 | "Updates the cookies in COOKIE-JAR by replacing those which are 312 | equal to a cookie in \(the list) NEW-COOKIES with the corresponding 313 | `new' cookie and adding those which are really new." 314 | (setf (cookie-jar-cookies cookie-jar) 315 | (let ((updated-cookies 316 | (loop for old-cookie in (cookie-jar-cookies cookie-jar) 317 | collect (or (find old-cookie new-cookies :test #'cookie=) 318 | old-cookie)))) 319 | (union updated-cookies 320 | (set-difference new-cookies updated-cookies :test #'cookie=) 321 | :test #'cookie=))) 322 | cookie-jar) 323 | 324 | (defun delete-old-cookies (cookie-jar) 325 | "Removes all cookies from COOKIE-JAR which have either expired 326 | or which don't have an expiry date." 327 | (setf (cookie-jar-cookies cookie-jar) 328 | (loop with now = (get-universal-time) 329 | for cookie in (cookie-jar-cookies cookie-jar) 330 | for expires = (cookie-expires cookie) 331 | unless (or (null expires) (< expires now)) 332 | collect cookie)) 333 | cookie-jar) 334 | -------------------------------------------------------------------------------- /docs/Makefile: -------------------------------------------------------------------------------- 1 | 2 | all: 3 | xsltproc --stringparam library-version `perl -ne 'print "$$1\n" if (/:version "(.*)"/)' ../drakma.asd` clixdoc.xsl index.xml > index.html 4 | -------------------------------------------------------------------------------- /docs/clixdoc.xsl: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/edicl/drakma/a4ee4410ad3e42dcefdfa4ae8c2b40d15257de3e/docs/clixdoc.xsl -------------------------------------------------------------------------------- /docs/index.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Drakma - A Common Lisp HTTP client 6 | 7 | Drakma is a full-featured HTTP client implemented in Common Lisp. 8 | It knows how to handle HTTP/1.1 chunking, 9 | persistent connections, re-usable sockets, SSL, continuable uploads, file uploads, cookies, and more. 15 | 16 | 17 |

Drakma - A Common Lisp HTTP client

18 | 19 |
20 | 21 |

22 | Drakma is a full-featured HTTP client implemented in Common 23 | Lisp. It knows how to handle HTTP/1.1 24 | chunking, persistent 25 | connections, re-usable 26 | sockets, SSL, continuable uploads, 28 | file uploads, cookies, and more. 30 |

31 |

32 | The code comes with a BSD-style 34 | license so you can basically do with it whatever you want. 35 |

36 | 37 |
38 | 39 | 40 | 41 | 42 | 43 | 44 | 54 | 55 |

56 | Here is a collection of example uses of Drakma to which 57 | demonstrate some of its features. In the examples, text is 58 | color coded to indicate where it comes from (REPL input, REPL output, HTTP headers sent and HTTP headers received). Headers 63 | particularly relevant to the example at hand are shown in bold. 66 |

67 | 68 | 69 | 
? (ql:quickload :drakma)
  70 | To load "drakma":
  71 |   Load 1 ASDF system:
  72 |     drakma
  73 | ; Loading "drakma"
  74 | To load "cl+ssl":
  75 |   Load 1 ASDF system:
  76 |     flexi-streams
  77 |   Install 8 Quicklisp releases:
  78 |     alexandria babel bordeaux-threads cffi cl+ssl
  79 |     trivial-features trivial-garbage trivial-gray-streams
  80 | ...
  81 | ; Loading "drakma"
  82 | 
  83 | (:DRAKMA)
  84 | 
  85 |
86 | 87 | 88 |

89 | In some of the following examples, the headers exchanged 90 | between Drakma and the HTTP server should be shown, for 91 | illustration purposes. This can be achieved like so: 92 |

93 | 
? (setf drakma:*header-stream* *standard-output*)
  94 | #<SYNONYM-STREAM to *TERMINAL-IO* #x3020006AC7DD>
  95 |
96 | 97 | 98 |

99 | Request a page. Note how Drakma automatically follows the 301 100 | redirect and how the fourth return value shows the 101 | new URI. 102 |

103 | 
? (drakma:http-request "http://lisp.org/")
 104 | GET / HTTP/1.1
 105 | Host: lisp.org
 106 | User-Agent: Drakma/1.3.0 (Clozure Common Lisp Version 1.8-r15286M  (DarwinX8664); Darwin; 12.2.0; http://weitz.de/drakma/)
 107 | Accept: */*
 108 | Connection: close
 109 | 
 110 | HTTP/1.1 307  Temporary Redirect
 111 | Date: Sun, 09 Dec 2012 08:01:56 GMT
 112 | Connection: Close
 113 | Server: AllegroServe/1.2.65
 114 | Transfer-Encoding: chunked
 115 | LOCATION: http://lisp.org/index.html
 116 | 
 117 | GET /index.html HTTP/1.1
 118 | Host: lisp.org
 119 | User-Agent: Drakma/1.3.0 (Clozure Common Lisp Version 1.8-r15286M  (DarwinX8664); Darwin; 12.2.0; http://weitz.de/drakma/)
 120 | Accept: */*
 121 | Connection: close
 122 | 
 123 | HTTP/1.1 200  OK
 124 | Date: Sun, 09 Dec 2012 08:01:56 GMT
 125 | Connection: Close
 126 | Server: AllegroServe/1.2.65
 127 | Content-Type: text/html
 128 | Content-Length: 459
 129 | LAST-MODIFIED: Wed, 26 Oct 2011 02:26:26 GMT
 130 | 
 131 | "<HTML>
 132 | <HEAD>
 133 |   <title>John McCarthy, 1927-2011</title>
 134 |   <STYLE type=\"text/css\">
 135 |     BODY {text-align: center}
 136 |   </STYLE>
 137 | </HEAD>
 138 | <BODY>
 139 | <h1>John McCarthy</h1>
 140 | <img src=\"jmccolor.jpg\" alt=\"a picture of John McCarthy, from his website\"/>
 141 | <h3>1927-2011</h3>
 142 | <br><br>
 143 | <a href=\"http://www-formal.stanford.edu/jmc/\">John McCarthy's Home Page</a><br>
 144 | <a href=\"http://news.stanford.edu/news/2011/october/john-mccarthy-obit-102511.html\">Obituary</a>
 145 | </BODY>
 146 | </HTML>
 147 | "
 148 | 200
 149 | ((:DATE . "Sun, 09 Dec 2012 08:01:56 GMT") (:CONNECTION . "Close") (:SERVER . "AllegroServe/1.2.65")
 150 |  (:CONTENT-TYPE . "text/html") (:CONTENT-LENGTH . "459") (:LAST-MODIFIED . "Wed, 26 Oct 2011 02:26:26 GMT"))
 151 | #<URI http://lisp.org/index.html>
 152 | #<FLEXI-STREAMS:FLEXI-IO-STREAM #x30200155DB1D>
 153 | T
 154 | " OK"
 155 |
156 | 157 | 158 |

159 | Drakma automatically interprets the 'charset=utf-8' part 160 | correctly. 161 |

162 | 
? (subseq (drakma:http-request "http://www.cl.cam.ac.uk/~mgk25/ucs/examples/digraphs.txt") 0 298)
 163 | GET /~mgk25/ucs/examples/digraphs.txt HTTP/1.1
 164 | Host: www.cl.cam.ac.uk
 165 | User-Agent: Drakma/1.3.0 (Clozure Common Lisp Version 1.8-r15286M  (DarwinX8664); Darwin; 12.2.0; http://weitz.de/drakma/)
 166 | Accept: */*
 167 | Connection: close
 168 | 
 169 | HTTP/1.1 200 OK
 170 | Date: Sun, 09 Dec 2012 08:15:04 GMT
 171 | Server: Apache/2.2.3 (CentOS)
 172 | Last-Modified: Mon, 06 Apr 2009 18:13:43 GMT
 173 | ETag: "17cd62-298-466e6dbcd03c0"
 174 | Accept-Ranges: bytes
 175 | Content-Length: 664
 176 | X-UA-Compatible: IE=edge
 177 | Connection: close
 178 | Content-Type: text/plain; charset=utf-8
 179 | 
 180 | "Latin Digraphs and Ligatures in ISO10646-1
 181 | 
 182 | A short table of ligatures and digraphs follows. Some of these may not be
 183 | ligatures/digraphs in the technical sense, (for example, æ is a seperate
 184 | letter in English), but visually they behave that way.
 185 | 
 186 | AÆE : U+00C6
 187 | aæe : U+00E6
 188 | ſßs : U+00DF
 189 | IIJJ : U+0132"
 190 |
191 | 192 | 193 |

194 | For non-textual content types, a vector of octets is returned. 195 |

196 | 
? (drakma:http-request "https://api.github.com/repos/edicl/drakma/git/tags/tag-does-not-exist")
 197 | GET /repos/edicl/drakma/git/tags/tag-does-not-exist HTTP/1.1
 198 | Host: api.github.com
 199 | User-Agent: Drakma/1.3.0 (SBCL 1.1.1.31.master.2-9fac43f-dirty; Darwin; 12.2.0; http://weitz.de/drakma/)
 200 | Accept: */*
 201 | Connection: close
 202 | 
 203 | HTTP/1.1 404 Not Found
 204 | Server: nginx
 205 | Date: Fri, 28 Dec 2012 08:37:31 GMT
 206 | Content-Type: application/json; charset=utf-8
 207 | Connection: close
 208 | Status: 404 Not Found
 209 | X-GitHub-Media-Type: github.beta
 210 | X-RateLimit-Remaining: 48
 211 | X-RateLimit-Limit: 60
 212 | Content-Length: 23
 213 | X-Content-Type-Options: nosniff
 214 | Cache-Control: 
 215 | 
 216 | #(123 34 109 101 115 115 97 103 101 34 58 34 78 111 116 32 70 111 117 110 100 34 125)
 217 | 404
 218 | ((:SERVER . "nginx") (:DATE . "Fri, 28 Dec 2012 08:37:31 GMT") (:CONTENT-TYPE . "application/json; charset=utf-8")
 219 |  (:CONNECTION . "close") (:STATUS . "404 Not Found") (:X-GITHUB-MEDIA-TYPE . "github.beta") (:X-RATELIMIT-REMAINING . "48")
 220 |  (:X-RATELIMIT-LIMIT . "60") (:CONTENT-LENGTH . "23") (:X-CONTENT-TYPE-OPTIONS . "nosniff") (:CACHE-CONTROL . ""))
 221 | #<PURI:URI https://api.github.com/repos/edicl/drakma/git/tags/tag-does-not-exist>
 222 | #<FLEXI-STREAMS:FLEXI-IO-STREAM {101C40C043}>
 223 | T
 224 | "Not Found"
 225 | ? (flexi-streams:octets-to-string *)
 226 | "{\"message\":\"Not Found\"}"
227 | 228 | 229 |

230 | Request a page using the HTTPS protocol. Also note that the 231 | server uses chunked 233 | transfer encoding for its reply 234 |

235 | 
? (ql:quickload :cl-ppcre)
 236 | ? (cl-ppcre:scan-to-strings "(?s)You have.*your data."
 237 |                             (drakma:http-request "https://www.fortify.net/cgi/ssl_2.pl"))
 238 | GET /cgi/ssl_2.pl HTTP/1.1
 239 | Host: www.fortify.net
 240 | User-Agent: Drakma/1.3.0 (Clozure Common Lisp Version 1.8-r15286M  (DarwinX8664); Darwin; 12.2.0; http://weitz.de/drakma/)
 241 | Accept: */*
 242 | Connection: close
 243 | 
 244 | HTTP/1.1 200 OK
 245 | Date: Sun, 09 Dec 2012 08:15:31 GMT
 246 | Server: Apache
 247 | Connection: close
 248 | Transfer-Encoding: chunked
 249 | Content-Type: text/html
 250 | 
 251 | "You have connected to this web server using the RC4-SHA encryption cipher
 252 |  with a key length of 128 bits.
 253 |  <p>
 254 |  This is a high-grade encryption connection, regarded by most experts as being suitable
 255 |  for sending or receiving even the most sensitive or valuable information
 256 |  across a network.
 257 |  <p>
 258 |  In a crude analogy, using this cipher is similar to sending or storing your data inside
 259 |  a high quality safe - compared to an export-grade cipher which is similar to using
 260 |  a paper envelope to protect your data."
 261 | #()
 262 |
263 | 264 | 265 |

266 | Some servers adapt their behavior according to the Browser 267 | that is used. Drakma can claim to be i.e. MS Internet 268 | Explorer. 269 |

270 | 
? (cl-ppcre:scan-to-strings "<h4>.*" (drakma:http-request "http://whatsmyuseragent.com/" :user-agent :explorer))
 271 | GET / HTTP/1.1
 272 | Host: whatsmyuseragent.com
 273 | User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.1.4322; .NET CLR 2.0.50727)
 274 | Accept: */*
 275 | Connection: close
 276 | 
 277 | HTTP/1.1 200 OK
 278 | Date: Sun, 09 Dec 2012 08:23:50 GMT
 279 | Server: Apache
 280 | X-Powered-By: PHP/5.2.17
 281 | Connection: close
 282 | Transfer-Encoding: chunked
 283 | Content-Type: text/html
 284 | 
 285 | "<h4>Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.1.4322; .NET CLR 2.0.50727)</h4>"
 286 | #()
 287 |
288 | 289 | 290 |

291 | Drakma can send parameters in a POST request and knows how to 292 | deal with cookies. Note how Drakma 293 | sends the cookie back in the second request. 294 |

295 | 
? (let ((cookie-jar (make-instance 'drakma:cookie-jar)))
 296 |     (drakma:http-request "http://www.phpsecurepages.com/test/test.php"
 297 |                          :method :post
 298 |                          :parameters '(("entered_login" . "test")
 299 |                                        ("entered_password" . "test"))
 300 |                          :cookie-jar cookie-jar)
 301 |     (drakma:http-request "http://www.phpsecurepages.com/test/test2.php"
 302 |                          :cookie-jar cookie-jar)
 303 |     (drakma:cookie-jar-cookies cookie-jar))
 304 | POST /test/test.php HTTP/1.1
 305 | Host: www.phpsecurepages.com
 306 | User-Agent: Drakma/1.3.0 (Clozure Common Lisp Version 1.8-r15286M  (DarwinX8664); Darwin; 12.2.0; http://weitz.de/drakma/)
 307 | Accept: */*
 308 | Connection: close
 309 | Content-Type: application/x-www-form-urlencoded
 310 | Content-Length: 40
 311 | 
 312 | HTTP/1.1 200 OK
 313 | Date: Sun, 09 Dec 2012 08:25:13 GMT
 314 | Server:  
 315 | X-Powered-By: PHP/5.2.17
 316 | Set-Cookie: PHPSESSID=vijk3706eojs7n8u5cdpi3ju05; path=/
 317 | Expires: Thu, 19 Nov 1981 08:52:00 GMT
 318 | Cache-Control: no-store, no-cache, must-revalidate, post-check=0, pre-check=0
 319 | Pragma: no-cache
 320 | X-Powered-By: PleskLin
 321 | Content-Length: 4479
 322 | Connection: close
 323 | Content-Type: text/html
 324 | 
 325 | GET /test/test2.php HTTP/1.1
 326 | Host: www.phpsecurepages.com
 327 | User-Agent: Drakma/1.3.0 (Clozure Common Lisp Version 1.8-r15286M  (DarwinX8664); Darwin; 12.2.0; http://weitz.de/drakma/)
 328 | Accept: */*
 329 | Cookie: PHPSESSID=vijk3706eojs7n8u5cdpi3ju05
 330 | Connection: close
 331 | 
 332 | HTTP/1.1 200 OK
 333 | Date: Sun, 09 Dec 2012 08:25:16 GMT
 334 | Server:  
 335 | X-Powered-By: PHP/5.2.17
 336 | Expires: Thu, 19 Nov 1981 08:52:00 GMT
 337 | Cache-Control: no-store, no-cache, must-revalidate, post-check=0, pre-check=0
 338 | Pragma: no-cache
 339 | X-Powered-By: PleskLin
 340 | Content-Length: 4479
 341 | Connection: close
 342 | Content-Type: text/html
 343 | 
 344 | (#<COOKIE PHPSESSID=vijk3706eojs7n8u5cdpi3ju05; path=/; domain=www.phpsecurepages.com>)
 345 |
346 | 347 | 348 |

349 | Drakma can use a connection to a server for multiple requests. 350 |

351 | 
? (let ((stream (nth-value 4 (drakma:http-request "http://www.lispworks.com/" :close nil))))
 352 |     (nth-value 2 (drakma:http-request "http://www.lispworks.com/success-stories/index.html"
 353 |                                       :stream stream)))
 354 | GET / HTTP/1.1
 355 | Host: www.lispworks.com
 356 | User-Agent: Drakma/1.3.0 (Clozure Common Lisp Version 1.8-r15286M  (DarwinX8664); Darwin; 12.2.0; http://weitz.de/drakma/)
 357 | Accept: */*
 358 | 
 359 | HTTP/1.1 200 OK
 360 | Date: Sun, 09 Dec 2012 08:25:56 GMT
 361 | Server: Apache/2.2.22 (Unix) mod_ssl/2.2.22 OpenSSL/1.0.1c mod_apreq2-20051231/2.6.0 mod_perl/2.0.5 Perl/v5.8.9
 362 | Last-Modified: Tue, 20 Nov 2012 12:27:40 GMT
 363 | ETag: "336280-28eb-4ceec5c1f4700"
 364 | Accept-Ranges: bytes
 365 | Content-Length: 10475
 366 | Content-Type: text/html
 367 | 
 368 | GET /success-stories/index.html HTTP/1.1
 369 | Host: www.lispworks.com
 370 | User-Agent: Drakma/1.3.0 (Clozure Common Lisp Version 1.8-r15286M  (DarwinX8664); Darwin; 12.2.0; http://weitz.de/drakma/)
 371 | Accept: */*
 372 | Connection: close
 373 | 
 374 | HTTP/1.1 200 OK
 375 | Date: Sun, 09 Dec 2012 08:25:56 GMT
 376 | Server: Apache/2.2.22 (Unix) mod_ssl/2.2.22 OpenSSL/1.0.1c mod_apreq2-20051231/2.6.0 mod_perl/2.0.5 Perl/v5.8.9
 377 | Last-Modified: Tue, 20 Nov 2012 12:28:52 GMT
 378 | ETag: "336386-2940-4ceec6069e900"
 379 | Accept-Ranges: bytes
 380 | Content-Length: 10560
 381 | Connection: close
 382 | Content-Type: text/html
 383 | 
 384 | ((:DATE . "Sun, 09 Dec 2012 08:25:56 GMT")
 385 |  (:SERVER . "Apache/2.2.22 (Unix) mod_ssl/2.2.22 OpenSSL/1.0.1c mod_apreq2-20051231/2.6.0 mod_perl/2.0.5 Perl/v5.8.9")
 386 |  (:LAST-MODIFIED . "Tue, 20 Nov 2012 12:28:52 GMT") (:ETAG . "\"336386-2940-4ceec6069e900\"") (:ACCEPT-RANGES . "bytes")
 387 |  (:CONTENT-LENGTH . "10560") (:CONNECTION . "close") (:CONTENT-TYPE . "text/html"))
 388 |
389 | 390 | 391 |

392 | Drakma supports basic authorization. In this example, we use 393 | a locally running Hunchentoot server. 395 |

396 | 
? (ql:quickload :hunchentoot-test)
 397 | To load "hunchentoot-test":
 398 |   Load 4 ASDF systems:
 399 |     cl-ppcre cl-who drakma hunchentoot
 400 |   Install 1 Quicklisp release:
 401 |     hunchentoot
 402 | ...
 403 | ; Loading "hunchentoot-test"
 404 | 
 405 | (:HUNCHENTOOT-TEST)
 406 | ? (hunchentoot:start (make-instance 'hunchentoot:easy-acceptor :port 4242))
 407 | #<EASY-ACCEPTOR (host *, port 4242)>
 408 | ? (nth-value 1 (drakma:http-request "http://localhost:4242/hunchentoot/test/authorization.html"))
 409 | GET /hunchentoot/test/authorization.html HTTP/1.1
 410 | Host: localhost:4242
 411 | User-Agent: Drakma/1.3.0 (Clozure Common Lisp Version 1.8-r15286M  (DarwinX8664); Darwin; 12.2.0; http://weitz.de/drakma/)
 412 | Accept: */*
 413 | Connection: close
 414 | 
 415 | 127.0.0.1 - [2012-12-09 09:27:40] "GET /hunchentoot/test/authorization.html HTTP/1.1" 401 543 "-" "Drakma/1.3.0 (Clozure Common Lisp Version 1.8-r15286M  (DarwinX8664); Darwin; 12.2.0; http://weitz.de/drakma/)"
 416 | HTTP/1.1 401 Authorization Required
 417 | Content-Length: 543
 418 | Date: Sun, 09 Dec 2012 08:27:40 GMT
 419 | Server: Hunchentoot 1.2.5
 420 | Connection: Close
 421 | Www-Authenticate: Basic realm="Hunchentoot"
 422 | Content-Type: text/html; charset=iso-8859-1
 423 | 
 424 | 401
 425 | ? (nth-value 1 (drakma:http-request "http://localhost:4242/hunchentoot/test/authorization.html"
 426 |                                     :basic-authorization '("nanook" "igloo")))
 427 | GET /hunchentoot/test/authorization.html HTTP/1.1
 428 | Host: localhost:4242
 429 | User-Agent: Drakma/1.3.0 (Clozure Common Lisp Version 1.8-r15286M  (DarwinX8664); Darwin; 12.2.0; http://weitz.de/drakma/)
 430 | Authorization: Basic bmFub29rOmlnbG9v
 431 | Accept: */*
 432 | Connection: close
 433 | 
 434 | 127.0.0.1 nanook [2012-12-09 09:28:15] "GET /hunchentoot/test/authorization.html HTTP/1.1" 200 907 "-" "Drakma/1.3.0 (Clozure Common Lisp Version 1.8-r15286M  (DarwinX8664); Darwin; 12.2.0; http://weitz.de/drakma/)"
 435 | HTTP/1.1 200 OK
 436 | Content-Length: 907
 437 | Date: Sun, 09 Dec 2012 08:28:15 GMT
 438 | Server: Hunchentoot 1.2.5
 439 | Connection: Close
 440 | Content-Type: text/html; charset=utf-8
 441 | 
 442 | 200
 443 |
444 | 445 | 446 |

447 | Drakma can return a stream to the application so that the 448 | reply is not completely buffered in memory first. 449 |

450 | 
? (let ((stream (drakma:http-request "https://api.github.com/orgs/edicl/public_members"
 451 |                                       :want-stream t)))
 452 |     (setf (flexi-streams:flexi-stream-external-format stream) :utf-8)
 453 |     (yason:parse stream :object-as :plist))
 454 | GET /orgs/edicl/public_members HTTP/1.1
 455 | Host: api.github.com
 456 | User-Agent: Drakma/1.3.0 (SBCL 1.1.1.31.master.2-9fac43f-dirty; Darwin; 12.2.0; http://weitz.de/drakma/)
 457 | Accept: */*
 458 | Connection: close
 459 | 
 460 | HTTP/1.1 200 OK
 461 | Server: nginx
 462 | Date: Fri, 28 Dec 2012 10:27:34 GMT
 463 | Content-Type: application/json; charset=utf-8
 464 | Connection: close
 465 | Status: 200 OK
 466 | Last-Modified: Sat, 22 Dec 2012 18:39:14 GMT
 467 | X-Content-Type-Options: nosniff
 468 | X-RateLimit-Limit: 60
 469 | X-GitHub-Media-Type: github.beta
 470 | Vary: Accept
 471 | Content-Length: 1899
 472 | Cache-Control: public, max-age=60, s-maxage=60
 473 | ETag: "66a5dd35e79146a53029a1807293f9d3"
 474 | X-RateLimit-Remaining: 56
 475 | 
 476 | (("type" "User" "repos_url" "https://api.github.com/users/hanshuebner/repos" "followers_url"
 477 |   "https://api.github.com/users/hanshuebner/followers" "login" "hanshuebner" "gists_url"
 478 |   "https://api.github.com/users/hanshuebner/gists{/gist_id}" "following_url"
 479 |   "https://api.github.com/users/hanshuebner/following" "events_url"
 480 |   "https://api.github.com/users/hanshuebner/events{/privacy}" "organizations_url"
 481 |   "https://api.github.com/users/hanshuebner/orgs" "received_events_url"
 482 |   "https://api.github.com/users/hanshuebner/received_events" "url"
 483 |   "https://api.github.com/users/hanshuebner" "avatar_url"
 484 |   "https://secure.gravatar.com/avatar/280d76aa82179ae04550534649de1e6e?d=https://a248.e.akamai.net/assets.github.com%2Fimages%2Fgravatars%2Fgravatar-user-420.png"
 485 |   "subscriptions_url" "https://api.github.com/users/hanshuebner/subscriptions" "starred_url"
 486 |   "https://api.github.com/users/hanshuebner/starred{/owner}{/repo}" "id" 108751 "gravatar_id"
 487 |   "280d76aa82179ae04550534649de1e6e")
 488 |  ("type" "User" "repos_url" "https://api.github.com/users/nhabedi/repos" "followers_url"
 489 |   "https://api.github.com/users/nhabedi/followers" "login" "nhabedi" "gists_url"
 490 |   "https://api.github.com/users/nhabedi/gists{/gist_id}" "following_url"
 491 |   "https://api.github.com/users/nhabedi/following" "events_url"
 492 |   "https://api.github.com/users/nhabedi/events{/privacy}" "organizations_url"
 493 |   "https://api.github.com/users/nhabedi/orgs" "received_events_url"
 494 |   "https://api.github.com/users/nhabedi/received_events" "url"
 495 |   "https://api.github.com/users/nhabedi" "avatar_url"
 496 |   "https://secure.gravatar.com/avatar/24c09c7b0b2c0481283d854bacdd7926?d=https://a248.e.akamai.net/assets.github.com%2Fimages%2Fgravatars%2Fgravatar-user-420.png"
 497 |   "subscriptions_url" "https://api.github.com/users/nhabedi/subscriptions" "starred_url"
 498 |   "https://api.github.com/users/nhabedi/starred{/owner}{/repo}" "id" 537618 "gravatar_id"
 499 |   "24c09c7b0b2c0481283d854bacdd7926"))
 500 |
501 | 502 | 503 |

504 | Request contents can be assembled from various sources, and 505 | chunked encoding can be used by request bodies. Many servers 506 | do not support chunked encoding for request bodies, though. 507 |

508 | 
? (let ((temp-file (ensure-directories-exist #p"/tmp/quux.txt"))
 509 |         (continuation (drakma:http-request "http://localhost:4242/hunchentoot/test/parameter_latin1_post.html"
 510 |                                            :method :post
 511 |                                            :content :continuation)))
 512 |     (funcall continuation "foo=" t)
 513 |     (funcall continuation (list (char-code #\z) (char-code #\a)) t)
 514 |     (funcall continuation (lambda (stream)
 515 |                             (write-char #\p stream)) t)
 516 |     (with-open-file (out temp-file
 517 |                          :direction :output
 518 |                          :if-does-not-exist :create
 519 |                          :if-exists :supersede)
 520 |       (write-string "p" out))
 521 |     (funcall continuation temp-file t)
 522 |     (cl-ppcre:scan-to-strings "zappzerapp" (funcall continuation "zerapp")))
 523 | POST /hunchentoot/test/parameter_latin1_post.html HTTP/1.1
 524 | Host: localhost:4242
 525 | User-Agent: Drakma/1.3.0 (Clozure Common Lisp Version 1.8-r15286M  (DarwinX8664); Darwin; 12.2.0; http://weitz.de/drakma/)
 526 | Accept: */*
 527 | Connection: close
 528 | Content-Type: application/x-www-form-urlencoded
 529 | Transfer-Encoding: chunked
 530 | 
 531 | 127.0.0.1 - [2012-12-09 10:06:44] "POST /hunchentoot/test/parameter_latin1_post.html HTTP/1.1" 200 1312 "-" "Drakma/1.3.0 (Clozure Common Lisp Version 1.8-r15286M  (DarwinX8664); Darwin; 12.2.0; http://weitz.de/drakma/)"
 532 | HTTP/1.1 200 OK
 533 | Content-Length: 1312
 534 | Date: Sun, 09 Dec 2012 09:06:44 GMT
 535 | Server: Hunchentoot 1.2.5
 536 | Connection: Close
 537 | Last-Modified: Sun, 09 Dec 2012 09:06:44 GMT
 538 | Pragma: no-cache
 539 | Cache-Control: no-store, no-cache, must-revalidate, post-check=0, pre-check=0
 540 | Expires: Mon, 26 Jul 1997 05:00:00 GMT
 541 | Content-Type: text/html; charset=ISO-8859-1
 542 | 
 543 | "zappzerapp"
 544 | #()
 545 |
546 | 547 | 548 |

549 | Partial transfers of resources are possible. 551 |

552 | 
? (cl-ppcre:regex-replace-all
 553 |    "<.*?>"
 554 |    (format nil "~A~%~A"
 555 |            (drakma:http-request "http://members.shaw.ca/mitb/hunchentoot.html"
 556 |                                 :range '(998 1034))
 557 |            (drakma:http-request "http://members.shaw.ca/mitb/hunchentoot.html"
 558 |                                 :range '(1213 1249)))
 559 |    "")
 560 | GET /mitb/hunchentoot.html HTTP/1.1
 561 | Host: members.shaw.ca
 562 | User-Agent: Drakma/1.3.0 (Clozure Common Lisp Version 1.8-r15286M  (DarwinX8664); Darwin; 12.2.0; http://weitz.de/drakma/)
 563 | Accept: */*
 564 | Connection: close
 565 | Range: bytes=998-1034
 566 | 
 567 | HTTP/1.1 206 Partial Content
 568 | Date: Sun, 09 Dec 2012 09:16:16 GMT
 569 | Server: Apache/2.2.20 (Unix) mod_ldap_userdir/1.1.17
 570 | Last-Modified: Wed, 14 Mar 2012 23:22:04 GMT
 571 | ETag: "3b7eed-3238-4bb3c3e453f00"
 572 | Accept-Ranges: bytes
 573 | Content-Length: 37
 574 | Content-Range: bytes 998-1034/12856
 575 | Content-Type: text/html
 576 | Connection: close
 577 | 
 578 | GET /mitb/hunchentoot.html HTTP/1.1
 579 | Host: members.shaw.ca
 580 | User-Agent: Drakma/1.3.0 (Clozure Common Lisp Version 1.8-r15286M  (DarwinX8664); Darwin; 12.2.0; http://weitz.de/drakma/)
 581 | Accept: */*
 582 | Connection: close
 583 | Range: bytes=1213-1249
 584 | 
 585 | HTTP/1.1 206 Partial Content
 586 | Date: Sun, 09 Dec 2012 09:16:16 GMT
 587 | Server: Apache/2.2.20 (Unix) mod_ldap_userdir/1.1.17
 588 | Last-Modified: Wed, 14 Mar 2012 23:22:04 GMT
 589 | ETag: "3b7eed-3238-4bb3c3e453f00"
 590 | Accept-Ranges: bytes
 591 | Content-Length: 37
 592 | Content-Range: bytes 1213-1249/12856
 593 | Content-Type: text/html
 594 | 
 595 | "DRAKMA (Queen of Cosmic Greed)
 596 | HUNCHENTOOT (The Giant Spider)"
 597 | T
 598 |
599 | 600 | 601 | 602 | 603 |

604 | Drakma depends on a number of open source libraries, so the 605 | preferred method to download, compile and load it is via Quicklisp. Drakma's 607 | current version number is . 608 |

609 |

610 | The canonical location for the latest version of Drakma is http://weitz.de/files/drakma.tar.gz. 612 |

613 | 614 | 615 | 616 |

617 | The development version of Drakma can be found on 619 | github. Please use the github issue tracking system to 620 | submit bug reports. Patches are welcome, please use GitHub pull 622 | requests. If you want to make a change, please read this 624 | first. 625 |

626 | 627 | 628 | 629 | 630 | 631 | 632 |

633 | The HTTP-REQUEST function is the heart of 634 | Drakma. It is used to send requests to web servers and will 635 | either return the message body of the server's reply or (if 636 | the user so wishes) a stream one can read from. The wealth of 637 | keyword parameters might look a bit intimidating first, but 638 | you will rarely need more than two or three of them - the 639 | default behavior of Drakma is (hopefully) designed to do The 640 | Right Thing[TM] in most cases. 641 |

642 |

643 | You can use the *HEADER-STREAM* variable 644 | to debug requests handled by Drakma in a way similar to LiveHTTPHeaders. 646 |

647 | 648 | 649 | 650 | [Function]
651 | http-request uri
&rest args
652 |
&key 653 | protocol 654 | method 655 | force-ssl 656 | certificate 657 | key 658 | certificate-password 659 | verify 660 | max-depth 661 | ca-file 662 | ca-directory 663 | parameters 664 | url-encoder 665 | content 666 | content-type 667 | content-length 668 | form-data 669 | cookie-jar 670 | basic-authorization 671 | user-agent 672 | accept 673 | range 674 | proxy 675 | proxy-basic-authorization 676 | real-host 677 | additional-headers 678 | redirect 679 | auto-referer 680 | keep-alive 681 | close 682 | external-format-out 683 | external-format-in 684 | force-binary 685 | want-stream 686 | stream 687 | preserve-uri 688 | connection-timeout 689 | deadline 690 |
691 |
692 | => body-or-stream0, status-code1, 693 | headers2, uri3, stream4, 694 | must-close5, 695 | reason-phrase6 696 |
697 | 698 | 699 |

700 | Sends an HTTP 702 | request to a web server and returns its reply. 703 | uri is where the request is sent to, 704 | and it is either a string denoting a uniform resource 705 | identifier or a PURI:URI object. The scheme 706 | of uri must be `http' or `https'. 707 | The function returns SEVEN values - the body of the 708 | reply0 (but see below), the status 709 | code1 as an integer, an alist of the 710 | headers2 sent by the server where for each 711 | element the car (the name of the header) is a keyword and 712 | the cdr (the value of the header) is a string, the 713 | uri3 the reply comes from (which might be 714 | different from the uri the request 715 | was sent to in case of redirects), the stream4 716 | the reply was read from, a generalized boolean5 717 | which denotes whether the stream should be closed (and 718 | which you can usually ignore), and finally the reason 719 | phrase6 from the status line as a string. 720 |

721 |

722 | 723 | protocol is the HTTP protocol version 724 | which is going to be used in the request line. It must be 725 | one of the keywords :HTTP/1.0 or 726 | :HTTP/1.1. 727 |

728 |

729 | 730 | method is the method used in the 731 | request line, a keyword (like :GET or 732 | :HEAD) denoting a valid HTTP/1.1 or WebDAV 733 | request method, or :REPORT, as described in 734 | the Versioning Extensions to WebDAV. Additionally, you 735 | can also use the pseudo method :OPTIONS* 736 | which is like :OPTIONS but means that an 737 | "OPTIONS *" request line will be sent, i.e. the 738 | uri's path and query parts will be 739 | ignored. 740 |

741 |

742 | If force-ssl is true, SSL will be 743 | attached to the socket stream which connects Drakma with 744 | the web server. Usually, you don't have to provide this 745 | argument, as SSL will be attached anyway if the scheme of 746 | uri is `https'. 747 |

748 |

750 | certificate is the file name of the PEM 751 | encoded client certificate to present to the server when 752 | making a SSL connection. key specifies 753 | the file name of the PEM encoded private key matching the 754 | certificate. certificate-password 755 | specifies the pass phrase to use to decrypt the private key. 756 |

757 |

758 | 759 | verify can be specified to force 760 | verification of the certificate that is presented by the 761 | server in an SSL connection. It can be specified either 762 | as NIL if no check should be performed, 763 | :OPTIONAL to verify the server's certificate 764 | if it presented one or :REQUIRED to verify 765 | the server's certificate and fail if an invalid or no 766 | certificate was presented. 767 |

768 |

769 | 770 | max-depth can be specified to change 771 | the maximum allowed certificate signing depth that is 772 | accepted. The default is 10. 773 |

774 |

775 | 776 | 777 | ca-file and 778 | ca-directory can be specified to set 779 | the certificate authority bundle file or directory to use 780 | for certificate validation. 781 |

782 |

783 | The certificate, 784 | key, 785 | certificate-password, 786 | verify, 787 | max-depth, 788 | ca-file and 789 | ca-directory parameters are ignored 790 | for non-SSL requests. They are also ignored on LispWorks. 791 |

792 |

793 | 794 | 795 | parameters is an alist of name/value 796 | pairs (the car and the cdr each being a string) which 797 | denotes the parameters which are added to the query part 798 | of the URL or (in the case of a POST request) comprise the 799 | body of the request. (But see 800 | content below.) The values can also 801 | be NIL in which case only the name (without 802 | an equal sign) is used in the query string. The 803 | name/value pairs are URL-encoded using the FLEXI-STREAMS 804 | external format external-format-out 805 | before they are sent to the server unless 806 | form-data is true in which case the 807 | POST request body is sent as `multipart/form-data' using 808 | external-format-out. The values of 809 | the parameters alist can also be 810 | pathnames, open binary input streams, unary functions, or 811 | lists where the first element is of one of the former 812 | types. These values denote files which should be sent as 813 | part of the request body. If files are present in 814 | parameters, the content type of the 815 | request is always `multipart/form-data'. If the value is 816 | a list, the part of the list behind the first element is 817 | treated as a plist which can be used to specify a content 818 | type and/or a filename for the file, i.e. such a value 819 | could look like, e.g., (#p"/tmp/my_file.doc" 820 | :content-type "application/msword" :filename 821 | "upload.doc"). 822 |

823 |

824 | 825 | url-encoder specifies a custom URL 826 | encoder function which will be used by drakma to 827 | URL-encode parameter names and values. It needs to be a 828 | function of two arguments. The arguments are the string 829 | to encode and the external format to use (as accepted by 830 | FLEXI-STREAMS:STRING-TO-OCTETS). The return value must be 831 | the URL-encoded string. This can be used if specific 832 | encoding rules are required. 833 |

834 |

835 | 836 | 837 | content, if not NIL, is 838 | used as the request body - parameters 839 | is ignored in this case. content can 840 | be a string, a sequence of octets, a pathname, an open 841 | binary input stream, or a function designator. If 842 | content is a sequence, it will be 843 | directly sent to the server (using 844 | external-format-out in the case of 845 | strings). If content is a pathname, 846 | the binary contents of the corresponding file will be sent 847 | to the server. If content is a 848 | stream, everything that can be read from the stream until 849 | EOF will be sent to the server. If 850 | content is a function designator, the 851 | corresponding function will be called with one argument, 852 | the stream to the server, to which it should send data. 853 |

854 |

855 | Finally, content can also be the 856 | keyword :CONTINUATION in which case 857 | HTTP-REQUEST returns only one value - 858 | a `continuation' function. This function has one required 859 | argument and one optional argument. The first argument 860 | will be interpreted like content 861 | above (but it cannot be a keyword), i.e. it will be sent 862 | to the server according to its type. If the second 863 | argument is true, the continuation function can be called 864 | again to send more content, if it is NIL the 865 | continuation function returns what 866 | HTTP-REQUEST would have returned. 867 |

868 |

869 | If content is a sequence, Drakma will 870 | use LENGTH to determine its length and will use the result 871 | for the `Content-Length' header sent to the server. You 872 | can overwrite this with the 873 | content-length parameter (a 874 | non-negative integer) which you can also use for the cases 875 | where Drakma can't or won't determine the content length 876 | itself. You can also explicitly provide a 877 | content-length argument of 878 | NIL which will imply that no `Content-Length' 879 | header will be sent in any case. If no `Content-Length' 880 | header is sent, Drakma will use chunked encoding to send 881 | the content body. Note that this will not work with older 882 | web servers. 883 |

884 |

885 | 886 | Providing a true content-length 887 | argument which is not a non-negative integer means that 888 | Drakma /must/ build the request body in RAM and compute 889 | the content length even if it would have otherwise used 890 | chunked encoding, for example in the case of file uploads. 891 |

892 |

893 | 894 | content-type is the corresponding 895 | `Content-Type' header to be sent and will be ignored 896 | unless content is provided as well. 897 |

898 |

899 | Note that a query already contained in 900 | uri will always be sent with the 901 | request line anyway in addition to other parameters sent 902 | by Drakma. 903 |

904 |

905 | 906 | cookie-jar is a cookie jar containing 907 | cookies which will potentially be sent to the server (if 908 | the domain matches, if they haven't expired, etc.) - this 909 | cookie jar will be modified according to the `Set-Cookie' 910 | header(s) sent back by the server. 911 |

912 |

913 | 914 | basic-authorization, if not 915 | NIL, should be a list of two strings 916 | (username and password) which will be sent to the server 917 | for basic authorization. 918 |

919 |

920 | 921 | user-agent, if not NIL, 922 | denotes which `User-Agent' header will be sent with the 923 | request. It can be one of the keywords 924 | :DRAKMA, :FIREFOX, 925 | :EXPLORER, :OPERA, or 926 | :SAFARI which denote the current version of 927 | Drakma or, in the latter four cases, a fixed string 928 | corresponding to a more or less recent (as of August 2006) 929 | version of the corresponding browser. Or it can be a 930 | string which is used directly. 931 |

932 |

933 | 934 | accept, if not NIL, 935 | specifies the contents of the `Accept' header sent. 936 |

937 |

938 | 939 | range optionally specifies a subrange 940 | of the resource to be requested. It must be specified as 941 | a list of two integers which indicate the start and 942 | (inclusive) end offset of the requested range, in bytes 943 | (i.e. octets). 944 |

945 |

946 | 947 | 948 | If proxy is not NIL, it 949 | should be a string denoting a proxy server through which 950 | the request should be sent. Or it can be a list of two 951 | values - a string denoting the proxy server and an integer 952 | denoting the port to use (which will default to 80 953 | otherwise). Defaults to 954 | *default-http-proxy*. 955 | proxy-basic-authorization is used 956 | like basic-authorization, but for the 957 | proxy, and only if proxy is true. If 958 | the host portion of the uri is present in the 959 | *NO-PROXY-DOMAINS* or the 960 | NO-PROXY-DOMAINS list then the proxy 961 | setting will be ignored for this request. 962 |

963 |

964 | If NO-PROXY-DOMAINS is set then it 965 | will supersede the *NO-PROXY-DOMAINS* 966 | variable. Inserting domains into this list will allow them 967 | to ignore the proxy setting. 968 |

969 |

970 | 971 | If real-host is not NIL, 972 | request is sent to the denoted host instead of the 973 | uri host. When specified, 974 | real-host supersedes 975 | proxy. 976 |

977 |

978 | 979 | additional-headers is a name/value 980 | alist of additional HTTP headers which should be sent with 981 | the request. Unlike in parameters, 982 | the cdrs can not only be strings but also designators for 983 | unary functions (which should in turn return a string) in 984 | which case the function is called each time the header is 985 | written. 986 |

987 |

988 | 989 | 990 | If redirect is not NIL, 991 | it must be a non-negative integer or T. If 992 | redirect is true, Drakma will follow 993 | redirects (return codes 301, 302, 303, or 307) unless 994 | redirect is 0. If 995 | redirect is an integer, it will be 996 | decreased by 1 with each redirect. Furthermore, if 997 | auto-referer is true when following 998 | redirects, Drakma will populate the `Referer' header with 999 | the uri that triggered the 1000 | redirection, overwriting an existing `Referer' header (in 1001 | additional-headers) if necessary. 1002 |

1003 |

1004 | 1005 | 1006 | If keep-alive is T, the server will 1007 | be asked to keep the connection alive, i.e. not to close 1008 | it after the reply has been sent. (Note that this not 1009 | necessary if both the client and the server use HTTP 1.1.) 1010 | If close is T, the server is 1011 | explicitly asked to close the connection after the reply 1012 | has been sent. keep-alive and 1013 | close are obviously mutually 1014 | exclusive. 1015 |

1016 |

1017 | 1018 | 1019 | If the message body sent by the server has a text content 1020 | type, Drakma will try to return it as a Lisp string. 1021 | It'll first check if the `Content-Type' header denotes an 1022 | encoding to be used, or otherwise it will use the 1023 | external-format-in argument. The 1024 | body is decoded using FLEXI-STREAMS. If FLEXI-STREAMS 1025 | doesn't know the external format, the body is returned as 1026 | an array of octets. If the body is empty, Drakma will 1027 | return NIL. 1028 |

1029 |

1030 | If the message body doesn't have a text content type or if 1031 | force-binary is true, the body is 1032 | always returned as an array of octets. 1033 |

1034 |

1035 | 1036 | If want-stream is true, the message 1037 | body is NOT read and instead the (open) socket stream is 1038 | returned as the first return value. If the sixth value of 1039 | HTTP-REQUEST is true, the stream 1040 | should be closed (and not be re-used) after the body has 1041 | been read. The stream returned is a flexi-stream 1043 | with a chunked stream as its underlying stream. 1045 | If you want to read binary data from this stream, read 1046 | from the underlying stream which you can get with 1047 | FLEXI-STREAM-STREAM. 1048 |

1049 |

1050 | 1051 | Drakma will usually create a new socket connection for 1052 | each HTTP request. However, you can use the 1053 | stream argument to provide an open 1054 | socket stream which should be re-used. 1055 | stream MUST be a stream returned by a 1056 | previous invocation of HTTP-REQUEST 1057 | where the sixth return value wasn't true. Obviously, it 1058 | must also be connected to the correct server and at the 1059 | right position (i.e. the message body, if any, must have 1060 | been read). Drakma will NEVER attach SSL to a stream 1061 | provided as the stream argument. 1062 |

1063 |

1064 | 1065 | connection-timeout is the time (in 1066 | seconds) Drakma will wait until it considers an attempt to 1067 | connect to a server as a failure. It is supported only on 1068 | some platforms (currently abcl, clisp, LispWorks, mcl, 1069 | openmcl and sbcl). READ-TIMEOUT and WRITE-TIMEOUT are the 1070 | read and write timeouts (in seconds) for the socket stream 1071 | to the server. All three timeout arguments can also be 1072 | NIL (meaning no timeout), and they don't 1073 | apply if an existing stream is re-used. READ-TIMEOUT 1074 | argument is only available for LispWorks, WRITE-TIMEOUT is 1075 | only available for LispWorks 5.0 or higher. 1076 |

1077 |

1078 | 1079 | deadline, a time in the future, 1080 | specifies the time until which the request should be 1081 | finished. The deadline is specified in internal time 1082 | units. If the server fails to respond until that time, a 1083 | COMMUNICATION-DEADLINE-EXPIRED condition is signalled. 1084 | deadline is only available on CCL 1.2 1085 | and later. 1086 |

1087 |

1088 | 1089 | If preserve-uri is not 1090 | NIL, the given uri will 1091 | not be processed. This means that the 1092 | uri will be sent as-is to the remote 1093 | server and it is the responsibility of the client to make 1094 | sure that all parameters are encoded properly. Note that 1095 | if this parameter is given, and the request is not a POST 1096 | with a content-type of `multipart/form-data', 1097 | parameters will not be used. 1098 |

1099 |

1100 | If decode-content is not 1101 | NIL, then the content will automatically be 1102 | decoded according to any encodings specified in the 1103 | Content-Encoding header. The actual decoding is done by 1104 | the decode-stream generic function, 1105 | and you can implement new methods to support additional 1106 | encodings. Any encodings in Transfer-Encoding, such as 1107 | chunking, are always performed. 1108 |

1109 | 1110 | 1111 | 1112 | 1113 | name parameters 1114 | boolean 1115 | 1116 |

1117 | If parameters is an alist of 1118 | parameters as returned by, for example, 1119 | READ-TOKENS-AND-PARAMETERS and name 1120 | is a string naming a parameter, this function returns the 1121 | full parameter (name and value) - or NIL if 1122 | it's not in parameters. 1123 |

1124 | 1125 | 1126 | 1127 | 1128 | name parameters 1129 | (or string null) 1130 | 1131 |

1132 | If parameters is an alist of 1133 | parameters as returned by, for example, 1134 | READ-TOKENS-AND-PARAMETERS and name 1135 | is a string naming a parameter, this function returns the 1136 | value of this parameter - or NIL if it's not 1137 | in parameters. 1138 |

1139 | 1140 | 1141 | 1142 | 1143 | string external-format 1144 | string 1145 | 1146 |

1147 | Returns a URL-encoded version of the string 1148 | string using the external format 1149 | external-format. 1150 |

1151 | 1152 | 1153 | 1154 | 1155 | encoding-type stream 1156 | stream 1157 | 1158 |

1159 | Generic function to decode a stream. This is a generic 1160 | function which decodes the stream based on the 1161 | encoding-type. If a response contains one or more 1162 | transfer or content encodings, then decode-stream is 1163 | called for each encoding type in the correct order to 1164 | properly decode the stream to its original content. 1165 |

1166 |

1167 | encoding-type will be a keyword 1168 | created by upcasing and interning the encoding type from 1169 | the header. stream will be the 1170 | stream that needs to be 1171 | decoded. decode-stream returns a new 1172 | stream from which you can read the decoded data. 1173 |

1174 | 1175 | 1176 | 1177 | 1178 | 1179 |

1180 | A function which determines whether the content body 1181 | returned by the server is text and should be treated as 1182 | such or not. The function is called after the request 1183 | headers have been read and it must 1184 | accept two arguments, headers and 1185 | external-format-in, where 1186 | headers is like the third return value 1187 | of HTTP-REQUEST while 1188 | external-format-in is the 1189 | HTTP-REQUEST argument of the same 1190 | name. It should return NIL if the body 1191 | should be regarded as binary content, or a FLEXI-STREAMS 1193 | external format (which will be used to read the body) 1194 | otherwise. 1195 |

1196 |

1197 | This function will only be called if the force-binary 1199 | argument to HTTP-REQUEST is 1200 | NIL. 1201 |

1202 |

1203 | The initial value of this variable is a function which 1204 | uses *TEXT-CONTENT-TYPES* to 1205 | determine whether the body is text and then proceeds as 1206 | described in the HTTP-REQUEST 1207 | documentation entry. 1208 |

1209 | 1210 | 1211 | 1212 | 1213 | 1214 |

1215 | HTTP proxy to be used as default for the proxy keyword 1216 | argument of HTTP-REQUEST. If not 1217 | NIL, it should be a string denoting a proxy 1218 | server through which the request should be sent. Or it 1219 | can be a list of two values - a string denoting the proxy 1220 | server and an integer denoting the port to use (which 1221 | will default to 80 otherwise). 1222 |

1223 | 1224 | 1225 | 1226 | 1227 | 1228 |

1229 | A list of domains for which a proxy should not be used. 1230 |

1231 | 1232 | 1233 | 1234 | 1235 | 1236 |

1237 | The default value for the external format keyword 1238 | arguments of HTTP-REQUEST. The value 1239 | of this variable will be interpreted by FLEXI-STREAMS. 1241 | The initial value is the keyword :LATIN-1. 1242 | (Note that Drakma binds *DEFAULT-EOL-STYLE* 1244 | to :LF). 1245 |

1246 | 1247 | 1248 | 1249 | 1250 | 1251 |

1252 | If this variable is not NIL, it should be 1253 | bound to a stream to which incoming and outgoing headers 1254 | will be written for debugging purposes. 1255 |

1256 | 1257 | 1258 | 1259 | 1260 | 1261 |

1262 | A list of conses which are used by the default value of 1263 | *BODY-FORMAT-FUNCTION* to decide 1264 | whether a 'Content-Type' header denotes text content. The 1265 | car and cdr of each cons should each be a string or 1266 | NIL. A content type matches one of these 1267 | entries (and thus denotes text) if the type part is STRING-EQUAL 1269 | to the car or if the car is NIL and if the 1270 | subtype part is STRING-EQUAL 1272 | to the cdr or if the cdr is NIL. 1273 |

1274 |

1275 | The initial value of this variable is the list 1276 | 

(("text" . nil))
which means that every content 1277 | type that starts with "text/" is regarded as text, no 1278 | matter what the subtype is. 1279 |

1280 | 1281 | 1282 | 1283 | 1284 | 1285 | 1286 |

1287 | This section assembles a couple of convenience functions which 1288 | can be used to access information returned as the third value 1289 | (headers) of 1290 | HTTP-REQUEST. 1291 |

1292 |

1293 | Note that if the server sends multiple 1295 | headers with the same name, these are comprised into one 1296 | entry by HTTP-REQUEST. The values are 1297 | separated by commas. 1298 |

1299 | 1300 | 1301 | headers 1302 | list 1303 | 1304 |

1305 | Reads and parses a `Content-Type' header and returns it as 1306 | three values - the type, the subtype, and an alist 1307 | (possibly empty) of name/value pairs for the optional 1308 | parameters. headers is supposed to 1309 | be an alist of headers as returned by 1310 | HTTP-REQUEST. Returns 1311 | NIL if there is no such header amongst 1312 | headers. 1313 |

1314 | 1315 | 1316 | 1317 | 1318 | name headers 1319 | (or string null) 1320 | 1321 |

1322 | If headers is an alist of headers as 1323 | returned by HTTP-REQUEST and 1324 | name is a keyword naming a header, 1325 | this function returns the corresponding value of this 1326 | header (or NIL if it's not in 1327 | headers). 1328 |

1329 | 1330 | 1331 | 1332 | 1333 | string &key value-required-p 1334 | list 1335 | 1336 |

1337 | Reads a comma-separated list of tokens from the string 1338 | string. Each token can be followed 1339 | by an optional, semicolon-separated list of 1340 | attribute/value pairs where the attributes are tokens 1341 | followed by a #\= character and a token or a quoted 1342 | string. Returned is a list where each element is either a 1343 | string (for a simple token) or a cons of a string (the 1344 | token) and an alist (the attribute/value pairs). If 1345 | value-required-p is NIL, 1346 | the value part (including the #\= character) of each 1347 | attribute/value pair is optional. 1348 |

1349 | 1350 | 1351 | 1352 | 1353 | string 1354 | list 1355 | 1356 |

1357 | Splits the string string into a list 1358 | of substrings separated by commas and optional whitespace. 1359 | Empty substrings are ignored. 1360 |

1361 | 1362 | 1363 | 1364 | 1365 | 1366 | 1367 |

1368 | HTTP-REQUEST can deal with HTTP 1370 | cookies if it gets a cookie jar, 1371 | a collection of COOKIE objects, as its cookie-jar argument. Cookies sent 1373 | by the web server will be added to the cookie jar (or updated) 1374 | if appropriate and cookies already in the cookie jar will be 1375 | sent to the server together with the request. 1376 |

1377 |

1378 | Drakma will never remove cookies from a cookie jar 1379 | automatically. You have to do it manually using 1380 | DELETE-OLD-COOKIES. 1381 |

1382 | 1383 | 1384 | 1385 |

1386 | Instances of this class represent HTTP 1388 | cookies. If you need to create your own cookies, you 1389 | should use MAKE-INSTANCE 1391 | with the initargs :NAME, :DOMAIN, 1392 | :VALUE, :PATH, 1393 | :EXPIRES, :SECUREP, and 1394 | :HTTP-ONLY-P all of which are optional except 1395 | for the first two. The meaning of these initargs and the corresponding accessors should 1397 | be pretty clear if one looks at the original 1399 | cookie specification (and at this 1401 | page for the HttpOnly extension). 1402 |

1403 | 
? (make-instance 'drakma:cookie
1404 |                  :name "Foo" 
1405 |                  :value "Bar"
1406 |                  :expires (+ (get-universal-time) 3600)
1407 |                  :domain ".weitz.de")
1408 | #<COOKIE Foo=Bar; expires=Sun, 09-12-2012 20:37:42 GMT; path=/; domain=.weitz.de>
1409 |
1410 | 1411 | 1412 | 1413 | 1414 | string 1415 | universal-time 1416 | 1417 |

1418 | Parses a cookie expiry date and returns it as a Lisp universal 1420 | time. Currently understands the following formats: 1421 |

1422 | 
"Wed, 06-Feb-2008 21:01:38 GMT"
1423 | "Wed, 06-Feb-08 21:01:38 GMT"
1424 | "Tue Feb 13 08:00:00 2007 GMT"
1425 | "Wednesday, 07-February-2027 08:55:23 GMT"
1426 | "Wed, 07-02-2017 10:34:45 GMT"
1427 |

1428 | Instead of "GMT" time zone abbreviations like "CEST" and UTC 1429 | offsets like "GMT-01:30" are also allowed. 1430 |

1431 |

1432 | While this function has "cookie" in its name, it might 1433 | come in handy in other situations as well and it is thus 1434 | exported as a convenience function. 1435 |

1436 | 1437 | 1438 | 1439 | 1440 | cookie1 cookie2 1441 | boolean 1442 | 1443 | Returns a true value if the cookies 1444 | cookie1 and 1445 | cookie2 are equal. Two cookies are 1446 | considered to be equal if name and path are equal. 1447 | 1448 | 1449 | 1450 | 1451 | 1452 | cookie 1453 | string 1454 | 1455 | 1456 | cookie 1457 | (or string null) 1458 | 1459 | 1460 | cookie 1461 | string 1462 | 1463 | 1464 | cookie 1465 | (or string null) 1466 | 1467 | 1468 | cookie 1469 | (or integer null) 1470 | 1471 | 1472 | cookie 1473 | boolean 1474 | 1475 | 1476 | cookie 1477 | boolean 1478 | 1479 | 1480 | 1481 | 1482 | 1483 |

1484 | An object of this class encapsulates a collection (a list, 1485 | actually) of COOKIE objects. You create a new 1486 | cookie jar with (MAKE-INSTANCE 'COOKIE-JAR) 1487 | where you can optionally provide a list of 1488 | COOKIE objects with the 1489 | :COOKIES initarg. The cookies in a cookie jar 1490 | are accessed with COOKIE-JAR-COOKIES. 1491 |

1492 | 1493 | 1494 | 1495 | 1496 | 1497 | cookie-jar 1498 | list 1499 | 1500 | 1501 | 1502 | 1503 | cookie-jar 1504 | cookie-jar 1505 | 1506 |

1507 | Removes all cookies from cookie-jar 1508 | which have either expired or which don't have an expiry 1509 | date. 1510 |

1511 | 1512 | 1513 | 1514 | 1515 | 1516 |

1517 | When this variable is not NIL, cookie domains 1518 | containing no dots are considered valid. The default is 1519 | NIL, meaning to disallow such domains except 1520 | for "localhost". 1521 |

1522 | 1523 | 1524 | 1525 | 1526 | 1527 |

1528 | Whether Drakma is allowed to treat `Expires' dates in 1529 | cookie headers as non-existent if it can't parse them. If 1530 | the value of this variable is NIL (which is 1531 | the default), an error will be signalled instead. 1532 |

1533 | 1534 | 1535 | 1536 | 1537 | 1538 |

1539 | Determines how duplicate cookies in the response are 1540 | handled, defaults to T. Cookies are 1541 | considered duplicate using COOKIE=. 1543 |

1544 |

1545 | Valid values are: 1546 |

    1547 |
  • NIL - duplicates will not be 1548 | removed,
    • 1549 |
  • T or :KEEP-LAST - for 1550 | duplicates, only the last cookie value will be kept, 1551 | based on the order of the response header,
    • 1552 |
  • :KEEP-FIRST - for duplicates, only the 1553 | first cookie value will be kept, based on the order of 1554 | the response header.
    • 1555 |
1556 |

1557 |

1558 | Misbehaving servers may send duplicate cookies back in the 1559 | same Set-Cookie header: 1560 |

1561 | 
HTTP/1.1 200  OK
1562 | Server: My-hand-rolled-server
1563 | Date: Wed, 07 Apr 2010 15:12:30 GMT
1564 | Connection: Close
1565 | Content-Type: text/html
1566 | Content-Length: 82
1567 | Set-Cookie: a=1; Path=/; Secure, a=2; Path=/; Secure
1568 |
1569 |

1570 | In this case Drakma has to choose whether cookie "a" has 1571 | the value "1" or "2". By default, Drakma will choose the 1572 | last value specified, in this case "2". 1573 |

1574 |

1575 | By default, Drakma conforms to RFC2109 1577 | HTTP State Management Mechanism, section 4.3.3 Cookie 1578 | Management: 1579 | 1580 |

1581 | 1582 | If a user agent receives a Set-Cookie response header 1583 | whose NAME is the same as a pre-existing cookie, and 1584 | whose Domain and Path attribute values exactly 1585 | (string) match those of a pre-existing cookie, the new 1586 | cookie supersedes the old. 1587 | 1588 |
1589 |

1590 | 1591 | 1592 | 1593 | 1594 | 1595 |

1596 | This section lists all the condition types that are defined by 1597 | Drakma. 1598 |

1599 | 1600 | 1601 | 1602 |

1603 | Signalled if Drakma tries to parse the date of an incoming 1604 | cookie header and can't interpret it. 1605 |

1606 | 1607 | 1608 | 1609 | 1610 | 1611 |

1612 | Signalled if someone tries to create a COOKIE object 1613 | that's not valid. 1614 |

1615 | 1616 | 1617 | 1618 | 1619 | cookie-error 1620 | (or cookie null) 1621 | 1622 |

1623 | The COOKIE object that caused this error. 1624 | Can be NIL in case such an object couldn't be 1625 | initialized. 1626 |

1627 | 1628 | 1629 | 1630 | 1631 | 1632 |

1633 | Signalled if a function was called with inconsistent or 1634 | illegal parameters. 1635 |

1636 | 1637 | 1638 | 1639 | 1640 | 1641 |

1642 | Signalled if Drakma encounters wrong or unknown syntax 1643 | when reading the reply from the server. 1644 |

1645 | 1646 | 1647 | 1648 | 1649 | 1650 |

1651 | Superclass for all conditions related to Drakma. 1652 |

1653 | 1654 | 1655 | 1656 | 1657 | 1658 |

1659 | Superclass for all errors related to Drakma. 1660 |

1661 | 1662 | 1663 | 1664 | 1665 | 1666 |

1667 | Superclass for all warnings related to Drakma. 1668 |

1669 | 1670 | 1671 | 1672 | 1673 | 1674 | 1675 | 1676 | 1677 | 1678 | 1679 | -------------------------------------------------------------------------------- /drakma-test.asd: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- 2 | 3 | ;;; Copyright (c) 2013, Anton Vodonosov. All rights reserved. 4 | 5 | ;;; Redistribution and use in source and binary forms, with or without 6 | ;;; modification, are permitted provided that the following conditions 7 | ;;; are met: 8 | 9 | ;;; * Redistributions of source code must retain the above copyright 10 | ;;; notice, this list of conditions and the following disclaimer. 11 | 12 | ;;; * Redistributions in binary form must reproduce the above 13 | ;;; copyright notice, this list of conditions and the following 14 | ;;; disclaimer in the documentation and/or other materials 15 | ;;; provided with the distribution. 16 | 17 | ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED 18 | ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 19 | ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 20 | ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY 21 | ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 22 | ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE 23 | ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 24 | ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 25 | ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 26 | ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 27 | ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | 29 | (defsystem :drakma-test 30 | :description "Test suite for drakma" 31 | :author "Dr. Edi Weitz" 32 | :license "BSD" 33 | :serial t 34 | :version "0.1" 35 | :depends-on (:drakma :fiveam :hunchentoot) 36 | :pathname #P"test/" 37 | :components ((:file "drakma-test")) 38 | :perform (test-op (o s) 39 | (uiop:symbol-call :fiveam '#:run! :drakma))) 40 | -------------------------------------------------------------------------------- /drakma.asd: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- 2 | ;;; $Header: /usr/local/cvsrep/drakma/drakma.asd,v 1.49 2008/05/24 03:21:22 edi Exp $ 3 | 4 | ;;; Copyright (c) 2006-2012, Dr. Edmund Weitz. All rights reserved. 5 | 6 | ;;; Redistribution and use in source and binary forms, with or without 7 | ;;; modification, are permitted provided that the following conditions 8 | ;;; are met: 9 | 10 | ;;; * Redistributions of source code must retain the above copyright 11 | ;;; notice, this list of conditions and the following disclaimer. 12 | 13 | ;;; * Redistributions in binary form must reproduce the above 14 | ;;; copyright notice, this list of conditions and the following 15 | ;;; disclaimer in the documentation and/or other materials 16 | ;;; provided with the distribution. 17 | 18 | ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED 19 | ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 20 | ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 21 | ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY 22 | ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE 24 | ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 25 | ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 26 | ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 27 | ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 28 | ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | 30 | (in-package :cl-user) 31 | 32 | #+:lispworks 33 | (unless (find-symbol "STREAM-WRITE-TIMEOUT" :stream) 34 | (pushnew :lw-does-not-have-write-timeout *features*)) 35 | 36 | (defpackage :drakma-asd 37 | (:use :cl :asdf)) 38 | 39 | (in-package :drakma-asd) 40 | 41 | (defsystem :drakma 42 | :description "Full-featured http/https client based on usocket" 43 | :author "Dr. Edi Weitz" 44 | :license "BSD" 45 | :serial t 46 | :version "2.0.10" 47 | :components ((:file "packages") 48 | (:file "specials") 49 | (:file "conditions") 50 | (:file "util") 51 | (:file "read") 52 | (:file "cookies") 53 | (:file "encoding") 54 | (:file "request")) 55 | :depends-on (:puri 56 | :cl-base64 57 | :chunga 58 | :flexi-streams 59 | :cl-ppcre 60 | #-:drakma-no-chipz :chipz 61 | #-:lispworks :usocket 62 | #-(or :lispworks7.1 (and :allegro (not :allegro-cl-express)) :mocl-ssl :drakma-no-ssl) :cl+ssl) 63 | :perform (test-op (o s) 64 | (asdf:load-system :drakma-test) 65 | (asdf:perform 'asdf:test-op :drakma-test))) 66 | -------------------------------------------------------------------------------- /encoding.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: DRAKMA; Base: 10 -*- 2 | ;;; $Header: /usr/local/cvsrep/drakma/read.lisp,v 1.17 2008/05/25 11:35:20 edi Exp $ 3 | 4 | ;;; Copyright (c) 2006-2012, Dr. Edmund Weitz. All rights reserved. 5 | 6 | ;;; Redistribution and use in source and binary forms, with or without 7 | ;;; modification, are permitted provided that the following conditions 8 | ;;; are met: 9 | 10 | ;;; * Redistributions of source code must retain the above copyright 11 | ;;; notice, this list of conditions and the following disclaimer. 12 | 13 | ;;; * Redistributions in binary form must reproduce the above 14 | ;;; copyright notice, this list of conditions and the following 15 | ;;; disclaimer in the documentation and/or other materials 16 | ;;; provided with the distribution. 17 | 18 | ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED 19 | ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 20 | ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 21 | ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY 22 | ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE 24 | ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 25 | ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 26 | ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 27 | ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 28 | ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | 30 | (in-package :drakma) 31 | 32 | (defgeneric decode-stream (encoding-type stream) 33 | (:documentation "Generic function to decode a stream. 34 | This is a generic function which decodes the stream based on the encoding-type. 35 | If a response contains one or more transfer or content encodings, then decode-stream 36 | is called for each encoding type in the correct order to properly decode the stream to its 37 | original content. 38 | 39 | ENCODING-TYPE will be a keyword created by upcasing and interning the encoding type from the header. 40 | STREAM will be the stream that needs to be decoded. decode-stream returns a new stream from 41 | which you can read the decoded data.")) 42 | 43 | (defmethod decode-stream ((encoding-type t) stream) 44 | "Default handler, just return the stream." 45 | stream) 46 | 47 | #-:drakma-no-chipz 48 | (defmethod decode-stream ((encoding-type (eql :gzip)) stream) 49 | "Decode stream using gzip compression." 50 | (chipz:make-decompressing-stream 'chipz:gzip stream)) 51 | 52 | #-:drakma-no-chipz 53 | (defmethod decode-stream ((encoding-type (eql :deflate)) stream) 54 | "Decode stream using deflate compression in zlib container." 55 | (chipz:make-decompressing-stream 'chipz:zlib stream)) 56 | 57 | (defmethod decode-stream ((encoding-type (eql :chunked)) (stream chunked-input-stream)) 58 | "Decode a chunked stream. 59 | Special method for chunked-input-stream that just turns chunking on." 60 | (setf (chunked-stream-input-chunking-p stream) t) 61 | stream) 62 | 63 | (defmethod decode-stream ((encoding-type (eql :chunked)) stream) 64 | "General decode method for chunked stream. 65 | Creates new chunked-stream." 66 | (let ((chunk-stream (make-chunked-stream stream))) 67 | (decode-stream :chunked chunk-stream))) 68 | 69 | (defun decode-response-stream (headers stream &key (decode-content t)) 70 | "Perform all necessary decodings on stream, from the Transfer-Encoding and 71 | Content-Encoding headers. 72 | 73 | If DECODE-CONTENT is nil, only the Transfer-Encoding headers will be used." 74 | (let ((transfer-encodings (header-value :transfer-encoding headers)) 75 | (content-encodings (and decode-content 76 | (header-value :content-encoding headers)))) 77 | (when transfer-encodings 78 | (setq transfer-encodings (split-tokens transfer-encodings))) 79 | (when content-encodings 80 | (setq content-encodings (split-tokens content-encodings))) 81 | ;; Reverse, because we need to run decodings in the opposite order 82 | ;; they were applied. 83 | (let ((encodings (nreverse (nconc content-encodings transfer-encodings)))) 84 | (loop for s = stream then (decode-stream encoding s) 85 | for encoding-str in encodings 86 | for encoding = (intern (string-upcase encoding-str) 'keyword) 87 | finally (return s))))) 88 | 89 | (defun decode-flexi-stream (headers stream &key (decode-content t)) 90 | (declare (flexi-input-stream stream)) 91 | "Perform all necessary decodings on the internal stream of a flexi-stream. 92 | Wrapper around decode-response-stream which preserverves the external format of the 93 | flexi-stream. 94 | 95 | If DECODE-CONTENT is nil, the Content-Encoding header will not be used to 96 | determine which decoding mechanisms to use. Most servers use Content-Encoding 97 | to identify compression." 98 | (let* ((raw-stream (flexi-stream-stream stream)) 99 | (result (decode-response-stream headers raw-stream 100 | :decode-content decode-content))) 101 | (if (eq raw-stream result) 102 | stream 103 | (make-flexi-stream result 104 | :external-format 105 | (flexi-stream-external-format stream) 106 | :element-type 107 | (flexi-stream-element-type stream))))) 108 | -------------------------------------------------------------------------------- /packages.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- 2 | ;;; $Header: /usr/local/cvsrep/drakma/packages.lisp,v 1.22 2008/01/14 01:57:01 edi Exp $ 3 | 4 | ;;; Copyright (c) 2006-2012, Dr. Edmund Weitz. All rights reserved. 5 | 6 | ;;; Redistribution and use in source and binary forms, with or without 7 | ;;; modification, are permitted provided that the following conditions 8 | ;;; are met: 9 | 10 | ;;; * Redistributions of source code must retain the above copyright 11 | ;;; notice, this list of conditions and the following disclaimer. 12 | 13 | ;;; * Redistributions in binary form must reproduce the above 14 | ;;; copyright notice, this list of conditions and the following 15 | ;;; disclaimer in the documentation and/or other materials 16 | ;;; provided with the distribution. 17 | 18 | ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED 19 | ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 20 | ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 21 | ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY 22 | ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE 24 | ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 25 | ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 26 | ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 27 | ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 28 | ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | 30 | (in-package :cl-user) 31 | 32 | (defpackage :drakma 33 | (:use :cl :flexi-streams :chunga) 34 | ;; the variable defined in the ASDF system definition 35 | (:shadow #:syntax-error #:parameter-error) 36 | (:export #:*drakma-version* 37 | #:*allow-dotless-cookie-domains-p* 38 | #:*body-format-function* 39 | #:*remove-duplicate-cookies-p* 40 | #:*default-http-proxy* 41 | #:*no-proxy-domains* 42 | #:*drakma-default-external-format* 43 | #:*header-stream* 44 | #:*ignore-unparseable-cookie-dates-p* 45 | #:*text-content-types* 46 | #:cookie 47 | #:cookie-error 48 | #:cookie-error-cookie 49 | #:cookie-date-parse-error 50 | #:cookie-domain 51 | #:cookie-expires 52 | #:cookie-http-only-p 53 | #:cookie-jar 54 | #:cookie-jar-cookies 55 | #:cookie-name 56 | #:cookie-path 57 | #:cookie-securep 58 | #:cookie-value 59 | #:cookie= 60 | #:delete-old-cookies 61 | #:decode-stream 62 | #:drakma-condition 63 | #:drakma-error 64 | #:drakma-warning 65 | #:get-content-type 66 | #:header-value 67 | #:http-request 68 | #:parameter-error 69 | #:parameter-present-p 70 | #:parameter-value 71 | #:parse-cookie-date 72 | #:read-tokens-and-parameters 73 | #:split-tokens 74 | #:syntax-error 75 | #:url-encode)) 76 | -------------------------------------------------------------------------------- /read.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: DRAKMA; Base: 10 -*- 2 | ;;; $Header: /usr/local/cvsrep/drakma/read.lisp,v 1.17 2008/05/25 11:35:20 edi Exp $ 3 | 4 | ;;; Copyright (c) 2006-2012, Dr. Edmund Weitz. All rights reserved. 5 | 6 | ;;; Redistribution and use in source and binary forms, with or without 7 | ;;; modification, are permitted provided that the following conditions 8 | ;;; are met: 9 | 10 | ;;; * Redistributions of source code must retain the above copyright 11 | ;;; notice, this list of conditions and the following disclaimer. 12 | 13 | ;;; * Redistributions in binary form must reproduce the above 14 | ;;; copyright notice, this list of conditions and the following 15 | ;;; disclaimer in the documentation and/or other materials 16 | ;;; provided with the distribution. 17 | 18 | ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED 19 | ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 20 | ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 21 | ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY 22 | ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE 24 | ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 25 | ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 26 | ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 27 | ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 28 | ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | 30 | (in-package :drakma) 31 | 32 | (defun read-status-line (stream &optional log-stream) 33 | "Reads one line from STREAM \(using Chunga's READ-LINE*) and 34 | interprets it as a HTTP status line. Returns a list of two or 35 | three values - the protocol \(HTTP version) as a keyword, the 36 | status code as an integer, and optionally the reason phrase." 37 | (let* ((*current-error-message* "While reading status line:") 38 | (line (or (read-line* stream log-stream) 39 | (error 'drakma-simple-error 40 | :format-control "No status line - probably network error."))) 41 | (first-space-pos (or (position #\Space line :test #'char=) 42 | (syntax-error "No space in status line ~S." line))) 43 | (second-space-pos (position #\Space line 44 | :test #'char= 45 | :start (1+ first-space-pos)))) 46 | (list (cond ((string-equal line "HTTP/1.0" :end1 first-space-pos) :http/1.0) 47 | ((string-equal line "HTTP/1.1" :end1 first-space-pos) :http/1.1) 48 | (t (syntax-error "Unknown protocol in ~S." line))) 49 | (or (ignore-errors (parse-integer line 50 | :start (1+ first-space-pos) 51 | :end second-space-pos)) 52 | (syntax-error "Status code in ~S is not an integer." line)) 53 | (and second-space-pos (subseq line (1+ second-space-pos)))))) 54 | 55 | (defun get-content-type (headers) 56 | "Reads and parses a `Content-Type' header and returns it as 57 | three values - the type, the subtype, and an alist \(possibly 58 | empty) of name/value pairs for the optional parameters. HEADERS 59 | is supposed to be an alist of headers as returned by 60 | HTTP-REQUEST. Returns NIL if there is no such header amongst 61 | HEADERS." 62 | (when-let (content-type (header-value :content-type headers)) 63 | (with-sequence-from-string (stream content-type) 64 | (let* ((*current-error-message* "Corrupted Content-Type header:") 65 | (type (read-token stream)) 66 | (subtype (and (assert-char stream #\/) 67 | (read-token stream))) 68 | (parameters (read-name-value-pairs stream))) 69 | (values type subtype parameters))))) 70 | 71 | (defun read-token-and-parameters (stream) 72 | "Reads and returns \(as a two-element list) from STREAM a token 73 | and an optional list of parameters \(attribute/value pairs) 74 | following the token." 75 | (skip-whitespace stream) 76 | (list (read-token stream) 77 | (read-name-value-pairs stream))) 78 | 79 | (defun skip-more-commas (stream) 80 | "Reads and consumes from STREAM any number of commas and 81 | whitespace. Returns the following character or NIL in case of 82 | END-OF-FILE." 83 | (loop while (eql (peek-char* stream nil) #\,) 84 | do (read-char* stream) (skip-whitespace stream)) 85 | (skip-whitespace stream)) 86 | 87 | (defun read-tokens-and-parameters (string &key (value-required-p t)) 88 | "Reads a comma-separated list of tokens from the string STRING. 89 | Each token can be followed by an optional, semicolon-separated 90 | list of attribute/value pairs where the attributes are tokens 91 | followed by a #\\= character and a token or a quoted string. 92 | Returned is a list where each element is either a string \(for a 93 | simple token) or a cons of a string \(the token) and an alist 94 | \(the attribute/value pairs). If VALUE-REQUIRED-P is NIL, the 95 | value part \(including the #\\= character) of each attribute/value 96 | pair is optional." 97 | (with-sequence-from-string (stream string) 98 | (loop with *current-error-message* = (format nil "While parsing ~S:" string) 99 | for first = t then nil 100 | for next = (and (skip-whitespace stream) 101 | (or first (assert-char stream #\,)) 102 | (skip-whitespace stream) 103 | (skip-more-commas stream)) 104 | for token = (and next (read-token stream)) 105 | for parameters = (and token 106 | (read-name-value-pairs stream 107 | :value-required-p value-required-p)) 108 | while token 109 | collect (if parameters (cons token parameters) token)))) 110 | 111 | (defun split-tokens (string) 112 | "Splits the string STRING into a list of substrings separated 113 | by commas and optional whitespace. Empty substrings are 114 | ignored." 115 | (loop for old-position = -1 then position 116 | for position = (and old-position 117 | (position #\, string :test #'char= :start (1+ old-position))) 118 | for substring = (and old-position 119 | (trim-whitespace (subseq string (1+ old-position) position))) 120 | while old-position 121 | when (plusp (length substring)) 122 | collect substring)) 123 | -------------------------------------------------------------------------------- /request.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: DRAKMA; Base: 10 -*- 2 | ;;; $Header: /usr/local/cvsrep/drakma/request.lisp,v 1.58 2008/05/30 11:30:45 edi Exp $ 3 | 4 | ;;; Copyright (c) 2006-2012, Dr. Edmund Weitz. All rights reserved. 5 | 6 | ;;; Redistribution and use in source and binary forms, with or without 7 | ;;; modification, are permitted provided that the following conditions 8 | ;;; are met: 9 | 10 | ;;; * Redistributions of source code must retain the above copyright 11 | ;;; notice, this list of conditions and the following disclaimer. 12 | 13 | ;;; * Redistributions in binary form must reproduce the above 14 | ;;; copyright notice, this list of conditions and the following 15 | ;;; disclaimer in the documentation and/or other materials 16 | ;;; provided with the distribution. 17 | 18 | ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED 19 | ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 20 | ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 21 | ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY 22 | ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE 24 | ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 25 | ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 26 | ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 27 | ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 28 | ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | 30 | (in-package :drakma) 31 | 32 | (defun determine-body-format (headers external-format-in) 33 | "The default function used by Drakma to determine how the content 34 | body is to be read. See the docstring of *BODY-FORMAT-FUNCTION* for 35 | more info." 36 | (handler-case 37 | (multiple-value-bind (type subtype params) 38 | (get-content-type headers) 39 | (when (text-content-type-p type subtype) 40 | (let* ((charset (parameter-value "charset" params)) 41 | (name (cond (charset (as-keyword charset)) 42 | (t external-format-in)))) 43 | (make-external-format name :eol-style :lf)))) 44 | (error (condition) 45 | (drakma-warn "Problems determining charset \(falling back to binary):~%~A" 46 | condition)))) 47 | 48 | (defun send-content (content stream &optional external-format-out) 49 | "Sends CONTENT to the stream STREAM as part of the request body 50 | depending on the type of CONTENT." 51 | (when content 52 | (cond ((stringp content) 53 | (setf (flexi-stream-external-format stream) external-format-out) 54 | (write-string content stream) 55 | (setf (flexi-stream-external-format stream) +latin-1+)) 56 | ((or (arrayp content) (listp content)) 57 | (write-sequence content stream)) 58 | ((and (streamp content) 59 | (input-stream-p content) 60 | (open-stream-p content) 61 | (subtypep (stream-element-type content) 'octet)) 62 | (let ((buf (make-array +buffer-size+ :element-type 'octet))) 63 | (loop 64 | (let ((pos (read-sequence buf content))) 65 | (when (zerop pos) (return)) 66 | (write-sequence buf stream :end pos))))) 67 | ((pathnamep content) 68 | (with-open-file (from content :element-type 'octet) 69 | ;; calls itself with a stream now 70 | (send-content from stream))) 71 | ((or (functionp content) 72 | (and (symbolp content) 73 | (fboundp content))) 74 | (funcall content stream)) 75 | (t (parameter-error "Don't know how to send content ~S to server." content))))) 76 | 77 | (defun make-form-data-function (parameters boundary external-format-out) 78 | "Creates and returns a closure which can be used as an argument for 79 | SEND-CONTENT to send PARAMETERS as a `multipart/form-data' request 80 | body using the boundary BOUNDARY." 81 | (lambda (stream) 82 | (flet ((crlf () 83 | "Sends carriage return and linefeed to STREAM." 84 | (write-char #\Return stream) 85 | (write-char #\Linefeed stream))) 86 | (dolist (name/value parameters) 87 | (destructuring-bind (name . value) 88 | name/value 89 | (when (or (pathnamep value) 90 | (streamp value) 91 | (functionp value)) 92 | (setq value (list value))) 93 | (format stream "--~A" boundary) 94 | (crlf) 95 | (format stream "Content-Disposition: form-data; name=\"~A\"" name) 96 | (cond ((stringp value) 97 | (crlf) 98 | (format stream "Content-Type: text/plain; charset=~a" external-format-out) 99 | (crlf) (crlf) 100 | (setf (flexi-stream-external-format stream) external-format-out) 101 | (format stream "~A" value) 102 | (setf (flexi-stream-external-format stream) +latin-1+)) 103 | ((null value) 104 | (crlf)) 105 | ((and (listp value) 106 | (first value) 107 | (not (stringp (first value)))) 108 | (let* ((file-source (first value)) 109 | (filename (or (getf (rest value) :filename) 110 | (etypecase file-source 111 | (function "user-closure") 112 | (file-stream (or (file-namestring file-source) 113 | "user-stream")) 114 | (stream "user-stream") 115 | (pathname (file-namestring file-source))))) 116 | (content-type (or (getf (rest value) :content-type) 117 | "application/octet-stream"))) 118 | (format stream "; filename=\"~A\"" filename) 119 | (crlf) 120 | (format stream "Content-Type: ~A" content-type) 121 | (crlf) (crlf) 122 | ;; use SEND-CONTENT to send file as binary data 123 | (send-content file-source stream))) 124 | (t (parameter-error 125 | "Don't know what to do with name/value pair (~S . ~S) in multipart/form-data body." 126 | name value))) 127 | (crlf))) 128 | (format stream "--~A--" boundary) 129 | (crlf)))) 130 | 131 | (defun %read-body (stream element-type) 132 | ;; On ABCL, a flexi-stream is not a normal stream. This is caused by 133 | ;; a bug in ABCL which is supposedly quite difficult to fix. More 134 | ;; details here: http://abcl.org/trac/ticket/377 135 | #-abcl 136 | (declare (stream stream)) 137 | "Helper function to read from stream into a buffer of element-type, which is returned." 138 | (let ((buffer (make-array +buffer-size+ :element-type element-type)) 139 | (result (make-array +buffer-size+ :element-type element-type :adjustable t)) 140 | (result-length +buffer-size+)) 141 | (loop for index = 0 then size 142 | for pos = (read-sequence buffer stream) 143 | for size = (+ index pos) 144 | do 145 | (when (>= size result-length) 146 | (adjust-array result (setf result-length (* result-length 2)))) 147 | (replace result buffer :start1 index :end2 pos) 148 | while (= pos +buffer-size+) 149 | finally (adjust-array result size)) 150 | result)) 151 | 152 | (defun read-body (stream headers textp &key (decode-content t)) 153 | "Reads the message body from the HTTP stream STREAM using the 154 | information contained in HEADERS \(as produced by HTTP-REQUEST). If 155 | TEXTP is true, the body is assumed to be of content type `text' and 156 | will be returned as a string. Otherwise an array of octets \(or NIL 157 | for an empty body) is returned. Returns the optional `trailer' HTTP 158 | headers of the chunked stream \(if any) as a second value." 159 | (let ((content-length (when-let (value (and (not (header-value :transfer-encoding headers)) ;; see RFC 2616, section 4.4, 3. 160 | (header-value :content-length headers))) 161 | (parse-integer value))) 162 | (element-type (if textp 163 | #+:lispworks7.1 'lw:simple-char #-:lispworks7.1 'character 164 | 'octet))) 165 | (values (cond ((eql content-length 0) nil) 166 | (content-length 167 | (setf (flexi-stream-element-type stream) 'octet) 168 | (let ((result (make-array content-length :element-type 'octet))) 169 | #+:clisp 170 | (setf (flexi-stream-element-type stream) 'octet) 171 | (read-sequence result stream) 172 | (when (and decode-content (header-value :content-encoding headers)) 173 | (setq result (with-input-from-sequence (s result) 174 | (%read-body (decode-response-stream headers s) 'octet)))) 175 | (when textp 176 | (setf result 177 | (octets-to-string result :external-format (flexi-stream-external-format stream)) 178 | #+:clisp (flexi-stream-element-type stream) 179 | #+:clisp element-type)) 180 | result)) 181 | (t 182 | ;; no content length, read until EOF (or end of chunking) 183 | #+:clisp 184 | (setf (flexi-stream-element-type stream) element-type) 185 | ;; Help the streams on top of chunked streams 186 | ;; detect EOF at the end of chunking without trying 187 | ;; to reading extra data. 188 | (setf (chunked-input-stream-eof-after-last-chunk (flexi-stream-stream stream)) t) 189 | (unwind-protect 190 | (%read-body (decode-flexi-stream headers stream 191 | :decode-content decode-content) 192 | element-type) 193 | (setf (chunked-input-stream-eof-after-last-chunk (flexi-stream-stream stream)) nil)))) 194 | (chunked-input-stream-trailers (flexi-stream-stream stream))))) 195 | 196 | (defun trivial-uri-path (uri-string) 197 | "If the PRESERVE-URI argument is used, the URI needs to be passed to 198 | the server in unmodified form. This function returns just the path 199 | component of the URI with no URL encoding or other modifications done." 200 | (cl-ppcre:regex-replace "[^/]+://[^/]*/?" uri-string "/")) 201 | 202 | (defun http-request (uri &rest args 203 | &key (protocol :http/1.1) 204 | (method :get) 205 | force-ssl 206 | certificate 207 | key 208 | certificate-password 209 | verify 210 | (max-depth 10) 211 | ca-file 212 | ca-directory 213 | parameters 214 | (url-encoder #'url-encode) 215 | content 216 | (content-type "application/x-www-form-urlencoded") 217 | (content-length nil content-length-provided-p) 218 | form-data 219 | cookie-jar 220 | basic-authorization 221 | (user-agent :drakma) 222 | (accept "*/*") 223 | range 224 | (proxy *default-http-proxy*) 225 | (no-proxy-domains *no-proxy-domains*) 226 | proxy-basic-authorization 227 | real-host 228 | additional-headers 229 | (redirect 5) 230 | auto-referer 231 | keep-alive 232 | (close t) 233 | (external-format-out *drakma-default-external-format*) 234 | (external-format-in *drakma-default-external-format*) 235 | force-binary 236 | want-stream 237 | stream 238 | preserve-uri 239 | decode-content ; default to nil for backwards compatibility 240 | #+(or abcl clisp lispworks mcl openmcl sbcl) 241 | (connection-timeout 20) 242 | #+:lispworks7.1 (read-timeout 20) 243 | #+(and :lispworks7.1 (not :lw-does-not-have-write-timeout)) 244 | (write-timeout 20 write-timeout-provided-p) 245 | #+:openmcl 246 | deadline 247 | &aux (unparsed-uri (if (stringp uri) (copy-seq uri) (puri:copy-uri uri)))) 248 | "Sends a HTTP request to a web server and returns its reply. URI 249 | is where the request is sent to, and it is either a string denoting a 250 | uniform resource identifier or a PURI:URI object. The scheme of URI 251 | must be `http' or `https'. The function returns SEVEN values - the 252 | body of the reply \(but see below), the status code as an integer, an 253 | alist of the headers sent by the server where for each element the car 254 | \(the name of the header) is a keyword and the cdr \(the value of the 255 | header) is a string, the URI the reply comes from \(which might be 256 | different from the URI the request was sent to in case of redirects), 257 | the stream the reply was read from, a generalized boolean which 258 | denotes whether the stream should be closed \(and which you can 259 | usually ignore), and finally the reason phrase from the status line as 260 | a string. 261 | 262 | PROTOCOL is the HTTP protocol which is going to be used in the 263 | request line, it must be one of the keywords :HTTP/1.0 or 264 | :HTTP/1.1. METHOD is the method used in the request line, a 265 | keyword \(like :GET or :HEAD) denoting a valid HTTP/1.1 or WebDAV 266 | request method, or :REPORT, as described in the Versioning 267 | Extensions to WebDAV. Additionally, you can also use the pseudo 268 | method :OPTIONS* which is like :OPTIONS but means that an 269 | \"OPTIONS *\" request line will be sent, i.e. the URI's path and 270 | query parts will be ignored. 271 | 272 | If FORCE-SSL is true, SSL will be attached to the socket stream 273 | which connects Drakma with the web server. Usually, you don't 274 | have to provide this argument, as SSL will be attached anyway if 275 | the scheme of URI is `https'. 276 | 277 | CERTIFICATE is the file name of the PEM encoded client certificate to 278 | present to the server when making a SSL connection. KEY specifies the 279 | file name of the PEM encoded private key matching the certificate. 280 | CERTIFICATE-PASSWORD specifies the pass phrase to use to decrypt the 281 | private key. 282 | 283 | VERIFY can be specified to force verification of the certificate that 284 | is presented by the server in an SSL connection. It can be specified 285 | either as NIL if no check should be performed, :OPTIONAL to verify the 286 | server's certificate if it presented one or :REQUIRED to verify the 287 | server's certificate and fail if an invalid or no certificate was 288 | presented. 289 | 290 | MAX-DEPTH can be specified to change the maximum allowed certificate 291 | signing depth that is accepted. The default is 10. 292 | 293 | CA-FILE and CA-DIRECTORY can be specified to set the certificate 294 | authority bundle file or directory to use for certificate validation. 295 | 296 | The CERTIFICATE, KEY, CERTIFICATE-PASSWORD, VERIFY, MAX-DEPTH, CA-FILE 297 | and CA-DIRECTORY parameters are ignored for non-SSL requests. They 298 | are also ignored on LispWorks. 299 | 300 | PARAMETERS is an alist of name/value pairs \(the car and the cdr each 301 | being a string) which denotes the parameters which are added to the 302 | query part of the URL or \(in the case of a POST request) comprise the 303 | body of the request. (But see CONTENT below.) The values can also be 304 | NIL in which case only the name \(without an equal sign) is used in 305 | the query string. The name/value pairs are URL-encoded using the 306 | FLEXI-STREAMS external format EXTERNAL-FORMAT-OUT before they are sent 307 | to the server unless FORM-DATA is true in which case the POST request 308 | body is sent as `multipart/form-data' using EXTERNAL-FORMAT-OUT. The 309 | values of the PARAMETERS alist can also be pathnames, open binary 310 | input streams, unary functions, or lists where the first element is of 311 | one of the former types. These values denote files which should be 312 | sent as part of the request body. If files are present in PARAMETERS, 313 | the content type of the request is always `multipart/form-data'. If 314 | the value is a list, the part of the list behind the first element is 315 | treated as a plist which can be used to specify a content type and/or 316 | a filename for the file, i.e. such a value could look like, e.g., 317 | \(#p\"/tmp/my_file.doc\" :content-type \"application/msword\" 318 | :filename \"upload.doc\"). 319 | 320 | URL-ENCODER specifies a custom URL encoder function which will be used 321 | by drakma to URL-encode parameter names and values. It needs to be a 322 | function of one argument. The argument is the string to encode, the 323 | return value must be the URL-encoded string. This can be used if 324 | specific encoding rules are required. 325 | 326 | CONTENT, if not NIL, is used as the request body - PARAMETERS is 327 | ignored in this case. CONTENT can be a string, a sequence of 328 | octets, a pathname, an open binary input stream, or a function 329 | designator. If CONTENT is a sequence, it will be directly sent 330 | to the server \(using EXTERNAL-FORMAT-OUT in the case of 331 | strings). If CONTENT is a pathname, the binary contents of the 332 | corresponding file will be sent to the server. If CONTENT is a 333 | stream, everything that can be read from the stream until EOF 334 | will be sent to the server. If CONTENT is a function designator, 335 | the corresponding function will be called with one argument, the 336 | stream to the server, to which it should send data. 337 | 338 | Finally, CONTENT can also be the keyword :CONTINUATION in which case 339 | HTTP-REQUEST returns only one value - a `continuation' function. This 340 | function has one required argument and one optional argument. The 341 | first argument will be interpreted like CONTENT above \(but it cannot 342 | be a keyword), i.e. it will be sent to the server according to its 343 | type. If the second argument is true, the continuation function can 344 | be called again to send more content, if it is NIL the continuation 345 | function returns what HTTP-REQUEST would have returned. 346 | 347 | If CONTENT is a sequence, Drakma will use LENGTH to determine its 348 | length and will use the result for the `Content-Length' header sent to 349 | the server. You can overwrite this with the CONTENT-LENGTH parameter 350 | \(a non-negative integer) which you can also use for the cases where 351 | Drakma can't or won't determine the content length itself. You can 352 | also explicitly provide a CONTENT-LENGTH argument of NIL which will 353 | imply that no `Content-Length' header will be sent in any case. If no 354 | `Content-Length' header is sent, Drakma will use chunked encoding to 355 | send the content body. Note that this will not work with older web 356 | servers. 357 | 358 | Providing a true CONTENT-LENGTH argument which is not a non-negative 359 | integer means that Drakma /must/ build the request body in RAM and 360 | compute the content length even if it would have otherwise used 361 | chunked encoding, for example in the case of file uploads. 362 | 363 | CONTENT-TYPE is the corresponding `Content-Type' header to be sent and 364 | will be ignored unless CONTENT is provided as well. 365 | 366 | Note that a query already contained in URI will always be sent with 367 | the request line anyway in addition to other parameters sent by 368 | Drakma. 369 | 370 | COOKIE-JAR is a cookie jar containing cookies which will 371 | potentially be sent to the server \(if the domain matches, if 372 | they haven't expired, etc.) - this cookie jar will be modified 373 | according to the `Set-Cookie' header\(s) sent back by the server. 374 | 375 | BASIC-AUTHORIZATION, if not NIL, should be a list of two strings 376 | \(username and password) which will be sent to the server for 377 | basic authorization. USER-AGENT, if not NIL, denotes which 378 | `User-Agent' header will be sent with the request. It can be one 379 | of the keywords :DRAKMA, :FIREFOX, :EXPLORER, :OPERA, or :SAFARI 380 | which denote the current version of Drakma or, in the latter four 381 | cases, a fixed string corresponding to a more or less recent \(as 382 | of August 2006) version of the corresponding browser. Or it can 383 | be a string which is used directly. 384 | 385 | ACCEPT, if not NIL, specifies the contents of the `Accept' header 386 | sent. 387 | 388 | RANGE optionally specifies a subrange of the resource to be requested. 389 | It must be specified as a list of two integers which indicate the 390 | start and \(inclusive) end offset of the requested range, in bytes 391 | \(i.e. octets). 392 | 393 | If PROXY is not NIL, it should be a string denoting a proxy 394 | server through which the request should be sent. Or it can be a 395 | list of two values - a string denoting the proxy server and an 396 | integer denoting the port to use \(which will default to 80 397 | otherwise). Defaults to *default-http-proxy*. 398 | PROXY-BASIC-AUTHORIZATION is used like 399 | BASIC-AUTHORIZATION, but for the proxy, and only if PROXY is 400 | true. If the host portion of the uri is present in the 401 | *no-proxy-domains* or the NO-PROXY-DOMAINS list then the proxy 402 | setting will be ignored for this request. 403 | 404 | If NO-PROXY-DOMAINS is set then it will supersede the 405 | *no-proxy-domains* variable. Inserting domains into this list will 406 | allow them to ignore the proxy setting. 407 | 408 | If REAL-HOST is not NIL, request is sent to the denoted host instead 409 | of the URI host. When specified, REAL-HOST supersedes PROXY. 410 | 411 | ADDITIONAL-HEADERS is a name/value alist of additional HTTP headers 412 | which should be sent with the request. Unlike in PARAMETERS, the cdrs 413 | can not only be strings but also designators for unary functions 414 | \(which should in turn return a string) in which case the function is 415 | called each time the header is written. 416 | 417 | If REDIRECT is not NIL, it must be a non-negative integer or T. 418 | If REDIRECT is true, Drakma will follow redirects \(return codes 419 | 301, 302, 303, or 307) unless REDIRECT is 0. If REDIRECT is an 420 | integer, it will be decreased by 1 with each redirect. 421 | Furthermore, if AUTO-REFERER is true when following redirects, 422 | Drakma will populate the `Referer' header with the URI that 423 | triggered the redirection, overwriting an existing `Referer' 424 | header \(in ADDITIONAL-HEADERS) if necessary. 425 | 426 | If KEEP-ALIVE is T, the server will be asked to keep the 427 | connection alive, i.e. not to close it after the reply has been 428 | sent. \(Note that this not necessary if both the client and the 429 | server use HTTP 1.1.) If CLOSE is T, the server is explicitly 430 | asked to close the connection after the reply has been sent. 431 | KEEP-ALIVE and CLOSE are obviously mutually exclusive. 432 | 433 | If the message body sent by the server has a text content type, Drakma 434 | will try to return it as a Lisp string. It'll first check if the 435 | `Content-Type' header denotes an encoding to be used, or otherwise it 436 | will use the EXTERNAL-FORMAT-IN argument. The body is decoded using 437 | FLEXI-STREAMS. If FLEXI-STREAMS doesn't know the external format, the 438 | body is returned as an array of octets. If the body is empty, Drakma 439 | will return NIL. 440 | 441 | If the message body doesn't have a text content type or if 442 | FORCE-BINARY is true, the body is always returned as an array of 443 | octets. 444 | 445 | If WANT-STREAM is true, the message body is NOT read and instead the 446 | \(open) socket stream is returned as the first return value. If the 447 | sixth value of HTTP-REQUEST is true, the stream should be closed \(and 448 | not be re-used) after the body has been read. The stream returned is 449 | a flexi stream \(see http://weitz.de/flexi-streams/) with a chunked 450 | stream \(see http://weitz.de/chunga/) as its underlying stream. If 451 | you want to read binary data from this stream, read from the 452 | underlying stream which you can get with FLEXI-STREAM-STREAM. 453 | 454 | Drakma will usually create a new socket connection for each HTTP 455 | request. However, you can use the STREAM argument to provide an 456 | open socket stream which should be re-used. STREAM MUST be a 457 | stream returned by a previous invocation of HTTP-REQUEST where 458 | the sixth return value wasn't true. Obviously, it must also be 459 | connected to the correct server and at the right position 460 | \(i.e. the message body, if any, must have been read). Drakma 461 | will NEVER attach SSL to a stream provided as the STREAM 462 | argument. 463 | 464 | CONNECTION-TIMEOUT is the time \(in seconds) Drakma will wait until it 465 | considers an attempt to connect to a server as a failure. It is 466 | supported only on some platforms \(currently abcl, clisp, LispWorks, 467 | mcl, openmcl and sbcl). READ-TIMEOUT and WRITE-TIMEOUT are the read 468 | and write timeouts \(in seconds) for the socket stream to the server. 469 | All three timeout arguments can also be NIL \(meaning no timeout), and 470 | they don't apply if an existing stream is re-used. READ-TIMEOUT 471 | argument is only available for LispWorks, WRITE-TIMEOUT is only 472 | available for LispWorks 5.0 or higher. 473 | 474 | DEADLINE, a time in the future, specifies the time until which the 475 | request should be finished. The deadline is specified in internal 476 | time units. If the server fails to respond until that time, a 477 | COMMUNICATION-DEADLINE-EXPIRED condition is signalled. DEADLINE is 478 | only available on CCL 1.2 and later. 479 | 480 | If PRESERVE-URI is not NIL, the given URI will not be processed. This 481 | means that the URI will be sent as-is to the remote server and it is 482 | the responsibility of the client to make sure that all parameters are 483 | encoded properly. Note that if this parameter is given, and the 484 | request is not a POST with a content-type of `multipart/form-data', 485 | PARAMETERS will not be used. 486 | 487 | If DECODE-CONTENT is not NIL, then the content will automatically be 488 | decoded according to any encodings specified in the Content-Encoding 489 | header. The actual decoding is done by the DECODE-STREAM generic function, 490 | and you can implement new methods to support additional encodings. 491 | Any encodings in Transfer-Encoding, such as chunking, are always performed." 492 | #+lispworks7.1 493 | (declare (ignore certificate key certificate-password verify max-depth ca-file ca-directory)) 494 | (unless (member protocol '(:http/1.0 :http/1.1) :test #'eq) 495 | (parameter-error "Don't know how to handle protocol ~S." protocol)) 496 | (setq uri (cond ((puri:uri-p uri) (puri:copy-uri uri)) 497 | (t (puri:parse-uri uri)))) 498 | (unless (member method +known-methods+ :test #'eq) 499 | (parameter-error "Don't know how to handle method ~S." method)) 500 | (unless (member (puri:uri-scheme uri) '(:http :https) :test #'eq) 501 | (parameter-error "Don't know how to handle scheme ~S." (puri:uri-scheme uri))) 502 | (when (and close keep-alive) 503 | (parameter-error "CLOSE and KEEP-ALIVE must not be both true.")) 504 | (when (and form-data (not (member method '(:post :put :report) :test #'eq))) 505 | (parameter-error "FORM-DATA only makes sense with POST requests.")) 506 | (when range 507 | (unless (and (listp range) 508 | (integerp (first range)) 509 | (integerp (second range)) 510 | (<= (first range) (second range))) 511 | (parameter-error "RANGE parameter must be specified as list of two integers, with the second larger or equal to the first"))) 512 | ;; supersede PROXY with REAL-HOST 513 | (when real-host 514 | (setq proxy real-host)) 515 | ;; convert PROXY argument to canonical form 516 | (when proxy 517 | (when (atom proxy) 518 | (setq proxy (list proxy 80)))) 519 | ;; Ignore the proxy for whitelisted hosts. 520 | (when (member (puri:uri-host uri) no-proxy-domains :test #'string=) 521 | (setq proxy '())) 522 | ;; make sure we don't get :CRLF on Windows 523 | (let ((*default-eol-style* :lf) 524 | (file-parameters-p (find-if-not (lambda (thing) 525 | (or (stringp thing) 526 | (null thing))) 527 | parameters :key #'cdr)) 528 | parameters-used-p) 529 | (when (and file-parameters-p (not (or (eq method :post) 530 | (eq method :put)))) 531 | (parameter-error "Don't know how to handle parameters in ~S, as this is not a POST or PUT request." 532 | parameters)) 533 | (when (or (eq method :post) 534 | (eq method :put) ; make Drakma more flexible towards wrongly implemented endpoints 535 | ) 536 | ;; create content body for POST unless it was provided 537 | (unless content 538 | ;; mark PARAMETERS argument as used up, so we don't use it 539 | ;; again below 540 | (setq parameters-used-p t) 541 | (cond ((or form-data file-parameters-p) 542 | (let ((boundary (format nil "----------~A" (make-random-string)))) 543 | (setq content (make-form-data-function parameters boundary external-format-out) 544 | content-type (format nil "multipart/form-data; boundary=~A" boundary))) 545 | (unless (or file-parameters-p content-length-provided-p) 546 | (setq content-length (or content-length t)))) 547 | (t 548 | (setq content (alist-to-url-encoded-string parameters external-format-out url-encoder) 549 | content-type "application/x-www-form-urlencoded"))))) 550 | (let ((proxying-https-p (and proxy (not stream) (not real-host) 551 | (or force-ssl 552 | (eq :https (puri:uri-scheme uri))))) 553 | http-stream raw-http-stream must-close done) 554 | (unwind-protect 555 | (progn 556 | (let ((host (or (and proxy (first proxy)) 557 | (puri:uri-host uri))) 558 | (port (cond ((and proxy (not real-host)) (second proxy)) 559 | ((puri:uri-port uri)) 560 | (t (default-port uri)))) 561 | (use-ssl (and (not proxying-https-p) 562 | (or force-ssl 563 | (eq (puri:uri-scheme uri) :https))))) 564 | #+(and :lispworks5.0 :mswindows 565 | (not :lw-does-not-have-write-timeout)) 566 | (when use-ssl 567 | (when (and write-timeout write-timeout-provided-p) 568 | (drakma-warn "Disabling WRITE-TIMEOUT because it doesn't mix well with SSL.")) 569 | (setq write-timeout nil)) 570 | (setq http-stream (or stream 571 | #+:lispworks7.1 572 | (comm:open-tcp-stream host port 573 | :element-type 'octet 574 | :timeout connection-timeout 575 | :read-timeout read-timeout 576 | #-:lw-does-not-have-write-timeout 577 | :write-timeout 578 | #-:lw-does-not-have-write-timeout 579 | write-timeout 580 | :errorp t) 581 | #-:lispworks7.1 582 | (usocket:socket-stream 583 | (usocket:socket-connect host port 584 | :element-type 'octet 585 | #+:openmcl :deadline 586 | #+:openmcl deadline 587 | #+(or abcl clisp lispworks mcl openmcl sbcl) 588 | :timeout 589 | #+(or abcl clisp lispworks mcl openmcl sbcl) 590 | connection-timeout 591 | :nodelay :if-supported))) 592 | raw-http-stream http-stream) 593 | #+:openmcl 594 | (when deadline 595 | ;; it is correct to set the deadline here even though 596 | ;; it may have been initialized by SOCKET-CONNECT 597 | ;; already - the stream may have been passed in by the 598 | ;; user and the user may want to adjust the deadline 599 | ;; for every request 600 | (setf (ccl:stream-deadline http-stream) deadline)) 601 | (labels ((write-http-line (fmt &rest args) 602 | (when *header-stream* 603 | (format *header-stream* "~?~%" fmt args)) 604 | (format http-stream "~?~C~C" fmt args #\Return #\Linefeed)) 605 | (write-header (name value-fmt &rest value-args) 606 | (write-http-line "~A: ~?" name value-fmt value-args)) 607 | (wrap-stream (http-stream) 608 | (make-flexi-stream (make-chunked-stream http-stream) 609 | :external-format +latin-1+))) 610 | (when (and use-ssl 611 | ;; don't attach SSL to existing streams 612 | (not stream)) 613 | #+:lispworks7.1 614 | (comm:attach-ssl http-stream 615 | :ssl-side :client 616 | #-(or lispworks4 lispworks5 lispworks6) 617 | :tlsext-host-name 618 | #-(or lispworks4 lispworks5 lispworks6) 619 | (puri:uri-host uri)) 620 | #-:lispworks7.1 621 | (setq http-stream (make-ssl-stream http-stream 622 | :hostname (puri:uri-host uri) 623 | :certificate certificate 624 | :key key 625 | :certificate-password certificate-password 626 | :verify verify 627 | :max-depth max-depth 628 | :ca-file ca-file 629 | :ca-directory ca-directory))) 630 | (cond (stream 631 | (setf (flexi-stream-element-type http-stream) 632 | #+:lispworks6 'lw:simple-char #-:lispworks6 'character 633 | (flexi-stream-external-format http-stream) +latin-1+)) 634 | (t 635 | (setq http-stream (wrap-stream http-stream)))) 636 | (when proxying-https-p 637 | ;; set up a tunnel through the proxy server to the 638 | ;; final destination 639 | (write-http-line "CONNECT ~A:~:[443~;~:*~A~] HTTP/1.1" 640 | (puri:uri-host uri) (puri:uri-port uri)) 641 | (write-http-line "Host: ~@[[~*~]~A~@[]~*~]:~:[443~;~:*~A~]" 642 | (puri:uri-is-ip6 uri) 643 | (puri:uri-host uri) 644 | (puri:uri-is-ip6 uri) 645 | (puri:uri-port uri)) 646 | (write-http-line "") 647 | (force-output http-stream) 648 | ;; check we get a 200 response before proceeding 649 | (unless (eql (second (read-status-line http-stream *header-stream*)) 200) 650 | (error "Unable to establish HTTPS tunnel through proxy.")) 651 | ;; got a connection; we have to read a blank line, 652 | ;; turn on SSL, and then we can transmit 653 | (read-line* http-stream) 654 | #+:lispworks7.1 655 | (comm:attach-ssl raw-http-stream 656 | :ssl-side :client 657 | #-(or lispworks4 lispworks5 lispworks6) 658 | :tlsext-host-name 659 | #-(or lispworks4 lispworks5 lispworks6) 660 | (puri:uri-host uri)) 661 | #-:lispworks7.1 662 | (setq http-stream (wrap-stream 663 | (make-ssl-stream raw-http-stream 664 | :hostname (puri:uri-host uri) 665 | :certificate certificate 666 | :key key 667 | :certificate-password certificate-password 668 | :verify verify 669 | :max-depth max-depth 670 | :ca-file ca-file 671 | :ca-directory ca-directory)))) 672 | (when-let (all-get-parameters 673 | (and (not preserve-uri) 674 | (append (dissect-query (puri:uri-query uri)) 675 | (and (not parameters-used-p) parameters)))) 676 | (setf (puri:uri-query uri) 677 | (alist-to-url-encoded-string all-get-parameters external-format-out url-encoder))) 678 | (when (eq method :options*) 679 | ;; special pseudo-method 680 | (setf method :options 681 | (puri:uri-path uri) "*" 682 | (puri:uri-query uri) nil)) 683 | (write-http-line "~A ~A ~A" 684 | (string-upcase method) 685 | (if (and preserve-uri 686 | (stringp unparsed-uri)) 687 | (trivial-uri-path unparsed-uri) 688 | (puri:render-uri (if (and proxy 689 | (null stream) 690 | (not proxying-https-p) 691 | (not real-host)) 692 | uri 693 | (make-instance 'puri:uri 694 | :path (puri:uri-path uri) 695 | :parsed-path (puri:uri-parsed-path uri) 696 | :query (puri:uri-query uri) 697 | :escaped t)) 698 | nil)) 699 | (string-upcase protocol)) 700 | (when (not (assoc "Host" additional-headers :test #'string-equal)) 701 | (write-header "Host" "~@[[~*~]~A~@[]~*~]~@[:~A~]" 702 | (puri:uri-is-ip6 uri) 703 | (puri:uri-host uri) 704 | (puri:uri-is-ip6 uri) 705 | (non-default-port uri))) 706 | (when user-agent 707 | (write-header "User-Agent" "~A" (user-agent-string user-agent))) 708 | (when basic-authorization 709 | (write-header "Authorization" "Basic ~A" 710 | (base64:string-to-base64-string 711 | (format nil "~A:~A" 712 | (first basic-authorization) 713 | (second basic-authorization))))) 714 | (when (and proxy proxy-basic-authorization) 715 | (write-header "Proxy-Authorization" "Basic ~A" 716 | (base64:string-to-base64-string 717 | (format nil "~A:~A" 718 | (first proxy-basic-authorization) 719 | (second proxy-basic-authorization))))) 720 | (when accept 721 | (write-header "Accept" "~A" accept)) 722 | (when range 723 | (write-header "Range" "bytes=~A-~A" (first range) (second range))) 724 | (when cookie-jar 725 | ;; write all cookies in one fell swoop, so even Sun's 726 | ;; web server has a chance to get it 727 | (when-let (cookies (loop for cookie in (cookie-jar-cookies cookie-jar) 728 | when (send-cookie-p cookie uri force-ssl) 729 | collect (cookie-name cookie) and 730 | collect (cookie-value cookie))) 731 | (write-header "Cookie" "~{~A=~A~^; ~}" cookies))) 732 | (when keep-alive 733 | (write-header "Connection" "Keep-Alive")) 734 | (when close 735 | (setq must-close close) 736 | (write-header "Connection" "close")) 737 | (loop for (name . value) in additional-headers 738 | do (write-header name "~A" 739 | (cond ((or (functionp value) 740 | (and (symbolp value) 741 | (fboundp value))) 742 | (funcall value)) 743 | (t value)))) 744 | (when content 745 | (when content-type 746 | (write-header "Content-Type" "~A" content-type)) 747 | (when (or (and (not content-length-provided-p) 748 | (stringp content)) 749 | (and content-length 750 | (not (or (and (integerp content-length) 751 | (not (minusp content-length))) 752 | (typep content '(or (vector octet) list)) 753 | (eq content :continuation))))) 754 | ;; CONTENT-LENGTH forces us to compute request body 755 | ;; in RAM 756 | (setq content 757 | (with-output-to-sequence (bin-out) 758 | (let ((out (make-flexi-stream bin-out :external-format +latin-1+))) 759 | (send-content content out external-format-out))))) 760 | (when (and (or (not content-length-provided-p) 761 | (eq content-length t)) 762 | (typep content '(or (vector octet) list))) 763 | (setq content-length (length content))) 764 | (cond (content-length 765 | (write-header "Content-Length" "~D" content-length)) 766 | (t 767 | (write-header "Transfer-Encoding" "chunked")))) 768 | ;; end of request headers 769 | (when *header-stream* 770 | (terpri *header-stream*)) 771 | (format http-stream "~C~C" #\Return #\Linefeed) 772 | (force-output http-stream) 773 | (when (and content (null content-length)) 774 | (setf (chunked-stream-output-chunking-p 775 | (flexi-stream-stream http-stream)) t)) 776 | (labels ((finish-request (content &optional continuep) 777 | (send-content content http-stream external-format-out) 778 | (when continuep 779 | (force-output http-stream) 780 | (return-from finish-request)) 781 | (setf (chunked-stream-output-chunking-p 782 | (flexi-stream-stream http-stream)) nil) 783 | (finish-output http-stream) 784 | (with-character-stream-semantics 785 | (multiple-value-bind (server-protocol status-code status-text) 786 | ;; loop until status is NOT 100 787 | (loop for (server-protocol status-code status-text) 788 | = (read-status-line http-stream *header-stream*) 789 | when (= status-code 100) 790 | ;; ignore headers sent until non-100 status is seen 791 | do (read-http-headers http-stream *header-stream*) 792 | until (/= status-code 100) 793 | finally (return (values server-protocol status-code status-text))) 794 | (let ((headers (read-http-headers http-stream *header-stream*)) 795 | body external-format-body) 796 | (let ((connections (header-value :connection headers))) 797 | (when connections 798 | (setq connections (split-tokens connections))) 799 | (when (or (member "close" connections :test #'string-equal) 800 | (not (or (and (eq protocol :http/1.1) 801 | (eq server-protocol :http/1.1)) 802 | (member "Keep-Alive" connections 803 | :test #'string-equal)))) 804 | (setq must-close t))) 805 | (when cookie-jar 806 | (update-cookies (get-cookies headers uri) cookie-jar)) 807 | (when (and redirect 808 | (member status-code +redirect-codes+) 809 | (header-value :location headers)) 810 | (unless (or (eq redirect t) 811 | (and (integerp redirect) 812 | (plusp redirect))) 813 | (cerror "Continue anyway." 814 | 'drakma-simple-error 815 | :format-control "Status code was ~A, but ~ 816 | ~:[REDIRECT is ~S~;redirection limit has been exceeded~]." 817 | :format-arguments (list status-code (integerp redirect) redirect))) 818 | (when auto-referer 819 | (setq additional-headers (set-referer uri additional-headers))) 820 | (let* ((location (header-value :location headers)) 821 | (new-uri (let (puri:*strict-parse*) 822 | (puri:merge-uris location uri))) 823 | ;; can we re-use the stream? 824 | (old-server-p (and (string= (puri:uri-host new-uri) 825 | (puri:uri-host uri)) 826 | (eql (puri:uri-port new-uri) 827 | (puri:uri-port uri)) 828 | (eq (puri:uri-scheme new-uri) 829 | (puri:uri-scheme uri))))) 830 | (unless old-server-p 831 | (setq must-close t 832 | want-stream nil)) 833 | ;; try to re-use the stream, but only 834 | ;; if the user hasn't opted for a 835 | ;; connection which is always secure 836 | (let ((re-use-stream (and old-server-p 837 | (not must-close) 838 | (not force-ssl)))) 839 | ;; close stream if we can't re-use it 840 | (unless re-use-stream 841 | (ignore-errors (close http-stream))) 842 | (setq done t) 843 | (return-from http-request 844 | (let ((method (if (and (member status-code +redirect-to-get-codes+) 845 | (member method +redirect-to-get-methods+)) 846 | :get 847 | method))) 848 | (apply #'http-request new-uri 849 | :method method 850 | :redirect (cond ((integerp redirect) (1- redirect)) 851 | (t redirect)) 852 | :stream (and re-use-stream http-stream) 853 | :additional-headers (remove "Authorization" additional-headers 854 | :test 'string-equal :key 'car) 855 | :parameters parameters 856 | :preserve-uri t 857 | :form-data (if (eq method :get) 858 | nil 859 | form-data) 860 | args)))))) 861 | (let ((transfer-encodings (header-value :transfer-encoding headers))) 862 | (when transfer-encodings 863 | (setq transfer-encodings (split-tokens transfer-encodings))) 864 | (when (member "chunked" transfer-encodings :test #'equalp) 865 | (setf (chunked-stream-input-chunking-p 866 | (flexi-stream-stream http-stream)) t))) 867 | (when (setq external-format-body 868 | (and (not force-binary) 869 | (funcall *body-format-function* 870 | headers external-format-in))) 871 | (setf (flexi-stream-external-format http-stream) 872 | external-format-body)) 873 | (when force-binary 874 | (setf (flexi-stream-element-type http-stream) 'octet)) 875 | (unless (or want-stream 876 | (eq method :head) 877 | (= status-code 204)) 878 | (let (trailers) 879 | (multiple-value-setq (body trailers) 880 | (read-body http-stream headers external-format-body 881 | :decode-content decode-content)) 882 | (when trailers 883 | (drakma-warn "Adding trailers from chunked encoding to HTTP headers.") 884 | (setq headers (nconc headers trailers))))) 885 | (setq done t) 886 | (values (if want-stream 887 | (decode-flexi-stream headers http-stream 888 | :decode-content decode-content) 889 | body) 890 | status-code 891 | headers 892 | uri 893 | http-stream 894 | must-close 895 | status-text)))))) 896 | (when (eq content :continuation) 897 | (return-from http-request #'finish-request)) 898 | (finish-request content))))) 899 | ;; the cleanup form of the UNWIND-PROTECT above 900 | (when (and http-stream 901 | (or (not done) 902 | (and must-close 903 | (not want-stream))) 904 | (not (eq content :continuation))) 905 | (ignore-errors (close http-stream))))))) 906 | -------------------------------------------------------------------------------- /specials.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: DRAKMA; Base: 10 -*- 2 | ;;; $Header: /usr/local/cvsrep/drakma/specials.lisp,v 1.19 2008/01/14 01:57:02 edi Exp $ 3 | 4 | ;;; Copyright (c) 2006-2012, Dr. Edmund Weitz. All rights reserved. 5 | 6 | ;;; Redistribution and use in source and binary forms, with or without 7 | ;;; modification, are permitted provided that the following conditions 8 | ;;; are met: 9 | 10 | ;;; * Redistributions of source code must retain the above copyright 11 | ;;; notice, this list of conditions and the following disclaimer. 12 | 13 | ;;; * Redistributions in binary form must reproduce the above 14 | ;;; copyright notice, this list of conditions and the following 15 | ;;; disclaimer in the documentation and/or other materials 16 | ;;; provided with the distribution. 17 | 18 | ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED 19 | ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 20 | ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 21 | ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY 22 | ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE 24 | ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 25 | ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 26 | ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 27 | ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 28 | ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | 30 | (in-package :drakma) 31 | 32 | (defparameter *drakma-version* #.(asdf:component-version (asdf:find-system :drakma)) 33 | "Drakma's version number as a string.") 34 | 35 | (defmacro define-constant (name value &optional doc) 36 | "A version of DEFCONSTANT for, cough, /strict/ CL implementations." 37 | ;; See 38 | `(defconstant ,name (if (boundp ',name) (symbol-value ',name) ,value) 39 | ,@(when doc (list doc)))) 40 | 41 | (define-constant +latin-1+ (make-external-format :latin-1 :eol-style :lf) 42 | "Default external format when reading headers.") 43 | 44 | (define-constant +redirect-codes+ '(301 302 303 307) 45 | "A list of all HTTP return codes that redirect us to another URI.") 46 | 47 | (define-constant +redirect-to-get-codes+ '(302 303) 48 | "A list of HTTP return codes that redirect using a GET method 49 | (see http://en.wikipedia.org/wiki/Post/Redirect/Get).") 50 | 51 | (define-constant +known-methods+ '(:copy 52 | :delete 53 | :get 54 | :head 55 | :lock 56 | :mkcol 57 | :move 58 | :options 59 | :options* 60 | :patch 61 | :post 62 | :propfind 63 | :proppatch 64 | :put 65 | :report 66 | :trace 67 | :unlock) 68 | "The HTTP methods \(including WebDAV methods) Drakma knows.") 69 | 70 | (define-constant +redirect-to-get-methods+ '(:post) 71 | "A list of HTTP methods that should be changed to GET in case of redirect 72 | (see http://en.wikipedia.org/wiki/Post/Redirect/Get).") 73 | 74 | (defconstant +buffer-size+ 8192) 75 | 76 | (defvar *drakma-default-external-format* ':latin-1 77 | "The default value for the external format keyword arguments of 78 | HTTP-REQUEST. The value of this variable will be interpreted by 79 | FLEXI-STREAMS. The initial value is the keyword :LATIN-1. 80 | (Note that Drakma binds *DEFAULT-EOL-STYLE* to :LF).") 81 | 82 | (defvar *header-stream* nil 83 | "If this variable is not NIL, it should be bound to a stream to 84 | which incoming and outgoing headers will be written for debugging 85 | purposes.") 86 | 87 | (defvar *allow-dotless-cookie-domains-p* nil 88 | "When this variable is not NIL, cookie domains containing no dots 89 | are considered valid. The default is NIL, meaning to disallow such 90 | domains except for \"localhost\".") 91 | 92 | (defvar *ignore-unparseable-cookie-dates-p* nil 93 | "Whether Drakma is allowed to treat `Expires' dates in cookie 94 | headers as non-existent if it can't parse them. If the value of this 95 | variable is NIL \(which is the default), an error will be signalled 96 | instead.") 97 | 98 | (defvar *remove-duplicate-cookies-p* t 99 | "Determines how duplicate cookies in the response are handled, 100 | defaults to T. Cookies are considered duplicate using COOKIE=. Valid 101 | values are: 102 | 103 | NIL - duplicates will not be removed, 104 | T or :KEEP-LAST - for duplicates, only the last cookie value will be kept, based on the 105 | order of the response header, 106 | :KEEP-FIRST - for duplicates, only the first cookie value will be kept, based on the order of the response 107 | header. 108 | 109 | Misbehaving servers may send duplicate cookies back in the 110 | same Set-Cookie header: 111 | 112 | HTTP/1.1 200 OK 113 | Server: My-hand-rolled-server 114 | Date: Wed, 07 Apr 2010 15:12:30 GMT 115 | Connection: Close 116 | Content-Type: text/html 117 | Content-Length: 82 118 | Set-Cookie: a=1; Path=/; Secure, a=2; Path=/; Secure 119 | 120 | In this case Drakma has to choose whether cookie 'a' has the value '1' 121 | or '2'. By default, Drakma will choose the last value specified, in 122 | this case '2'. By default, Drakma conforms to RFC2109 HTTP State 123 | Management Mechanism, section 4.3.3 Cookie Management: 124 | 125 | If a user agent receives a Set-Cookie response header whose NAME 126 | is the same as a pre-existing cookie, and whose Domain and Path 127 | attribute values exactly \(string) match those of a pre-existing 128 | cookie, the new cookie supersedes the old.") 129 | 130 | (defvar *text-content-types* '(("text" . nil)) 131 | "A list of conses which are used by the default value of 132 | *BODY-FORMAT-FUNCTION* to decide whether a 'Content-Type' header 133 | denotes text content. The car and cdr of each cons should each be a 134 | string or NIL. A content type matches one of these 135 | entries (and thus denotes text) if the type part is STRING-EQUAL 136 | to the car or if the car is NIL and if the subtype part 137 | is STRING-EQUAL 138 | to the cdr or if the cdr is NIL. 139 | 140 | The initial value of this variable is the list 141 | 142 | \((\"text\" . nil)) 143 | 144 | which means that every content type that starts with \"text/\" is 145 | regarded as text, no matter what the subtype is.") 146 | 147 | (defvar *body-format-function* 'determine-body-format 148 | "A function which determines whether the content body returned by 149 | the server is text and should be treated as such or not. The function 150 | is called after the request headers have been read and it must accept 151 | two arguments, headers and external-format-in, where headers is like 152 | the third return value of HTTP-REQUEST while external-format-in is the 153 | HTTP-REQUEST argument of the same name. It should return NIL if the 154 | body should be regarded as binary content, or a FLEXI-STREAMS external 155 | format \(which will be used to read the body) otherwise. 156 | 157 | This function will only be called if the force-binary argument to 158 | HTTP-REQUEST is NIL. 159 | 160 | The initial value of this variable is a function which uses 161 | *TEXT-CONTENT-TYPES* to determine whether the body is text and then 162 | proceeds as described in the HTTP-REQUEST documentation entry.") 163 | 164 | (defvar *time-zone-map* 165 | ;; list taken from 166 | ;; 167 | '(("A" . -1) 168 | ("ACDT" . -10.5) 169 | ("ACST" . -9.5) 170 | ("ADT" . 3) 171 | ("AEDT" . -11) 172 | ("AEST" . -10) 173 | ("AKDT" . 8) 174 | ("AKST" . 9) 175 | ("AST" . 4) 176 | ("AWDT" . -9) 177 | ("AWST" . -8) 178 | ("B" . -2) 179 | ("BST" . -1) 180 | ("C" . -3) 181 | ("CDT" . 5) 182 | ("CEDT" . -2) 183 | ("CEST" . -2) 184 | ("CET" . -1) 185 | ("CST" . -10.5) 186 | ("CST" . -9.5) 187 | ("CST" . 6) 188 | ("CXT" . -7) 189 | ("D" . -4) 190 | ("E" . -5) 191 | ("EDT" . 4) 192 | ("EEDT" . -3) 193 | ("EEST" . -3) 194 | ("EET" . -2) 195 | ("EST" . -11) 196 | ("EST" . -10) 197 | ("EST" . 5) 198 | ("F" . -6) 199 | ("G" . -7) 200 | ("GMT" . 0) 201 | ("H" . -8) 202 | ("HAA" . 3) 203 | ("HAC" . 5) 204 | ("HADT" . 9) 205 | ("HAE" . 4) 206 | ("HAP" . 7) 207 | ("HAR" . 6) 208 | ("HAST" . 10) 209 | ("HAT" . 2.5) 210 | ("HAY" . 8) 211 | ("HNA" . 4) 212 | ("HNC" . 6) 213 | ("HNE" . 5) 214 | ("HNP" . 8) 215 | ("HNR" . 7) 216 | ("HNT" . 3.5) 217 | ("HNY" . 9) 218 | ("I" . -9) 219 | ("IST" . -1) 220 | ("K" . -10) 221 | ("L" . -11) 222 | ("M" . -12) 223 | ("MDT" . 6) 224 | ("MESZ" . -2) 225 | ("MEZ" . -1) 226 | ("MST" . 7) 227 | ("N" . 1) 228 | ("NDT" . 2.5) 229 | ("NFT" . -11.5) 230 | ("NST" . 3.5) 231 | ("O" . 2) 232 | ("P" . 3) 233 | ("PDT" . 7) 234 | ("PST" . 8) 235 | ("Q" . 4) 236 | ("R" . 5) 237 | ("S" . 6) 238 | ("T" . 7) 239 | ("U" . 8) 240 | ("UTC" . 0) 241 | ("V" . 9) 242 | ("W" . 10) 243 | ("WEDT" . -1) 244 | ("WEST" . -1) 245 | ("WET" . 0) 246 | ("WST" . -9) 247 | ("WST" . -8) 248 | ("X" . 11) 249 | ("Y" . 12) 250 | ("Z" . 0)) 251 | "An alist which maps time zone abbreviations to Common Lisp 252 | timezones.") 253 | 254 | (defvar *default-http-proxy* nil 255 | "HTTP proxy to be used as default. If not NIL, it should be a string 256 | denoting a proxy server through which the request should be sent. Or 257 | it can be a list of two values - a string denoting the proxy server 258 | and an integer denoting the port to use \(which will default to 80 259 | otherwise).") 260 | 261 | ;; stuff for Nikodemus Siivola's HYPERDOC 262 | ;; see 263 | ;; and 264 | ;; also used by LW-ADD-ONS 265 | 266 | (defvar *no-proxy-domains* nil 267 | "A list of domains for which a proxy should not be used.") 268 | 269 | (defvar *hyperdoc-base-uri* "http://weitz.de/drakma/") 270 | 271 | (let ((exported-symbols-alist 272 | (loop for symbol being the external-symbols of :drakma 273 | collect (cons symbol 274 | (concatenate 'string 275 | "#" 276 | (string-downcase symbol)))))) 277 | (defun hyperdoc-lookup (symbol type) 278 | (declare (ignore type)) 279 | (cdr (assoc symbol 280 | exported-symbols-alist 281 | :test #'eq)))) 282 | -------------------------------------------------------------------------------- /test/drakma-test.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- 2 | 3 | ;;; Copyright (c) 2013, Anton Vodonosov. All rights reserved. 4 | 5 | ;;; Redistribution and use in source and binary forms, with or without 6 | ;;; modification, are permitted provided that the following conditions 7 | ;;; are met: 8 | 9 | ;;; * Redistributions of source code must retain the above copyright 10 | ;;; notice, this list of conditions and the following disclaimer. 11 | 12 | ;;; * Redistributions in binary form must reproduce the above 13 | ;;; copyright notice, this list of conditions and the following 14 | ;;; disclaimer in the documentation and/or other materials 15 | ;;; provided with the distribution. 16 | 17 | ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED 18 | ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 19 | ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 20 | ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY 21 | ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 22 | ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE 23 | ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 24 | ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 25 | ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 26 | ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 27 | ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | 29 | (defpackage :drakma-test 30 | (:use :cl :fiveam)) 31 | 32 | (in-package :drakma-test) 33 | 34 | (def-suite :drakma) 35 | (in-suite :drakma) 36 | 37 | (defparameter *http-server* nil) 38 | 39 | (def-fixture init-destroy-httpd () 40 | (unwind-protect 41 | (progn 42 | (setf *http-server* 43 | (make-instance 'hunchentoot:easy-acceptor 44 | :port 10456 45 | :address "127.0.0.1")) 46 | (hunchentoot:start *http-server*) 47 | (&body)) 48 | (progn 49 | (when *http-server* 50 | (hunchentoot:stop *http-server*) 51 | (setf *http-server* nil))))) 52 | 53 | (test get-google 54 | (let ((drakma:*header-stream* *standard-output*)) 55 | (multiple-value-bind (body-or-stream status-code) 56 | (drakma:http-request "http://google.com/") 57 | (is (> (length body-or-stream) 0)) 58 | (is (= 200 status-code))))) 59 | 60 | #-:drakma-no-chipz 61 | (test get-google-gzip 62 | (let ((drakma:*header-stream* *standard-output*)) 63 | (multiple-value-bind (body-or-stream status-code) 64 | (drakma:http-request "https://www.google.com/" 65 | :additional-headers '(("Accept-Encoding" . "gzip")) 66 | :decode-content t) 67 | (is (> (length body-or-stream) 0)) 68 | (is (= 200 status-code))))) 69 | 70 | #-:drakma-no-chipz 71 | (test get-google-gzip-no-close 72 | (let ((drakma:*header-stream* *standard-output*)) 73 | (multiple-value-bind (body-or-stream status-code headers uri stream must-close) 74 | (drakma:http-request "https://www.google.com/" 75 | :additional-headers '(("Accept-Encoding" . "gzip")) 76 | :decode-content t 77 | :close nil) 78 | (declare (ignore headers uri)) 79 | (unless must-close 80 | (close stream)) 81 | (is (> (length body-or-stream) 0)) 82 | (is (= 200 status-code))))) 83 | 84 | (test get-google-ssl 85 | (let ((drakma:*header-stream* *standard-output*)) 86 | (multiple-value-bind (body-or-stream status-code) 87 | (drakma:http-request "https://google.com/") 88 | (is (> (length body-or-stream) 0)) 89 | (is (= 200 status-code))))) 90 | 91 | (test post-google 92 | (let ((drakma:*header-stream* *standard-output*)) 93 | (multiple-value-bind (body-or-stream status-code headers uri stream must-close reason-phrase) 94 | (drakma:http-request "http://google.com/" :method :post :parameters '(("a" . "b"))) 95 | (declare (ignore headers uri stream must-close)) 96 | (is (> (length body-or-stream) 0)) 97 | (is (= 405 status-code)) 98 | (is (string= "Method Not Allowed" reason-phrase))))) 99 | 100 | (test post-google-ssl 101 | (let ((drakma:*header-stream* *standard-output*)) 102 | (multiple-value-bind (body-or-stream status-code headers uri stream must-close reason-phrase) 103 | (drakma:http-request "https://google.com/" :method :post :parameters '(("a" . "b"))) 104 | (declare (ignore headers uri stream must-close)) 105 | (is (> (length body-or-stream) 0)) 106 | (is (= 405 status-code)) 107 | (is (string= "Method Not Allowed" reason-phrase))))) 108 | 109 | (test post-x-www-form 110 | (with-fixture init-destroy-httpd () 111 | (let ((drakma:*header-stream* *standard-output*)) 112 | (multiple-value-bind (body-or-stream status-code headers uri stream must-close) 113 | (drakma:http-request "http://127.0.0.1:10456/x-www-form/post" 114 | :method :post :parameters '(("a" . "b"))) 115 | (declare (ignore headers uri stream must-close)) 116 | (is (= (length body-or-stream) 0)) 117 | (is (= 201 status-code)))))) 118 | 119 | (test put-x-www-form 120 | "Beware, we just support this because it happens in the wild. 121 | But this is not according to HTTP spec." 122 | (with-fixture init-destroy-httpd () 123 | (let ((drakma:*header-stream* *standard-output*)) 124 | (multiple-value-bind (body-or-stream status-code headers uri stream must-close) 125 | (drakma:http-request "http://127.0.0.1:10456/x-www-form/put" 126 | :method :put :parameters '(("a" . "b"))) 127 | (declare (ignore headers uri stream must-close)) 128 | (is (= (length body-or-stream) 0)) 129 | (is (= 200 status-code)))))) 130 | 131 | (test post-multipart-form 132 | (with-fixture init-destroy-httpd () 133 | (let ((drakma:*header-stream* *standard-output*) 134 | (*default-pathname-defaults* #.(or *compile-file-pathname* *load-pathname*))) 135 | (multiple-value-bind (body-or-stream status-code headers uri stream must-close) 136 | (drakma:http-request "http://127.0.0.1:10456/multipart-form/post" 137 | :method :post :parameters '(("a" . #P"../README.md"))) 138 | (declare (ignore headers uri stream must-close)) 139 | (is (= (length body-or-stream) 0)) 140 | (is (= 201 status-code)))))) 141 | 142 | (test put-multipart-form 143 | "Beware, we just support this because it happens in the wild. 144 | But this is not according to HTTP spec." 145 | (with-fixture init-destroy-httpd () 146 | (let ((drakma:*header-stream* *standard-output*) 147 | (*default-pathname-defaults* #.(or *compile-file-pathname* *load-pathname*))) 148 | (multiple-value-bind (body-or-stream status-code headers uri stream must-close) 149 | (drakma:http-request "http://127.0.0.1:10456/multipart-form/put" 150 | :method :put :parameters '(("a" . #P"../README.md"))) 151 | (declare (ignore headers uri stream must-close)) 152 | (is (= (length body-or-stream) 0)) 153 | (is (= 200 status-code)))))) 154 | 155 | (test gzip-content 156 | (let ((drakma:*header-stream* *standard-output*) 157 | (drakma:*text-content-types* (cons '(nil . "json") drakma:*text-content-types*))) 158 | (multiple-value-bind (body-or-stream status-code) 159 | (drakma:http-request "http://httpbin.org/gzip" :decode-content t) 160 | (is (= 200 status-code)) 161 | (is (typep body-or-stream 'string)) 162 | (is (search "\"gzipped\": true" body-or-stream))))) 163 | 164 | (test deflate-content 165 | (let ((drakma:*header-stream* *standard-output*) 166 | (drakma:*text-content-types* (cons '(nil . "json") drakma:*text-content-types*))) 167 | (multiple-value-bind (body-or-stream status-code) 168 | (drakma:http-request "http://httpbin.org/deflate" :decode-content t) 169 | (is (= 200 status-code)) 170 | (is (typep body-or-stream 'string)) 171 | (is (search "\"deflated\": true" body-or-stream))))) 172 | 173 | (test gzip-content-undecoded 174 | (let ((drakma:*header-stream* *standard-output*)) 175 | (multiple-value-bind (body-or-stream status-code) 176 | (drakma:http-request "http://httpbin.org/gzip") 177 | (is (= 200 status-code)) 178 | (is (typep body-or-stream '(vector flexi-streams:octet))) 179 | (is (> (length body-or-stream) 0)) 180 | (is (equalp #(#x1f #x8b) 181 | (subseq body-or-stream 0 2)))))) 182 | 183 | (test deflate-content-undecoded 184 | (let ((drakma:*header-stream* *standard-output*)) 185 | (multiple-value-bind (body-or-stream status-code) 186 | (drakma:http-request "http://httpbin.org/deflate") 187 | (is (= 200 status-code)) 188 | (is (typep body-or-stream '(vector flexi-streams:octet))) 189 | (is (> (length body-or-stream) 0)) 190 | (is (equalp #x78 (aref body-or-stream 0)))))) 191 | 192 | (test stream 193 | (multiple-value-bind (stream status-code) 194 | (drakma:http-request "http://google.com/" :want-stream t) 195 | (is (streamp stream)) 196 | (is (= 200 status-code)) 197 | (is (subtypep (stream-element-type stream) 'character)) 198 | (let ((buffer (make-string 1))) 199 | (read-sequence buffer stream)))) 200 | 201 | (test force-binary 202 | (multiple-value-bind (stream status-code) 203 | (drakma:http-request "http://google.com/" :want-stream t :force-binary t) 204 | (is (streamp stream)) 205 | (is (= 200 status-code)) 206 | (is (subtypep (stream-element-type stream) 'flexi-streams:octet)) 207 | (let ((buffer (make-array 1 :element-type 'flexi-streams:octet))) 208 | (read-sequence buffer stream)))) 209 | 210 | (test verify.wrong.host 211 | (signals error 212 | (drakma:http-request "https://wrong.host.badssl.com/" :verify :required)) 213 | (signals error 214 | (drakma:http-request "https://wrong.host.badssl.com/" :verify :optional)) 215 | (finishes 216 | (drakma:http-request "https://wrong.host.badssl.com//" :verify nil))) 217 | 218 | (test verify.expired 219 | (signals error 220 | (drakma:http-request "https://expired.badssl.com//" :verify :required)) 221 | (signals error 222 | (drakma:http-request "https://expired.badssl.com/" :verify :optional)) 223 | (finishes 224 | (drakma:http-request "https://expired.badssl.com/" :verify nil))) 225 | 226 | (test verify.self-signed 227 | (signals error 228 | (drakma:http-request "https://self-signed.badssl.com/" :verify :required))) 229 | 230 | (test verify.untrusted-root 231 | (signals error 232 | (drakma:http-request "https://untrusted-root.badssl.com/" :verify :required))) 233 | 234 | 235 | ;; ------------------- server routes -------------------- 236 | 237 | (defun content-type-eq-p (expected-content-type header) 238 | (string= header 239 | expected-content-type 240 | :end1 (length expected-content-type))) 241 | 242 | (hunchentoot:define-easy-handler (x-www-form-post :uri "/x-www-form/post") () 243 | (let ((expected-content-type "application/x-www-form-urlencoded")) 244 | (assert (content-type-eq-p 245 | expected-content-type 246 | (hunchentoot:header-in "Content-Type" hunchentoot:*request*))) 247 | (assert (equalp '(("a" . "b")) (hunchentoot:post-parameters*)))) 248 | (setf (hunchentoot:return-code hunchentoot:*reply*) 201) 249 | "") 250 | 251 | (hunchentoot:define-easy-handler (x-www-form-put :uri "/x-www-form/put") () 252 | (let ((expected-content-type "application/x-www-form-urlencoded") 253 | (raw-body (hunchentoot:raw-post-data :force-text t))) 254 | (assert (content-type-eq-p 255 | expected-content-type 256 | (hunchentoot:header-in "Content-Type" hunchentoot:*request*))) 257 | (assert (string= "a=b" raw-body))) 258 | (setf (hunchentoot:return-code hunchentoot:*reply*) 200) 259 | "") 260 | 261 | (hunchentoot:define-easy-handler (multipart-form-post :uri "/multipart-form/post") () 262 | (let ((expected-content-type "multipart/form-data") 263 | (post-param (car (hunchentoot:post-parameters*)))) 264 | (assert (content-type-eq-p 265 | expected-content-type 266 | (hunchentoot:header-in "Content-Type" hunchentoot:*request*))) 267 | (assert (string= "a" (first post-param))) 268 | (assert (string= "README.md" (third post-param))) 269 | (assert (string= "application/octet-stream" (fourth post-param)))) 270 | (setf (hunchentoot:return-code hunchentoot:*reply*) 201) 271 | "") 272 | 273 | (hunchentoot:define-easy-handler (multipart-form-put :uri "/multipart-form/put") () 274 | (let ((expected-content-type "multipart/form-data") 275 | (raw-body (hunchentoot:raw-post-data :force-text t))) 276 | (assert (content-type-eq-p 277 | expected-content-type 278 | (hunchentoot:header-in "Content-Type" hunchentoot:*request*))) 279 | (assert (ppcre:scan "Content-Disposition: form-data; name=\"a\"; filename=\"README.md\"" 280 | raw-body)) 281 | (assert (ppcre:scan "Content-Type: application/octet-stream" 282 | raw-body))) 283 | (setf (hunchentoot:return-code hunchentoot:*reply*) 200) 284 | "") 285 | -------------------------------------------------------------------------------- /util.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: DRAKMA; Base: 10 -*- 2 | ;;; $Header: /usr/local/cvsrep/drakma/util.lisp,v 1.36 2008/05/30 11:30:45 edi Exp $ 3 | 4 | ;;; Copyright (c) 2006-2012, Dr. Edmund Weitz. All rights reserved. 5 | 6 | ;;; Redistribution and use in source and binary forms, with or without 7 | ;;; modification, are permitted provided that the following conditions 8 | ;;; are met: 9 | 10 | ;;; * Redistributions of source code must retain the above copyright 11 | ;;; notice, this list of conditions and the following disclaimer. 12 | 13 | ;;; * Redistributions in binary form must reproduce the above 14 | ;;; copyright notice, this list of conditions and the following 15 | ;;; disclaimer in the documentation and/or other materials 16 | ;;; provided with the distribution. 17 | 18 | ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED 19 | ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 20 | ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 21 | ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY 22 | ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE 24 | ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 25 | ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 26 | ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 27 | ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 28 | ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | 30 | (in-package :drakma) 31 | 32 | #+:lispworks 33 | (require "comm") 34 | 35 | #+:lispworks 36 | (eval-when (:compile-toplevel :load-toplevel :execute) 37 | (import 'lw:when-let)) 38 | 39 | #-:lispworks 40 | (defmacro when-let ((var expr) &body body) 41 | "Evaluates EXPR, binds it to VAR, and executes BODY if VAR has 42 | a true value." 43 | `(let ((,var ,expr)) 44 | (when ,var 45 | ,@body))) 46 | 47 | #+:lispworks 48 | (eval-when (:compile-toplevel :load-toplevel :execute) 49 | (import 'lw:with-unique-names)) 50 | 51 | #-:lispworks 52 | (defmacro with-unique-names ((&rest bindings) &body body) 53 | "Syntax: WITH-UNIQUE-NAMES ( { var | (var x) }* ) declaration* form* 54 | 55 | Executes a series of forms with each VAR bound to a fresh, 56 | uninterned symbol. The uninterned symbol is as if returned by a call 57 | to GENSYM with the string denoted by X - or, if X is not supplied, the 58 | string denoted by VAR - as argument. 59 | 60 | The variable bindings created are lexical unless special declarations 61 | are specified. The scopes of the name bindings and declarations do not 62 | include the Xs. 63 | 64 | The forms are evaluated in order, and the values of all but the last 65 | are discarded \(that is, the body is an implicit PROGN)." 66 | ;; reference implementation posted to comp.lang.lisp as 67 | ;; by Vebjorn Ljosa - see also 68 | ;; 69 | `(let ,(mapcar #'(lambda (binding) 70 | (check-type binding (or cons symbol)) 71 | (if (consp binding) 72 | (destructuring-bind (var x) binding 73 | (check-type var symbol) 74 | `(,var (gensym ,(etypecase x 75 | (symbol (symbol-name x)) 76 | (character (string x)) 77 | (string x))))) 78 | `(,binding (gensym ,(symbol-name binding))))) 79 | bindings) 80 | ,@body)) 81 | 82 | (defun ends-with-p (seq suffix &key (test #'char-equal)) 83 | "Returns true if the sequence SEQ ends with the sequence 84 | SUFFIX. Individual elements are compared with TEST." 85 | (let ((mismatch (mismatch seq suffix :from-end t :test test))) 86 | (or (null mismatch) 87 | (= mismatch (- (length seq) (length suffix)))))) 88 | 89 | (defun starts-with-p (seq prefix &key (test #'char-equal)) 90 | "Returns true if the sequence SEQ starts with the sequence 91 | PREFIX whereby the elements are compared using TEST." 92 | (let ((mismatch (mismatch seq prefix :test test))) 93 | (or (null mismatch) 94 | (= mismatch (length prefix))))) 95 | 96 | (defun url-encode (string external-format) 97 | "Returns a URL-encoded version of the string STRING using the 98 | external format EXTERNAL-FORMAT." 99 | (with-output-to-string (out) 100 | (loop for octet across (string-to-octets (or string "") 101 | :external-format external-format) 102 | for char = (code-char octet) 103 | do (cond ((or (char<= #\0 char #\9) 104 | (char<= #\a char #\z) 105 | (char<= #\A char #\Z) 106 | (find char "$-_.!*'()," :test #'char=)) 107 | (write-char char out)) 108 | ((char= char #\Space) 109 | (write-char #\+ out)) 110 | (t (format out "%~2,'0x" (char-code char))))))) 111 | 112 | (defun alist-to-url-encoded-string (alist external-format url-encoder) 113 | "ALIST is supposed to be an alist of name/value pairs where both 114 | names and values are strings \(or, for values, NIL). This function 115 | returns a string where this list is represented as for the content 116 | type `application/x-www-form-urlencoded', i.e. the values are 117 | URL-encoded using the external format EXTERNAL-FORMAT, the pairs are 118 | joined with a #\\& character, and each name is separated from its 119 | value with a #\\= character. If the value is NIL, no #\\= is used." 120 | (with-output-to-string (out) 121 | (loop for first = t then nil 122 | for (name . value) in alist 123 | unless first do (write-char #\& out) 124 | do (format out "~A~:[~;=~A~]" 125 | (funcall url-encoder name external-format) 126 | value 127 | (funcall url-encoder value external-format))))) 128 | 129 | (defun default-port (uri) 130 | "Returns the default port number for the \(PURI) URI URI. 131 | Works only with the http and https schemes." 132 | (ecase (puri:uri-scheme uri) 133 | (:http 80) 134 | (:https 443))) 135 | 136 | (defun non-default-port (uri) 137 | "If the \(PURI) URI specifies an explicit port number which is 138 | different from the default port its scheme, this port number is 139 | returned, otherwise NIL." 140 | (when-let (port (puri:uri-port uri)) 141 | (when (/= port (default-port uri)) 142 | port))) 143 | 144 | (defun user-agent-string (token) 145 | "Returns a corresponding user agent string if TOKEN is one of 146 | the keywords :DRAKMA, :FIREFOX, :EXPLORER, :OPERA, or :SAFARI. 147 | Returns TOKEN itself otherwise." 148 | (case token 149 | (:drakma 150 | (format nil "Drakma/~A (~A~@[ ~A~]; ~A;~@[ ~A;~] http://weitz.de/drakma/)" 151 | *drakma-version* 152 | (or (lisp-implementation-type) "Common Lisp") 153 | (or (lisp-implementation-version) "") 154 | (or #-:clisp (software-type) 155 | #+(or :win32 :mswindows) "Windows" 156 | #-(or :win32 :mswindows) "Unix") 157 | (or #-:clisp (software-version)))) 158 | (:firefox 159 | "Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.0.6) Gecko/20060728 Firefox/1.5.0.6") 160 | (:explorer 161 | "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.1.4322; .NET CLR 2.0.50727)") 162 | (:opera 163 | "Opera/9.01 (Windows NT 5.1; U; en)") 164 | (:safari 165 | "Mozilla/5.0 (Macintosh; U; Intel Mac OS X; en) AppleWebKit/418.8 (KHTML, like Gecko) Safari/419.3") 166 | (otherwise token))) 167 | 168 | (defun header-value (name headers) 169 | "If HEADERS is an alist of headers as returned by HTTP-REQUEST 170 | and NAME is a keyword naming a header, this function returns the 171 | corresponding value of this header \(or NIL if it's not in 172 | HEADERS)." 173 | (cdr (assoc name headers :test 174 | (etypecase name (keyword #'eq) (string #'equalp))))) 175 | 176 | (defun parameter-present-p (name parameters) 177 | "If PARAMETERS is an alist of parameters as returned by, for 178 | example, READ-TOKENS-AND-PARAMETERS and NAME is a string naming a 179 | parameter, this function returns the full parameter \(name and 180 | value) - or NIL if it's not in PARAMETERS." 181 | (assoc name parameters :test #'string-equal)) 182 | 183 | (defun parameter-value (name parameters) 184 | "If PARAMETERS is an alist of parameters as returned by, for 185 | example, READ-TOKENS-AND-PARAMETERS and NAME is a string naming a 186 | parameter, this function returns the value of this parameter - or 187 | NIL if it's not in PARAMETERS." 188 | (cdr (parameter-present-p name parameters))) 189 | 190 | (defun make-random-string (&optional (length 50)) 191 | "Generates and returns a random string length LENGTH. The 192 | string will consist solely of decimal digits and ASCII letters." 193 | (with-output-to-string (s) 194 | (dotimes (i length) 195 | (write-char (ecase (random 5) 196 | ((0 1) (code-char (+ #.(char-code #\a) (random 26)))) 197 | ((2 3) (code-char (+ #.(char-code #\A) (random 26)))) 198 | ((4) (code-char (+ #.(char-code #\0) (random 10))))) 199 | s)))) 200 | 201 | (defun safe-parse-integer (string) 202 | "Like PARSE-INTEGER, but returns NIL instead of signalling an error." 203 | (ignore-errors (parse-integer string))) 204 | 205 | (defun interpret-as-month (string) 206 | "Tries to interpret STRING as a string denoting a month and returns 207 | the corresponding number of the month. Accepts three-letter 208 | abbreviations like \"Feb\" and full month names likes \"February\". 209 | Finally, the function also accepts strings representing integers from 210 | one to twelve." 211 | (or (when-let (pos (position (subseq string 0 (min 3 (length string))) 212 | '("Jan" "Feb" "Mar" "Apr" "May" "Jun" 213 | "Jul" "Aug" "Sep" "Oct" "Nov" "Dec") 214 | :test #'string=)) 215 | (1+ pos)) 216 | (when-let (num (safe-parse-integer string)) 217 | (when (<= 1 num 12) 218 | num)))) 219 | 220 | (defun interpret-as-time-zone (string) 221 | "Tries to interpret STRING as a time zone abbreviation which can 222 | either be something like \"PST\" or \"GMT\" with an offset like 223 | \"GMT-02:00\"." 224 | (or (cdr (assoc string *time-zone-map* :test #'string=)) 225 | (cl-ppcre:register-groups-bind (sign hours minutes) ("(?:GMT|)\\s*([+-]?)(\\d\\d):?(\\d\\d)" string) 226 | (* (if (equal sign "-") 1 -1) 227 | (+ (parse-integer hours) (/ (parse-integer minutes) 60)))) 228 | (cookie-date-parse-error "Can't interpret ~S as a time zone." string))) 229 | 230 | (defun set-referer (referer-uri &optional alist) 231 | "Returns a fresh copy of the HTTP header list ALIST with the 232 | `Referer' header set to REFERER-URI. If REFERER-URI is NIL, the 233 | result will be a list of headers without a `Referer' header." 234 | (let ((alist-sans-referer (remove "Referer" alist :key #'car :test #'string=))) 235 | (cond (referer-uri (acons "Referer" referer-uri alist-sans-referer)) 236 | (t alist-sans-referer)))) 237 | 238 | (defun text-content-type-p (type subtype) 239 | "Returns a true value iff the combination of TYPE and SUBTYPE 240 | matches an entry of *TEXT-CONTENT-TYPES*. See docstring of 241 | *TEXT-CONTENT-TYPES* for more info." 242 | (loop for (candidate-type . candidate-subtype) in *text-content-types* 243 | thereis (and (or (null candidate-type) 244 | (string-equal type candidate-type)) 245 | (or (null candidate-subtype) 246 | (string-equal subtype candidate-subtype))))) 247 | 248 | (defmacro with-sequence-from-string ((stream string) &body body) 249 | "Kludge to make Chunga tokenizing functionality usable. Works like 250 | WITH-INPUT-FROM-STRING, but creates a sequence of octets that works 251 | with CHUNGA::PEEK-CHAR* and friends." 252 | `(flex:with-input-from-sequence (,stream (map 'list #'char-code ,string)) 253 | ,@body)) 254 | 255 | (defun split-set-cookie-string (string) 256 | "Splits the string STRING which is assumed to be the value of a 257 | `Set-Cookie' into parts corresponding to individual cookies and 258 | returns a list of these parts \(substrings). 259 | 260 | The string /should/ be split at commas, but heuristical approach is 261 | used instead which doesn't split at commas which are followed by what 262 | cannot be recognized as the start of the next cookie. This is 263 | necessary because servers send headers containing unquoted commas 264 | which are not meant as separators." 265 | ;; this would of course be a lot easier with CL-PPCRE's SPLIT 266 | (let ((cookie-start 0) 267 | (string-length (length string)) 268 | search-start 269 | result) 270 | (tagbody 271 | ;; at this point we know that COOKIE-START is the start of a new 272 | ;; cookie (at the start of the string or behind a comma) 273 | next-cookie 274 | (setq search-start cookie-start) 275 | ;; we reach this point if the last comma didn't separate two 276 | ;; cookies or if there was no previous comma 277 | skip-comma 278 | (unless (< search-start string-length) 279 | (return-from split-set-cookie-string (nreverse result))) 280 | ;; look is there's a comma 281 | (let* ((comma-pos (position #\, string :start search-start)) 282 | ;; and if so, look for a #\= behind the comma 283 | (equals-pos (and comma-pos (position #\= string :start comma-pos))) 284 | ;; check that (except for whitespace) there's only a token 285 | ;; (the name of the next cookie) between #\, and #\= 286 | (new-cookie-start-p (and equals-pos 287 | (every 'token-char-p 288 | (trim-whitespace string 289 | :start (1+ comma-pos) 290 | :end equals-pos))))) 291 | (when (and comma-pos (not new-cookie-start-p)) 292 | (setq search-start (1+ comma-pos)) 293 | (go skip-comma)) 294 | (let ((end-pos (or comma-pos string-length))) 295 | (push (trim-whitespace (subseq string cookie-start end-pos)) result) 296 | (setq cookie-start (1+ end-pos)) 297 | (go next-cookie)))))) 298 | 299 | #-:lispworks7.1 300 | (defun make-ssl-stream (http-stream &key certificate key certificate-password verify (max-depth 10) ca-file ca-directory 301 | hostname) 302 | "Attaches SSL to the stream HTTP-STREAM and returns the SSL stream 303 | \(which will not be equal to HTTP-STREAM)." 304 | (declare (ignorable http-stream certificate-password max-depth ca-directory hostname)) 305 | (check-type verify (member nil :optional :required)) 306 | (when (and certificate 307 | (not (probe-file certificate))) 308 | (error "certificate file ~A not found" certificate)) 309 | (when (and key 310 | (not (probe-file key))) 311 | (error "key file ~A not found" key)) 312 | (when (and ca-file 313 | (not (probe-file ca-file))) 314 | (error "ca file ~A not found" ca-file)) 315 | #+(and :allegro (not :allegro-cl-express) (not :drakma-no-ssl)) 316 | (socket:make-ssl-client-stream http-stream 317 | :certificate certificate 318 | :key key 319 | :certificate-password certificate-password 320 | :verify verify 321 | :max-depth max-depth 322 | :ca-file ca-file 323 | :ca-directory ca-directory) 324 | #+(and :mocl-ssl (not :drakma-no-ssl)) 325 | (progn 326 | (when (or ca-file ca-directory) 327 | (warn ":max-depth, :ca-file and :ca-directory arguments not available on this platform")) 328 | (rt:start-ssl http-stream :verify verify)) 329 | #+(and (or :allegro-cl-express (not :allegro)) (not :mocl-ssl) (not :drakma-no-ssl)) 330 | (let ((s http-stream) 331 | (ctx (cl+ssl:make-context :verify-depth max-depth 332 | :verify-mode cl+ssl:+ssl-verify-none+ 333 | :verify-callback nil 334 | :verify-location (or (and ca-file ca-directory 335 | (list ca-file ca-directory)) 336 | ca-file ca-directory 337 | :default)))) 338 | (cl+ssl:with-global-context (ctx :auto-free-p t) 339 | (cl+ssl:make-ssl-client-stream 340 | s 341 | :verify verify 342 | :hostname hostname 343 | :certificate certificate 344 | :key key 345 | :password certificate-password))) 346 | #+:drakma-no-ssl 347 | (error "SSL not supported. Remove :drakma-no-ssl from *features* to enable SSL")) 348 | 349 | (defun dissect-query (query-string) 350 | "Accepts a query string as in PURI:URI-QUERY and returns a 351 | corresponding alist of name/value pairs." 352 | (when query-string 353 | (loop for parameter-pair in (cl-ppcre:split "&" query-string) 354 | for (name value) = (cl-ppcre:split "=" parameter-pair :limit 2) 355 | collect (cons name value)))) 356 | --------------------------------------------------------------------------------