1 ;;; url.el --- Uniform Resource Locator retrieval tool -*- lexical-binding: t -*-
3 ;; Copyright (C) 1996-1999, 2001, 2004-2016 Free Software Foundation,
6 ;; Author: Bill Perry <wmperry@gnu.org>
7 ;; Maintainer: emacs-devel@gnu.org
8 ;; Keywords: comm, data, processes, hypermedia
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 ;; Registered URI schemes: http://www.iana.org/assignments/uri-schemes
40 (require 'url-history
)
42 (require 'url-privacy
)
43 (require 'url-methods
)
49 (defcustom url-configuration-directory
50 (locate-user-emacs-file "url/" ".url/")
51 "Directory used by the URL package for cookies, history, etc."
55 (defun url-do-setup ()
56 "Setup the URL package.
57 This is to avoid conflict with user settings if URL is dumped with
59 (unless url-setup-done
62 ;;(push '("http" "80") tcp-binary-process-input-services)
64 (mailcap-parse-mailcaps)
65 (mailcap-parse-mimetypes)
67 ;; Register all the authentication schemes we can handle
68 (url-register-auth-scheme "basic" nil
4)
69 (url-register-auth-scheme "digest" nil
7)
73 (expand-file-name "cookies" url-configuration-directory
)))
75 (setq url-history-file
77 (expand-file-name "history" url-configuration-directory
)))
79 ;; Parse the global history file if it exists, so that it can be used
80 ;; for URL completion, etc.
81 (url-history-parse-history)
82 (url-history-setup-save-timer)
85 (url-cookie-setup-save-timer)
86 (url-cookie-parse-file url-cookie-file
)
88 ;; Read in proxy gateways
89 (let ((noproxy (and (not (assoc "no_proxy" url-proxy-services
))
90 (or (getenv "NO_PROXY")
92 (getenv "no_proxy")))))
94 (setq url-proxy-services
95 (cons (cons "no_proxy"
102 ((= x ?.
) (regexp-quote "."))
105 (t (char-to-string x
))))
107 url-proxy-services
))))
109 (url-setup-privacy-info)
110 (run-hooks 'url-load-hook
)
111 (setq url-setup-done t
)))
113 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
114 ;;; Retrieval functions
115 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
117 (defvar url-redirect-buffer nil
118 "New buffer into which the retrieval will take place.
119 Sometimes while retrieving a URL, the URL library needs to use another buffer
120 than the one returned initially by `url-retrieve'. In this case, it sets this
121 variable in the original buffer as a forwarding pointer.")
123 (defvar url-retrieve-number-of-calls
0)
124 (autoload 'url-cache-prune-cache
"url-cache")
127 (defun url-retrieve (url callback
&optional cbargs silent inhibit-cookies
)
128 "Retrieve URL asynchronously and call CALLBACK with CBARGS when finished.
129 URL is either a string or a parsed URL. If it is a string
130 containing characters that are not valid in a URI, those
131 characters are percent-encoded; see `url-encode-url'.
133 CALLBACK is called when the object has been completely retrieved, with
134 the current buffer containing the object, and any MIME headers associated
135 with it. It is called as (apply CALLBACK STATUS CBARGS).
136 STATUS is a plist representing what happened during the request,
137 with most recent events first, or an empty list if no events have
138 occurred. Each pair is one of:
140 \(:redirect REDIRECTED-TO) - the request was redirected to this URL
141 \(:error (ERROR-SYMBOL . DATA)) - an error occurred. The error can be
142 signaled with (signal ERROR-SYMBOL DATA).
144 Return the buffer URL will load into, or nil if the process has
145 already completed (i.e. URL was a mailto URL or similar; in this case
146 the callback is not called).
148 The variables `url-request-data', `url-request-method' and
149 `url-request-extra-headers' can be dynamically bound around the
150 request; dynamic binding of other variables doesn't necessarily
153 If SILENT, then don't message progress reports and the like.
154 If INHIBIT-COOKIES, cookies will neither be stored nor sent to
156 If URL is a multibyte string, it will be encoded as utf-8 and
157 URL-encoded before it's used."
158 ;;; XXX: There is code in Emacs that does dynamic binding
159 ;;; of the following variables around url-retrieve:
160 ;;; url-standalone-mode, url-gateway-unplugged, w3-honor-stylesheets,
161 ;;; url-confirmation-func, url-cookie-multiple-line,
162 ;;; url-cookie-{{,secure-}storage,confirmation}
163 ;;; url-standalone-mode and url-gateway-unplugged should work as
164 ;;; usual. url-confirmation-func is only used in nnwarchive.el and
165 ;;; webmail.el; the latter should be updated. Is
166 ;;; url-cookie-multiple-line needed anymore? The other url-cookie-*
167 ;;; are (for now) only used in synchronous retrievals.
168 (url-retrieve-internal url callback
(cons nil cbargs
) silent
171 (defun url-retrieve-internal (url callback cbargs
&optional silent
173 "Internal function; external interface is `url-retrieve'.
174 The callback function will receive an updated value of CBARGS as
175 arguments; its first element should be a plist specifying what has
176 happened so far during the request, as described in the docstring
177 of `url-retrieve' (if in doubt, specify nil).
179 If SILENT, don't message progress reports and the like.
180 If INHIBIT-COOKIES, cookies will neither be stored nor sent to
182 If URL is a multibyte string, it will be encoded as utf-8 and
183 URL-encoded before it's used."
185 (url-gc-dead-buffers)
187 (set-text-properties 0 (length url
) nil url
)
188 (setq url
(url-encode-url url
)))
189 (if (not (vectorp url
))
190 (setq url
(url-generic-parse-url url
)))
191 (if (not (functionp callback
))
192 (error "Must provide a callback function to url-retrieve"))
193 (unless (url-type url
)
194 (error "Bad url: %s" (url-recreate-url url
)))
195 (setf (url-silent url
) silent
)
196 (setf (url-use-cookies url
) (not inhibit-cookies
))
197 ;; Once in a while, remove old entries from the URL cache.
198 (when (zerop (% url-retrieve-number-of-calls
1000))
199 (condition-case error
200 (url-cache-prune-cache)
202 (message "Error when expiring the cache: %s" error
))))
203 (setq url-retrieve-number-of-calls
(1+ url-retrieve-number-of-calls
))
204 (let ((loader (url-scheme-get-property (url-type url
) 'loader
))
205 (url-using-proxy (if (url-host url
)
206 (url-find-proxy-for-url url
(url-host url
))))
208 (asynch (url-scheme-get-property (url-type url
) 'asynchronous-p
)))
213 (let ((url-current-object url
))
214 (setq buffer
(funcall loader url callback cbargs
)))
215 (setq buffer
(funcall loader url
))
217 (with-current-buffer buffer
218 (apply callback cbargs
))))
219 (if url-history-track
220 (url-history-update-url url
(current-time)))
224 (defun url-retrieve-synchronously (url &optional silent inhibit-cookies
)
225 "Retrieve URL synchronously.
226 Return the buffer containing the data, or nil if there are no data
227 associated with it (the case for dired, info, or mailto URLs that need
228 no further processing). URL is either a string or a parsed URL.
229 If SILENT is non-nil, don't display progress reports and similar messages.
230 If INHIBIT-COOKIES is non-nil, cookies will neither be stored nor sent
234 (let ((retrieval-done nil
)
237 (url-retrieve url
(lambda (&rest ignored
)
238 (url-debug 'retrieval
"Synchronous fetching done (%S)" (current-buffer))
239 (setq retrieval-done t
240 asynch-buffer
(current-buffer)))
241 nil silent inhibit-cookies
))
242 (if (null asynch-buffer
)
243 ;; We do not need to do anything, it was a mailto or something
244 ;; similar that takes processing completely outside of the URL
247 (let ((proc (get-buffer-process asynch-buffer
)))
248 ;; If the access method was synchronous, `retrieval-done' should
249 ;; hopefully already be set to t. If it is nil, and `proc' is also
250 ;; nil, it implies that the async process is not running in
251 ;; asynch-buffer. This happens e.g. for FTP files. In such a case
252 ;; url-file.el should probably set something like a `url-process'
253 ;; buffer-local variable so we can find the exact process that we
254 ;; should be waiting for. In the mean time, we'll just wait for any
256 (while (not retrieval-done
)
257 (url-debug 'retrieval
258 "Spinning in url-retrieve-synchronously: %S (%S)"
259 retrieval-done asynch-buffer
)
260 (if (buffer-local-value 'url-redirect-buffer asynch-buffer
)
261 (setq proc
(get-buffer-process
263 (buffer-local-value 'url-redirect-buffer
265 (if (and proc
(memq (process-status proc
)
266 '(closed exit signal failed
))
267 ;; Make sure another process hasn't been started.
268 (eq proc
(or (get-buffer-process asynch-buffer
) proc
)))
269 ;; FIXME: It's not clear whether url-retrieve's callback is
270 ;; guaranteed to be called or not. It seems that url-http
271 ;; decides sometimes consciously not to call it, so it's not
272 ;; clear that it's a bug, but even then we need to decide how
273 ;; url-http can then warn us that the download has completed.
274 ;; In the mean time, we use this here workaround.
275 ;; XXX: The callback must always be called. Any
276 ;; exception is a bug that should be fixed, not worked
278 (progn ;; Call delete-process so we run any sentinel now.
279 (delete-process proc
)
280 (setq retrieval-done t
)))
281 ;; We used to use `sit-for' here, but in some cases it wouldn't
282 ;; work because apparently pending keyboard input would always
283 ;; interrupt it before it got a chance to handle process input.
284 ;; `sleep-for' was tried but it lead to other forms of
286 (unless (or (with-local-quit
287 (accept-process-output proc
))
289 ;; accept-process-output returned nil, maybe because the process
290 ;; exited (and may have been replaced with another). If we got
291 ;; a quit, just stop.
293 (delete-process proc
))
294 (setq proc
(and (not quit-flag
)
295 (get-buffer-process asynch-buffer
)))))))
298 ;; url-mm-callback called from url-mm, which requires mm-decode.
299 (declare-function mm-dissect-buffer
"mm-decode"
300 (&optional no-strict-mime loose-mime from
))
301 (declare-function mm-display-part
"mm-decode"
302 (handle &optional no-default force
))
304 (defun url-mm-callback (&rest ignored
)
305 (let ((handle (mm-dissect-buffer t
)))
306 (url-mark-buffer-as-dead (current-buffer))
308 (generate-new-buffer (url-recreate-url url-current-object
))
309 (if (eq (mm-display-part handle
) 'external
)
311 (set-process-sentinel
312 ;; Fixme: this shouldn't have to know the form of the
313 ;; undisplayer produced by `mm-display-part'.
314 (get-buffer-process (cdr (mm-handle-undisplayer handle
)))
315 `(lambda (proc event
)
316 (mm-destroy-parts (quote ,handle
))))
317 (message "Viewing externally")
318 (kill-buffer (current-buffer)))
319 (display-buffer (current-buffer))
320 (add-hook 'kill-buffer-hook
321 `(lambda () (mm-destroy-parts ',handle
))
325 (defun url-mm-url (url)
326 "Retrieve URL and pass to the appropriate viewing application."
327 ;; These requires could advantageously be moved to url-mm-callback or
328 ;; turned into autoloads, but I suspect that it would introduce some bugs
329 ;; because loading those files from a process sentinel or filter may
330 ;; result in some undesirable corner cases.
333 (url-retrieve url
'url-mm-callback nil
))
335 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
337 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
338 (defvar url-dead-buffer-list nil
)
340 (defun url-mark-buffer-as-dead (buff)
341 (push buff url-dead-buffer-list
))
343 (defun url-gc-dead-buffers ()
345 (while (setq buff
(pop url-dead-buffer-list
))
346 (if (buffer-live-p buff
)
347 (kill-buffer buff
)))))
350 ((fboundp 'display-warning
)
351 (defalias 'url-warn
'display-warning
))
353 (defun url-warn (class message
&optional level
)
354 (warn "(%s/%s) %s" class
(or level
'warning
) message
)))
356 (defun url-warn (class message
&optional level
)
357 (with-current-buffer (get-buffer-create "*URL-WARNINGS*")
358 (goto-char (point-max))
360 (insert (format "(%s/%s) %s\n" class
(or level
'warning
) message
)))
361 (display-buffer (current-buffer))))))