├── .pre-release.sh ├── doc ├── clixdoc.xsl ├── Makefile └── index.xml ├── drakma-test.asd ├── drakma.asd ├── packages.lisp ├── test └── drakma-test.lisp ├── conditions.lisp ├── read.lisp ├── CHANGELOG ├── specials.lisp ├── cookies.lisp ├── util.lisp └── request.lisp /.pre-release.sh: -------------------------------------------------------------------------------- 1 | cd doc; make 2 | -------------------------------------------------------------------------------- /doc/clixdoc.xsl: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ruricolist/drakma/master/doc/clixdoc.xsl -------------------------------------------------------------------------------- /doc/Makefile: -------------------------------------------------------------------------------- 1 | 2 | all: 3 | xsltproc --stringparam library-version `perl -ne 'print "$$1\n" if (/\(defvar \*drakma-version-string\* "(.*)"/)' ../drakma.asd` clixdoc.xsl index.xml > index.html 4 | -------------------------------------------------------------------------------- /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 | :serial t 32 | :version "0.1" 33 | :depends-on (:drakma :fiveam) 34 | :pathname #P"test/" 35 | :components ((:file "drakma-test"))) 36 | -------------------------------------------------------------------------------- /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 | :serial t 44 | :version "1.3.9" 45 | :components ((:file "packages") 46 | (:file "specials") 47 | (:file "conditions") 48 | (:file "util") 49 | (:file "read") 50 | (:file "cookies") 51 | (:file "request")) 52 | :depends-on (:puri 53 | :cl-base64 54 | :chunga 55 | :flexi-streams 56 | :cl-ppcre 57 | #-:lispworks :usocket 58 | #-(or :lispworks :allegro :mocl-ssl :drakma-no-ssl) :cl+ssl)) 59 | -------------------------------------------------------------------------------- /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 | #:drakma-condition 62 | #:drakma-error 63 | #:drakma-warning 64 | #:get-content-type 65 | #:header-value 66 | #:http-request 67 | #:parameter-error 68 | #:parameter-present-p 69 | #:parameter-value 70 | #:parse-cookie-date 71 | #:read-tokens-and-parameters 72 | #:split-tokens 73 | #:syntax-error 74 | #:url-encode)) 75 | -------------------------------------------------------------------------------- /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 | (test get-google 38 | (let ((drakma:*header-stream* *standard-output*)) 39 | (multiple-value-bind (body-or-stream status-code) 40 | (drakma:http-request "http://google.com/") 41 | (is (> (length body-or-stream) 0)) 42 | (is (= 200 status-code))))) 43 | 44 | (test get-google-ssl 45 | (let ((drakma:*header-stream* *standard-output*)) 46 | (multiple-value-bind (body-or-stream status-code) 47 | (drakma:http-request "https://google.com/") 48 | (is (> (length body-or-stream) 0)) 49 | (is (= 200 status-code))))) 50 | 51 | (test post-google 52 | (let ((drakma:*header-stream* *standard-output*)) 53 | (multiple-value-bind (body-or-stream status-code headers uri stream must-close reason-phrase) 54 | (drakma:http-request "http://google.com/" :method :post :parameters '(("a" . "b"))) 55 | (declare (ignore headers uri stream must-close)) 56 | (is (> (length body-or-stream) 0)) 57 | (is (= 405 status-code)) 58 | (is (string= "Method Not Allowed" reason-phrase))))) 59 | 60 | (test post-google-ssl 61 | (let ((drakma:*header-stream* *standard-output*)) 62 | (multiple-value-bind (body-or-stream status-code headers uri stream must-close reason-phrase) 63 | (drakma:http-request "https://google.com/" :method :post :parameters '(("a" . "b"))) 64 | (declare (ignore headers uri stream must-close)) 65 | (is (> (length body-or-stream) 0)) 66 | (is (= 405 status-code)) 67 | (is (string= "Method Not Allowed" reason-phrase))))) 68 | 69 | 70 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /CHANGELOG: -------------------------------------------------------------------------------- 1 | Version 1.3.9 2 | 2014-05-01 3 | Added SSL/TLS support for mocl (Wukix Inc) 4 | reindent and refactor cond into if (Hans Huebner) 5 | 6 | Version 1.3.8 7 | 2014-02-25 8 | Determine version number from asdf package (Hans Huebner) 9 | Silence warning on LispWorks (Hans Huebner) 10 | All symbols from puri are prefixed with puri:. (Kilian Sprotte) 11 | 12 | Version 1.3.7 13 | 2013-11-21 14 | Dummy without any functional changes 15 | 16 | Version 1.3.6 17 | Documentation fixes (thanks to sarvid and stassats for the report) 18 | 19 | Version 1.3.5 20 | Ignore incoming Content-Length header when chunking is on 21 | Make POST requests use external-format-out for multipart/form-data. (Raymond Wiker) 22 | Fixed the link to the SBCL documentation pertaining to "defining constants" (Aaron France) 23 | Added *NO-PROXY-DOMAINS* special variable (Aaron France) 24 | 25 | Version 1.3.4 26 | Add *default-http-proxy* special variable (Tomas Zellerin) 27 | 28 | Version 1.3.3 29 | Change handling of empty and missing Location headers (Paul M. Rodriguez) 30 | 31 | Version 1.3.2 32 | Redirect to GET only for POST requests (Vsevolod Dyomkin) 33 | 34 | Version 1.3.1 35 | 2013-03-23 36 | When redirecting from POST to GET, clear the FORM-DATA flag 37 | Add trivial test suite (Anton Vodonosov) 38 | 39 | Version 1.3.0 40 | 2012-12-28 41 | Redirect HTTP 302 and 303 using GET (Orivej Desh) 42 | Add URL-ENCODER keyword argument 43 | Move documentation to XML format and update docstrings 44 | 45 | Version 1.2.9 46 | 2012-10-18 47 | Fix bug with Content-Length computation (Manabu Takayama) 48 | Add REAL-HOST keyword argument (Orivej Desh) 49 | 50 | Version 1.2.8 51 | 2012-09-12 52 | fix the computation of request's Content-Length (Manabu Takayama) 53 | 54 | Version 1.2.7 55 | 2012-08-16 56 | Support :REPORT method (Cyrus Harmon) 57 | Make PRESERVE-URI work better - PURI:URI mangles paths with encoded &'s. 58 | 59 | Version 1.2.6 60 | 2012-03-03 61 | Enable timeouts for more implementations (Francisco Vides Fernández) 62 | Export URL-ENCODE (suggested by Rob Blackwell) 63 | Fix incorrect range header syntax 64 | 65 | Version 1.2.5 66 | 2012-01-30 67 | use cl-ppcre:split instead of split-string to fix bug with GET 68 | parameter handling (thanks to Rob Blackwell) 69 | use :nodelay :if-supported (Anton Vodonosov) 70 | Allow specification of client certificate (all platforms) 71 | Add arguments that allow validation of server certificate 72 | 73 | Version 1.2.4 74 | 2011-08-31 75 | Make sure GET parameters are always URL-encoded 76 | Add :RANGE keyword argument (Hans Huebner) 77 | Better handling of optional filenames when uploading (Stas Boukarev) 78 | Don't funcall symbols that aren't FBOUNDP (Fare Rideau) 79 | Allow disabling of SSL when building (Marko Kocic) 80 | 81 | Version 1.2.3 82 | 2010-08-05 83 | Fix UPDATE-COOKIES (Vsevolod Dyomkin) 84 | Fix typo in documentation HTML (Walter Rader) 85 | 86 | Version 1.2.2 87 | 2010-07-10 88 | Make sure pathless URIs work (Hans Huebner, Manuel Odendahl) 89 | 90 | Version 1.2.1 91 | 2010-05-19 92 | Fix a couple of typos (thanks to Stelian Ionescu, Giovanni Gigante, and Zach Beane) 93 | 94 | Version 1.2.0 95 | 2010-05-19 96 | Introduced *REMOVE-DUPLICATE-COOKIES-P* (Ryan Davis) 97 | Enabled https through a proxy (Bill St. Clair and Dave Lambert) 98 | Bugfix for redirect of a request through a proxy (Bill St. Clair) 99 | Export PARSE-COOKIE-DATE 100 | Safer method to render URIs 101 | Allowed for GET/POST parameters without a value (seen on Lotus webservers) 102 | 103 | Version 1.1.0 104 | 2009-12-01 105 | Allowed additional headers to be function designators (suggested by Xiangjun Wu) 106 | Be more liberal when parsing cookies (thanks to Andrei Stebakov) 107 | Added HTTP method PATCH (thanks to Xiangjun Wu) 108 | Don't send GET parameters again when redirecting (reported by Eugene Ossintsev) 109 | Solidify feature expressions (thanks to Joshua Taylor) 110 | Make SEND-COOKIE-P work for pathless URIs (thanks to Tomo Matsumoto) 111 | 112 | Version 1.0.0 113 | 2009-02-19 114 | Use the new ("binary") version of Chunga 115 | Added conditions types 116 | Some performance improvements 117 | Be more lenient about content length (thanks to Zach Beane and "pix") 118 | Added *ALLOW-DOTLESS-COOKIE-DOMAINS-P* (thanks to Daniel Janus) 119 | Fix generation of user agent header (bug caught by Chaitanya Gupta) 120 | Added DEADLINE parameter for CCL (thanks to Hans Huebner) 121 | Fixed bug where READ-BODY returned NIL although TEXTP was true (thanks to Hans Huebner) 122 | 123 | Version 0.11.5 124 | 2008-03-21 125 | Added workaround for CLISP (thanks to Anton Vodonosov) 126 | 127 | Version 0.11.4 128 | 2008-02-13 129 | Improved error detection in MAKE-FORM-DATA-FUNCTION (suggested by Daniel Janus) 130 | 131 | Version 0.11.3 132 | 2008-01-14 133 | The previous change is only needed for Windows 134 | 135 | Version 0.11.2 136 | 2008-01-14 137 | Disable WRITE-TIMEOUT for LW 5.0 if SSL is used (reported by Nico de Jager) 138 | 139 | Version 0.11.1 140 | 2007-10-11 141 | Make Drakma work with AllegroCL's "modern" mode (patch by Ross Jekel) 142 | Needs at least Chunga 0.4.1 and FLEXI-STREAMS 0.13.1 143 | 144 | Version 0.11.0 145 | 2007-10-01 146 | Added *TEXT-CONTENT-TYPES* and *BODY-FORMAT-FUNCTION* (suggested by Peter Eddy) 147 | 148 | Version 0.10.2 149 | 2007-09-29 150 | Fixed bug introduced in latest change... (reported by Ross Jekel) 151 | 152 | Version 0.10.1 153 | 2007-09-25 154 | Use parameters in URI if they weren't used up for the content body (suggested by Jan Rychter) 155 | 156 | Version 0.10.0 157 | 2007-09-18 158 | Added support for "HttpOnly" cookie attribute (due to a bug report by Alexey Goldin) 159 | 160 | Version 0.9.1 161 | 2007-07-12 162 | Improved CL+SSL support (patch by David Lichteblau) 163 | 164 | Version 0.9.0 165 | 2007-06-30 166 | Added reason phrase to return values (patch by Holger Duerer) 167 | 168 | Version 0.8.0 169 | 2007-06-25 170 | In cookie dates, accept time zones different from "GMT" (reported by Didier Verna) 171 | Added *ignore-unparseable-cookie-dates-p* 172 | 173 | Version 0.7.1 174 | 2007-06-17 175 | Allow streams or functions as file designators (suggested by Andrei Stebakov) 176 | 177 | Version 0.7.0 178 | 2007-04-07 179 | Switched from trivial-sockets to usocket (patch by Erik Huelsmann) 180 | 181 | Version 0.6.2 182 | 2007-03-09 183 | Fixed release dates (thanks to Jeffrey Cunningham) 184 | 185 | Version 0.6.1 186 | 2007-03-08 187 | Changed SPLIT-STRING so that it doesn't rely on unspecified behaviour (reported by Jianshi Huang) 188 | 189 | Version 0.6.0 190 | 2007-02-08 191 | Make sure stream is closed in case of early errors (thanks to Chris Dean for test data) 192 | Robustified cookie parsing 193 | Send all outgoing cookies in one fell swoop (for Sun's buggy web server) 194 | Deal with empty Location headers 195 | Deal with corrupted Content-Type headers 196 | 197 | Version 0.5.5 198 | 2007-02-05 199 | Fixed socket leak in case of redirects (bug report by Chris Dean) 200 | 201 | Version 0.5.4 202 | 2006-12-01 203 | Workaround for servers which send headers after 100 status line (provided by Donavon Keithley) 204 | 205 | Version 0.5.3 206 | 2006-10-11 207 | Set stream element type for binary streams as needed for CLISP (reported by Magnus Henoch) 208 | 209 | Version 0.5.2 210 | 2006-10-08 211 | Adhere to user-provided content length if FORM-DATA is true 212 | 213 | Version 0.5.1 214 | 2006-10-07 215 | Take Content-Encoding header into account (due to a bug report by Gregory Tod) 216 | 217 | Version 0.5.0 218 | 2006-09-25 219 | Fixed bug where body sometimes wasn't read (reported by Ivan Toshkov) 220 | Added AUTO-REFERER feature (thanks to Colin Simmonds) 221 | 222 | Version 0.4.4 223 | 2006-09-24 224 | Treat "localhost" special for cookies (reported by Ivan Toshkov) 225 | 226 | Version 0.4.3 227 | 2006-09-24 228 | Circumvent CL+SSL for AllegroCL (suggested by David Lichteblau) 229 | 230 | Version 0.4.2 231 | 2006-09-07 232 | Fixed :OPTIONS* method 233 | 234 | Version 0.4.1 235 | 2006-09-07 236 | Added more methods including :OPTIONS* pseudo method (suggested by Ralf Mattes) 237 | Always (except for POST) add parameters to URI query 238 | Always read body (unless there's no chunking and no content length) 239 | 240 | Version 0.4.0 241 | 2006-09-05 242 | Added file uploads 243 | Added multipart/form-data 244 | Added enforced computation of request bodies in RAM 245 | Use LF line endings in default external format 246 | 247 | Version 0.3.1 248 | 2006-09-04 249 | Don't use underlying streams of flexi streams anymore 250 | Returned streams now have element type OCTET when FORCE-BINARY is true 251 | Better default "User-Agent" header for some Lisps 252 | Added info about mailing lists 253 | Added note about Gentoo 254 | 255 | Version 0.3.0 256 | 2006-09-02 257 | Added client-side chunked encoding and various ways to send the content 258 | 259 | Version 0.2.0 260 | 2006-09-01 261 | Completely re-factored for portability, chunking code is in Chunga now 262 | 263 | Version 0.1.3 264 | 2006-08-30 265 | REQUIRE "comm" before WITH-STREAM-INPUT-BUFFER is used 266 | 267 | Version 0.1.2 268 | 2006-08-27 269 | Notes about SSL and listener font 270 | 271 | Version 0.1.1 272 | 2006-08-27 273 | Note about CL-BASE64 and KMRCL 274 | 275 | Version 0.1.0 276 | 2006-08-27 277 | First public release 278 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 #'eq))) 174 | 175 | (defun parameter-present-p (name parameters) 176 | "If PARAMETERS is an alist of parameters as returned by, for 177 | example, READ-TOKENS-AND-PARAMETERS and NAME is a string naming a 178 | parameter, this function returns the full parameter \(name and 179 | value) - or NIL if it's not in PARAMETERS." 180 | (assoc name parameters :test #'string-equal)) 181 | 182 | (defun parameter-value (name parameters) 183 | "If PARAMETERS is an alist of parameters as returned by, for 184 | example, READ-TOKENS-AND-PARAMETERS and NAME is a string naming a 185 | parameter, this function returns the value of this parameter - or 186 | NIL if it's not in PARAMETERS." 187 | (cdr (parameter-present-p name parameters))) 188 | 189 | (defun make-random-string (&optional (length 50)) 190 | "Generates and returns a random string length LENGTH. The 191 | string will consist solely of decimal digits and ASCII letters." 192 | (with-output-to-string (s) 193 | (dotimes (i length) 194 | (write-char (ecase (random 5) 195 | ((0 1) (code-char (+ #.(char-code #\a) (random 26)))) 196 | ((2 3) (code-char (+ #.(char-code #\A) (random 26)))) 197 | ((4) (code-char (+ #.(char-code #\0) (random 10))))) 198 | s)))) 199 | 200 | (defun safe-parse-integer (string) 201 | "Like PARSE-INTEGER, but returns NIL instead of signalling an error." 202 | (ignore-errors (parse-integer string))) 203 | 204 | (defun interpret-as-month (string) 205 | "Tries to interpret STRING as a string denoting a month and returns 206 | the corresponding number of the month. Accepts three-letter 207 | abbreviations like \"Feb\" and full month names likes \"February\". 208 | Finally, the function also accepts strings representing integers from 209 | one to twelve." 210 | (or (when-let (pos (position (subseq string 0 (min 3 (length string))) 211 | '("Jan" "Feb" "Mar" "Apr" "May" "Jun" 212 | "Jul" "Aug" "Sep" "Oct" "Nov" "Dec") 213 | :test #'string=)) 214 | (1+ pos)) 215 | (when-let (num (safe-parse-integer string)) 216 | (when (<= 1 num 12) 217 | num)))) 218 | 219 | (defun interpret-as-time-zone (string) 220 | "Tries to interpret STRING as a time zone abbreviation which can 221 | either be something like \"PST\" or \"GMT\" with an offset like 222 | \"GMT-02:00\"." 223 | (when-let (zone (cdr (assoc string *time-zone-map* :test #'string=))) 224 | (return-from interpret-as-time-zone zone)) 225 | (unless (and (= (length string) 9) 226 | (starts-with-p string "GMT") 227 | (find (char string 3) "+-" :test #'char=) 228 | (char= (char string 6) #\:) 229 | (every (lambda (pos) 230 | (digit-char-p (char string pos))) 231 | '(4 5 7 8))) 232 | (cookie-date-parse-error "Can't interpret ~S as a time zone." string)) 233 | (let ((hours (parse-integer string :start 4 :end 6)) 234 | (minutes (parse-integer string :start 7 :end 9))) 235 | (* (if (char= (char string 3) #\+) -1 1) 236 | (+ hours (/ minutes 60))))) 237 | 238 | (defun set-referer (referer-uri &optional alist) 239 | "Returns a fresh copy of the HTTP header list ALIST with the 240 | `Referer' header set to REFERER-URI. If REFERER-URI is NIL, the 241 | result will be a list of headers without a `Referer' header." 242 | (let ((alist-sans-referer (remove "Referer" alist :key #'car :test #'string=))) 243 | (cond (referer-uri (acons "Referer" referer-uri alist-sans-referer)) 244 | (t alist-sans-referer)))) 245 | 246 | (defun text-content-type-p (type subtype) 247 | "Returns a true value iff the combination of TYPE and SUBTYPE 248 | matches an entry of *TEXT-CONTENT-TYPES*. See docstring of 249 | *TEXT-CONTENT-TYPES* for more info." 250 | (loop for (candidate-type . candidate-subtype) in *text-content-types* 251 | thereis (and (or (null candidate-type) 252 | (string-equal type candidate-type)) 253 | (or (null candidate-subtype) 254 | (string-equal subtype candidate-subtype))))) 255 | 256 | (defmacro with-sequence-from-string ((stream string) &body body) 257 | "Kludge to make Chunga tokenizing functionality usable. Works like 258 | WITH-INPUT-FROM-STRING, but creates a sequence of octets that works 259 | with CHUNGA::PEEK-CHAR* and friends." 260 | `(flex:with-input-from-sequence (,stream (map 'list #'char-code ,string)) 261 | ,@body)) 262 | 263 | (defun split-set-cookie-string (string) 264 | "Splits the string STRING which is assumed to be the value of a 265 | `Set-Cookie' into parts corresponding to individual cookies and 266 | returns a list of these parts \(substrings). 267 | 268 | The string /should/ be split at commas, but heuristical approach is 269 | used instead which doesn't split at commas which are followed by what 270 | cannot be recognized as the start of the next cookie. This is 271 | necessary because servers send headers containing unquoted commas 272 | which are not meant as separators." 273 | ;; this would of course be a lot easier with CL-PPCRE's SPLIT 274 | (let ((cookie-start 0) 275 | (string-length (length string)) 276 | search-start 277 | result) 278 | (tagbody 279 | ;; at this point we know that COOKIE-START is the start of a new 280 | ;; cookie (at the start of the string or behind a comma) 281 | next-cookie 282 | (setq search-start cookie-start) 283 | ;; we reach this point if the last comma didn't separate two 284 | ;; cookies or if there was no previous comma 285 | skip-comma 286 | (unless (< search-start string-length) 287 | (return-from split-set-cookie-string (nreverse result))) 288 | ;; look is there's a comma 289 | (let* ((comma-pos (position #\, string :start search-start)) 290 | ;; and if so, look for a #\= behind the comma 291 | (equals-pos (and comma-pos (position #\= string :start comma-pos))) 292 | ;; check that (except for whitespace) there's only a token 293 | ;; (the name of the next cookie) between #\, and #\= 294 | (new-cookie-start-p (and equals-pos 295 | (every 'token-char-p 296 | (trim-whitespace string 297 | :start (1+ comma-pos) 298 | :end equals-pos))))) 299 | (when (and comma-pos (not new-cookie-start-p)) 300 | (setq search-start (1+ comma-pos)) 301 | (go skip-comma)) 302 | (let ((end-pos (or comma-pos string-length))) 303 | (push (trim-whitespace (subseq string cookie-start end-pos)) result) 304 | (setq cookie-start (1+ end-pos)) 305 | (go next-cookie)))))) 306 | 307 | #-:lispworks 308 | (defun make-ssl-stream (http-stream &key certificate key certificate-password verify (max-depth 10) ca-file ca-directory) 309 | "Attaches SSL to the stream HTTP-STREAM and returns the SSL stream 310 | \(which will not be equal to HTTP-STREAM)." 311 | (declare (ignorable max-depth)) 312 | (check-type verify (member nil :optional :required)) 313 | (when (and certificate 314 | (not (probe-file certificate))) 315 | (error "certificate file ~A not found" certificate)) 316 | (when (and key 317 | (not (probe-file key))) 318 | (error "key file ~A not found" key)) 319 | (when (and ca-file 320 | (not (probe-file ca-file))) 321 | (error "ca file ~A not found" ca-file)) 322 | #+(and :allegro (not :drakma-no-ssl)) 323 | (socket:make-ssl-client-stream http-stream 324 | :certificate certificate 325 | :key key 326 | :certificate-password certificate-password 327 | :verify verify 328 | :max-depth max-depth 329 | :ca-file ca-file 330 | :ca-directory ca-directory) 331 | #+(and :mocl-ssl (not :drakma-no-ssl)) 332 | (progn 333 | (when (or ca-file ca-directory) 334 | (warn ":max-depth, :ca-file and :ca-directory arguments not available on this platform")) 335 | (rt:start-ssl http-stream :verify verify)) 336 | #+(and (not :allegro) (not :mocl-ssl) (not :drakma-no-ssl)) 337 | (let ((s http-stream)) 338 | (when (or verify ca-file ca-directory) 339 | (warn ":verify, :max-depth, :ca-file and :ca-directory arguments not available on this platform")) 340 | (cl+ssl:make-ssl-client-stream 341 | (cl+ssl:stream-fd s) 342 | :close-callback (lambda () (close s)) 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 | -------------------------------------------------------------------------------- /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 | (let ((transfer-encodings (header-value :transfer-encoding headers)) 38 | (content-encodings (header-value :content-encoding headers))) 39 | (when transfer-encodings 40 | (setq transfer-encodings (split-tokens transfer-encodings))) 41 | (when content-encodings 42 | (setq content-encodings (split-tokens content-encodings))) 43 | (multiple-value-bind (type subtype params) 44 | (get-content-type headers) 45 | (when (and (text-content-type-p type subtype) 46 | (null (set-difference transfer-encodings 47 | '("chunked" "identity") 48 | :test #'equalp)) 49 | (null (set-difference content-encodings 50 | '("identity") 51 | :test #'equalp))) 52 | (let* ((charset (parameter-value "charset" params)) 53 | (name (cond (charset (as-keyword charset)) 54 | (t external-format-in)))) 55 | (make-external-format name :eol-style :lf))))) 56 | (error (condition) 57 | (drakma-warn "Problems determining charset \(falling back to binary):~%~A" 58 | condition)))) 59 | 60 | (defun send-content (content stream &optional external-format-out) 61 | "Sends CONTENT to the stream STREAM as part of the request body 62 | depending on the type of CONTENT." 63 | (when content 64 | (cond ((stringp content) 65 | (setf (flexi-stream-external-format stream) external-format-out) 66 | (write-string content stream) 67 | (setf (flexi-stream-external-format stream) +latin-1+)) 68 | ((or (arrayp content) (listp content)) 69 | (write-sequence content stream)) 70 | ((and (streamp content) 71 | (input-stream-p content) 72 | (open-stream-p content) 73 | (subtypep (stream-element-type content) 'octet)) 74 | (let ((buf (make-array +buffer-size+ :element-type 'octet))) 75 | (loop 76 | (let ((pos (read-sequence buf content))) 77 | (when (zerop pos) (return)) 78 | (write-sequence buf stream :end pos))))) 79 | ((pathnamep content) 80 | (with-open-file (from content :element-type 'octet) 81 | ;; calls itself with a stream now 82 | (send-content from stream))) 83 | ((or (functionp content) 84 | (and (symbolp content) 85 | (fboundp content))) 86 | (funcall content stream)) 87 | (t (parameter-error "Don't know how to send content ~S to server." content))))) 88 | 89 | (defun make-form-data-function (parameters boundary external-format-out) 90 | "Creates and returns a closure which can be used as an argument for 91 | SEND-CONTENT to send PARAMETERS as a `multipart/form-data' request 92 | body using the boundary BOUNDARY." 93 | (lambda (stream) 94 | (flet ((crlf () 95 | "Sends carriage return and linefeed to STREAM." 96 | (write-char #\Return stream) 97 | (write-char #\Linefeed stream))) 98 | (dolist (name/value parameters) 99 | (destructuring-bind (name . value) 100 | name/value 101 | (when (or (pathnamep value) 102 | (streamp value) 103 | (functionp value)) 104 | (setq value (list value))) 105 | (format stream "--~A" boundary) 106 | (crlf) 107 | (format stream "Content-Disposition: form-data; name=\"~A\"" name) 108 | (cond ((stringp value) 109 | (crlf) 110 | (format stream "Content-Type: text/plain; charset=~a" external-format-out) 111 | (crlf) (crlf) 112 | (setf (flexi-stream-external-format stream) external-format-out) 113 | (format stream "~A" value) 114 | (setf (flexi-stream-external-format stream) +latin-1+)) 115 | ((and (listp value) 116 | (first value) 117 | (not (stringp (first value)))) 118 | (let* ((file-source (first value)) 119 | (filename (or (getf (rest value) :filename) 120 | (etypecase file-source 121 | (function "user-closure") 122 | (file-stream (or (file-namestring file-source) 123 | "user-stream")) 124 | (stream "user-stream") 125 | (pathname (file-namestring file-source))))) 126 | (content-type (or (getf (rest value) :content-type) 127 | "application/octet-stream"))) 128 | (format stream "; filename=\"~A\"" filename) 129 | (crlf) 130 | (format stream "Content-Type: ~A" content-type) 131 | (crlf) (crlf) 132 | ;; use SEND-CONTENT to send file as binary data 133 | (send-content file-source stream))) 134 | (t (parameter-error 135 | "Don't know what to do with name/value pair (~S . ~S) in multipart/form-data body." 136 | name value))) 137 | (crlf))) 138 | (format stream "--~A--" boundary) 139 | (crlf)))) 140 | 141 | (defun read-body (stream headers must-close textp) 142 | "Reads the message body from the HTTP stream STREAM using the 143 | information contained in HEADERS \(as produced by HTTP-REQUEST). If 144 | TEXTP is true, the body is assumed to be of content type `text' and 145 | will be returned as a string. Otherwise an array of octets \(or NIL 146 | for an empty body) is returned. Returns the optional `trailer' HTTP 147 | headers of the chunked stream \(if any) as a second value." 148 | (let ((content-length (when-let (value (and (not (header-value :transfer-encoding headers)) ;; see RFC 2616, section 4.4, 3. 149 | (header-value :content-length headers))) 150 | (parse-integer value))) 151 | (element-type (if textp 152 | #+:lispworks 'lw:simple-char #-:lispworks 'character 153 | 'octet)) 154 | (chunkedp (chunked-stream-input-chunking-p (flexi-stream-stream stream)))) 155 | (values (cond ((eql content-length 0) nil) 156 | (content-length 157 | (setf (flexi-stream-element-type stream) 'octet) 158 | (let ((result (make-array content-length :element-type 'octet))) 159 | #+:clisp 160 | (setf (flexi-stream-element-type stream) 'octet) 161 | (read-sequence result stream) 162 | (when textp 163 | (setf result 164 | (octets-to-string result :external-format (flexi-stream-external-format stream)) 165 | #+:clisp (flexi-stream-element-type stream) 166 | #+:clisp element-type)) 167 | result)) 168 | ((or chunkedp must-close) 169 | ;; no content length, read until EOF (or end of chunking) 170 | #+:clisp 171 | (setf (flexi-stream-element-type stream) element-type) 172 | (let ((buffer (make-array +buffer-size+ :element-type element-type)) 173 | (result (make-array 0 :element-type element-type :adjustable t))) 174 | (loop for index = 0 then (+ index pos) 175 | for pos = (read-sequence buffer stream) 176 | do (adjust-array result (+ index pos)) 177 | (replace result buffer :start1 index :end2 pos) 178 | while (= pos +buffer-size+)) 179 | result))) 180 | (chunked-input-stream-trailers (flexi-stream-stream stream))))) 181 | 182 | (defun trivial-uri-path (uri-string) 183 | "If the PRESERVE-URI argument is used, the URI needs to be passed to 184 | the server in unmodified form. This function returns just the path 185 | component of the URI with no URL encoding or other modifications done." 186 | (cl-ppcre:regex-replace "[^/]+://[^/]*/?" uri-string "/")) 187 | 188 | (defun http-request (uri &rest args 189 | &key (protocol :http/1.1) 190 | (method :get) 191 | force-ssl 192 | certificate 193 | key 194 | certificate-password 195 | verify 196 | max-depth 197 | ca-file 198 | ca-directory 199 | parameters 200 | (url-encoder #'url-encode) 201 | content 202 | (content-type "application/x-www-form-urlencoded") 203 | (content-length nil content-length-provided-p) 204 | form-data 205 | cookie-jar 206 | basic-authorization 207 | (user-agent :drakma) 208 | (accept "*/*") 209 | range 210 | (proxy *default-http-proxy*) 211 | (no-proxy-domains *no-proxy-domains*) 212 | proxy-basic-authorization 213 | real-host 214 | additional-headers 215 | (redirect 5) 216 | auto-referer 217 | keep-alive 218 | (close t) 219 | (external-format-out *drakma-default-external-format*) 220 | (external-format-in *drakma-default-external-format*) 221 | force-binary 222 | want-stream 223 | stream 224 | preserve-uri 225 | #+(or abcl clisp lispworks mcl openmcl sbcl) 226 | (connection-timeout 20) 227 | #+:lispworks (read-timeout 20) 228 | #+(and :lispworks (not :lw-does-not-have-write-timeout)) 229 | (write-timeout 20 write-timeout-provided-p) 230 | #+:openmcl 231 | deadline 232 | &aux (unparsed-uri (if (stringp uri) (copy-seq uri) (puri:copy-uri uri)))) 233 | "Sends a HTTP request to a web server and returns its reply. URI 234 | is where the request is sent to, and it is either a string denoting a 235 | uniform resource identifier or a PURI:URI object. The scheme of URI 236 | must be `http' or `https'. The function returns SEVEN values - the 237 | body of the reply \(but see below), the status code as an integer, an 238 | alist of the headers sent by the server where for each element the car 239 | \(the name of the header) is a keyword and the cdr \(the value of the 240 | header) is a string, the URI the reply comes from \(which might be 241 | different from the URI the request was sent to in case of redirects), 242 | the stream the reply was read from, a generalized boolean which 243 | denotes whether the stream should be closed \(and which you can 244 | usually ignore), and finally the reason phrase from the status line as 245 | a string. 246 | 247 | PROTOCOL is the HTTP protocol which is going to be used in the 248 | request line, it must be one of the keywords :HTTP/1.0 or 249 | :HTTP/1.1. METHOD is the method used in the request line, a 250 | keyword \(like :GET or :HEAD) denoting a valid HTTP/1.1 or WebDAV 251 | request method, or :REPORT, as described in the Versioning 252 | Extensions to WebDAV. Additionally, you can also use the pseudo 253 | method :OPTIONS* which is like :OPTIONS but means that an 254 | \"OPTIONS *\" request line will be sent, i.e. the URI's path and 255 | query parts will be ignored. 256 | 257 | If FORCE-SSL is true, SSL will be attached to the socket stream 258 | which connects Drakma with the web server. Usually, you don't 259 | have to provide this argument, as SSL will be attached anyway if 260 | the scheme of URI is `https'. 261 | 262 | CERTIFICATE is the file name of the PEM encoded client certificate to 263 | present to the server when making a SSL connection. KEY specifies the 264 | file name of the PEM encoded private key matching the certificate. 265 | CERTIFICATE-PASSWORD specifies the pass phrase to use to decrypt the 266 | private key. 267 | 268 | VERIFY can be specified to force verification of the certificate that 269 | is presented by the server in an SSL connection. It can be specified 270 | either as NIL if no check should be performed, :OPTIONAL to verify the 271 | server's certificate if it presented one or :REQUIRED to verify the 272 | server's certificate and fail if an invalid or no certificate was 273 | presented. 274 | 275 | MAX-DEPTH can be specified to change the maximum allowed certificate 276 | signing depth that is accepted. The default is 10. 277 | 278 | CA-FILE and CA-DIRECTORY can be specified to set the certificate 279 | authority bundle file or directory to use for certificate validation. 280 | 281 | The CERTIFICATE, KEY, CERTIFICATE-PASSWORD, VERIFY, MAX-DEPTH, CA-FILE 282 | and CA-DIRECTORY parameters are ignored for non-SSL requests. They 283 | are also ignored on LispWorks. 284 | 285 | PARAMETERS is an alist of name/value pairs \(the car and the cdr each 286 | being a string) which denotes the parameters which are added to the 287 | query part of the URL or \(in the case of a POST request) comprise the 288 | body of the request. (But see CONTENT below.) The values can also be 289 | NIL in which case only the name \(without an equal sign) is used in 290 | the query string. The name/value pairs are URL-encoded using the 291 | FLEXI-STREAMS external format EXTERNAL-FORMAT-OUT before they are sent 292 | to the server unless FORM-DATA is true in which case the POST request 293 | body is sent as `multipart/form-data' using EXTERNAL-FORMAT-OUT. The 294 | values of the PARAMETERS alist can also be pathnames, open binary 295 | input streams, unary functions, or lists where the first element is of 296 | one of the former types. These values denote files which should be 297 | sent as part of the request body. If files are present in PARAMETERS, 298 | the content type of the request is always `multipart/form-data'. If 299 | the value is a list, the part of the list behind the first element is 300 | treated as a plist which can be used to specify a content type and/or 301 | a filename for the file, i.e. such a value could look like, e.g., 302 | \(#p\"/tmp/my_file.doc\" :content-type \"application/msword\" 303 | :filename \"upload.doc\"). 304 | 305 | URL-ENCODER specifies a custom URL encoder function which will be used 306 | by drakma to URL-encode parameter names and values. It needs to be a 307 | function of one argument. The argument is the string to encode, the 308 | return value must be the URL-encoded string. This can be used if 309 | specific encoding rules are required. 310 | 311 | CONTENT, if not NIL, is used as the request body - PARAMETERS is 312 | ignored in this case. CONTENT can be a string, a sequence of 313 | octets, a pathname, an open binary input stream, or a function 314 | designator. If CONTENT is a sequence, it will be directly sent 315 | to the server \(using EXTERNAL-FORMAT-OUT in the case of 316 | strings). If CONTENT is a pathname, the binary contents of the 317 | corresponding file will be sent to the server. If CONTENT is a 318 | stream, everything that can be read from the stream until EOF 319 | will be sent to the server. If CONTENT is a function designator, 320 | the corresponding function will be called with one argument, the 321 | stream to the server, to which it should send data. 322 | 323 | Finally, CONTENT can also be the keyword :CONTINUATION in which case 324 | HTTP-REQUEST returns only one value - a `continuation' function. This 325 | function has one required argument and one optional argument. The 326 | first argument will be interpreted like CONTENT above \(but it cannot 327 | be a keyword), i.e. it will be sent to the server according to its 328 | type. If the second argument is true, the continuation function can 329 | be called again to send more content, if it is NIL the continuation 330 | function returns what HTTP-REQUEST would have returned. 331 | 332 | If CONTENT is a sequence, Drakma will use LENGTH to determine its 333 | length and will use the result for the `Content-Length' header sent to 334 | the server. You can overwrite this with the CONTENT-LENGTH parameter 335 | \(a non-negative integer) which you can also use for the cases where 336 | Drakma can't or won't determine the content length itself. You can 337 | also explicitly provide a CONTENT-LENGTH argument of NIL which will 338 | imply that no `Content-Length' header will be sent in any case. If no 339 | `Content-Length' header is sent, Drakma will use chunked encoding to 340 | send the content body. Note that this will not work with older web 341 | servers. 342 | 343 | Providing a true CONTENT-LENGTH argument which is not a non-negative 344 | integer means that Drakma /must/ build the request body in RAM and 345 | compute the content length even if it would have otherwise used 346 | chunked encoding, for example in the case of file uploads. 347 | 348 | CONTENT-TYPE is the corresponding `Content-Type' header to be sent and 349 | will be ignored unless CONTENT is provided as well. 350 | 351 | Note that a query already contained in URI will always be sent with 352 | the request line anyway in addition to other parameters sent by 353 | Drakma. 354 | 355 | COOKIE-JAR is a cookie jar containing cookies which will 356 | potentially be sent to the server \(if the domain matches, if 357 | they haven't expired, etc.) - this cookie jar will be modified 358 | according to the `Set-Cookie' header\(s) sent back by the server. 359 | 360 | BASIC-AUTHORIZATION, if not NIL, should be a list of two strings 361 | \(username and password) which will be sent to the server for 362 | basic authorization. USER-AGENT, if not NIL, denotes which 363 | `User-Agent' header will be sent with the request. It can be one 364 | of the keywords :DRAKMA, :FIREFOX, :EXPLORER, :OPERA, or :SAFARI 365 | which denote the current version of Drakma or, in the latter four 366 | cases, a fixed string corresponding to a more or less recent \(as 367 | of August 2006) version of the corresponding browser. Or it can 368 | be a string which is used directly. 369 | 370 | ACCEPT, if not NIL, specifies the contents of the `Accept' header 371 | sent. 372 | 373 | RANGE optionally specifies a subrange of the resource to be requested. 374 | It must be specified as a list of two integers which indicate the 375 | start and \(inclusive) end offset of the requested range, in bytes 376 | \(i.e. octets). 377 | 378 | If PROXY is not NIL, it should be a string denoting a proxy 379 | server through which the request should be sent. Or it can be a 380 | list of two values - a string denoting the proxy server and an 381 | integer denoting the port to use \(which will default to 80 382 | otherwise). Defaults to *default-http-proxy*. 383 | PROXY-BASIC-AUTHORIZATION is used like 384 | BASIC-AUTHORIZATION, but for the proxy, and only if PROXY is 385 | true. If the host portion of the uri is present in the 386 | *no-proxy-domains* or the NO-PROXY-DOMAINS list then the proxy 387 | setting will be ignored for this request. 388 | 389 | If NO-PROXY-DOMAINS is set then it will supersede the 390 | *no-proxy-domains* variable. Inserting domains into this list will 391 | allow them to ignore the proxy setting. 392 | 393 | If REAL-HOST is not NIL, request is sent to the denoted host instead 394 | of the URI host. When specified, REAL-HOST supersedes PROXY. 395 | 396 | ADDITIONAL-HEADERS is a name/value alist of additional HTTP headers 397 | which should be sent with the request. Unlike in PARAMETERS, the cdrs 398 | can not only be strings but also designators for unary functions 399 | \(which should in turn return a string) in which case the function is 400 | called each time the header is written. 401 | 402 | If REDIRECT is not NIL, it must be a non-negative integer or T. 403 | If REDIRECT is true, Drakma will follow redirects \(return codes 404 | 301, 302, 303, or 307) unless REDIRECT is 0. If REDIRECT is an 405 | integer, it will be decreased by 1 with each redirect. 406 | Furthermore, if AUTO-REFERER is true when following redirects, 407 | Drakma will populate the `Referer' header with the URI that 408 | triggered the redirection, overwriting an existing `Referer' 409 | header \(in ADDITIONAL-HEADERS) if necessary. 410 | 411 | If KEEP-ALIVE is T, the server will be asked to keep the 412 | connection alive, i.e. not to close it after the reply has been 413 | sent. \(Note that this not necessary if both the client and the 414 | server use HTTP 1.1.) If CLOSE is T, the server is explicitly 415 | asked to close the connection after the reply has been sent. 416 | KEEP-ALIVE and CLOSE are obviously mutually exclusive. 417 | 418 | If the message body sent by the server has a text content type, Drakma 419 | will try to return it as a Lisp string. It'll first check if the 420 | `Content-Type' header denotes an encoding to be used, or otherwise it 421 | will use the EXTERNAL-FORMAT-IN argument. The body is decoded using 422 | FLEXI-STREAMS. If FLEXI-STREAMS doesn't know the external format, the 423 | body is returned as an array of octets. If the body is empty, Drakma 424 | will return NIL. 425 | 426 | If the message body doesn't have a text content type or if 427 | FORCE-BINARY is true, the body is always returned as an array of 428 | octets. 429 | 430 | If WANT-STREAM is true, the message body is NOT read and instead the 431 | \(open) socket stream is returned as the first return value. If the 432 | sixth value of HTTP-REQUEST is true, the stream should be closed \(and 433 | not be re-used) after the body has been read. The stream returned is 434 | a flexi stream \(see http://weitz.de/flexi-streams/) with a chunked 435 | stream \(see http://weitz.de/chunga/) as its underlying stream. If 436 | you want to read binary data from this stream, read from the 437 | underlying stream which you can get with FLEXI-STREAM-STREAM. 438 | 439 | Drakma will usually create a new socket connection for each HTTP 440 | request. However, you can use the STREAM argument to provide an 441 | open socket stream which should be re-used. STREAM MUST be a 442 | stream returned by a previous invocation of HTTP-REQUEST where 443 | the sixth return value wasn't true. Obviously, it must also be 444 | connected to the correct server and at the right position 445 | \(i.e. the message body, if any, must have been read). Drakma 446 | will NEVER attach SSL to a stream provided as the STREAM 447 | argument. 448 | 449 | CONNECTION-TIMEOUT is the time \(in seconds) Drakma will wait until it 450 | considers an attempt to connect to a server as a failure. It is 451 | supported only on some platforms \(currently abcl, clisp, LispWorks, 452 | mcl, openmcl and sbcl). READ-TIMEOUT and WRITE-TIMEOUT are the read 453 | and write timeouts \(in seconds) for the socket stream to the server. 454 | All three timeout arguments can also be NIL \(meaning no timeout), and 455 | they don't apply if an existing stream is re-used. READ-TIMEOUT 456 | argument is only available for LispWorks, WRITE-TIMEOUT is only 457 | available for LispWorks 5.0 or higher. 458 | 459 | DEADLINE, a time in the future, specifies the time until which the 460 | request should be finished. The deadline is specified in internal 461 | time units. If the server fails to respond until that time, a 462 | COMMUNICATION-DEADLINE-EXPIRED condition is signalled. DEADLINE is 463 | only available on CCL 1.2 and later. 464 | 465 | If PRESERVE-URI is not NIL, the given URI will not be processed. This 466 | means that the URI will be sent as-is to the remote server and it is 467 | the responsibility of the client to make sure that all parameters are 468 | encoded properly. Note that if this parameter is given, and the 469 | request is not a POST with a content-type of `multipart/form-data', 470 | PARAMETERS will not be used." 471 | #+lispworks 472 | (declare (ignore certificate key certificate-password verify max-depth ca-file ca-directory)) 473 | (unless (member protocol '(:http/1.0 :http/1.1) :test #'eq) 474 | (parameter-error "Don't know how to handle protocol ~S." protocol)) 475 | (setq uri (cond ((puri:uri-p uri) (puri:copy-uri uri)) 476 | (t (puri:parse-uri uri)))) 477 | (unless (member method +known-methods+ :test #'eq) 478 | (parameter-error "Don't know how to handle method ~S." method)) 479 | (unless (member (puri:uri-scheme uri) '(:http :https) :test #'eq) 480 | (parameter-error "Don't know how to handle scheme ~S." (puri:uri-scheme uri))) 481 | (when (and close keep-alive) 482 | (parameter-error "CLOSE and KEEP-ALIVE must not be both true.")) 483 | (when (and form-data (not (member method '(:post :report) :test #'eq))) 484 | (parameter-error "FORM-DATA only makes sense with POST requests.")) 485 | (when range 486 | (unless (and (listp range) 487 | (integerp (first range)) 488 | (integerp (second range)) 489 | (<= (first range) (second range))) 490 | (parameter-error "RANGE parameter must be specified as list of two integers, with the second larger or equal to the first"))) 491 | ;; supersede PROXY with REAL-HOST 492 | (when real-host 493 | (setq proxy real-host)) 494 | ;; convert PROXY argument to canonical form 495 | (when proxy 496 | (when (atom proxy) 497 | (setq proxy (list proxy 80)))) 498 | ;; Ignore the proxy for whitelisted hosts. 499 | (when (member (puri:uri-host uri) no-proxy-domains :test #'string=) 500 | (setq proxy '())) 501 | ;; make sure we don't get :CRLF on Windows 502 | (let ((*default-eol-style* :lf) 503 | (file-parameters-p (find-if-not (lambda (thing) 504 | (or (stringp thing) 505 | (null thing))) 506 | parameters :key #'cdr)) 507 | parameters-used-p) 508 | (when (and file-parameters-p (not (eq method :post))) 509 | (parameter-error "Don't know how to handle parameters in ~S, as this is not a POST request." 510 | parameters)) 511 | (when (eq method :post) 512 | ;; create content body for POST unless it was provided 513 | (unless content 514 | ;; mark PARAMETERS argument as used up, so we don't use it 515 | ;; again below 516 | (setq parameters-used-p t) 517 | (cond ((or form-data file-parameters-p) 518 | (let ((boundary (format nil "----------~A" (make-random-string)))) 519 | (setq content (make-form-data-function parameters boundary external-format-out) 520 | content-type (format nil "multipart/form-data; boundary=~A" boundary))) 521 | (unless (or file-parameters-p content-length-provided-p) 522 | (setq content-length (or content-length t)))) 523 | (t 524 | (setq content (alist-to-url-encoded-string parameters external-format-out url-encoder) 525 | content-type "application/x-www-form-urlencoded"))))) 526 | (let ((proxying-https-p (and proxy (not stream) (eq :https (puri:uri-scheme uri)))) 527 | http-stream raw-http-stream must-close done) 528 | (unwind-protect 529 | (progn 530 | (let ((host (or (and proxy (first proxy)) 531 | (puri:uri-host uri))) 532 | (port (cond (proxy (second proxy)) 533 | ((puri:uri-port uri)) 534 | (t (default-port uri)))) 535 | (use-ssl (and (not proxying-https-p) 536 | (or force-ssl 537 | (eq (puri:uri-scheme uri) :https))))) 538 | #+(and :lispworks5.0 :mswindows 539 | (not :lw-does-not-have-write-timeout)) 540 | (when use-ssl 541 | (when (and write-timeout write-timeout-provided-p) 542 | (drakma-warn "Disabling WRITE-TIMEOUT because it doesn't mix well with SSL.")) 543 | (setq write-timeout nil)) 544 | (setq http-stream (or stream 545 | #+:lispworks 546 | (comm:open-tcp-stream host port 547 | :element-type 'octet 548 | :timeout connection-timeout 549 | :read-timeout read-timeout 550 | #-:lw-does-not-have-write-timeout 551 | :write-timeout 552 | #-:lw-does-not-have-write-timeout 553 | write-timeout 554 | :errorp t) 555 | #-:lispworks 556 | (usocket:socket-stream 557 | (usocket:socket-connect host port 558 | :element-type 'octet 559 | #+:openmcl :deadline 560 | #+:openmcl deadline 561 | #+(or abcl clisp lispworks mcl openmcl sbcl) 562 | :timeout 563 | #+(or abcl clisp lispworks mcl openmcl sbcl) 564 | connection-timeout 565 | :nodelay :if-supported))) 566 | raw-http-stream http-stream) 567 | #+:openmcl 568 | (when deadline 569 | ;; it is correct to set the deadline here even though 570 | ;; it may have been initialized by SOCKET-CONNECT 571 | ;; already - the stream may have been passed in by the 572 | ;; user and the user may want to adjust the deadline 573 | ;; for every request 574 | (setf (ccl:stream-deadline http-stream) deadline)) 575 | (labels ((write-http-line (fmt &rest args) 576 | (when *header-stream* 577 | (format *header-stream* "~?~%" fmt args)) 578 | (format http-stream "~?~C~C" fmt args #\Return #\Linefeed)) 579 | (write-header (name value-fmt &rest value-args) 580 | (write-http-line "~A: ~?" name value-fmt value-args)) 581 | (wrap-stream (http-stream) 582 | (make-flexi-stream (make-chunked-stream http-stream) 583 | :external-format +latin-1+))) 584 | (when (and use-ssl 585 | ;; don't attach SSL to existing streams 586 | (not stream)) 587 | #+:lispworks 588 | (comm:attach-ssl http-stream :ssl-side :client) 589 | #-:lispworks 590 | (setq http-stream (make-ssl-stream http-stream 591 | :certificate certificate 592 | :key key 593 | :certificate-password certificate-password 594 | :verify verify 595 | :max-depth max-depth 596 | :ca-file ca-file 597 | :ca-directory ca-directory))) 598 | (cond (stream 599 | (setf (flexi-stream-element-type http-stream) 600 | #+:lispworks 'lw:simple-char #-:lispworks 'character 601 | (flexi-stream-external-format http-stream) +latin-1+)) 602 | (t 603 | (setq http-stream (wrap-stream http-stream)))) 604 | (when proxying-https-p 605 | ;; set up a tunnel through the proxy server to the 606 | ;; final destination 607 | (write-http-line "CONNECT ~A:~:[443~;~:*~A~] HTTP/1.1" 608 | (puri:uri-host uri) (puri:uri-port uri)) 609 | (write-http-line "Host: ~A:~:[443~;~:*~A~]" 610 | (puri:uri-host uri) (puri:uri-port uri)) 611 | (write-http-line "") 612 | (force-output http-stream) 613 | ;; check we get a 200 response before proceeding 614 | (unless (eql (second (read-status-line http-stream *header-stream*)) 200) 615 | (error "Unable to establish HTTPS tunnel through proxy.")) 616 | ;; got a connection; we have to read a blank line, 617 | ;; turn on SSL, and then we can transmit 618 | (read-line* http-stream) 619 | #+:lispworks 620 | (comm:attach-ssl raw-http-stream :ssl-side :client) 621 | #-:lispworks 622 | (setq http-stream (wrap-stream (make-ssl-stream raw-http-stream)))) 623 | (when-let (all-get-parameters 624 | (and (not preserve-uri) 625 | (append (dissect-query (puri:uri-query uri)) 626 | (and (not parameters-used-p) parameters)))) 627 | (setf (puri:uri-query uri) 628 | (alist-to-url-encoded-string all-get-parameters external-format-out url-encoder))) 629 | (when (eq method :options*) 630 | ;; special pseudo-method 631 | (setf method :options 632 | (puri:uri-path uri) "*" 633 | (puri:uri-query uri) nil)) 634 | (write-http-line "~A ~A ~A" 635 | (string-upcase method) 636 | (if (and preserve-uri 637 | (stringp unparsed-uri)) 638 | (trivial-uri-path unparsed-uri) 639 | (puri:render-uri (if (and proxy 640 | (null stream) 641 | (not proxying-https-p) 642 | (not real-host)) 643 | uri 644 | (make-instance 'puri:uri 645 | :path (or (puri:uri-path uri) "/") 646 | :query (puri:uri-query uri))) 647 | nil)) 648 | (string-upcase protocol)) 649 | (write-header "Host" "~A~@[:~A~]" (puri:uri-host uri) (non-default-port uri)) 650 | (when user-agent 651 | (write-header "User-Agent" "~A" (user-agent-string user-agent))) 652 | (when basic-authorization 653 | (write-header "Authorization" "Basic ~A" 654 | (base64:string-to-base64-string 655 | (format nil "~A:~A" 656 | (first basic-authorization) 657 | (second basic-authorization))))) 658 | (when (and proxy proxy-basic-authorization) 659 | (write-header "Proxy-Authorization" "Basic ~A" 660 | (base64:string-to-base64-string 661 | (format nil "~A:~A" 662 | (first proxy-basic-authorization) 663 | (second proxy-basic-authorization))))) 664 | (when accept 665 | (write-header "Accept" "~A" accept)) 666 | (when range 667 | (write-header "Range" "bytes=~A-~A" (first range) (second range))) 668 | (when cookie-jar 669 | ;; write all cookies in one fell swoop, so even Sun's 670 | ;; web server has a chance to get it 671 | (when-let (cookies (loop for cookie in (cookie-jar-cookies cookie-jar) 672 | when (send-cookie-p cookie uri force-ssl) 673 | collect (cookie-name cookie) and 674 | collect (cookie-value cookie))) 675 | (write-header "Cookie" "~{~A=~A~^; ~}" cookies))) 676 | (when keep-alive 677 | (write-header "Connection" "Keep-Alive")) 678 | (when close 679 | (setq must-close close) 680 | (write-header "Connection" "close")) 681 | (loop for (name . value) in additional-headers 682 | do (write-header name "~A" 683 | (cond ((or (functionp value) 684 | (and (symbolp value) 685 | (fboundp value))) 686 | (funcall value)) 687 | (t value)))) 688 | (when content 689 | (when content-type 690 | (write-header "Content-Type" "~A" content-type)) 691 | (when (or (and (not content-length-provided-p) 692 | (stringp content)) 693 | (and content-length 694 | (not (or (and (integerp content-length) 695 | (not (minusp content-length))) 696 | (typep content '(or (vector octet) list)) 697 | (eq content :continuation))))) 698 | ;; CONTENT-LENGTH forces us to compute request body 699 | ;; in RAM 700 | (setq content 701 | (with-output-to-sequence (bin-out) 702 | (let ((out (make-flexi-stream bin-out :external-format +latin-1+))) 703 | (send-content content out external-format-out))))) 704 | (when (and (or (not content-length-provided-p) 705 | (eq content-length t)) 706 | (typep content '(or (vector octet) list))) 707 | (setq content-length (length content))) 708 | (cond (content-length 709 | (write-header "Content-Length" "~D" content-length)) 710 | (t 711 | (write-header "Transfer-Encoding" "chunked")))) 712 | ;; end of request headers 713 | (when *header-stream* 714 | (terpri *header-stream*)) 715 | (format http-stream "~C~C" #\Return #\Linefeed) 716 | (force-output http-stream) 717 | (when (and content (null content-length)) 718 | (setf (chunked-stream-output-chunking-p 719 | (flexi-stream-stream http-stream)) t)) 720 | (labels ((finish-request (content &optional continuep) 721 | (send-content content http-stream external-format-out) 722 | (when continuep 723 | (force-output http-stream) 724 | (return-from finish-request)) 725 | (setf (chunked-stream-output-chunking-p 726 | (flexi-stream-stream http-stream)) nil) 727 | (finish-output http-stream) 728 | (with-character-stream-semantics 729 | (multiple-value-bind (server-protocol status-code status-text) 730 | ;; loop until status is NOT 100 731 | (loop for (server-protocol status-code status-text) 732 | = (read-status-line http-stream *header-stream*) 733 | when (= status-code 100) 734 | ;; ignore headers sent until non-100 status is seen 735 | do (read-http-headers http-stream *header-stream*) 736 | until (/= status-code 100) 737 | finally (return (values server-protocol status-code status-text))) 738 | (let ((headers (read-http-headers http-stream *header-stream*)) 739 | body external-format-body) 740 | (let ((connections (header-value :connection headers))) 741 | (when connections 742 | (setq connections (split-tokens connections))) 743 | (when (or (member "close" connections :test #'string-equal) 744 | (not (or (and (eq protocol :http/1.1) 745 | (eq server-protocol :http/1.1)) 746 | (member "Keep-Alive" connections 747 | :test #'string-equal)))) 748 | (setq must-close t))) 749 | (when cookie-jar 750 | (update-cookies (get-cookies headers uri) cookie-jar)) 751 | (when (and redirect 752 | (member status-code +redirect-codes+) 753 | (header-value :location headers)) 754 | (unless (or (eq redirect t) 755 | (and (integerp redirect) 756 | (plusp redirect))) 757 | (cerror "Continue anyway." 758 | 'drakma-simple-error 759 | :format-control "Status code was ~A, but ~ 760 | ~:[REDIRECT is ~S~;redirection limit has been exceeded~]." 761 | :format-arguments (list status-code (integerp redirect) redirect))) 762 | (when auto-referer 763 | (setq additional-headers (set-referer uri additional-headers))) 764 | (let* ((location (header-value :location headers)) 765 | (new-uri (puri:merge-uris location uri)) 766 | ;; can we re-use the stream? 767 | (old-server-p (and (string= (puri:uri-host new-uri) 768 | (puri:uri-host uri)) 769 | (eql (puri:uri-port new-uri) 770 | (puri:uri-port uri)) 771 | (eq (puri:uri-scheme new-uri) 772 | (puri:uri-scheme uri))))) 773 | (unless old-server-p 774 | (setq must-close t 775 | want-stream nil)) 776 | ;; try to re-use the stream, but only 777 | ;; if the user hasn't opted for a 778 | ;; connection which is always secure 779 | (let ((re-use-stream (and old-server-p 780 | (not must-close) 781 | (not force-ssl)))) 782 | ;; close stream if we can't re-use it 783 | (unless re-use-stream 784 | (ignore-errors (close http-stream))) 785 | (setq done t) 786 | (return-from http-request 787 | (let ((method (if (and (member status-code +redirect-to-get-codes+) 788 | (member method +redirect-to-get-methods+)) 789 | :get 790 | method))) 791 | (apply #'http-request new-uri 792 | :method method 793 | :redirect (cond ((integerp redirect) (1- redirect)) 794 | (t redirect)) 795 | :stream (and re-use-stream http-stream) 796 | :additional-headers additional-headers 797 | :parameters parameters 798 | :preserve-uri t 799 | :form-data (if (eq method :get) 800 | nil 801 | form-data) 802 | args)))))) 803 | (let ((transfer-encodings (header-value :transfer-encoding headers))) 804 | (when transfer-encodings 805 | (setq transfer-encodings (split-tokens transfer-encodings))) 806 | (when (member "chunked" transfer-encodings :test #'equalp) 807 | (setf (chunked-stream-input-chunking-p 808 | (flexi-stream-stream http-stream)) t))) 809 | (when (setq external-format-body 810 | (and (not force-binary) 811 | (funcall *body-format-function* 812 | headers external-format-in))) 813 | (setf (flexi-stream-external-format http-stream) 814 | external-format-body)) 815 | (when force-binary 816 | (setf (flexi-stream-element-type http-stream) 'octet)) 817 | (unless (or want-stream (eq method :head)) 818 | (let (trailers) 819 | (multiple-value-setq (body trailers) 820 | (read-body http-stream headers must-close external-format-body)) 821 | (when trailers 822 | (drakma-warn "Adding trailers from chunked encoding to HTTP headers.") 823 | (setq headers (nconc headers trailers))))) 824 | (setq done t) 825 | (values (cond (want-stream http-stream) 826 | (t body)) 827 | status-code 828 | headers 829 | uri 830 | http-stream 831 | must-close 832 | status-text)))))) 833 | (when (eq content :continuation) 834 | (return-from http-request #'finish-request)) 835 | (finish-request content))))) 836 | ;; the cleanup form of the UNWIND-PROTECT above 837 | (when (and http-stream 838 | (or (not done) 839 | (and must-close 840 | (not want-stream))) 841 | (not (eq content :continuation))) 842 | (ignore-errors (close http-stream))))))) 843 | -------------------------------------------------------------------------------- /doc/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 | For discussions and questions regarding Drakma please use the drakma-devel 619 | mailing list. If you want to be notified about future 620 | releases subscribe to the drakma-announce 622 | mailing list. These mailing lists were made available thanks 623 | to the services of common-lisp.net. 625 |

