Commit 196716cf authored by Juanma Barranquero's avatar Juanma Barranquero

* 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.
parent 589d1988
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> 2014-03-25 Barry O'Reilly <gundaetiapo@gmail.com>
* simple.el (primitive-undo): Correction to 2014-03-24 change. * simple.el (primitive-undo): Correction to 2014-03-24 change.
......
...@@ -205,13 +205,9 @@ If VERSION is nil, the package is not loaded (it is \"disabled\")." ...@@ -205,13 +205,9 @@ If VERSION is nil, the package is not loaded (it is \"disabled\")."
(defvar Info-directory-list) (defvar Info-directory-list)
(declare-function info-initialize "info" ()) (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 url-http-file-exists-p "url-http" (url))
(declare-function lm-header "lisp-mnt" (header)) (declare-function lm-header "lisp-mnt" (header))
(declare-function lm-commentary "lisp-mnt" (&optional file)) (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/")) (defcustom package-archives '(("gnu" . "http://elpa.gnu.org/packages/"))
"An alist of archives from which to fetch. "An alist of archives from which to fetch.
...@@ -770,38 +766,14 @@ This macro retrieves FILE from LOCATION into a temporary buffer, ...@@ -770,38 +766,14 @@ This macro retrieves FILE from LOCATION into a temporary buffer,
and evaluates BODY while that buffer is current. This work and evaluates BODY while that buffer is current. This work
buffer is killed afterwards. Return the last value in BODY." buffer is killed afterwards. Return the last value in BODY."
(declare (indent 2) (debug t)) (declare (indent 2) (debug t))
`(let* ((http (string-match "\\`https?:" ,location)) `(with-temp-buffer
(buffer (if (string-match-p "\\`https?:" ,location)
(if http (url-insert-file-contents (concat ,location ,file))
(url-retrieve-synchronously (concat ,location ,file)) (unless (file-name-absolute-p ,location)
(generate-new-buffer "*package work buffer*")))) (error "Archive location %s is not an absolute file name"
(prog1 ,location))
(with-current-buffer buffer (insert-file-contents (expand-file-name ,file ,location)))
(if http ,@body))
(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))))))
(defun package--archive-file-exists-p (location file) (defun package--archive-file-exists-p (location file)
(let ((http (string-match "\\`https?:" location))) (let ((http (string-match "\\`https?:" location)))
...@@ -1270,7 +1242,7 @@ similar to an entry in `package-alist'. Save the cached copy to ...@@ -1270,7 +1242,7 @@ similar to an entry in `package-alist'. Save the cached copy to
(car archive))))) (car archive)))))
;; Read the retrieved buffer to make sure it is valid (e.g. it ;; Read the retrieved buffer to make sure it is valid (e.g. it
;; may fetch a URL redirect page). ;; may fetch a URL redirect page).
(when (listp (read buffer)) (when (listp (read (current-buffer)))
(make-directory dir t) (make-directory dir t)
(setq buffer-file-name (expand-file-name file dir)) (setq buffer-file-name (expand-file-name file dir))
(let ((version-control 'never) (let ((version-control 'never)
...@@ -1529,8 +1501,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." ...@@ -1529,8 +1501,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
(setq readme-string (buffer-string)) (setq readme-string (buffer-string))
t)) t))
(error nil)) (error nil))
(let ((coding (detect-coding-string readme-string t))) (insert readme-string))
(insert (decode-coding-string readme-string coding t))))
((file-readable-p readme) ((file-readable-p readme)
(insert-file-contents readme) (insert-file-contents readme)
(goto-char (point-max)))))))) (goto-char (point-max))))))))
......
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> 2014-02-05 Glenn Morris <rgm@gnu.org>
* url-cookie.el (url-cookie-list): Doc fix. * url-cookie.el (url-cookie-list): Doc fix.
......
...@@ -33,6 +33,7 @@ ...@@ -33,6 +33,7 @@
(autoload 'url-expand-file-name "url-expand" "Convert url to a fully specified url, and canonicalize it.") (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 '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-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. ;; Always used after mm-dissect-buffer and defined in the same file.
(declare-function mm-save-part-to-file "mm-decode" (handle 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." ...@@ -293,8 +294,15 @@ They count bytes from the beginning of the body."
;;;###autoload ;;;###autoload
(defun url-insert-file-contents (url &optional visit beg end replace) (defun url-insert-file-contents (url &optional visit beg end replace)
(let ((buffer (url-retrieve-synchronously url))) (let ((buffer (url-retrieve-synchronously url)))
(if (not buffer) (unless buffer (signal 'file-error (list url "No Data")))
(error "Opening input file: No such file or directory, %s" url)) (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)) (if visit (setq buffer-file-name url))
(save-excursion (save-excursion
(let* ((start (point)) (let* ((start (point))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment