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