626 |

627 | The development version of Drakma can be found on 629 | github. Please use the github issue tracking system to 630 | submit bug reports. Patches are welcome, github pull requests 631 | are preferred to mailed patches. If you want to send patches, 632 | please read this 633 | first. 634 |

635 | 636 | 637 | 638 | 639 | 640 | 641 |

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

651 |

652 | You can use the *HEADER-STREAM* variable 653 | to debug requests handled by Drakma in a way similar to LiveHTTPHeaders. 655 |

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

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

730 |

731 | 732 | protocol is the HTTP protocol version 733 | which is going to be used in the request line. It must be 734 | one of the keywords :HTTP/1.0 or 735 | :HTTP/1.1. 736 |

737 |

738 | 739 | method is the method used in the 740 | request line, a keyword (like :GET or 741 | :HEAD) denoting a valid HTTP/1.1 or WebDAV 742 | request method, or :REPORT, as described in 743 | the Versioning Extensions to WebDAV. Additionally, you 744 | can also use the pseudo method :OPTIONS* 745 | which is like :OPTIONS but means that an 746 | "OPTIONS *" request line will be sent, i.e. the 747 | uri's path and query parts will be 748 | ignored. 749 |

750 |

751 | If force-ssl is true, SSL will be 752 | attached to the socket stream which connects Drakma with 753 | the web server. Usually, you don't have to provide this 754 | argument, as SSL will be attached anyway if the scheme of 755 | uri is `https'. 756 |

