1 ;;; url.el --- Uniform Resource Locator retrieval tool -*- lexical-binding: t -*-
3 ;; Copyright (C) 1996-1999, 2001, 2004-2017 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
61 (mailcap-parse-mailcaps)
62 (mailcap-parse-mimetypes)
64 ;; Register all the authentication schemes we can handle
65 (url-register-auth-scheme "basic" nil
4)
66 (url-register-auth-scheme "digest" nil
7)
70 (expand-file-name "cookies" url-configuration-directory
)))
72 (setq url-history-file
74 (expand-file-name "history" url-configuration-directory
)))
76 ;; Parse the global history file if it exists, so that it can be used
77 ;; for URL completion, etc.
78 (url-history-parse-history)
79 (url-history-setup-save-timer)
82 (url-cookie-setup-save-timer)
83 (url-cookie-parse-file url-cookie-file
)
85 ;; Read in proxy gateways
86 (let ((noproxy (and (not (assoc "no_proxy" url-proxy-services
))
87 (or (getenv "NO_PROXY")
89 (getenv "no_proxy")))))
91 (setq url-proxy-services
92 (cons (cons "no_proxy"
99 ((= x ?.
) (regexp-quote "."))
102 (t (char-to-string x
))))
104 url-proxy-services
))))
106 (url-setup-privacy-info)
107 (run-hooks 'url-load-hook
)
108 (setq url-setup-done t
)))
110 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
111 ;;; Retrieval functions
112 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
114 (defvar url-redirect-buffer nil
115 "New buffer into which the retrieval will take place.
116 Sometimes while retrieving a URL, the URL library needs to use another buffer
117 than the one returned initially by `url-retrieve'. In this case, it sets this
118 variable in the original buffer as a forwarding pointer.")
120 (defvar url-retrieve-number-of-calls
0)
121 (autoload 'url-cache-prune-cache
"url-cache")
124 (defun url-retrieve (url callback
&optional cbargs silent inhibit-cookies
)
125 "Retrieve URL asynchronously and call CALLBACK with CBARGS when finished.
126 URL is either a string or a parsed URL. If it is a string
127 containing characters that are not valid in a URI, those
128 characters are percent-encoded; see `url-encode-url'.
130 CALLBACK is called when the object has been completely retrieved, with
131 the current buffer containing the object, and any MIME headers associated
132 with it. It is called as (apply CALLBACK STATUS CBARGS).
133 STATUS is a plist representing what happened during the request,
134 with most recent events first, or an empty list if no events have
135 occurred. Each pair is one of:
137 \(:redirect REDIRECTED-TO) - the request was redirected to this URL
138 \(:error (ERROR-SYMBOL . DATA)) - an error occurred. The error can be
139 signaled with (signal ERROR-SYMBOL DATA).
141 Return the buffer URL will load into, or nil if the process has
142 already completed (i.e. URL was a mailto URL or similar; in this case
143 the callback is not called).
145 The variables `url-request-data', `url-request-method' and
146 `url-request-extra-headers' can be dynamically bound around the
147 request; dynamic binding of other variables doesn't necessarily
150 If SILENT, then don't message progress reports and the like.
151 If INHIBIT-COOKIES, cookies will neither be stored nor sent to
153 If URL is a multibyte string, it will be encoded as utf-8 and
154 URL-encoded before it's used."
155 ;;; XXX: There is code in Emacs that does dynamic binding
156 ;;; of the following variables around url-retrieve:
157 ;;; url-standalone-mode, url-gateway-unplugged, w3-honor-stylesheets,
158 ;;; url-confirmation-func, url-cookie-multiple-line,
159 ;;; url-cookie-{{,secure-}storage,confirmation}
160 ;;; url-standalone-mode and url-gateway-unplugged should work as
161 ;;; usual. url-confirmation-func is only used in nnwarchive.el and
162 ;;; webmail.el; the latter should be updated. Is
163 ;;; url-cookie-multiple-line needed anymore? The other url-cookie-*
164 ;;; are (for now) only used in synchronous retrievals.
165 (url-retrieve-internal url callback
(cons nil cbargs
) silent
168 (defun url-retrieve-internal (url callback cbargs
&optional silent
170 "Internal function; external interface is `url-retrieve'.
171 The callback function will receive an updated value of CBARGS as
172 arguments; its first element should be a plist specifying what has
173 happened so far during the request, as described in the docstring
174 of `url-retrieve' (if in doubt, specify nil).
176 If SILENT, don't message progress reports and the like.
177 If INHIBIT-COOKIES, cookies will neither be stored nor sent to
179 If URL is a multibyte string, it will be encoded as utf-8 and
180 URL-encoded before it's used."
182 (url-gc-dead-buffers)
184 (set-text-properties 0 (length url
) nil url
)
185 (setq url
(url-encode-url url
)))
186 (if (not (url-p url
))
187 (setq url
(url-generic-parse-url url
)))
188 (if (not (functionp callback
))
189 (error "Must provide a callback function to url-retrieve"))
190 (unless (url-type url
)
191 (error "Bad url: %s" (url-recreate-url url
)))
192 (setf (url-silent url
) silent
)
193 (setf (url-use-cookies url
) (not inhibit-cookies
))
194 ;; Once in a while, remove old entries from the URL cache.
195 (when (zerop (% url-retrieve-number-of-calls
1000))
196 (condition-case error
197 (url-cache-prune-cache)
199 (message "Error when expiring the cache: %s" error
))))
200 (setq url-retrieve-number-of-calls
(1+ url-retrieve-number-of-calls
))
201 (let ((loader (url-scheme-get-property (url-type url
) 'loader
))
202 (url-using-proxy (if (url-host url
)
203 (url-find-proxy-for-url url
(url-host url
))))
205 (asynch (url-scheme-get-property (url-type url
) 'asynchronous-p
)))
210 (let ((url-current-object url
))
211 (setq buffer
(funcall loader url callback cbargs
)))
212 (setq buffer
(funcall loader url
))
214 (with-current-buffer buffer
215 (apply callback cbargs
))))
216 (if url-history-track
217 (url-history-update-url url
(current-time)))
221 (defun url-retrieve-synchronously (url &optional silent inhibit-cookies timeout
)
222 "Retrieve URL synchronously.
223 Return the buffer containing the data, or nil if there are no data
224 associated with it (the case for dired, info, or mailto URLs that need
225 no further processing). URL is either a string or a parsed URL.
227 If SILENT is non-nil, don't do any messaging while retrieving.
228 If INHIBIT-COOKIES is non-nil, refuse to store cookies. If
229 TIMEOUT is passed, it should be a number that says (in seconds)
230 how long to wait for a response before giving up."
233 (let ((retrieval-done nil
)
234 (start-time (current-time))
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 (and (not retrieval-done
)
258 (< (float-time (time-subtract
259 (current-time) start-time
))
261 (url-debug 'retrieval
262 "Spinning in url-retrieve-synchronously: %S (%S)"
263 retrieval-done asynch-buffer
)
264 (if (buffer-local-value 'url-redirect-buffer asynch-buffer
)
265 (setq proc
(get-buffer-process
267 (buffer-local-value 'url-redirect-buffer
269 (if (and proc
(memq (process-status proc
)
270 '(closed exit signal failed
))
271 ;; Make sure another process hasn't been started.
272 (eq proc
(or (get-buffer-process asynch-buffer
) proc
)))
273 ;; FIXME: It's not clear whether url-retrieve's callback is
274 ;; guaranteed to be called or not. It seems that url-http
275 ;; decides sometimes consciously not to call it, so it's not
276 ;; clear that it's a bug, but even then we need to decide how
277 ;; url-http can then warn us that the download has completed.
278 ;; In the mean time, we use this here workaround.
279 ;; XXX: The callback must always be called. Any
280 ;; exception is a bug that should be fixed, not worked
282 (progn ;; Call delete-process so we run any sentinel now.
283 (delete-process proc
)
284 (setq retrieval-done t
)))
285 ;; We used to use `sit-for' here, but in some cases it wouldn't
286 ;; work because apparently pending keyboard input would always
287 ;; interrupt it before it got a chance to handle process input.
288 ;; `sleep-for' was tried but it lead to other forms of
290 (unless (or (with-local-quit
291 (accept-process-output proc
1))
293 ;; accept-process-output returned nil, maybe because the process
294 ;; exited (and may have been replaced with another). If we got
295 ;; a quit, just stop.
297 (delete-process proc
))
298 (setq proc
(and (not quit-flag
)
299 (get-buffer-process asynch-buffer
)))))))
302 ;; url-mm-callback called from url-mm, which requires mm-decode.
303 (declare-function mm-dissect-buffer
"mm-decode"
304 (&optional no-strict-mime loose-mime from
))
305 (declare-function mm-display-part
"mm-decode"
306 (handle &optional no-default force
))
308 (defun url-mm-callback (&rest ignored
)
309 (let ((handle (mm-dissect-buffer t
)))
310 (url-mark-buffer-as-dead (current-buffer))
312 (generate-new-buffer (url-recreate-url url-current-object
))
313 (if (eq (mm-display-part handle
) 'external
)
315 (set-process-sentinel
316 ;; Fixme: this shouldn't have to know the form of the
317 ;; undisplayer produced by `mm-display-part'.
318 (get-buffer-process (cdr (mm-handle-undisplayer handle
)))
319 `(lambda (proc event
)
320 (mm-destroy-parts (quote ,handle
))))
321 (message "Viewing externally")
322 (kill-buffer (current-buffer)))
323 (display-buffer (current-buffer))
324 (add-hook 'kill-buffer-hook
325 `(lambda () (mm-destroy-parts ',handle
))
329 (defun url-mm-url (url)
330 "Retrieve URL and pass to the appropriate viewing application."
331 ;; These requires could advantageously be moved to url-mm-callback or
332 ;; turned into autoloads, but I suspect that it would introduce some bugs
333 ;; because loading those files from a process sentinel or filter may
334 ;; result in some undesirable corner cases.
337 (url-retrieve url
'url-mm-callback nil
))
339 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
341 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
342 (defvar url-dead-buffer-list nil
)
344 (defun url-mark-buffer-as-dead (buff)
345 (push buff url-dead-buffer-list
))
347 (defun url-gc-dead-buffers ()
349 (while (setq buff
(pop url-dead-buffer-list
))
350 (if (buffer-live-p buff
)
351 (kill-buffer buff
)))))
354 ((fboundp 'display-warning
)
355 (defalias 'url-warn
'display-warning
))
357 (defun url-warn (class message
&optional level
)
358 (warn "(%s/%s) %s" class
(or level
'warning
) message
)))
360 (defun url-warn (class message
&optional level
)
361 (with-current-buffer (get-buffer-create "*URL-WARNINGS*")
362 (goto-char (point-max))
364 (insert (format "(%s/%s) %s\n" class
(or level
'warning
) message
)))
365 (display-buffer (current-buffer))))))