Package: emacs;
Reported by: Richard Copley <rcopley <at> gmail.com>
Date: Tue, 14 May 2019 21:27:02 UTC
Severity: normal
Fixed in version 26.3
Done: Stefan Monnier <monnier <at> iro.umontreal.ca>
Bug is archived. No further changes may be made.
Message #34 received at 35739 <at> debbugs.gnu.org (full text, mbox):
From: Stefan Monnier <monnier <at> iro.umontreal.ca> To: Richard Copley <rcopley <at> gmail.com> Cc: 35739 <at> debbugs.gnu.org, Eli Zaretskii <eliz <at> gnu.org>, Noam Postavsky <npostavs <at> gmail.com> Subject: Re: bug#35739: Bad signature from GNU ELPA Date: Wed, 15 May 2019 10:03:57 -0400
> --- a/lisp/emacs-lisp/package.el
> +++ b/lisp/emacs-lisp/package.el
> @@ -1225,7 +1225,7 @@ package--with-work-buffer
> (goto-char (point-min))
> (unless (search-forward-regexp "^\r?\n\r?" nil 'noerror)
> (error "Error retrieving: %s %S" ,url-sym "incomprehensible buffer")))
> - (url-insert-buffer-contents ,b-sym ,url-sym)
> + (url-insert ,b-sym)
> (kill-buffer ,b-sym)
> (goto-char (point-min)))))
> nil
[ Boy, this macro looks awfully deeply indented.
We need to rewrite this to fit into the usual 80 columns. ]
That actually looks very good [it would also need to change the other
url-insert-file-contents in that macro, of course].
Eli, do you think this could also be a fix for bug#34909?
E.g. something like the patch below?
Stefan
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 949ad711ae..8a16dba1c2 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1202,40 +1182,45 @@ package--with-work-buffer
(let ((url-sym (make-symbol "url"))
(b-sym (make-symbol "b-sym")))
`(cl-macrolet ((unless-error (body-2 &rest before-body)
- (let ((err (make-symbol "err")))
- `(with-temp-buffer
- (when (condition-case ,err
- (progn ,@before-body t)
- ,(list 'error ',error-form
- (list 'unless ',noerror-1
- `(signal (car ,err) (cdr ,err)))))
- ,@body-2)))))
+ (let ((err (make-symbol "err")))
+ `(with-temp-buffer
+ (set-buffer-multibyte nil)
+ (when (condition-case ,err
+ (progn ,@before-body t)
+ ,(list 'error ',error-form
+ (list 'unless ',noerror-1
+ `(signal (car ,err)
+ (cdr ,err)))))
+ ,@body-2)))))
(if (string-match-p "\\`https?:" ,url-1)
(let ((,url-sym (concat ,url-1 ,file)))
(if ,async
(unless-error nil
- (url-retrieve ,url-sym
- (lambda (status)
- (let ((,b-sym (current-buffer)))
- (require 'url-handlers)
- (unless-error ,body
- (when-let* ((er (plist-get status :error)))
- (error "Error retrieving: %s %S" ,url-sym er))
- (with-current-buffer ,b-sym
- (goto-char (point-min))
- (unless (search-forward-regexp "^\r?\n\r?" nil 'noerror)
- (error "Error retrieving: %s %S" ,url-sym "incomprehensible buffer")))
- (url-insert-buffer-contents ,b-sym ,url-sym)
- (kill-buffer ,b-sym)
- (goto-char (point-min)))))
- nil
- 'silent))
- (unless-error ,body (url-insert-file-contents ,url-sym))))
+ (url-retrieve
+ ,url-sym
+ (lambda (status)
+ (let ((,b-sym (current-buffer)))
+ (require 'url-handlers)
+ (unless-error ,body
+ (when-let* ((er (plist-get status :error)))
+ (error "Error retrieving: %s %S" ,url-sym er))
+ (with-current-buffer ,b-sym
+ (goto-char (point-min))
+ (unless (search-forward-regexp "^\r?\n\r?" nil t)
+ (error "Error retrieving: %s %S"
+ ,url-sym "incomprehensible buffer")))
+ (url-insert ,b-sym)
+ (kill-buffer ,b-sym)
+ (goto-char (point-min)))))
+ nil
+ 'silent))
+ (unless-error ,body (url-insert ,url-sym))))
(unless-error ,body
- (let ((url (expand-file-name ,file ,url-1)))
- (unless (file-name-absolute-p url)
- (error "Location %s is not a url nor an absolute file name" url))
- (insert-file-contents url))))))))
+ (let ((url (expand-file-name ,file ,url-1)))
+ (unless (file-name-absolute-p url)
+ (error "Location %s is not a url nor an absolute file name"
+ url))
+ (insert-file-contents url))))))))
(define-error 'bad-signature "Failed to verify signature")
@@ -1294,7 +1279,8 @@ package--check-signature
(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))
@@ -1303,8 +1289,9 @@ package--check-signature
;; 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))))))
@@ -1581,15 +1568,18 @@ package--download-one-archive
(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
@@ -1903,7 +1893,8 @@ package-install-from-archive
;; 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)
@@ -2477,10 +2468,12 @@ describe-package-1
(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)
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index e35d999e0f..783466ca70 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -299,7 +299,8 @@ url-file-local-copy
(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 @@ url-insert
(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)
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.