757 |

759 | certificate is the file name of the PEM 760 | encoded client certificate to present to the server when 761 | making a SSL connection. key specifies 762 | the file name of the PEM encoded private key matching the 763 | certificate. certificate-password 764 | specifies the pass phrase to use to decrypt the private key. 765 |

766 |

767 | 768 | verify can be specified to force 769 | verification of the certificate that is presented by the 770 | server in an SSL connection. It can be specified either 771 | as NIL if no check should be performed, 772 | :OPTIONAL to verify the server's certificate 773 | if it presented one or :REQUIRED to verify 774 | the server's certificate and fail if an invalid or no 775 | certificate was presented. 776 |

777 |

778 | 779 | max-depth can be specified to change 780 | the maximum allowed certificate signing depth that is 781 | accepted. The default is 10. 782 |

783 |

784 | 785 | 786 | ca-file and 787 | ca-directory can be specified to set 788 | the certificate authority bundle file or directory to use 789 | for certificate validation. 790 |

791 |

792 | The certificate, 793 | key, 794 | certificate-password, 795 | verify, 796 | max-depth, 797 | ca-file and 798 | ca-directory parameters are ignored 799 | for non-SSL requests. They are also ignored on LispWorks. 800 |

801 |

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

832 |

833 | 834 | url-encoder specifies a custom URL 835 | encoder function which will be used by drakma to 836 | URL-encode parameter names and values. It needs to be a 837 | function of two arguments. The arguments are the string 838 | to encode and the external format to use (as accepted by 839 | FLEXI-STREAMS:STRING-TO-OCTETS). The return value must be 840 | the URL-encoded string. This can be used if specific 841 | encoding rules are required. 842 |

