diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ChangeLog | 11 | ||||
| -rw-r--r-- | lisp/emacs-lisp/package.el | 49 | ||||
| -rw-r--r-- | lisp/url/ChangeLog | 5 | ||||
| -rw-r--r-- | lisp/url/url-handlers.el | 12 |
4 files changed, 36 insertions, 41 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0b54768f0cf..468e83f4218 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -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. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 49366cffc22..17136437cf9 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -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)))))))) diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 0cdcc139905..cb37b4511bd 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -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. diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index e52aad83e47..ecf56e786b5 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -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)) |