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