* lisp/emacs-lisp/package.el: Fix bug#16733 (again).

(url-http-parse-response, url-http-end-of-headers, url-recreate-url)
  (url-http-target-url): Remove unused declarations.
  (package-handle-response): Remove.
  (package--with-work-buffer): Use url-insert-file-contents and simplify.
  (package--download-one-archive): Use current-buffer instead of
  dynamic binding of `buffer'.
  (describe-package-1): Do not decode readme-string.

* lisp/url/url-handlers.el (url-http-parse-response): Add autoload.
  (url-insert-file-contents): Signal file-error in case of HTTP error.
This commit is contained in:
Juanma Barranquero 2014-03-26 16:21:17 +01:00
parent 589d1988d8
commit 196716cf35
4 changed files with 36 additions and 41 deletions

View file

@ -1,3 +1,14 @@
2014-03-26 Juanma Barranquero <lekktu@gmail.com>
* emacs-lisp/package.el: Fix bug#16733 (again).
(url-http-parse-response, url-http-end-of-headers, url-recreate-url)
(url-http-target-url): Remove unused declarations.
(package-handle-response): Remove.
(package--with-work-buffer): Use url-insert-file-contents and simplify.
(package--download-one-archive): Use current-buffer instead of
dynamic binding of `buffer'.
(describe-package-1): Do not decode readme-string.
2014-03-25 Barry O'Reilly <gundaetiapo@gmail.com>
* simple.el (primitive-undo): Correction to 2014-03-24 change.

View file

@ -205,13 +205,9 @@ If VERSION is nil, the package is not loaded (it is \"disabled\")."
(defvar Info-directory-list)
(declare-function info-initialize "info" ())
(declare-function url-http-parse-response "url-http" ())
(declare-function url-http-file-exists-p "url-http" (url))
(declare-function lm-header "lisp-mnt" (header))
(declare-function lm-commentary "lisp-mnt" (&optional file))
(defvar url-http-end-of-headers)
(declare-function url-recreate-url "url-parse" (urlobj))
(defvar url-http-target-url)
(defcustom package-archives '(("gnu" . "http://elpa.gnu.org/packages/"))
"An alist of archives from which to fetch.
@ -770,38 +766,14 @@ This macro retrieves FILE from LOCATION into a temporary buffer,
and evaluates BODY while that buffer is current. This work
buffer is killed afterwards. Return the last value in BODY."
(declare (indent 2) (debug t))
`(let* ((http (string-match "\\`https?:" ,location))
(buffer
(if http
(url-retrieve-synchronously (concat ,location ,file))
(generate-new-buffer "*package work buffer*"))))
(prog1
(with-current-buffer buffer
(if http
(progn (package-handle-response)
(re-search-forward "^$" nil 'move)
(forward-char)
(delete-region (point-min) (point)))
(unless (file-name-absolute-p ,location)
(error "Archive location %s is not an absolute file name"
,location))
(insert-file-contents (expand-file-name ,file ,location)))
,@body)
(kill-buffer buffer))))
(defun package-handle-response ()
"Handle the response from a `url-retrieve-synchronously' call.
Parse the HTTP response and throw if an error occurred.
The url package seems to require extra processing for this.
This should be called in a `save-excursion', in the download buffer.
It will move point to somewhere in the headers."
;; We assume HTTP here.
(require 'url-http)
(let ((response (url-http-parse-response)))
(when (or (< response 200) (>= response 300))
(error "Error downloading %s:%s"
(url-recreate-url url-http-target-url)
(buffer-substring-no-properties (point) (line-end-position))))))
`(with-temp-buffer
(if (string-match-p "\\`https?:" ,location)
(url-insert-file-contents (concat ,location ,file))
(unless (file-name-absolute-p ,location)
(error "Archive location %s is not an absolute file name"
,location))
(insert-file-contents (expand-file-name ,file ,location)))
,@body))
(defun package--archive-file-exists-p (location file)
(let ((http (string-match "\\`https?:" location)))
@ -1270,7 +1242,7 @@ similar to an entry in `package-alist'. Save the cached copy to
(car archive)))))
;; Read the retrieved buffer to make sure it is valid (e.g. it
;; may fetch a URL redirect page).
(when (listp (read buffer))
(when (listp (read (current-buffer)))
(make-directory dir t)
(setq buffer-file-name (expand-file-name file dir))
(let ((version-control 'never)
@ -1529,8 +1501,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
(setq readme-string (buffer-string))
t))
(error nil))
(let ((coding (detect-coding-string readme-string t)))
(insert (decode-coding-string readme-string coding t))))
(insert readme-string))
((file-readable-p readme)
(insert-file-contents readme)
(goto-char (point-max))))))))

View file

@ -1,3 +1,8 @@
2014-03-26 Juanma Barranquero <lekktu@gmail.com>
* url-handlers.el (url-http-parse-response): Add autoload.
(url-insert-file-contents): Signal file-error in case of HTTP error.
2014-02-05 Glenn Morris <rgm@gnu.org>
* url-cookie.el (url-cookie-list): Doc fix.

View file

@ -33,6 +33,7 @@
(autoload 'url-expand-file-name "url-expand" "Convert url to a fully specified url, and canonicalize it.")
(autoload 'mm-dissect-buffer "mm-decode" "Dissect the current buffer and return a list of MIME handles.")
(autoload 'url-scheme-get-property "url-methods" "Get property of a URL SCHEME.")
(autoload 'url-http-parse-response "url-http" "Parse just the response code.")
;; Always used after mm-dissect-buffer and defined in the same file.
(declare-function mm-save-part-to-file "mm-decode" (handle file))
@ -293,8 +294,15 @@ They count bytes from the beginning of the body."
;;;###autoload
(defun url-insert-file-contents (url &optional visit beg end replace)
(let ((buffer (url-retrieve-synchronously url)))
(if (not buffer)
(error "Opening input file: No such file or directory, %s" url))
(unless buffer (signal 'file-error (list url "No Data")))
(with-current-buffer buffer
(let ((response (url-http-parse-response)))
(if (and (>= response 200) (< response 300))
(goto-char (point-min))
(let ((desc (buffer-substring-no-properties (1+ (point))
(line-end-position))))
(kill-buffer buffer)
(signal 'file-error (list url desc))))))
(if visit (setq buffer-file-name url))
(save-excursion
(let* ((start (point))