* lisp/emacs-lisp/package.el: Fix decoding of downloaded files
This is a different fix for bug#34909, which should also fix bug#35739. Our downloading code used to automatically decode the result according to the usual heuristics for files. This caused problems when we later needed to save the data in a file that needed to be byte-for-byte equal to the original in order to pass the signature verification, especially because we didn't keep track of which coding-system was used to decode the data. (package--unless-error): New macro extracted from package--with-response-buffer-1, so that we can specify edebug and indent specs. (package--with-response-buffer-1): Use it. More importantly, change code so it runs `body` in a unibyte buffer with undecoded data. (package--download-one-archive): Don't encode with utf-8 since the data is not decoded yet. (describe-package-1): Explicitly decode the readem.txt files here. * lisp/url/url-handlers.el (url-insert-file-contents): Use it. (url-insert): Don't decode if buffer is unibyte. * lisp/url/url-http.el (url-http--insert-file-helper): New function, extracted from url-insert-file-contents.
This commit is contained in:
Stefan Monnier
parent
2a5705761e
commit
5f9671e57e
3 changed files with 98 additions and 63 deletions
|
|
@ -1203,42 +1203,60 @@ errors signaled by ERROR-FORM or by BODY).
|
|||
:error-function (lambda () ,error-form)
|
||||
:noerror ,noerror))
|
||||
|
||||
(defmacro package--unless-error (body &rest before-body)
|
||||
(declare (debug t) (indent 1))
|
||||
(let ((err (make-symbol "err")))
|
||||
`(with-temp-buffer
|
||||
(set-buffer-multibyte nil)
|
||||
(when (condition-case ,err
|
||||
(progn ,@before-body t)
|
||||
(error (funcall error-function)
|
||||
(unless noerror
|
||||
(signal (car ,err) (cdr ,err)))))
|
||||
(funcall ,body)))))
|
||||
|
||||
(cl-defun package--with-response-buffer-1 (url body &key async file error-function noerror &allow-other-keys)
|
||||
(cl-macrolet ((unless-error (body &rest before-body)
|
||||
(let ((err (make-symbol "err")))
|
||||
`(with-temp-buffer
|
||||
(when (condition-case ,err
|
||||
(progn ,@before-body t)
|
||||
(error (funcall error-function)
|
||||
(unless noerror
|
||||
(signal (car ,err) (cdr ,err)))))
|
||||
(funcall ,body))))))
|
||||
(if (string-match-p "\\`https?:" url)
|
||||
(if (string-match-p "\\`https?:" url)
|
||||
(let ((url (concat url file)))
|
||||
(if async
|
||||
(unless-error #'ignore
|
||||
(url-retrieve url
|
||||
(lambda (status)
|
||||
(let ((b (current-buffer)))
|
||||
(require 'url-handlers)
|
||||
(unless-error body
|
||||
(when-let* ((er (plist-get status :error)))
|
||||
(error "Error retrieving: %s %S" url er))
|
||||
(with-current-buffer b
|
||||
(goto-char (point-min))
|
||||
(unless (search-forward-regexp "^\r?\n\r?" nil 'noerror)
|
||||
(error "Error retrieving: %s %S" url "incomprehensible buffer")))
|
||||
(url-insert-buffer-contents b url)
|
||||
(kill-buffer b)
|
||||
(goto-char (point-min)))))
|
||||
nil
|
||||
'silent))
|
||||
(unless-error body (url-insert-file-contents url))))
|
||||
(unless-error body
|
||||
(package--unless-error #'ignore
|
||||
(url-retrieve
|
||||
url
|
||||
(lambda (status)
|
||||
(let ((b (current-buffer)))
|
||||
(require 'url-handlers)
|
||||
(package--unless-error body
|
||||
(when-let* ((er (plist-get status :error)))
|
||||
(error "Error retrieving: %s %S" url er))
|
||||
(with-current-buffer b
|
||||
(goto-char (point-min))
|
||||
(unless (search-forward-regexp "^\r?\n\r?" nil t)
|
||||
(error "Error retrieving: %s %S"
|
||||
url "incomprehensible buffer")))
|
||||
(url-insert b)
|
||||
(kill-buffer b)
|
||||
(goto-char (point-min)))))
|
||||
nil
|
||||
'silent))
|
||||
(package--unless-error body
|
||||
;; Copy&pasted from url-insert-file-contents,
|
||||
;; except it calls `url-insert' because we want the contents
|
||||
;; literally (but there's no url-insert-file-contents-literally).
|
||||
(let ((buffer (url-retrieve-synchronously url)))
|
||||
(unless buffer (signal 'file-error (list url "No Data")))
|
||||
(when (fboundp 'url-http--insert-file-helper)
|
||||
;; XXX: This is HTTP/S specific and should be moved
|
||||
;; to url-http instead. See bug#17549.
|
||||
(url-http--insert-file-helper buffer url))
|
||||
(url-insert buffer)
|
||||
(kill-buffer buffer)
|
||||
(goto-char (point-min))))))
|
||||
(package--unless-error body
|
||||
(let ((url (expand-file-name file url)))
|
||||
(unless (file-name-absolute-p url)
|
||||
(error "Location %s is not a url nor an absolute file name" url))
|
||||
(insert-file-contents url))))))
|
||||
(error "Location %s is not a url nor an absolute file name"
|
||||
url))
|
||||
(insert-file-contents-literally url)))))
|
||||
|
||||
(define-error 'bad-signature "Failed to verify signature")
|
||||
|
||||
|
|
@ -1297,7 +1315,8 @@ else, even if an error is signaled."
|
|||
(package--with-response-buffer location :file sig-file
|
||||
:async async :noerror t
|
||||
;; Connection error is assumed to mean "no sig-file".
|
||||
:error-form (let ((allow-unsigned (eq package-check-signature 'allow-unsigned)))
|
||||
:error-form (let ((allow-unsigned
|
||||
(eq package-check-signature 'allow-unsigned)))
|
||||
(when (and callback allow-unsigned)
|
||||
(funcall callback nil))
|
||||
(when unwind (funcall unwind))
|
||||
|
|
@ -1306,8 +1325,9 @@ else, even if an error is signaled."
|
|||
;; OTOH, an error here means "bad signature", which we never
|
||||
;; suppress. (Bug#22089)
|
||||
(unwind-protect
|
||||
(let ((sig (package--check-signature-content (buffer-substring (point) (point-max))
|
||||
string sig-file)))
|
||||
(let ((sig (package--check-signature-content
|
||||
(buffer-substring (point) (point-max))
|
||||
string sig-file)))
|
||||
(when callback (funcall callback sig))
|
||||
sig)
|
||||
(when unwind (funcall unwind))))))
|
||||
|
|
@ -1584,15 +1604,18 @@ similar to an entry in `package-alist'. Save the cached copy to
|
|||
(member name package-unsigned-archives))
|
||||
;; If we don't care about the signature, save the file and
|
||||
;; we're done.
|
||||
(progn (let ((coding-system-for-write 'utf-8))
|
||||
(write-region content nil local-file nil 'silent))
|
||||
(package--update-downloads-in-progress archive))
|
||||
(progn
|
||||
(cl-assert (not enable-multibyte-characters))
|
||||
(let ((coding-system-for-write 'binary))
|
||||
(write-region content nil local-file nil 'silent))
|
||||
(package--update-downloads-in-progress archive))
|
||||
;; If we care, check it (perhaps async) and *then* write the file.
|
||||
(package--check-signature
|
||||
location file content async
|
||||
;; This function will be called after signature checking.
|
||||
(lambda (&optional good-sigs)
|
||||
(let ((coding-system-for-write 'utf-8))
|
||||
(cl-assert (not enable-multibyte-characters))
|
||||
(let ((coding-system-for-write 'binary))
|
||||
(write-region content nil local-file nil 'silent))
|
||||
;; Write out good signatures into archive-contents.signed file.
|
||||
(when good-sigs
|
||||
|
|
@ -1906,7 +1929,8 @@ if all the in-between dependencies are also in PACKAGE-LIST."
|
|||
;; Update the old pkg-desc which will be shown on the description buffer.
|
||||
(setf (package-desc-signed pkg-desc) t)
|
||||
;; Update the new (activated) pkg-desc as well.
|
||||
(when-let* ((pkg-descs (cdr (assq (package-desc-name pkg-desc) package-alist))))
|
||||
(when-let* ((pkg-descs (cdr (assq (package-desc-name pkg-desc)
|
||||
package-alist))))
|
||||
(setf (package-desc-signed (car pkg-descs)) t))))))))))
|
||||
|
||||
(defun package-installed-p (package &optional min-version)
|
||||
|
|
@ -2480,10 +2504,12 @@ The description is read from the installed package files."
|
|||
(replace-match ""))))
|
||||
|
||||
(if (package-installed-p desc)
|
||||
;; For installed packages, get the description from the installed files.
|
||||
;; For installed packages, get the description from the
|
||||
;; installed files.
|
||||
(insert (package--get-description desc))
|
||||
|
||||
;; For non-built-in, non-installed packages, get description from the archive.
|
||||
;; For non-built-in, non-installed packages, get description from
|
||||
;; the archive.
|
||||
(let* ((basename (format "%s-readme.txt" name))
|
||||
readme-string)
|
||||
|
||||
|
|
@ -2493,7 +2519,10 @@ The description is read from the installed package files."
|
|||
(goto-char (point-max))
|
||||
(unless (bolp)
|
||||
(insert ?\n)))
|
||||
(setq readme-string (buffer-string))
|
||||
(cl-assert (not enable-multibyte-characters))
|
||||
(setq readme-string
|
||||
;; The readme.txt files are defined to contain utf-8 text.
|
||||
(decode-coding-region (point-min) (point-max) 'utf-8 t))
|
||||
t)
|
||||
(insert (or readme-string
|
||||
"This package does not provide a description.")))
|
||||
|
|
|
|||
|
|
@ -299,7 +299,8 @@ accessible."
|
|||
(defun url-insert (buffer &optional beg end)
|
||||
"Insert the body of a URL object.
|
||||
BUFFER should be a complete URL buffer as returned by `url-retrieve'.
|
||||
If the headers specify a coding-system, it is applied to the body before it is inserted.
|
||||
If the headers specify a coding-system (and current buffer is multibyte),
|
||||
it is applied to the body before it is inserted.
|
||||
Returns a list of the form (SIZE CHARSET), where SIZE is the size in bytes
|
||||
of the inserted text and CHARSET is the charset that was specified in the header,
|
||||
or nil if none was found.
|
||||
|
|
@ -311,12 +312,13 @@ They count bytes from the beginning of the body."
|
|||
(buffer-substring (+ (point-min) beg)
|
||||
(if end (+ (point-min) end) (point-max)))
|
||||
(buffer-string))))
|
||||
(charset (mail-content-type-get (mm-handle-type handle)
|
||||
'charset)))
|
||||
(charset (if enable-multibyte-characters
|
||||
(mail-content-type-get (mm-handle-type handle)
|
||||
'charset))))
|
||||
(mm-destroy-parts handle)
|
||||
(if charset
|
||||
(insert (mm-decode-string data (mm-charset-to-coding-system charset)))
|
||||
(insert data))
|
||||
(insert (if charset
|
||||
(mm-decode-string data (mm-charset-to-coding-system charset))
|
||||
data))
|
||||
(list (length data) charset)))
|
||||
|
||||
(defvar url-http-codes)
|
||||
|
|
@ -349,23 +351,10 @@ if it had been inserted from a file named URL."
|
|||
(defun url-insert-file-contents (url &optional visit beg end replace)
|
||||
(let ((buffer (url-retrieve-synchronously url)))
|
||||
(unless buffer (signal 'file-error (list url "No Data")))
|
||||
(with-current-buffer buffer
|
||||
(when (fboundp 'url-http--insert-file-helper)
|
||||
;; XXX: This is HTTP/S specific and should be moved to url-http
|
||||
;; instead. See bug#17549.
|
||||
(when (bound-and-true-p url-http-response-status)
|
||||
;; Don't signal an error if VISIT is non-nil, because
|
||||
;; 'insert-file-contents' doesn't. This is required to
|
||||
;; support, e.g., 'browse-url-emacs', which is a fancy way of
|
||||
;; visiting the HTML source of a URL: in that case, we want to
|
||||
;; display a file buffer even if the URL does not exist and
|
||||
;; 'url-retrieve-synchronously' returns 404 or whatever.
|
||||
(unless (or visit
|
||||
(and (>= url-http-response-status 200)
|
||||
(< url-http-response-status 300)))
|
||||
(let ((desc (nth 2 (assq url-http-response-status url-http-codes))))
|
||||
(kill-buffer buffer)
|
||||
;; Signal file-error per bug#16733.
|
||||
(signal 'file-error (list url desc))))))
|
||||
(url-http--insert-file-helper buffer url visit))
|
||||
(url-insert-buffer-contents buffer url visit beg end replace)))
|
||||
|
||||
(put 'insert-file-contents 'url-file-handlers 'url-insert-file-contents)
|
||||
|
|
|
|||
|
|
@ -530,6 +530,23 @@ work correctly."
|
|||
(declare-function gnutls-peer-status "gnutls.c" (proc))
|
||||
(declare-function gnutls-negotiate "gnutls.el" t t)
|
||||
|
||||
(defun url-http--insert-file-helper (buffer url &optional visit)
|
||||
(with-current-buffer buffer
|
||||
(when (bound-and-true-p url-http-response-status)
|
||||
;; Don't signal an error if VISIT is non-nil, because
|
||||
;; 'insert-file-contents' doesn't. This is required to
|
||||
;; support, e.g., 'browse-url-emacs', which is a fancy way of
|
||||
;; visiting the HTML source of a URL: in that case, we want to
|
||||
;; display a file buffer even if the URL does not exist and
|
||||
;; 'url-retrieve-synchronously' returns 404 or whatever.
|
||||
(unless (or visit
|
||||
(and (>= url-http-response-status 200)
|
||||
(< url-http-response-status 300)))
|
||||
(let ((desc (nth 2 (assq url-http-response-status url-http-codes))))
|
||||
(kill-buffer buffer)
|
||||
;; Signal file-error per bug#16733.
|
||||
(signal 'file-error (list url desc)))))))
|
||||
|
||||
(defun url-http-parse-headers ()
|
||||
"Parse and handle HTTP specific headers.
|
||||
Return t if and only if the current buffer is still active and
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue