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