843 |

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

863 |

864 | Finally, content can also be the 865 | keyword :CONTINUATION in which case 866 | HTTP-REQUEST returns only one value - 867 | a `continuation' function. This function has one required 868 | argument and one optional argument. The first argument 869 | will be interpreted like content 870 | above (but it cannot be a keyword), i.e. it will be sent 871 | to the server according to its type. If the second 872 | argument is true, the continuation function can be called 873 | again to send more content, if it is NIL the 874 | continuation function returns what 875 | HTTP-REQUEST would have returned. 876 |

877 |

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

893 |

894 | 895 | Providing a true content-length 896 | argument which is not a non-negative integer means that 897 | Drakma /must/ build the request body in RAM and compute 898 | the content length even if it would have otherwise used 899 | chunked encoding, for example in the case of file uploads. 900 |

901 |

902 | 903 | content-type is the corresponding 904 | `Content-Type' header to be sent and will be ignored 905 | unless content is provided as well. 906 |

907 |

908 | Note that a query already contained in 909 | uri will always be sent with the 910 | request line anyway in addition to other parameters sent 911 | by Drakma. 912 |

913 |

914 | 915 | cookie-jar is a cookie jar containing 916 | cookies which will potentially be sent to the server (if 917 | the domain matches, if they haven't expired, etc.) - this 918 | cookie jar will be modified according to the `Set-Cookie' 919 | header(s) sent back by the server. 920 |

921 |

922 | 923 | basic-authorization, if not 924 | NIL, should be a list of two strings 925 | (username and password) which will be sent to the server 926 | for basic authorization. 927 |

928 |

929 | 930 | user-agent, if not NIL, 931 | denotes which `User-Agent' header will be sent with the 932 | request. It can be one of the keywords 933 | :DRAKMA, :FIREFOX, 934 | :EXPLORER, :OPERA, or 935 | :SAFARI which denote the current version of 936 | Drakma or, in the latter four cases, a fixed string 937 | corresponding to a more or less recent (as of August 2006) 938 | version of the corresponding browser. Or it can be a 939 | string which is used directly. 940 |

941 |

942 | 943 | accept, if not NIL, 944 | specifies the contents of the `Accept' header sent. 945 |

946 |

947 | 948 | range optionally specifies a subrange 949 | of the resource to be requested. It must be specified as 950 | a list of two integers which indicate the start and 951 | (inclusive) end offset of the requested range, in bytes 952 | (i.e. octets). 953 |

954 |

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

972 |

973 | If NO-PROXY-DOMAINS is set then it 974 | will supersede the *NO-PROXY-DOMAINS* 975 | variable. Inserting domains into this list will allow them 976 | to ignore the proxy setting. 977 |

978 |

979 | 980 | If real-host is not NIL, 981 | request is sent to the denoted host instead of the 982 | uri host. When specified, 983 | real-host supersedes 984 | proxy. 985 |

986 |

987 | 988 | additional-headers is a name/value 989 | alist of additional HTTP headers which should be sent with 990 | the request. Unlike in parameters, 991 | the cdrs can not only be strings but also designators for 992 | unary functions (which should in turn return a string) in 993 | which case the function is called each time the header is 994 | written. 995 |

996 |

997 | 998 | 999 | If redirect is not NIL, 1000 | it must be a non-negative integer or T. If 1001 | redirect is true, Drakma will follow 1002 | redirects (return codes 301, 302, 303, or 307) unless 1003 | redirect is 0. If 1004 | redirect is an integer, it will be 1005 | decreased by 1 with each redirect. Furthermore, if 1006 | auto-referer is true when following 1007 | redirects, Drakma will populate the `Referer' header with 1008 | the uri that triggered the 1009 | redirection, overwriting an existing `Referer' header (in 1010 | additional-headers) if necessary. 1011 |

1012 |

1013 | 1014 | 1015 | If keep-alive is T, the server will 1016 | be asked to keep the connection alive, i.e. not to close 1017 | it after the reply has been sent. (Note that this not 1018 | necessary if both the client and the server use HTTP 1.1.) 1019 | If close is T, the server is 1020 | explicitly asked to close the connection after the reply 1021 | has been sent. keep-alive and 1022 | close are obviously mutually 1023 | exclusive. 1024 |

1025 |

1026 | 1027 | 1028 | If the message body sent by the server has a text content 1029 | type, Drakma will try to return it as a Lisp string. 1030 | It'll first check if the `Content-Type' header denotes an 1031 | encoding to be used, or otherwise it will use the 1032 | external-format-in argument. The 1033 | body is decoded using FLEXI-STREAMS. If FLEXI-STREAMS 1034 | doesn't know the external format, the body is returned as 1035 | an array of octets. If the body is empty, Drakma will 1036 | return NIL. 1037 |

1038 |

1039 | If the message body doesn't have a text content type or if 1040 | force-binary is true, the body is 1041 | always returned as an array of octets. 1042 |

1043 |

1044 | 1045 | If want-stream is true, the message 1046 | body is NOT read and instead the (open) socket stream is 1047 | returned as the first return value. If the sixth value of 1048 | HTTP-REQUEST is true, the stream 1049 | should be closed (and not be re-used) after the body has 1050 | been read. The stream returned is a flexi-stream 1052 | with a chunked stream as its underlying stream. 1054 | If you want to read binary data from this stream, read 1055 | from the underlying stream which you can get with 1056 | FLEXI-STREAM-STREAM. 1057 |

1058 |

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

1072 |

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

1086 |

1087 | 1088 | deadline, a time in the future, 1089 | specifies the time until which the request should be 1090 | finished. The deadline is specified in internal time 1091 | units. If the server fails to respond until that time, a 1092 | COMMUNICATION-DEADLINE-EXPIRED condition is signalled. 1093 | deadline is only available on CCL 1.2 1094 | and later. 1095 |

1096 |

1097 | 1098 | If preserve-uri is not 1099 | NIL, the given uri will 1100 | not be processed. This means that the 1101 | uri will be sent as-is to the remote 1102 | server and it is the responsibility of the client to make 1103 | sure that all parameters are encoded properly. Note that 1104 | if this parameter is given, and the request is not a POST 1105 | with a content-type of `multipart/form-data', 1106 | parameters will not be used. 1107 |

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

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

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

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

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

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

1150 | 1151 | 1152 | 1153 | 1154 | 1155 |

1156 | A function which determines whether the content body 1157 | returned by the server is text and should be treated as 1158 | such or not. The function is called after the request 1159 | headers have been read and it must 1160 | accept two arguments, headers and 1161 | external-format-in, where 1162 | headers is like the third return value 1163 | of HTTP-REQUEST while 1164 | external-format-in is the 1165 | HTTP-REQUEST argument of the same 1166 | name. It should return NIL if the body 1167 | should be regarded as binary content, or a FLEXI-STREAMS 1169 | external format (which will be used to read the body) 1170 | otherwise. 1171 |

1172 |

1173 | This function will only be called if the force-binary 1175 | argument to HTTP-REQUEST is 1176 | NIL. 1177 |

1178 |

1179 | The initial value of this variable is a function which 1180 | uses *TEXT-CONTENT-TYPES* to 1181 | determine whether the body is text and then proceeds as 1182 | described in the HTTP-REQUEST 1183 | documentation entry. 1184 |

1185 | 1186 | 1187 | 1188 | 1189 | 1190 |

1191 | HTTP proxy to be used as default for the proxy keyword 1192 | argument of HTTP-REQUEST. If not 1193 | NIL, it should be a string denoting a proxy 1194 | server through which the request should be sent. Or it 1195 | can be a list of two values - a string denoting the proxy 1196 | server and an integer denoting the port to use (which 1197 | will default to 80 otherwise). 1198 |

1199 | 1200 | 1201 | 1202 | 1203 | 1204 |

1205 | A list of domains for which a proxy should not be used. 1206 |

1207 | 1208 | 1209 | 1210 | 1211 | 1212 |

1213 | The default value for the external format keyword 1214 | arguments of HTTP-REQUEST. The value 1215 | of this variable will be interpreted by FLEXI-STREAMS. 1217 | The initial value is the keyword :LATIN-1. 1218 | (Note that Drakma binds *DEFAULT-EOL-STYLE* 1220 | to :LF). 1221 |

1222 | 1223 | 1224 | 1225 | 1226 | 1227 |

1228 | If this variable is not NIL, it should be 1229 | bound to a stream to which incoming and outgoing headers 1230 | will be written for debugging purposes. 1231 |

1232 | 1233 | 1234 | 1235 | 1236 | 1237 |

1238 | A list of conses which are used by the default value of 1239 | *BODY-FORMAT-FUNCTION* to decide 1240 | whether a 'Content-Type' header denotes text content. The 1241 | car and cdr of each cons should each be a string or 1242 | NIL. A content type matches one of these 1243 | entries (and thus denotes text) if the type part is STRING-EQUAL 1245 | to the car or if the car is NIL and if the 1246 | subtype part is STRING-EQUAL 1248 | to the cdr or if the cdr is NIL. 1249 |

1250 |

1251 | The initial value of this variable is the list 1252 | 

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

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

1263 | This section assembles a couple of convenience functions which 1264 | can be used to access information returned as the third value 1265 | (headers) of 1266 | HTTP-REQUEST. 1267 |

1268 |

1269 | Note that if the server sends multiple 1271 | headers with the same name, these are comprised into one 1272 | entry by HTTP-REQUEST. The values are 1273 | separated by commas. 1274 |

1275 | 1276 | 1277 | headers 1278 | list 1279 | 1280 |

1281 | Reads and parses a `Content-Type' header and returns it as 1282 | three values - the type, the subtype, and an alist 1283 | (possibly empty) of name/value pairs for the optional 1284 | parameters. headers is supposed to 1285 | be an alist of headers as returned by 1286 | HTTP-REQUEST. Returns 1287 | NIL if there is no such header amongst 1288 | headers. 1289 |

1290 | 1291 | 1292 | 1293 | 1294 | name headers 1295 | (or string null) 1296 | 1297 |

1298 | If headers is an alist of headers as 1299 | returned by HTTP-REQUEST and 1300 | name is a keyword naming a header, 1301 | this function returns the corresponding value of this 1302 | header (or NIL if it's not in 1303 | headers). 1304 |

1305 | 1306 | 1307 | 1308 | 1309 | string &key value-required-p 1310 | list 1311 | 1312 |

1313 | Reads a comma-separated list of tokens from the string 1314 | string. Each token can be followed 1315 | by an optional, semicolon-separated list of 1316 | attribute/value pairs where the attributes are tokens 1317 | followed by a #\= character and a token or a quoted 1318 | string. Returned is a list where each element is either a 1319 | string (for a simple token) or a cons of a string (the 1320 | token) and an alist (the attribute/value pairs). If 1321 | value-required-p is NIL, 1322 | the value part (including the #\= character) of each 1323 | attribute/value pair is optional. 1324 |

1325 | 1326 | 1327 | 1328 | 1329 | string 1330 | list 1331 | 1332 |

1333 | Splits the string string into a list 1334 | of substrings separated by commas and optional whitespace. 1335 | Empty substrings are ignored. 1336 |

1337 | 1338 | 1339 | 1340 | 1341 | 1342 | 1343 |

1344 | HTTP-REQUEST can deal with HTTP 1346 | cookies if it gets a cookie jar, 1347 | a collection of COOKIE objects, as its cookie-jar argument. Cookies sent 1349 | by the web server will be added to the cookie jar (or updated) 1350 | if appropriate and cookies already in the cookie jar will be 1351 | sent to the server together with the request. 1352 |

1353 |

1354 | Drakma will never remove cookies from a cookie jar 1355 | automatically. You have to do it manually using 1356 | DELETE-OLD-COOKIES. 1357 |

1358 | 1359 | 1360 | 1361 |

1362 | Instances of this class represent HTTP 1364 | cookies. If you need to create your own cookies, you 1365 | should use MAKE-INSTANCE 1367 | with the initargs :NAME, :DOMAIN, 1368 | :VALUE, :PATH, 1369 | :EXPIRES, :SECUREP, and 1370 | :HTTP-ONLY-P all of which are optional except 1371 | for the first two. The meaning of these initargs and the corresponding accessors should 1373 | be pretty clear if one looks at the original 1375 | cookie specification (and at this 1377 | page for the HttpOnly extension). 1378 |

1379 | 
? (make-instance 'drakma:cookie
1380 |                  :name "Foo" 
1381 |                  :value "Bar"
1382 |                  :expires (+ (get-universal-time) 3600)
1383 |                  :domain ".weitz.de")
1384 | #<COOKIE Foo=Bar; expires=Sun, 09-12-2012 20:37:42 GMT; path=/; domain=.weitz.de>
1385 |
1386 | 1387 | 1388 | 1389 | 1390 | string 1391 | universal-time 1392 | 1393 |

1394 | Parses a cookie expiry date and returns it as a Lisp universal 1396 | time. Currently understands the following formats: 1397 |

1398 | 
"Wed, 06-Feb-2008 21:01:38 GMT"
1399 | "Wed, 06-Feb-08 21:01:38 GMT"
1400 | "Tue Feb 13 08:00:00 2007 GMT"
1401 | "Wednesday, 07-February-2027 08:55:23 GMT"
1402 | "Wed, 07-02-2017 10:34:45 GMT"
1403 |

1404 | Instead of "GMT" time zone abbreviations like "CEST" and UTC 1405 | offsets like "GMT-01:30" are also allowed. 1406 |

1407 |

1408 | While this function has "cookie" in its name, it might 1409 | come in handy in other situations as well and it is thus 1410 | exported as a convenience function. 1411 |

1412 | 1413 | 1414 | 1415 | 1416 | cookie1 cookie2 1417 | boolean 1418 | 1419 | Returns a true value if the cookies 1420 | cookie1 and 1421 | cookie2 are equal. Two cookies are 1422 | considered to be equal if name and path are equal. 1423 | 1424 | 1425 | 1426 | 1427 | 1428 | cookie 1429 | string 1430 | 1431 | 1432 | cookie 1433 | (or string null) 1434 | 1435 | 1436 | cookie 1437 | string 1438 | 1439 | 1440 | cookie 1441 | (or string null) 1442 | 1443 | 1444 | cookie 1445 | (or integer null) 1446 | 1447 | 1448 | cookie 1449 | boolean 1450 | 1451 | 1452 | cookie 1453 | boolean 1454 | 1455 | 1456 | 1457 | 1458 | 1459 |

1460 | An object of this class encapsulates a collection (a list, 1461 | actually) of COOKIE objects. You create a new 1462 | cookie jar with (MAKE-INSTANCE 'COOKIE-JAR) 1463 | where you can optionally provide a list of 1464 | COOKIE objects with the 1465 | :COOKIES initarg. The cookies in a cookie jar 1466 | are accessed with COOKIE-JAR-COOKIES. 1467 |

1468 | 1469 | 1470 | 1471 | 1472 | 1473 | cookie-jar 1474 | list 1475 | 1476 | 1477 | 1478 | 1479 | cookie-jar 1480 | cookie-jar 1481 | 1482 |

1483 | Removes all cookies from cookie-jar 1484 | which have either expired or which don't have an expiry 1485 | date. 1486 |

1487 | 1488 | 1489 | 1490 | 1491 | 1492 |

1493 | When this variable is not NIL, cookie domains 1494 | containing no dots are considered valid. The default is 1495 | NIL, meaning to disallow such domains except 1496 | for "localhost". 1497 |

1498 | 1499 | 1500 | 1501 | 1502 | 1503 |

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

1509 | 1510 | 1511 | 1512 | 1513 | 1514 |

1515 | Determines how duplicate cookies in the response are 1516 | handled, defaults to T. Cookies are 1517 | considered duplicate using COOKIE=. 1519 |

1520 |

1521 | Valid values are: 1522 |

    1523 |
  • NIL - duplicates will not be 1524 | removed,
    • 1525 |
  • T or :KEEP-LAST - for 1526 | duplicates, only the last cookie value will be kept, 1527 | based on the order of the response header,
    • 1528 |
  • :KEEP-FIRST - for duplicates, only the 1529 | first cookie value will be kept, based on the order of 1530 | the response header.
    • 1531 |
1532 |

1533 |

1534 | Misbehaving servers may send duplicate cookies back in the 1535 | same Set-Cookie header: 1536 |

1537 | 
HTTP/1.1 200  OK
1538 | Server: My-hand-rolled-server
1539 | Date: Wed, 07 Apr 2010 15:12:30 GMT
1540 | Connection: Close
1541 | Content-Type: text/html
1542 | Content-Length: 82
1543 | Set-Cookie: a=1; Path=/; Secure, a=2; Path=/; Secure
1544 |
1545 |

1546 | In this case Drakma has to choose whether cookie "a" has 1547 | the value "1" or "2". By default, Drakma will choose the 1548 | last value specified, in this case "2". 1549 |

1550 |

1551 | By default, Drakma conforms to RFC2109 1553 | HTTP State Management Mechanism, section 4.3.3 Cookie 1554 | Management: 1555 | 1556 |

1557 | 1558 | If a user agent receives a Set-Cookie response header 1559 | whose NAME is the same as a pre-existing cookie, and 1560 | whose Domain and Path attribute values exactly 1561 | (string) match those of a pre-existing cookie, the new 1562 | cookie supersedes the old. 1563 | 1564 |
1565 |

1566 | 1567 | 1568 | 1569 | 1570 | 1571 |

1572 | This section lists all the condition types that are defined by 1573 | Drakma. 1574 |

1575 | 1576 | 1577 | 1578 |

1579 | Signalled if Drakma tries to parse the date of an incoming 1580 | cookie header and can't interpret it. 1581 |

1582 | 1583 | 1584 | 1585 | 1586 | 1587 |

1588 | Signalled if someone tries to create a COOKIE object 1589 | that's not valid. 1590 |

1591 | 1592 | 1593 | 1594 | 1595 | cookie-error 1596 | (or cookie null) 1597 | 1598 |

1599 | The COOKIE object that caused this error. 1600 | Can be NIL in case such an object couldn't be 1601 | initialized. 1602 |

1603 | 1604 | 1605 | 1606 | 1607 | 1608 |

1609 | Signalled if a function was called with inconsistent or 1610 | illegal parameters. 1611 |

1612 | 1613 | 1614 | 1615 | 1616 | 1617 |

1618 | Signalled if Drakma encounters wrong or unknown syntax 1619 | when reading the reply from the server. 1620 |

1621 | 1622 | 1623 | 1624 | 1625 | 1626 |

1627 | Superclass for all conditions related to Drakma. 1628 |

1629 | 1630 | 1631 | 1632 | 1633 | 1634 |

1635 | Superclass for all errors related to Drakma. 1636 |

1637 | 1638 | 1639 | 1640 | 1641 | 1642 |

1643 | Superclass for all warnings related to Drakma. 1644 |

1645 | 1646 | 1647 | 1648 | 1649 | 1650 | 1651 | 1652 | 1653 | 1654 | 1655 | --------------------------------------------------------------------------------