Mercurial > emacs
annotate lisp/url/url-http.el @ 90533:8a8e69664178
Merge from emacs--devo--0
Patches applied:
* emacs--devo--0 (patch 343-356)
- Update from CVS
- Update for ERC 5.1.3.
- Merge from gnus--rel--5.10
* gnus--rel--5.10 (patch 113-115)
- Merge from emacs--devo--0
- Update from CVS
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-90
author | Miles Bader <miles@gnu.org> |
---|---|
date | Wed, 19 Jul 2006 00:42:56 +0000 |
parents | 13e99595c0ba |
children | 210a878f1395 b6689e223e2f |
rev | line source |
---|---|
54695 | 1 ;;; url-http.el --- HTTP retrieval routines |
54830
ccfdda7b76d2
(url-http-parse-headers, url-http-file-exists-p): Remove unused var `version'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
2 |
69043
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
3 ;; Copyright (C) 1999, 2001, 2004, 2005, 2006 Free Software Foundation, Inc. |
54830
ccfdda7b76d2
(url-http-parse-headers, url-http-file-exists-p): Remove unused var `version'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
4 |
54695 | 5 ;; Author: Bill Perry <wmperry@gnu.org> |
6 ;; Keywords: comm, data, processes | |
54932
fd6856033c18
(url-http-head-file-attributes, url-http-file-attributes):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54830
diff
changeset
|
7 |
54830
ccfdda7b76d2
(url-http-parse-headers, url-http-file-exists-p): Remove unused var `version'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
8 ;; This file is part of GNU Emacs. |
ccfdda7b76d2
(url-http-parse-headers, url-http-file-exists-p): Remove unused var `version'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
9 ;; |
ccfdda7b76d2
(url-http-parse-headers, url-http-file-exists-p): Remove unused var `version'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
10 ;; GNU Emacs is free software; you can redistribute it and/or modify |
ccfdda7b76d2
(url-http-parse-headers, url-http-file-exists-p): Remove unused var `version'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
11 ;; it under the terms of the GNU General Public License as published by |
ccfdda7b76d2
(url-http-parse-headers, url-http-file-exists-p): Remove unused var `version'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
12 ;; the Free Software Foundation; either version 2, or (at your option) |
ccfdda7b76d2
(url-http-parse-headers, url-http-file-exists-p): Remove unused var `version'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
13 ;; any later version. |
ccfdda7b76d2
(url-http-parse-headers, url-http-file-exists-p): Remove unused var `version'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
14 ;; |
ccfdda7b76d2
(url-http-parse-headers, url-http-file-exists-p): Remove unused var `version'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
15 ;; GNU Emacs is distributed in the hope that it will be useful, |
ccfdda7b76d2
(url-http-parse-headers, url-http-file-exists-p): Remove unused var `version'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
ccfdda7b76d2
(url-http-parse-headers, url-http-file-exists-p): Remove unused var `version'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
ccfdda7b76d2
(url-http-parse-headers, url-http-file-exists-p): Remove unused var `version'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
18 ;; GNU General Public License for more details. |
ccfdda7b76d2
(url-http-parse-headers, url-http-file-exists-p): Remove unused var `version'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
19 ;; |
ccfdda7b76d2
(url-http-parse-headers, url-http-file-exists-p): Remove unused var `version'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
20 ;; You should have received a copy of the GNU General Public License |
ccfdda7b76d2
(url-http-parse-headers, url-http-file-exists-p): Remove unused var `version'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
64084 | 22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
23 ;; Boston, MA 02110-1301, USA. | |
54695 | 24 |
54830
ccfdda7b76d2
(url-http-parse-headers, url-http-file-exists-p): Remove unused var `version'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
25 ;;; Commentary: |
ccfdda7b76d2
(url-http-parse-headers, url-http-file-exists-p): Remove unused var `version'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
26 |
ccfdda7b76d2
(url-http-parse-headers, url-http-file-exists-p): Remove unused var `version'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
27 ;;; Code: |
54695 | 28 |
66990
7b94c70f4e78
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66225
diff
changeset
|
29 (eval-when-compile (require 'cl)) |
7b94c70f4e78
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66225
diff
changeset
|
30 (defvar url-http-extra-headers) |
7b94c70f4e78
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66225
diff
changeset
|
31 (defvar url-http-target-url) |
54695 | 32 (require 'url-gw) |
33 (require 'url-util) | |
34 (require 'url-parse) | |
35 (require 'url-cookie) | |
36 (require 'mail-parse) | |
37 (require 'url-auth) | |
69043
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
38 (require 'url) |
54695 | 39 (autoload 'url-cache-create-filename "url-cache") |
40 | |
41 (defconst url-http-default-port 80 "Default HTTP port.") | |
42 (defconst url-http-asynchronous-p t "HTTP retrievals are asynchronous.") | |
43 (defalias 'url-http-expand-file-name 'url-default-expander) | |
44 | |
45 (defvar url-http-real-basic-auth-storage nil) | |
46 (defvar url-http-proxy-basic-auth-storage nil) | |
47 | |
48 (defvar url-http-open-connections (make-hash-table :test 'equal | |
49 :size 17) | |
50 "A hash table of all open network connections.") | |
51 | |
52 (defvar url-http-version "1.1" | |
53 "What version of HTTP we advertise, as a string. | |
54 Valid values are 1.1 and 1.0. | |
55 This is only useful when debugging the HTTP subsystem. | |
56 | |
57 Setting this to 1.0 will tell servers not to send chunked encoding, | |
69043
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
58 and other HTTP/1.1 specific features.") |
54695 | 59 |
60 (defvar url-http-attempt-keepalives t | |
61 "Whether to use a single TCP connection multiple times in HTTP. | |
62 This is only useful when debugging the HTTP subsystem. Setting to | |
69043
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
63 nil will explicitly close the connection to the server after every |
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
64 request.") |
54695 | 65 |
66 ;(eval-when-compile | |
67 ;; These are all macros so that they are hidden from external sight | |
68 ;; when the file is byte-compiled. | |
69 ;; | |
70 ;; This allows us to expose just the entry points we want. | |
71 | |
72 ;; These routines will allow us to implement persistent HTTP | |
73 ;; connections. | |
74 (defsubst url-http-debug (&rest args) | |
75 (if quit-flag | |
76 (let ((proc (get-buffer-process (current-buffer)))) | |
77 ;; The user hit C-g, honor it! Some things can get in an | |
78 ;; incredibly tight loop (chunked encoding) | |
79 (if proc | |
80 (progn | |
81 (set-process-sentinel proc nil) | |
82 (set-process-filter proc nil))) | |
83 (error "Transfer interrupted!"))) | |
84 (apply 'url-debug 'http args)) | |
85 | |
86 (defun url-http-mark-connection-as-busy (host port proc) | |
87 (url-http-debug "Marking connection as busy: %s:%d %S" host port proc) | |
88 (puthash (cons host port) | |
89 (delq proc (gethash (cons host port) url-http-open-connections)) | |
90 url-http-open-connections) | |
91 proc) | |
92 | |
93 (defun url-http-mark-connection-as-free (host port proc) | |
94 (url-http-debug "Marking connection as free: %s:%d %S" host port proc) | |
95 (set-process-buffer proc nil) | |
96 (set-process-sentinel proc 'url-http-idle-sentinel) | |
97 (puthash (cons host port) | |
98 (cons proc (gethash (cons host port) url-http-open-connections)) | |
99 url-http-open-connections) | |
100 nil) | |
101 | |
102 (defun url-http-find-free-connection (host port) | |
103 (let ((conns (gethash (cons host port) url-http-open-connections)) | |
104 (found nil)) | |
105 (while (and conns (not found)) | |
106 (if (not (memq (process-status (car conns)) '(run open))) | |
107 (progn | |
108 (url-http-debug "Cleaning up dead process: %s:%d %S" | |
109 host port (car conns)) | |
110 (url-http-idle-sentinel (car conns) nil)) | |
111 (setq found (car conns)) | |
112 (url-http-debug "Found existing connection: %s:%d %S" host port found)) | |
113 (pop conns)) | |
114 (if found | |
115 (url-http-debug "Reusing existing connection: %s:%d" host port) | |
116 (url-http-debug "Contacting host: %s:%d" host port)) | |
117 (url-lazy-message "Contacting host: %s:%d" host port) | |
69043
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
118 (url-http-mark-connection-as-busy |
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
119 host port |
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
120 (or found |
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
121 (let ((buf (generate-new-buffer " *url-http-temp*"))) |
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
122 ;; `url-open-stream' needs a buffer in which to do things |
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
123 ;; like authentication. But we use another buffer afterwards. |
69296
64b44b996827
(url-http-find-free-connection): Don't kill the process
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69054
diff
changeset
|
124 (unwind-protect |
64b44b996827
(url-http-find-free-connection): Don't kill the process
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69054
diff
changeset
|
125 (let ((proc (url-open-stream host buf host port))) |
64b44b996827
(url-http-find-free-connection): Don't kill the process
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69054
diff
changeset
|
126 ;; Drop the temp buffer link before killing the buffer. |
69328
7383e30e90bb
(url-http-find-free-connection): Fix braino in last fix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69296
diff
changeset
|
127 (set-process-buffer proc nil) |
7383e30e90bb
(url-http-find-free-connection): Fix braino in last fix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69296
diff
changeset
|
128 proc) |
69043
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
129 (kill-buffer buf))))))) |
54695 | 130 |
131 ;; Building an HTTP request | |
132 (defun url-http-user-agent-string () | |
133 (if (or (eq url-privacy-level 'paranoid) | |
134 (and (listp url-privacy-level) | |
135 (memq 'agent url-privacy-level))) | |
136 "" | |
137 (format "User-Agent: %sURL/%s%s\r\n" | |
138 (if url-package-name | |
139 (concat url-package-name "/" url-package-version " ") | |
140 "") | |
141 url-version | |
142 (cond | |
143 ((and url-os-type url-system-type) | |
144 (concat " (" url-os-type "; " url-system-type ")")) | |
145 ((or url-os-type url-system-type) | |
146 (concat " (" (or url-system-type url-os-type) ")")) | |
147 (t ""))))) | |
148 | |
149 (defun url-http-create-request (url &optional ref-url) | |
150 "Create an HTTP request for URL, referred to by REF-URL." | |
151 (declare (special proxy-object proxy-info)) | |
152 (let* ((extra-headers) | |
153 (request nil) | |
154 (no-cache (cdr-safe (assoc "Pragma" url-request-extra-headers))) | |
155 (proxy-obj (and (boundp 'proxy-object) proxy-object)) | |
156 (proxy-auth (if (or (cdr-safe (assoc "Proxy-Authorization" | |
157 url-request-extra-headers)) | |
158 (not proxy-obj)) | |
159 nil | |
160 (let ((url-basic-auth-storage | |
161 'url-http-proxy-basic-auth-storage)) | |
162 (url-get-authentication url nil 'any nil)))) | |
63802
58812680c2fd
(url-http-create-request): When computing real-fname,
Richard M. Stallman <rms@gnu.org>
parents:
63000
diff
changeset
|
163 (real-fname (url-filename (or proxy-obj url))) |
54695 | 164 (host (url-host (or proxy-obj url))) |
165 (auth (if (cdr-safe (assoc "Authorization" url-request-extra-headers)) | |
166 nil | |
167 (url-get-authentication (or | |
168 (and (boundp 'proxy-info) | |
169 proxy-info) | |
170 url) nil 'any nil)))) | |
171 (if (equal "" real-fname) | |
172 (setq real-fname "/")) | |
173 (setq no-cache (and no-cache (string-match "no-cache" no-cache))) | |
174 (if auth | |
175 (setq auth (concat "Authorization: " auth "\r\n"))) | |
176 (if proxy-auth | |
177 (setq proxy-auth (concat "Proxy-Authorization: " proxy-auth "\r\n"))) | |
178 | |
179 ;; Protection against stupid values in the referer | |
180 (if (and ref-url (stringp ref-url) (or (string= ref-url "file:nil") | |
181 (string= ref-url ""))) | |
182 (setq ref-url nil)) | |
183 | |
184 ;; We do not want to expose the referer if the user is paranoid. | |
185 (if (or (memq url-privacy-level '(low high paranoid)) | |
186 (and (listp url-privacy-level) | |
187 (memq 'lastloc url-privacy-level))) | |
188 (setq ref-url nil)) | |
189 | |
190 ;; url-request-extra-headers contains an assoc-list of | |
191 ;; header/value pairs that we need to put into the request. | |
192 (setq extra-headers (mapconcat | |
193 (lambda (x) | |
194 (concat (car x) ": " (cdr x))) | |
195 url-request-extra-headers "\r\n")) | |
196 (if (not (equal extra-headers "")) | |
197 (setq extra-headers (concat extra-headers "\r\n"))) | |
198 | |
199 ;; This was done with a call to `format'. Concatting parts has | |
65804
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
200 ;; the advantage of keeping the parts of each header together and |
54695 | 201 ;; allows us to elide null lines directly, at the cost of making |
202 ;; the layout less clear. | |
203 (setq request | |
65804
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
204 ;; We used to concat directly, but if one of the strings happens |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
205 ;; to being multibyte (even if it only contains pure ASCII) then |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
206 ;; every string gets converted with `string-MAKE-multibyte' which |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
207 ;; turns the 127-255 codes into things like latin-1 accented chars |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
208 ;; (it would work right if it used `string-TO-multibyte' instead). |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
209 ;; So to avoid the problem we force every string to be unibyte. |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
210 (mapconcat |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
211 ;; FIXME: Instead of `string-AS-unibyte' we'd want |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
212 ;; `string-to-unibyte', so as to properly signal an error if one |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
213 ;; of the strings contains a multibyte char. |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
214 'string-as-unibyte |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
215 (delq nil |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
216 (list |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
217 ;; The request |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
218 (or url-request-method "GET") " " |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
219 (if proxy-obj (url-recreate-url proxy-obj) real-fname) |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
220 " HTTP/" url-http-version "\r\n" |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
221 ;; Version of MIME we speak |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
222 "MIME-Version: 1.0\r\n" |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
223 ;; (maybe) Try to keep the connection open |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
224 "Connection: " (if (or proxy-obj |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
225 (not url-http-attempt-keepalives)) |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
226 "close" "keep-alive") "\r\n" |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
227 ;; HTTP extensions we support |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
228 (if url-extensions-header |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
229 (format |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
230 "Extension: %s\r\n" url-extensions-header)) |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
231 ;; Who we want to talk to |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
232 (if (/= (url-port (or proxy-obj url)) |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
233 (url-scheme-get-property |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
234 (url-type (or proxy-obj url)) 'default-port)) |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
235 (format |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
236 "Host: %s:%d\r\n" host (url-port (or proxy-obj url))) |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
237 (format "Host: %s\r\n" host)) |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
238 ;; Who its from |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
239 (if url-personal-mail-address |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
240 (concat |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
241 "From: " url-personal-mail-address "\r\n")) |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
242 ;; Encodings we understand |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
243 (if url-mime-encoding-string |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
244 (concat |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
245 "Accept-encoding: " url-mime-encoding-string "\r\n")) |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
246 (if url-mime-charset-string |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
247 (concat |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
248 "Accept-charset: " url-mime-charset-string "\r\n")) |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
249 ;; Languages we understand |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
250 (if url-mime-language-string |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
251 (concat |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
252 "Accept-language: " url-mime-language-string "\r\n")) |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
253 ;; Types we understand |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
254 "Accept: " (or url-mime-accept-string "*/*") "\r\n" |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
255 ;; User agent |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
256 (url-http-user-agent-string) |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
257 ;; Proxy Authorization |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
258 proxy-auth |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
259 ;; Authorization |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
260 auth |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
261 ;; Cookies |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
262 (url-cookie-generate-header-lines host real-fname |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
263 (equal "https" (url-type url))) |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
264 ;; If-modified-since |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
265 (if (and (not no-cache) |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
266 (member url-request-method '("GET" nil))) |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
267 (let ((tm (url-is-cached (or proxy-obj url)))) |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
268 (if tm |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
269 (concat "If-modified-since: " |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
270 (url-get-normalized-date tm) "\r\n")))) |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
271 ;; Whence we came |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
272 (if ref-url (concat |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
273 "Referer: " ref-url "\r\n")) |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
274 extra-headers |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
275 ;; Length of data |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
276 (if url-request-data |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
277 (concat |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
278 "Content-length: " (number-to-string |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
279 (length url-request-data)) |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
280 "\r\n")) |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
281 ;; End request |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
282 "\r\n" |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
283 ;; Any data |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
284 url-request-data)) |
f8c4f76b7870
(url-http-create-request): Avoid incorrect implicit uni->multibyte conversion.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
65097
diff
changeset
|
285 "")) |
54695 | 286 (url-http-debug "Request is: \n%s" request) |
287 request)) | |
288 | |
289 ;; Parsing routines | |
290 (defun url-http-clean-headers () | |
291 "Remove trailing \r from header lines. | |
292 This allows us to use `mail-fetch-field', etc." | |
293 (declare (special url-http-end-of-headers)) | |
294 (goto-char (point-min)) | |
295 (while (re-search-forward "\r$" url-http-end-of-headers t) | |
296 (replace-match ""))) | |
297 | |
298 (defun url-http-handle-authentication (proxy) | |
299 (declare (special status success url-http-method url-http-data | |
300 url-callback-function url-callback-arguments)) | |
301 (url-http-debug "Handling %s authentication" (if proxy "proxy" "normal")) | |
302 (let ((auth (or (mail-fetch-field (if proxy "proxy-authenticate" "www-authenticate")) | |
303 "basic")) | |
304 (type nil) | |
305 (url (url-recreate-url url-current-object)) | |
306 (url-basic-auth-storage 'url-http-real-basic-auth-storage) | |
307 ) | |
308 | |
309 ;; Cheating, but who cares? :) | |
310 (if proxy | |
311 (setq url-basic-auth-storage 'url-http-proxy-basic-auth-storage)) | |
312 | |
313 (setq auth (url-eat-trailing-space (url-strip-leading-spaces auth))) | |
314 (if (string-match "[ \t]" auth) | |
315 (setq type (downcase (substring auth 0 (match-beginning 0)))) | |
316 (setq type (downcase auth))) | |
317 | |
318 (if (not (url-auth-registered type)) | |
319 (progn | |
320 (widen) | |
321 (goto-char (point-max)) | |
322 (insert "<hr>Sorry, but I do not know how to handle " type | |
323 " authentication. If you'd like to write it," | |
324 " send it to " url-bug-address ".<hr>") | |
325 (setq status t)) | |
66990
7b94c70f4e78
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66225
diff
changeset
|
326 (let* ((args (url-parse-args (subst-char-in-string ?, ?\; auth))) |
7b94c70f4e78
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66225
diff
changeset
|
327 (auth (url-get-authentication url (cdr-safe (assoc "realm" args)) |
7b94c70f4e78
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66225
diff
changeset
|
328 type t args))) |
54695 | 329 (if (not auth) |
330 (setq success t) | |
331 (push (cons (if proxy "Proxy-Authorization" "Authorization") auth) | |
332 url-http-extra-headers) | |
333 (let ((url-request-method url-http-method) | |
334 (url-request-data url-http-data) | |
335 (url-request-extra-headers url-http-extra-headers)) | |
59326
2456c6683909
(url-http-handle-authentication): Don't kill the current buffer.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
58686
diff
changeset
|
336 (url-retrieve url url-callback-function |
2456c6683909
(url-http-handle-authentication): Don't kill the current buffer.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
58686
diff
changeset
|
337 url-callback-arguments))))))) |
54695 | 338 |
339 (defun url-http-parse-response () | |
340 "Parse just the response code." | |
341 (declare (special url-http-end-of-headers url-http-response-status)) | |
342 (if (not url-http-end-of-headers) | |
343 (error "Trying to parse HTTP response code in odd buffer: %s" (buffer-name))) | |
344 (url-http-debug "url-http-parse-response called in (%s)" (buffer-name)) | |
345 (goto-char (point-min)) | |
346 (skip-chars-forward " \t\n") ; Skip any blank crap | |
347 (skip-chars-forward "HTTP/") ; Skip HTTP Version | |
348 (read (current-buffer)) | |
349 (setq url-http-response-status (read (current-buffer)))) | |
350 | |
351 (defun url-http-handle-cookies () | |
352 "Handle all set-cookie / set-cookie2 headers in an HTTP response. | |
69043
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
353 The buffer must already be narrowed to the headers, so `mail-fetch-field' will |
54695 | 354 work correctly." |
355 (let ((cookies (mail-fetch-field "Set-Cookie" nil nil t)) | |
58686
2d413ef5bfec
(url-http-handle-cookies): Bind `url-current-object'
Andreas Schwab <schwab@suse.de>
parents:
58606
diff
changeset
|
356 (cookies2 (mail-fetch-field "Set-Cookie2" nil nil t)) |
66990
7b94c70f4e78
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66225
diff
changeset
|
357 (url-current-object url-http-target-url)) |
54695 | 358 (and cookies (url-http-debug "Found %d Set-Cookie headers" (length cookies))) |
359 (and cookies2 (url-http-debug "Found %d Set-Cookie2 headers" (length cookies2))) | |
360 (while cookies | |
361 (url-cookie-handle-set-cookie (pop cookies))) | |
362 ;;; (while cookies2 | |
363 ;;; (url-cookie-handle-set-cookie2 (pop cookies))) | |
364 ) | |
365 ) | |
366 | |
367 (defun url-http-parse-headers () | |
368 "Parse and handle HTTP specific headers. | |
369 Return t if and only if the current buffer is still active and | |
370 should be shown to the user." | |
371 ;; The comments after each status code handled are taken from RFC | |
372 ;; 2616 (HTTP/1.1) | |
373 (declare (special url-http-end-of-headers url-http-response-status | |
374 url-http-method url-http-data url-http-process | |
375 url-callback-function url-callback-arguments)) | |
376 | |
377 (url-http-mark-connection-as-free (url-host url-current-object) | |
378 (url-port url-current-object) | |
379 url-http-process) | |
380 | |
381 (if (or (not (boundp 'url-http-end-of-headers)) | |
382 (not url-http-end-of-headers)) | |
383 (error "Trying to parse headers in odd buffer: %s" (buffer-name))) | |
384 (goto-char (point-min)) | |
385 (url-http-debug "url-http-parse-headers called in (%s)" (buffer-name)) | |
386 (url-http-parse-response) | |
387 (mail-narrow-to-head) | |
388 ;;(narrow-to-region (point-min) url-http-end-of-headers) | |
70396
083f558fe283
(url-http-parse-headers): Don't reuse connection if "Connection: close" header
Eli Zaretskii <eliz@gnu.org>
parents:
69328
diff
changeset
|
389 (let ((connection (mail-fetch-field "Connection"))) |
083f558fe283
(url-http-parse-headers): Don't reuse connection if "Connection: close" header
Eli Zaretskii <eliz@gnu.org>
parents:
69328
diff
changeset
|
390 (if (and connection |
083f558fe283
(url-http-parse-headers): Don't reuse connection if "Connection: close" header
Eli Zaretskii <eliz@gnu.org>
parents:
69328
diff
changeset
|
391 (string= (downcase connection) "close")) |
083f558fe283
(url-http-parse-headers): Don't reuse connection if "Connection: close" header
Eli Zaretskii <eliz@gnu.org>
parents:
69328
diff
changeset
|
392 (delete-process url-http-process))) |
54830
ccfdda7b76d2
(url-http-parse-headers, url-http-file-exists-p): Remove unused var `version'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
393 (let ((class nil) |
54695 | 394 (success nil)) |
395 (setq class (/ url-http-response-status 100)) | |
396 (url-http-debug "Parsed HTTP headers: class=%d status=%d" class url-http-response-status) | |
397 (url-http-handle-cookies) | |
398 | |
399 (case class | |
400 ;; Classes of response codes | |
401 ;; | |
402 ;; 5xx = Server Error | |
403 ;; 4xx = Client Error | |
404 ;; 3xx = Redirection | |
405 ;; 2xx = Successful | |
406 ;; 1xx = Informational | |
407 (1 ; Information messages | |
408 ;; 100 = Continue with request | |
409 ;; 101 = Switching protocols | |
410 ;; 102 = Processing (Added by DAV) | |
411 (url-mark-buffer-as-dead (current-buffer)) | |
412 (error "HTTP responses in class 1xx not supported (%d)" url-http-response-status)) | |
413 (2 ; Success | |
414 ;; 200 Ok | |
415 ;; 201 Created | |
416 ;; 202 Accepted | |
417 ;; 203 Non-authoritative information | |
418 ;; 204 No content | |
419 ;; 205 Reset content | |
420 ;; 206 Partial content | |
421 ;; 207 Multi-status (Added by DAV) | |
422 (case url-http-response-status | |
423 ((204 205) | |
424 ;; No new data, just stay at the same document | |
425 (url-mark-buffer-as-dead (current-buffer)) | |
426 (setq success t)) | |
427 (otherwise | |
428 ;; Generic success for all others. Store in the cache, and | |
429 ;; mark it as successful. | |
430 (widen) | |
60035
a39aff2f88c4
(url-http-parse-headers): Test url-automatic-caching.
Richard M. Stallman <rms@gnu.org>
parents:
59685
diff
changeset
|
431 (if (and url-automatic-caching (equal url-http-method "GET")) |
54695 | 432 (url-store-in-cache (current-buffer))) |
433 (setq success t)))) | |
434 (3 ; Redirection | |
435 ;; 300 Multiple choices | |
436 ;; 301 Moved permanently | |
437 ;; 302 Found | |
438 ;; 303 See other | |
439 ;; 304 Not modified | |
440 ;; 305 Use proxy | |
441 ;; 307 Temporary redirect | |
442 (let ((redirect-uri (or (mail-fetch-field "Location") | |
443 (mail-fetch-field "URI")))) | |
444 (case url-http-response-status | |
445 (300 | |
446 ;; Quoth the spec (section 10.3.1) | |
447 ;; ------------------------------- | |
448 ;; The requested resource corresponds to any one of a set of | |
449 ;; representations, each with its own specific location and | |
450 ;; agent-driven negotiation information is being provided so | |
451 ;; that the user can select a preferred representation and | |
452 ;; redirect its request to that location. | |
453 ;; [...] | |
454 ;; If the server has a preferred choice of representation, it | |
455 ;; SHOULD include the specific URI for that representation in | |
456 ;; the Location field; user agents MAY use the Location field | |
457 ;; value for automatic redirection. | |
458 ;; ------------------------------- | |
459 ;; We do not support agent-driven negotiation, so we just | |
460 ;; redirect to the preferred URI if one is provided. | |
461 nil) | |
462 ((301 302 307) | |
463 ;; If the 301|302 status code is received in response to a | |
464 ;; request other than GET or HEAD, the user agent MUST NOT | |
465 ;; automatically redirect the request unless it can be | |
466 ;; confirmed by the user, since this might change the | |
467 ;; conditions under which the request was issued. | |
468 (if (member url-http-method '("HEAD" "GET")) | |
469 ;; Automatic redirection is ok | |
470 nil | |
471 ;; It is just too big of a pain in the ass to get this | |
472 ;; prompt all the time. We will just silently lose our | |
473 ;; data and convert to a GET method. | |
474 (url-http-debug "Converting `%s' request to `GET' because of REDIRECT(%d)" | |
475 url-http-method url-http-response-status) | |
476 (setq url-http-method "GET" | |
59685
d980e03df4e4
(url-http-parse-headers): Reset url-http-data to nil,
Eli Zaretskii <eliz@gnu.org>
parents:
59326
diff
changeset
|
477 url-http-data nil))) |
54695 | 478 (303 |
479 ;; The response to the request can be found under a different | |
480 ;; URI and SHOULD be retrieved using a GET method on that | |
481 ;; resource. | |
482 (setq url-http-method "GET" | |
483 url-http-data nil)) | |
484 (304 | |
485 ;; The 304 response MUST NOT contain a message-body. | |
486 (url-http-debug "Extracting document from cache... (%s)" | |
487 (url-cache-create-filename (url-view-url t))) | |
488 (url-cache-extract (url-cache-create-filename (url-view-url t))) | |
489 (setq redirect-uri nil | |
490 success t)) | |
491 (305 | |
492 ;; The requested resource MUST be accessed through the | |
493 ;; proxy given by the Location field. The Location field | |
494 ;; gives the URI of the proxy. The recipient is expected | |
495 ;; to repeat this single request via the proxy. 305 | |
496 ;; responses MUST only be generated by origin servers. | |
497 (error "Redirection thru a proxy server not supported: %s" | |
498 redirect-uri)) | |
499 (otherwise | |
500 ;; Treat everything like '300' | |
501 nil)) | |
502 (when redirect-uri | |
503 ;; Clean off any whitespace and/or <...> cruft. | |
504 (if (string-match "\\([^ \t]+\\)[ \t]" redirect-uri) | |
505 (setq redirect-uri (match-string 1 redirect-uri))) | |
506 (if (string-match "^<\\(.*\\)>$" redirect-uri) | |
507 (setq redirect-uri (match-string 1 redirect-uri))) | |
508 | |
509 ;; Some stupid sites (like sourceforge) send a | |
510 ;; non-fully-qualified URL (ie: /), which royally confuses | |
511 ;; the URL library. | |
512 (if (not (string-match url-nonrelative-link redirect-uri)) | |
66990
7b94c70f4e78
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66225
diff
changeset
|
513 ;; Be careful to use the real target URL, otherwise we may |
7b94c70f4e78
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66225
diff
changeset
|
514 ;; compute the redirection relative to the URL of the proxy. |
7b94c70f4e78
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66225
diff
changeset
|
515 (setq redirect-uri |
7b94c70f4e78
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66225
diff
changeset
|
516 (url-expand-file-name redirect-uri url-http-target-url))) |
7b94c70f4e78
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66225
diff
changeset
|
517 (let ((url-request-method url-http-method) |
54695 | 518 (url-request-data url-http-data) |
519 (url-request-extra-headers url-http-extra-headers)) | |
69043
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
520 ;; Put in the current buffer a forwarding pointer to the new |
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
521 ;; destination buffer. |
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
522 ;; FIXME: This is a hack to fix url-retrieve-synchronously |
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
523 ;; without changing the API. Instead url-retrieve should |
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
524 ;; either simply not return the "destination" buffer, or it |
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
525 ;; should take an optional `dest-buf' argument. |
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
526 (set (make-local-variable 'url-redirect-buffer) |
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
527 (url-retrieve redirect-uri url-callback-function |
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
528 (cons :redirect |
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
529 (cons redirect-uri |
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
530 url-callback-arguments)))) |
54695 | 531 (url-mark-buffer-as-dead (current-buffer)))))) |
532 (4 ; Client error | |
533 ;; 400 Bad Request | |
534 ;; 401 Unauthorized | |
535 ;; 402 Payment required | |
536 ;; 403 Forbidden | |
537 ;; 404 Not found | |
538 ;; 405 Method not allowed | |
539 ;; 406 Not acceptable | |
540 ;; 407 Proxy authentication required | |
541 ;; 408 Request time-out | |
542 ;; 409 Conflict | |
543 ;; 410 Gone | |
544 ;; 411 Length required | |
545 ;; 412 Precondition failed | |
546 ;; 413 Request entity too large | |
547 ;; 414 Request-URI too large | |
548 ;; 415 Unsupported media type | |
549 ;; 416 Requested range not satisfiable | |
550 ;; 417 Expectation failed | |
551 ;; 422 Unprocessable Entity (Added by DAV) | |
552 ;; 423 Locked | |
553 ;; 424 Failed Dependency | |
554 (case url-http-response-status | |
555 (401 | |
556 ;; The request requires user authentication. The response | |
557 ;; MUST include a WWW-Authenticate header field containing a | |
558 ;; challenge applicable to the requested resource. The | |
559 ;; client MAY repeat the request with a suitable | |
560 ;; Authorization header field. | |
561 (url-http-handle-authentication nil)) | |
562 (402 | |
563 ;; This code is reserved for future use | |
564 (url-mark-buffer-as-dead (current-buffer)) | |
565 (error "Somebody wants you to give them money")) | |
566 (403 | |
567 ;; The server understood the request, but is refusing to | |
568 ;; fulfill it. Authorization will not help and the request | |
569 ;; SHOULD NOT be repeated. | |
570 (setq success t)) | |
571 (404 | |
572 ;; Not found | |
573 (setq success t)) | |
574 (405 | |
575 ;; The method specified in the Request-Line is not allowed | |
576 ;; for the resource identified by the Request-URI. The | |
577 ;; response MUST include an Allow header containing a list of | |
578 ;; valid methods for the requested resource. | |
579 (setq success t)) | |
580 (406 | |
581 ;; The resource identified by the request is only capable of | |
582 ;; generating response entities which have content | |
583 ;; characteristics nota cceptable according to the accept | |
584 ;; headers sent in the request. | |
585 (setq success t)) | |
586 (407 | |
587 ;; This code is similar to 401 (Unauthorized), but indicates | |
588 ;; that the client must first authenticate itself with the | |
589 ;; proxy. The proxy MUST return a Proxy-Authenticate header | |
590 ;; field containing a challenge applicable to the proxy for | |
591 ;; the requested resource. | |
592 (url-http-handle-authentication t)) | |
593 (408 | |
594 ;; The client did not produce a request within the time that | |
595 ;; the server was prepared to wait. The client MAY repeat | |
596 ;; the request without modifications at any later time. | |
597 (setq success t)) | |
598 (409 | |
599 ;; The request could not be completed due to a conflict with | |
600 ;; the current state of the resource. This code is only | |
601 ;; allowed in situations where it is expected that the user | |
602 ;; mioght be able to resolve the conflict and resubmit the | |
603 ;; request. The response body SHOULD include enough | |
604 ;; information for the user to recognize the source of the | |
605 ;; conflict. | |
606 (setq success t)) | |
607 (410 | |
608 ;; The requested resource is no longer available at the | |
609 ;; server and no forwarding address is known. | |
610 (setq success t)) | |
611 (411 | |
612 ;; The server refuses to accept the request without a defined | |
613 ;; Content-Length. The client MAY repeat the request if it | |
614 ;; adds a valid Content-Length header field containing the | |
615 ;; length of the message-body in the request message. | |
616 ;; | |
617 ;; NOTE - this will never happen because | |
618 ;; `url-http-create-request' automatically calculates the | |
619 ;; content-length. | |
620 (setq success t)) | |
621 (412 | |
622 ;; The precondition given in one or more of the | |
623 ;; request-header fields evaluated to false when it was | |
624 ;; tested on the server. | |
625 (setq success t)) | |
626 ((413 414) | |
627 ;; The server is refusing to process a request because the | |
628 ;; request entity|URI is larger than the server is willing or | |
629 ;; able to process. | |
630 (setq success t)) | |
631 (415 | |
632 ;; The server is refusing to service the request because the | |
633 ;; entity of the request is in a format not supported by the | |
634 ;; requested resource for the requested method. | |
635 (setq success t)) | |
636 (416 | |
637 ;; A server SHOULD return a response with this status code if | |
638 ;; a request included a Range request-header field, and none | |
639 ;; of the range-specifier values in this field overlap the | |
640 ;; current extent of the selected resource, and the request | |
641 ;; did not include an If-Range request-header field. | |
642 (setq success t)) | |
643 (417 | |
644 ;; The expectation given in an Expect request-header field | |
645 ;; could not be met by this server, or, if the server is a | |
646 ;; proxy, the server has unambiguous evidence that the | |
647 ;; request could not be met by the next-hop server. | |
648 (setq success t)) | |
649 (otherwise | |
650 ;; The request could not be understood by the server due to | |
651 ;; malformed syntax. The client SHOULD NOT repeat the | |
652 ;; request without modifications. | |
653 (setq success t)))) | |
654 (5 | |
655 ;; 500 Internal server error | |
656 ;; 501 Not implemented | |
657 ;; 502 Bad gateway | |
658 ;; 503 Service unavailable | |
659 ;; 504 Gateway time-out | |
660 ;; 505 HTTP version not supported | |
661 ;; 507 Insufficient storage | |
662 (setq success t) | |
663 (case url-http-response-status | |
664 (501 | |
665 ;; The server does not support the functionality required to | |
666 ;; fulfill the request. | |
667 nil) | |
668 (502 | |
669 ;; The server, while acting as a gateway or proxy, received | |
670 ;; an invalid response from the upstream server it accessed | |
671 ;; in attempting to fulfill the request. | |
672 nil) | |
673 (503 | |
674 ;; The server is currently unable to handle the request due | |
675 ;; to a temporary overloading or maintenance of the server. | |
676 ;; The implication is that this is a temporary condition | |
677 ;; which will be alleviated after some delay. If known, the | |
678 ;; length of the delay MAY be indicated in a Retry-After | |
679 ;; header. If no Retry-After is given, the client SHOULD | |
680 ;; handle the response as it would for a 500 response. | |
681 nil) | |
682 (504 | |
683 ;; The server, while acting as a gateway or proxy, did not | |
684 ;; receive a timely response from the upstream server | |
685 ;; specified by the URI (e.g. HTTP, FTP, LDAP) or some other | |
686 ;; auxiliary server (e.g. DNS) it needed to access in | |
687 ;; attempting to complete the request. | |
688 nil) | |
689 (505 | |
690 ;; The server does not support, or refuses to support, the | |
691 ;; HTTP protocol version that was used in the request | |
692 ;; message. | |
693 nil) | |
694 (507 ; DAV | |
695 ;; The method could not be performed on the resource | |
696 ;; because the server is unable to store the representation | |
697 ;; needed to successfully complete the request. This | |
698 ;; condition is considered to be temporary. If the request | |
699 ;; which received this status code was the result of a user | |
700 ;; action, the request MUST NOT be repeated until it is | |
701 ;; requested by a separate user action. | |
702 nil))) | |
703 (otherwise | |
704 (error "Unknown class of HTTP response code: %d (%d)" | |
705 class url-http-response-status))) | |
706 (if (not success) | |
707 (url-mark-buffer-as-dead (current-buffer))) | |
708 (url-http-debug "Finished parsing HTTP headers: %S" success) | |
709 (widen) | |
710 success)) | |
711 | |
712 ;; Miscellaneous | |
713 (defun url-http-activate-callback () | |
714 "Activate callback specified when this buffer was created." | |
715 (declare (special url-http-process | |
716 url-callback-function | |
717 url-callback-arguments)) | |
718 (url-http-mark-connection-as-free (url-host url-current-object) | |
719 (url-port url-current-object) | |
720 url-http-process) | |
721 (url-http-debug "Activating callback in buffer (%s)" (buffer-name)) | |
722 (apply url-callback-function url-callback-arguments)) | |
723 | |
724 ;; ) | |
725 | |
726 ;; These unfortunately cannot be macros... please ignore them! | |
727 (defun url-http-idle-sentinel (proc why) | |
728 "Remove this (now defunct) process PROC from the list of open connections." | |
729 (maphash (lambda (key val) | |
730 (if (memq proc val) | |
731 (puthash key (delq proc val) url-http-open-connections))) | |
732 url-http-open-connections)) | |
733 | |
734 (defun url-http-end-of-document-sentinel (proc why) | |
735 ;; Sentinel used for old HTTP/0.9 or connections we know are going | |
736 ;; to die as the 'end of document' notifier. | |
737 (url-http-debug "url-http-end-of-document-sentinel in buffer (%s)" | |
738 (process-buffer proc)) | |
739 (url-http-idle-sentinel proc why) | |
66990
7b94c70f4e78
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66225
diff
changeset
|
740 (with-current-buffer (process-buffer proc) |
54695 | 741 (goto-char (point-min)) |
742 (if (not (looking-at "HTTP/")) | |
743 ;; HTTP/0.9 just gets passed back no matter what | |
744 (url-http-activate-callback) | |
745 (if (url-http-parse-headers) | |
746 (url-http-activate-callback))))) | |
747 | |
748 (defun url-http-simple-after-change-function (st nd length) | |
749 ;; Function used when we do NOT know how long the document is going to be | |
750 ;; Just _very_ simple 'downloaded %d' type of info. | |
751 (declare (special url-http-end-of-headers)) | |
752 (url-lazy-message "Reading %s..." (url-pretty-length nd))) | |
753 | |
754 (defun url-http-content-length-after-change-function (st nd length) | |
755 "Function used when we DO know how long the document is going to be. | |
756 More sophisticated percentage downloaded, etc. | |
757 Also does minimal parsing of HTTP headers and will actually cause | |
758 the callback to be triggered." | |
759 (declare (special url-current-object | |
760 url-http-end-of-headers | |
761 url-http-content-length | |
762 url-http-content-type | |
763 url-http-process)) | |
764 (if url-http-content-type | |
765 (url-display-percentage | |
766 "Reading [%s]... %s of %s (%d%%)" | |
767 (url-percentage (- nd url-http-end-of-headers) | |
768 url-http-content-length) | |
769 url-http-content-type | |
770 (url-pretty-length (- nd url-http-end-of-headers)) | |
771 (url-pretty-length url-http-content-length) | |
772 (url-percentage (- nd url-http-end-of-headers) | |
773 url-http-content-length)) | |
774 (url-display-percentage | |
775 "Reading... %s of %s (%d%%)" | |
776 (url-percentage (- nd url-http-end-of-headers) | |
777 url-http-content-length) | |
778 (url-pretty-length (- nd url-http-end-of-headers)) | |
779 (url-pretty-length url-http-content-length) | |
780 (url-percentage (- nd url-http-end-of-headers) | |
781 url-http-content-length))) | |
782 | |
783 (if (> (- nd url-http-end-of-headers) url-http-content-length) | |
784 (progn | |
785 ;; Found the end of the document! Wheee! | |
786 (url-display-percentage nil nil) | |
787 (message "Reading... done.") | |
788 (if (url-http-parse-headers) | |
789 (url-http-activate-callback))))) | |
790 | |
791 (defun url-http-chunked-encoding-after-change-function (st nd length) | |
792 "Function used when dealing with 'chunked' encoding. | |
793 Cannot give a sophisticated percentage, but we need a different | |
794 function to look for the special 0-length chunk that signifies | |
795 the end of the document." | |
796 (declare (special url-current-object | |
797 url-http-end-of-headers | |
798 url-http-content-type | |
799 url-http-chunked-length | |
800 url-http-chunked-counter | |
801 url-http-process url-http-chunked-start)) | |
802 (save-excursion | |
803 (goto-char st) | |
804 (let ((read-next-chunk t) | |
805 (case-fold-search t) | |
806 (regexp nil) | |
807 (no-initial-crlf nil)) | |
808 ;; We need to loop thru looking for more chunks even within | |
809 ;; one after-change-function call. | |
810 (while read-next-chunk | |
811 (setq no-initial-crlf (= 0 url-http-chunked-counter)) | |
812 (if url-http-content-type | |
813 (url-display-percentage nil | |
814 "Reading [%s]... chunk #%d" | |
815 url-http-content-type url-http-chunked-counter) | |
816 (url-display-percentage nil | |
817 "Reading... chunk #%d" | |
818 url-http-chunked-counter)) | |
819 (url-http-debug "Reading chunk %d (%d %d %d)" | |
820 url-http-chunked-counter st nd length) | |
821 (setq regexp (if no-initial-crlf | |
822 "\\([0-9a-z]+\\).*\r?\n" | |
823 "\r?\n\\([0-9a-z]+\\).*\r?\n")) | |
824 | |
825 (if url-http-chunked-start | |
826 ;; We know how long the chunk is supposed to be, skip over | |
827 ;; leading crap if possible. | |
828 (if (> nd (+ url-http-chunked-start url-http-chunked-length)) | |
829 (progn | |
830 (url-http-debug "Got to the end of chunk #%d!" | |
831 url-http-chunked-counter) | |
832 (goto-char (+ url-http-chunked-start | |
833 url-http-chunked-length))) | |
834 (url-http-debug "Still need %d bytes to hit end of chunk" | |
835 (- (+ url-http-chunked-start | |
836 url-http-chunked-length) | |
837 nd)) | |
838 (setq read-next-chunk nil))) | |
839 (if (not read-next-chunk) | |
840 (url-http-debug "Still spinning for next chunk...") | |
841 (if no-initial-crlf (skip-chars-forward "\r\n")) | |
842 (if (not (looking-at regexp)) | |
843 (progn | |
844 ;; Must not have received the entirety of the chunk header, | |
845 ;; need to spin some more. | |
846 (url-http-debug "Did not see start of chunk @ %d!" (point)) | |
847 (setq read-next-chunk nil)) | |
848 (add-text-properties (match-beginning 0) (match-end 0) | |
849 (list 'start-open t | |
850 'end-open t | |
851 'chunked-encoding t | |
66225 | 852 'face 'cursor |
54695 | 853 'invisible t)) |
62400
e30c08177a3b
Replace `string-to-int' by `string-to-number'.
Juanma Barranquero <lekktu@gmail.com>
parents:
60035
diff
changeset
|
854 (setq url-http-chunked-length (string-to-number (buffer-substring |
e30c08177a3b
Replace `string-to-int' by `string-to-number'.
Juanma Barranquero <lekktu@gmail.com>
parents:
60035
diff
changeset
|
855 (match-beginning 1) |
e30c08177a3b
Replace `string-to-int' by `string-to-number'.
Juanma Barranquero <lekktu@gmail.com>
parents:
60035
diff
changeset
|
856 (match-end 1)) |
e30c08177a3b
Replace `string-to-int' by `string-to-number'.
Juanma Barranquero <lekktu@gmail.com>
parents:
60035
diff
changeset
|
857 16) |
54695 | 858 url-http-chunked-counter (1+ url-http-chunked-counter) |
859 url-http-chunked-start (set-marker | |
860 (or url-http-chunked-start | |
861 (make-marker)) | |
862 (match-end 0))) | |
863 ; (if (not url-http-debug) | |
864 (delete-region (match-beginning 0) (match-end 0));) | |
865 (url-http-debug "Saw start of chunk %d (length=%d, start=%d" | |
866 url-http-chunked-counter url-http-chunked-length | |
867 (marker-position url-http-chunked-start)) | |
868 (if (= 0 url-http-chunked-length) | |
869 (progn | |
870 ;; Found the end of the document! Wheee! | |
871 (url-http-debug "Saw end of stream chunk!") | |
872 (setq read-next-chunk nil) | |
873 (url-display-percentage nil nil) | |
874 (goto-char (match-end 1)) | |
875 (if (re-search-forward "^\r*$" nil t) | |
63000
a2b860ef5fde
(url-http-chunked-encoding-after-change-function): Use `url-http-debug'
Eli Zaretskii <eliz@gnu.org>
parents:
62999
diff
changeset
|
876 (url-http-debug "Saw end of trailers...")) |
54695 | 877 (if (url-http-parse-headers) |
878 (url-http-activate-callback)))))))))) | |
879 | |
880 (defun url-http-wait-for-headers-change-function (st nd length) | |
881 ;; This will wait for the headers to arrive and then splice in the | |
882 ;; next appropriate after-change-function, etc. | |
883 (declare (special url-current-object | |
884 url-http-end-of-headers | |
885 url-http-content-type | |
886 url-http-content-length | |
887 url-http-transfer-encoding | |
888 url-callback-function | |
889 url-callback-arguments | |
890 url-http-process | |
891 url-http-method | |
892 url-http-after-change-function | |
893 url-http-response-status)) | |
894 (url-http-debug "url-http-wait-for-headers-change-function (%s)" | |
895 (buffer-name)) | |
896 (if (not (bobp)) | |
897 (let ((end-of-headers nil) | |
898 (old-http nil) | |
899 (content-length nil)) | |
900 (goto-char (point-min)) | |
901 (if (not (looking-at "^HTTP/[1-9]\\.[0-9]")) | |
902 ;; Not HTTP/x.y data, must be 0.9 | |
903 ;; God, I wish this could die. | |
904 (setq end-of-headers t | |
905 url-http-end-of-headers 0 | |
906 old-http t) | |
907 (if (re-search-forward "^\r*$" nil t) | |
908 ;; Saw the end of the headers | |
909 (progn | |
910 (url-http-debug "Saw end of headers... (%s)" (buffer-name)) | |
911 (setq url-http-end-of-headers (set-marker (make-marker) | |
912 (point)) | |
913 end-of-headers t) | |
914 (url-http-clean-headers)))) | |
915 | |
916 (if (not end-of-headers) | |
917 ;; Haven't seen the end of the headers yet, need to wait | |
918 ;; for more data to arrive. | |
919 nil | |
920 (if old-http | |
921 (message "HTTP/0.9 How I hate thee!") | |
922 (progn | |
923 (url-http-parse-response) | |
924 (mail-narrow-to-head) | |
925 ;;(narrow-to-region (point-min) url-http-end-of-headers) | |
926 (setq url-http-transfer-encoding (mail-fetch-field | |
927 "transfer-encoding") | |
928 url-http-content-type (mail-fetch-field "content-type")) | |
929 (if (mail-fetch-field "content-length") | |
930 (setq url-http-content-length | |
62400
e30c08177a3b
Replace `string-to-int' by `string-to-number'.
Juanma Barranquero <lekktu@gmail.com>
parents:
60035
diff
changeset
|
931 (string-to-number (mail-fetch-field "content-length")))) |
54695 | 932 (widen))) |
933 (if url-http-transfer-encoding | |
934 (setq url-http-transfer-encoding | |
935 (downcase url-http-transfer-encoding))) | |
936 | |
937 (cond | |
938 ((or (= url-http-response-status 204) | |
939 (= url-http-response-status 205)) | |
940 (url-http-debug "%d response must have headers only (%s)." | |
941 url-http-response-status (buffer-name)) | |
942 (if (url-http-parse-headers) | |
943 (url-http-activate-callback))) | |
944 ((string= "HEAD" url-http-method) | |
945 ;; A HEAD request is _ALWAYS_ terminated by the header | |
946 ;; information, regardless of any entity headers, | |
947 ;; according to section 4.4 of the HTTP/1.1 draft. | |
948 (url-http-debug "HEAD request must have headers only (%s)." | |
949 (buffer-name)) | |
950 (if (url-http-parse-headers) | |
951 (url-http-activate-callback))) | |
952 ((string= "CONNECT" url-http-method) | |
953 ;; A CONNECT request is finished, but we cannot stick this | |
954 ;; back on the free connectin list | |
955 (url-http-debug "CONNECT request must have headers only.") | |
956 (if (url-http-parse-headers) | |
957 (url-http-activate-callback))) | |
958 ((equal url-http-response-status 304) | |
959 ;; Only allowed to have a header section. We have to handle | |
960 ;; this here instead of in url-http-parse-headers because if | |
961 ;; you have a cached copy of something without a known | |
962 ;; content-length, and try to retrieve it from the cache, we'd | |
963 ;; fall into the 'being dumb' section and wait for the | |
964 ;; connection to terminate, which means we'd wait for 10 | |
965 ;; seconds for the keep-alives to time out on some servers. | |
966 (if (url-http-parse-headers) | |
967 (url-http-activate-callback))) | |
968 (old-http | |
969 ;; HTTP/0.9 always signaled end-of-connection by closing the | |
970 ;; connection. | |
971 (url-http-debug | |
972 "Saw HTTP/0.9 response, connection closed means end of document.") | |
973 (setq url-http-after-change-function | |
974 'url-http-simple-after-change-function)) | |
975 ((equal url-http-transfer-encoding "chunked") | |
976 (url-http-debug "Saw chunked encoding.") | |
977 (setq url-http-after-change-function | |
978 'url-http-chunked-encoding-after-change-function) | |
979 (if (> nd url-http-end-of-headers) | |
980 (progn | |
981 (url-http-debug | |
982 "Calling initial chunked-encoding for extra data at end of headers") | |
983 (url-http-chunked-encoding-after-change-function | |
984 (marker-position url-http-end-of-headers) nd | |
985 (- nd url-http-end-of-headers))))) | |
986 ((integerp url-http-content-length) | |
987 (url-http-debug | |
988 "Got a content-length, being smart about document end.") | |
989 (setq url-http-after-change-function | |
990 'url-http-content-length-after-change-function) | |
991 (cond | |
992 ((= 0 url-http-content-length) | |
993 ;; We got a NULL body! Activate the callback | |
994 ;; immediately! | |
995 (url-http-debug | |
996 "Got 0-length content-length, activating callback immediately.") | |
997 (if (url-http-parse-headers) | |
998 (url-http-activate-callback))) | |
999 ((> nd url-http-end-of-headers) | |
1000 ;; Have some leftover data | |
1001 (url-http-debug "Calling initial content-length for extra data at end of headers") | |
1002 (url-http-content-length-after-change-function | |
1003 (marker-position url-http-end-of-headers) | |
1004 nd | |
1005 (- nd url-http-end-of-headers))) | |
1006 (t | |
1007 nil))) | |
1008 (t | |
1009 (url-http-debug "No content-length, being dumb.") | |
1010 (setq url-http-after-change-function | |
1011 'url-http-simple-after-change-function))))) | |
1012 ;; We are still at the beginning of the buffer... must just be | |
1013 ;; waiting for a response. | |
1014 (url-http-debug "Spinning waiting for headers...")) | |
1015 (goto-char (point-max))) | |
1016 | |
1017 ;;;###autoload | |
1018 (defun url-http (url callback cbargs) | |
1019 "Retrieve URL via HTTP asynchronously. | |
1020 URL must be a parsed URL. See `url-generic-parse-url' for details. | |
1021 When retrieval is completed, the function CALLBACK is executed with | |
1022 CBARGS as the arguments." | |
1023 (check-type url vector "Need a pre-parsed URL.") | |
1024 (declare (special url-current-object | |
1025 url-http-end-of-headers | |
1026 url-http-content-type | |
1027 url-http-content-length | |
1028 url-http-transfer-encoding | |
1029 url-http-after-change-function | |
1030 url-callback-function | |
1031 url-callback-arguments | |
1032 url-http-method | |
1033 url-http-extra-headers | |
1034 url-http-data | |
1035 url-http-chunked-length | |
1036 url-http-chunked-start | |
1037 url-http-chunked-counter | |
1038 url-http-process)) | |
1039 (let ((connection (url-http-find-free-connection (url-host url) | |
1040 (url-port url))) | |
1041 (buffer (generate-new-buffer (format " *http %s:%d*" | |
1042 (url-host url) | |
1043 (url-port url))))) | |
1044 (if (not connection) | |
1045 ;; Failed to open the connection for some reason | |
1046 (progn | |
1047 (kill-buffer buffer) | |
1048 (setq buffer nil) | |
1049 (error "Could not create connection to %s:%d" (url-host url) | |
1050 (url-port url))) | |
66990
7b94c70f4e78
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66225
diff
changeset
|
1051 (with-current-buffer buffer |
54695 | 1052 (mm-disable-multibyte) |
1053 (setq url-current-object url | |
1054 mode-line-format "%b [%s]") | |
1055 | |
1056 (dolist (var '(url-http-end-of-headers | |
1057 url-http-content-type | |
1058 url-http-content-length | |
1059 url-http-transfer-encoding | |
1060 url-http-after-change-function | |
1061 url-http-response-status | |
1062 url-http-chunked-length | |
1063 url-http-chunked-counter | |
1064 url-http-chunked-start | |
1065 url-callback-function | |
1066 url-callback-arguments | |
1067 url-http-process | |
1068 url-http-method | |
1069 url-http-extra-headers | |
58686
2d413ef5bfec
(url-http-handle-cookies): Bind `url-current-object'
Andreas Schwab <schwab@suse.de>
parents:
58606
diff
changeset
|
1070 url-http-data |
66990
7b94c70f4e78
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66225
diff
changeset
|
1071 url-http-target-url)) |
54695 | 1072 (set (make-local-variable var) nil)) |
1073 | |
1074 (setq url-http-method (or url-request-method "GET") | |
1075 url-http-extra-headers url-request-extra-headers | |
1076 url-http-data url-request-data | |
1077 url-http-process connection | |
1078 url-http-chunked-length nil | |
1079 url-http-chunked-start nil | |
1080 url-http-chunked-counter 0 | |
1081 url-callback-function callback | |
1082 url-callback-arguments cbargs | |
58686
2d413ef5bfec
(url-http-handle-cookies): Bind `url-current-object'
Andreas Schwab <schwab@suse.de>
parents:
58606
diff
changeset
|
1083 url-http-after-change-function 'url-http-wait-for-headers-change-function |
66990
7b94c70f4e78
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66225
diff
changeset
|
1084 url-http-target-url (if (boundp 'proxy-object) |
7b94c70f4e78
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66225
diff
changeset
|
1085 proxy-object |
7b94c70f4e78
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66225
diff
changeset
|
1086 url-current-object)) |
54695 | 1087 |
1088 (set-process-buffer connection buffer) | |
1089 (set-process-sentinel connection 'url-http-end-of-document-sentinel) | |
1090 (set-process-filter connection 'url-http-generic-filter) | |
1091 (process-send-string connection (url-http-create-request url)))) | |
1092 buffer)) | |
1093 | |
1094 ;; Since Emacs 19/20 does not allow you to change the | |
1095 ;; `after-change-functions' hook in the midst of running them, we fake | |
1096 ;; an after change by hooking into the process filter and inserting | |
1097 ;; the data ourselves. This is slightly less efficient, but there | |
1098 ;; were tons of weird ways the after-change code was biting us in the | |
1099 ;; shorts. | |
1100 (defun url-http-generic-filter (proc data) | |
1101 ;; Sometimes we get a zero-length data chunk after the process has | |
1102 ;; been changed to 'free', which means it has no buffer associated | |
1103 ;; with it. Do nothing if there is no buffer, or 0 length data. | |
1104 (declare (special url-http-after-change-function)) | |
1105 (and (process-buffer proc) | |
1106 (/= (length data) 0) | |
66990
7b94c70f4e78
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66225
diff
changeset
|
1107 (with-current-buffer (process-buffer proc) |
54695 | 1108 (url-http-debug "Calling after change function `%s' for `%S'" url-http-after-change-function proc) |
1109 (funcall url-http-after-change-function | |
1110 (point-max) | |
1111 (progn | |
1112 (goto-char (point-max)) | |
1113 (insert data) | |
1114 (point-max)) | |
1115 (length data))))) | |
1116 | |
1117 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
1118 ;;; file-name-handler stuff from here on out | |
1119 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
69296
64b44b996827
(url-http-find-free-connection): Don't kill the process
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69054
diff
changeset
|
1120 (defalias 'url-http-symbol-value-in-buffer |
64b44b996827
(url-http-find-free-connection): Don't kill the process
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69054
diff
changeset
|
1121 (if (fboundp 'symbol-value-in-buffer) |
64b44b996827
(url-http-find-free-connection): Don't kill the process
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69054
diff
changeset
|
1122 'symbol-value-in-buffer |
64b44b996827
(url-http-find-free-connection): Don't kill the process
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69054
diff
changeset
|
1123 (lambda (symbol buffer &optional unbound-value) |
54695 | 1124 "Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound." |
66990
7b94c70f4e78
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66225
diff
changeset
|
1125 (with-current-buffer buffer |
69296
64b44b996827
(url-http-find-free-connection): Don't kill the process
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69054
diff
changeset
|
1126 (if (not (boundp symbol)) |
64b44b996827
(url-http-find-free-connection): Don't kill the process
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69054
diff
changeset
|
1127 unbound-value |
64b44b996827
(url-http-find-free-connection): Don't kill the process
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
69054
diff
changeset
|
1128 (symbol-value symbol)))))) |
54695 | 1129 |
1130 (defun url-http-head (url) | |
1131 (let ((url-request-method "HEAD") | |
1132 (url-request-data nil)) | |
1133 (url-retrieve-synchronously url))) | |
1134 | |
1135 ;;;###autoload | |
1136 (defun url-http-file-exists-p (url) | |
54830
ccfdda7b76d2
(url-http-parse-headers, url-http-file-exists-p): Remove unused var `version'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
1137 (let ((status nil) |
54695 | 1138 (exists nil) |
1139 (buffer (url-http-head url))) | |
1140 (if (not buffer) | |
1141 (setq exists nil) | |
1142 (setq status (url-http-symbol-value-in-buffer 'url-http-response-status | |
1143 buffer 500) | |
70606
13e99595c0ba
(url-http-file-exists-p): Test if status is integer.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
70396
diff
changeset
|
1144 exists (and (integerp status) |
13e99595c0ba
(url-http-file-exists-p): Test if status is integer.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
70396
diff
changeset
|
1145 (>= status 200) (< status 300))) |
54695 | 1146 (kill-buffer buffer)) |
1147 exists)) | |
1148 | |
1149 ;;;###autoload | |
1150 (defalias 'url-http-file-readable-p 'url-http-file-exists-p) | |
1151 | |
54932
fd6856033c18
(url-http-head-file-attributes, url-http-file-attributes):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54830
diff
changeset
|
1152 (defun url-http-head-file-attributes (url &optional id-format) |
54695 | 1153 (let ((buffer (url-http-head url)) |
1154 (attributes nil)) | |
1155 (when buffer | |
1156 (setq attributes (make-list 11 nil)) | |
1157 (setf (nth 1 attributes) 1) ; Number of links to file | |
1158 (setf (nth 2 attributes) 0) ; file uid | |
1159 (setf (nth 3 attributes) 0) ; file gid | |
1160 (setf (nth 7 attributes) ; file size | |
1161 (url-http-symbol-value-in-buffer 'url-http-content-length | |
1162 buffer -1)) | |
1163 (setf (nth 8 attributes) (eval-when-compile (make-string 10 ?-))) | |
1164 (kill-buffer buffer)) | |
1165 attributes)) | |
1166 | |
1167 ;;;###autoload | |
54932
fd6856033c18
(url-http-head-file-attributes, url-http-file-attributes):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54830
diff
changeset
|
1168 (defun url-http-file-attributes (url &optional id-format) |
54695 | 1169 (if (url-dav-supported-p url) |
54932
fd6856033c18
(url-http-head-file-attributes, url-http-file-attributes):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54830
diff
changeset
|
1170 (url-dav-file-attributes url id-format) |
fd6856033c18
(url-http-head-file-attributes, url-http-file-attributes):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54830
diff
changeset
|
1171 (url-http-head-file-attributes url id-format))) |
54695 | 1172 |
1173 ;;;###autoload | |
1174 (defun url-http-options (url) | |
69043
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
1175 "Return a property list describing options available for URL. |
54695 | 1176 This list is retrieved using the `OPTIONS' HTTP method. |
1177 | |
1178 Property list members: | |
1179 | |
1180 methods | |
1181 A list of symbols specifying what HTTP methods the resource | |
1182 supports. | |
1183 | |
1184 dav | |
1185 A list of numbers specifying what DAV protocol/schema versions are | |
1186 supported. | |
1187 | |
1188 dasl | |
1189 A list of supported DASL search types supported (string form) | |
1190 | |
1191 ranges | |
1192 A list of the units available for use in partial document fetches. | |
1193 | |
1194 p3p | |
1195 The `Platform For Privacy Protection' description for the resource. | |
1196 Currently this is just the raw header contents. This is likely to | |
1197 change once P3P is formally supported by the URL package or | |
69043
9ba40a61ae5b
Require `url' rather than try to autoload parts of it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
68640
diff
changeset
|
1198 Emacs/W3." |
54695 | 1199 (let* ((url-request-method "OPTIONS") |
1200 (url-request-data nil) | |
1201 (buffer (url-retrieve-synchronously url)) | |
1202 (header nil) | |
1203 (options nil)) | |
1204 (when (and buffer (= 2 (/ (url-http-symbol-value-in-buffer | |
1205 'url-http-response-status buffer 0) 100))) | |
1206 ;; Only parse the options if we got a 2xx response code! | |
66990
7b94c70f4e78
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66225
diff
changeset
|
1207 (with-current-buffer buffer |
54695 | 1208 (save-restriction |
1209 (save-match-data | |
1210 (mail-narrow-to-head) | |
1211 | |
1212 ;; Figure out what methods are supported. | |
1213 (when (setq header (mail-fetch-field "allow")) | |
1214 (setq options (plist-put | |
1215 options 'methods | |
1216 (mapcar 'intern (split-string header "[ ,]+"))))) | |
1217 | |
1218 ;; Check for DAV | |
1219 (when (setq header (mail-fetch-field "dav")) | |
1220 (setq options (plist-put | |
1221 options 'dav | |
1222 (delq 0 | |
1223 (mapcar 'string-to-number | |
1224 (split-string header "[, ]+")))))) | |
1225 | |
1226 ;; Now for DASL | |
1227 (when (setq header (mail-fetch-field "dasl")) | |
1228 (setq options (plist-put | |
1229 options 'dasl | |
1230 (split-string header "[, ]+")))) | |
1231 | |
1232 ;; P3P - should get more detailed here. FIXME | |
1233 (when (setq header (mail-fetch-field "p3p")) | |
1234 (setq options (plist-put options 'p3p header))) | |
1235 | |
1236 ;; Check for whether they accept byte-range requests. | |
1237 (when (setq header (mail-fetch-field "accept-ranges")) | |
1238 (setq options (plist-put | |
1239 options 'ranges | |
1240 (delq 'none | |
1241 (mapcar 'intern | |
1242 (split-string header "[, ]+")))))) | |
1243 )))) | |
1244 (if buffer (kill-buffer buffer)) | |
1245 options)) | |
1246 | |
1247 (provide 'url-http) | |
1248 | |
54830
ccfdda7b76d2
(url-http-parse-headers, url-http-file-exists-p): Remove unused var `version'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54770
diff
changeset
|
1249 ;; arch-tag: ba7c59ae-c0f4-4a31-9617-d85f221732ee |
54695 | 1250 ;;; url-http.el ends here |