diff options
| author | Stefan Monnier | 2019-05-18 18:32:47 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2019-05-18 18:32:47 -0400 |
| commit | 5f9671e57ee99cfe4653b2cb6aca16d52f9a5c53 (patch) | |
| tree | d1e0690d4cb44460f544800a493ecadd6b7d4671 | |
| parent | 2a5705761ea8204441862d59d5fd72a94f5d592a (diff) | |
| download | emacs-5f9671e57ee99cfe4653b2cb6aca16d52f9a5c53.tar.gz emacs-5f9671e57ee99cfe4653b2cb6aca16d52f9a5c53.zip | |
* 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.
| -rw-r--r-- | lisp/emacs-lisp/package.el | 113 | ||||
| -rw-r--r-- | lisp/url/url-handlers.el | 31 | ||||
| -rw-r--r-- | lisp/url/url-http.el | 17 |
3 files changed, 98 insertions, 63 deletions
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 656c4e15f6f..6b929160950 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el | |||
| @@ -1203,42 +1203,60 @@ errors signaled by ERROR-FORM or by BODY). | |||
| 1203 | :error-function (lambda () ,error-form) | 1203 | :error-function (lambda () ,error-form) |
| 1204 | :noerror ,noerror)) | 1204 | :noerror ,noerror)) |
| 1205 | 1205 | ||
| 1206 | (defmacro package--unless-error (body &rest before-body) | ||
| 1207 | (declare (debug t) (indent 1)) | ||
| 1208 | (let ((err (make-symbol "err"))) | ||
| 1209 | `(with-temp-buffer | ||
| 1210 | (set-buffer-multibyte nil) | ||
| 1211 | (when (condition-case ,err | ||
| 1212 | (progn ,@before-body t) | ||
| 1213 | (error (funcall error-function) | ||
| 1214 | (unless noerror | ||
| 1215 | (signal (car ,err) (cdr ,err))))) | ||
| 1216 | (funcall ,body))))) | ||
| 1217 | |||
| 1206 | (cl-defun package--with-response-buffer-1 (url body &key async file error-function noerror &allow-other-keys) | 1218 | (cl-defun package--with-response-buffer-1 (url body &key async file error-function noerror &allow-other-keys) |
| 1207 | (cl-macrolet ((unless-error (body &rest before-body) | 1219 | (if (string-match-p "\\`https?:" url) |
| 1208 | (let ((err (make-symbol "err"))) | ||
| 1209 | `(with-temp-buffer | ||
| 1210 | (when (condition-case ,err | ||
| 1211 | (progn ,@before-body t) | ||
| 1212 | (error (funcall error-function) | ||
| 1213 | (unless noerror | ||
| 1214 | (signal (car ,err) (cdr ,err))))) | ||
| 1215 | (funcall ,body)))))) | ||
| 1216 | (if (string-match-p "\\`https?:" url) | ||
| 1217 | (let ((url (concat url file))) | 1220 | (let ((url (concat url file))) |
| 1218 | (if async | 1221 | (if async |
| 1219 | (unless-error #'ignore | 1222 | (package--unless-error #'ignore |
| 1220 | (url-retrieve url | 1223 | (url-retrieve |
| 1221 | (lambda (status) | 1224 | url |
| 1222 | (let ((b (current-buffer))) | 1225 | (lambda (status) |
| 1223 | (require 'url-handlers) | 1226 | (let ((b (current-buffer))) |
| 1224 | (unless-error body | 1227 | (require 'url-handlers) |
| 1225 | (when-let* ((er (plist-get status :error))) | 1228 | (package--unless-error body |
| 1226 | (error "Error retrieving: %s %S" url er)) | 1229 | (when-let* ((er (plist-get status :error))) |
| 1227 | (with-current-buffer b | 1230 | (error "Error retrieving: %s %S" url er)) |
| 1228 | (goto-char (point-min)) | 1231 | (with-current-buffer b |
| 1229 | (unless (search-forward-regexp "^\r?\n\r?" nil 'noerror) | 1232 | (goto-char (point-min)) |
| 1230 | (error "Error retrieving: %s %S" url "incomprehensible buffer"))) | 1233 | (unless (search-forward-regexp "^\r?\n\r?" nil t) |
| 1231 | (url-insert-buffer-contents b url) | 1234 | (error "Error retrieving: %s %S" |
| 1232 | (kill-buffer b) | 1235 | url "incomprehensible buffer"))) |
| 1233 | (goto-char (point-min))))) | 1236 | (url-insert b) |
| 1234 | nil | 1237 | (kill-buffer b) |
| 1235 | 'silent)) | 1238 | (goto-char (point-min))))) |
| 1236 | (unless-error body (url-insert-file-contents url)))) | 1239 | nil |
| 1237 | (unless-error body | 1240 | 'silent)) |
| 1241 | (package--unless-error body | ||
| 1242 | ;; Copy&pasted from url-insert-file-contents, | ||
| 1243 | ;; except it calls `url-insert' because we want the contents | ||
| 1244 | ;; literally (but there's no url-insert-file-contents-literally). | ||
| 1245 | (let ((buffer (url-retrieve-synchronously url))) | ||
| 1246 | (unless buffer (signal 'file-error (list url "No Data"))) | ||
| 1247 | (when (fboundp 'url-http--insert-file-helper) | ||
| 1248 | ;; XXX: This is HTTP/S specific and should be moved | ||
| 1249 | ;; to url-http instead. See bug#17549. | ||
| 1250 | (url-http--insert-file-helper buffer url)) | ||
| 1251 | (url-insert buffer) | ||
| 1252 | (kill-buffer buffer) | ||
| 1253 | (goto-char (point-min)))))) | ||
| 1254 | (package--unless-error body | ||
| 1238 | (let ((url (expand-file-name file url))) | 1255 | (let ((url (expand-file-name file url))) |
| 1239 | (unless (file-name-absolute-p url) | 1256 | (unless (file-name-absolute-p url) |
| 1240 | (error "Location %s is not a url nor an absolute file name" url)) | 1257 | (error "Location %s is not a url nor an absolute file name" |
| 1241 | (insert-file-contents url)))))) | 1258 | url)) |
| 1259 | (insert-file-contents-literally url))))) | ||
| 1242 | 1260 | ||
| 1243 | (define-error 'bad-signature "Failed to verify signature") | 1261 | (define-error 'bad-signature "Failed to verify signature") |
| 1244 | 1262 | ||
| @@ -1297,7 +1315,8 @@ else, even if an error is signaled." | |||
| 1297 | (package--with-response-buffer location :file sig-file | 1315 | (package--with-response-buffer location :file sig-file |
| 1298 | :async async :noerror t | 1316 | :async async :noerror t |
| 1299 | ;; Connection error is assumed to mean "no sig-file". | 1317 | ;; Connection error is assumed to mean "no sig-file". |
| 1300 | :error-form (let ((allow-unsigned (eq package-check-signature 'allow-unsigned))) | 1318 | :error-form (let ((allow-unsigned |
| 1319 | (eq package-check-signature 'allow-unsigned))) | ||
| 1301 | (when (and callback allow-unsigned) | 1320 | (when (and callback allow-unsigned) |
| 1302 | (funcall callback nil)) | 1321 | (funcall callback nil)) |
| 1303 | (when unwind (funcall unwind)) | 1322 | (when unwind (funcall unwind)) |
| @@ -1306,8 +1325,9 @@ else, even if an error is signaled." | |||
| 1306 | ;; OTOH, an error here means "bad signature", which we never | 1325 | ;; OTOH, an error here means "bad signature", which we never |
| 1307 | ;; suppress. (Bug#22089) | 1326 | ;; suppress. (Bug#22089) |
| 1308 | (unwind-protect | 1327 | (unwind-protect |
| 1309 | (let ((sig (package--check-signature-content (buffer-substring (point) (point-max)) | 1328 | (let ((sig (package--check-signature-content |
| 1310 | string sig-file))) | 1329 | (buffer-substring (point) (point-max)) |
| 1330 | string sig-file))) | ||
| 1311 | (when callback (funcall callback sig)) | 1331 | (when callback (funcall callback sig)) |
| 1312 | sig) | 1332 | sig) |
| 1313 | (when unwind (funcall unwind)))))) | 1333 | (when unwind (funcall unwind)))))) |
| @@ -1584,15 +1604,18 @@ similar to an entry in `package-alist'. Save the cached copy to | |||
| 1584 | (member name package-unsigned-archives)) | 1604 | (member name package-unsigned-archives)) |
| 1585 | ;; If we don't care about the signature, save the file and | 1605 | ;; If we don't care about the signature, save the file and |
| 1586 | ;; we're done. | 1606 | ;; we're done. |
| 1587 | (progn (let ((coding-system-for-write 'utf-8)) | 1607 | (progn |
| 1588 | (write-region content nil local-file nil 'silent)) | 1608 | (cl-assert (not enable-multibyte-characters)) |
| 1589 | (package--update-downloads-in-progress archive)) | 1609 | (let ((coding-system-for-write 'binary)) |
| 1610 | (write-region content nil local-file nil 'silent)) | ||
| 1611 | (package--update-downloads-in-progress archive)) | ||
| 1590 | ;; If we care, check it (perhaps async) and *then* write the file. | 1612 | ;; If we care, check it (perhaps async) and *then* write the file. |
| 1591 | (package--check-signature | 1613 | (package--check-signature |
| 1592 | location file content async | 1614 | location file content async |
| 1593 | ;; This function will be called after signature checking. | 1615 | ;; This function will be called after signature checking. |
| 1594 | (lambda (&optional good-sigs) | 1616 | (lambda (&optional good-sigs) |
| 1595 | (let ((coding-system-for-write 'utf-8)) | 1617 | (cl-assert (not enable-multibyte-characters)) |
| 1618 | (let ((coding-system-for-write 'binary)) | ||
| 1596 | (write-region content nil local-file nil 'silent)) | 1619 | (write-region content nil local-file nil 'silent)) |
| 1597 | ;; Write out good signatures into archive-contents.signed file. | 1620 | ;; Write out good signatures into archive-contents.signed file. |
| 1598 | (when good-sigs | 1621 | (when good-sigs |
| @@ -1906,7 +1929,8 @@ if all the in-between dependencies are also in PACKAGE-LIST." | |||
| 1906 | ;; Update the old pkg-desc which will be shown on the description buffer. | 1929 | ;; Update the old pkg-desc which will be shown on the description buffer. |
| 1907 | (setf (package-desc-signed pkg-desc) t) | 1930 | (setf (package-desc-signed pkg-desc) t) |
| 1908 | ;; Update the new (activated) pkg-desc as well. | 1931 | ;; Update the new (activated) pkg-desc as well. |
| 1909 | (when-let* ((pkg-descs (cdr (assq (package-desc-name pkg-desc) package-alist)))) | 1932 | (when-let* ((pkg-descs (cdr (assq (package-desc-name pkg-desc) |
| 1933 | package-alist)))) | ||
| 1910 | (setf (package-desc-signed (car pkg-descs)) t)))))))))) | 1934 | (setf (package-desc-signed (car pkg-descs)) t)))))))))) |
| 1911 | 1935 | ||
| 1912 | (defun package-installed-p (package &optional min-version) | 1936 | (defun package-installed-p (package &optional min-version) |
| @@ -2480,10 +2504,12 @@ The description is read from the installed package files." | |||
| 2480 | (replace-match "")))) | 2504 | (replace-match "")))) |
| 2481 | 2505 | ||
| 2482 | (if (package-installed-p desc) | 2506 | (if (package-installed-p desc) |
| 2483 | ;; For installed packages, get the description from the installed files. | 2507 | ;; For installed packages, get the description from the |
| 2508 | ;; installed files. | ||
| 2484 | (insert (package--get-description desc)) | 2509 | (insert (package--get-description desc)) |
| 2485 | 2510 | ||
| 2486 | ;; For non-built-in, non-installed packages, get description from the archive. | 2511 | ;; For non-built-in, non-installed packages, get description from |
| 2512 | ;; the archive. | ||
| 2487 | (let* ((basename (format "%s-readme.txt" name)) | 2513 | (let* ((basename (format "%s-readme.txt" name)) |
| 2488 | readme-string) | 2514 | readme-string) |
| 2489 | 2515 | ||
| @@ -2493,7 +2519,10 @@ The description is read from the installed package files." | |||
| 2493 | (goto-char (point-max)) | 2519 | (goto-char (point-max)) |
| 2494 | (unless (bolp) | 2520 | (unless (bolp) |
| 2495 | (insert ?\n))) | 2521 | (insert ?\n))) |
| 2496 | (setq readme-string (buffer-string)) | 2522 | (cl-assert (not enable-multibyte-characters)) |
| 2523 | (setq readme-string | ||
| 2524 | ;; The readme.txt files are defined to contain utf-8 text. | ||
| 2525 | (decode-coding-region (point-min) (point-max) 'utf-8 t)) | ||
| 2497 | t) | 2526 | t) |
| 2498 | (insert (or readme-string | 2527 | (insert (or readme-string |
| 2499 | "This package does not provide a description."))) | 2528 | "This package does not provide a description."))) |
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index e35d999e0fe..4988068293e 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el | |||
| @@ -299,7 +299,8 @@ accessible." | |||
| 299 | (defun url-insert (buffer &optional beg end) | 299 | (defun url-insert (buffer &optional beg end) |
| 300 | "Insert the body of a URL object. | 300 | "Insert the body of a URL object. |
| 301 | BUFFER should be a complete URL buffer as returned by `url-retrieve'. | 301 | BUFFER should be a complete URL buffer as returned by `url-retrieve'. |
| 302 | If the headers specify a coding-system, it is applied to the body before it is inserted. | 302 | If the headers specify a coding-system (and current buffer is multibyte), |
| 303 | it is applied to the body before it is inserted. | ||
| 303 | Returns a list of the form (SIZE CHARSET), where SIZE is the size in bytes | 304 | Returns a list of the form (SIZE CHARSET), where SIZE is the size in bytes |
| 304 | of the inserted text and CHARSET is the charset that was specified in the header, | 305 | of the inserted text and CHARSET is the charset that was specified in the header, |
| 305 | or nil if none was found. | 306 | or nil if none was found. |
| @@ -311,12 +312,13 @@ They count bytes from the beginning of the body." | |||
| 311 | (buffer-substring (+ (point-min) beg) | 312 | (buffer-substring (+ (point-min) beg) |
| 312 | (if end (+ (point-min) end) (point-max))) | 313 | (if end (+ (point-min) end) (point-max))) |
| 313 | (buffer-string)))) | 314 | (buffer-string)))) |
| 314 | (charset (mail-content-type-get (mm-handle-type handle) | 315 | (charset (if enable-multibyte-characters |
| 315 | 'charset))) | 316 | (mail-content-type-get (mm-handle-type handle) |
| 317 | 'charset)))) | ||
| 316 | (mm-destroy-parts handle) | 318 | (mm-destroy-parts handle) |
| 317 | (if charset | 319 | (insert (if charset |
| 318 | (insert (mm-decode-string data (mm-charset-to-coding-system charset))) | 320 | (mm-decode-string data (mm-charset-to-coding-system charset)) |
| 319 | (insert data)) | 321 | data)) |
| 320 | (list (length data) charset))) | 322 | (list (length data) charset))) |
| 321 | 323 | ||
| 322 | (defvar url-http-codes) | 324 | (defvar url-http-codes) |
| @@ -349,23 +351,10 @@ if it had been inserted from a file named URL." | |||
| 349 | (defun url-insert-file-contents (url &optional visit beg end replace) | 351 | (defun url-insert-file-contents (url &optional visit beg end replace) |
| 350 | (let ((buffer (url-retrieve-synchronously url))) | 352 | (let ((buffer (url-retrieve-synchronously url))) |
| 351 | (unless buffer (signal 'file-error (list url "No Data"))) | 353 | (unless buffer (signal 'file-error (list url "No Data"))) |
| 352 | (with-current-buffer buffer | 354 | (when (fboundp 'url-http--insert-file-helper) |
| 353 | ;; XXX: This is HTTP/S specific and should be moved to url-http | 355 | ;; XXX: This is HTTP/S specific and should be moved to url-http |
| 354 | ;; instead. See bug#17549. | 356 | ;; instead. See bug#17549. |
| 355 | (when (bound-and-true-p url-http-response-status) | 357 | (url-http--insert-file-helper buffer url visit)) |
| 356 | ;; Don't signal an error if VISIT is non-nil, because | ||
| 357 | ;; 'insert-file-contents' doesn't. This is required to | ||
| 358 | ;; support, e.g., 'browse-url-emacs', which is a fancy way of | ||
| 359 | ;; visiting the HTML source of a URL: in that case, we want to | ||
| 360 | ;; display a file buffer even if the URL does not exist and | ||
| 361 | ;; 'url-retrieve-synchronously' returns 404 or whatever. | ||
| 362 | (unless (or visit | ||
| 363 | (and (>= url-http-response-status 200) | ||
| 364 | (< url-http-response-status 300))) | ||
| 365 | (let ((desc (nth 2 (assq url-http-response-status url-http-codes)))) | ||
| 366 | (kill-buffer buffer) | ||
| 367 | ;; Signal file-error per bug#16733. | ||
| 368 | (signal 'file-error (list url desc)))))) | ||
| 369 | (url-insert-buffer-contents buffer url visit beg end replace))) | 358 | (url-insert-buffer-contents buffer url visit beg end replace))) |
| 370 | 359 | ||
| 371 | (put 'insert-file-contents 'url-file-handlers 'url-insert-file-contents) | 360 | (put 'insert-file-contents 'url-file-handlers 'url-insert-file-contents) |
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 48e29987a51..00803a103a0 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el | |||
| @@ -530,6 +530,23 @@ work correctly." | |||
| 530 | (declare-function gnutls-peer-status "gnutls.c" (proc)) | 530 | (declare-function gnutls-peer-status "gnutls.c" (proc)) |
| 531 | (declare-function gnutls-negotiate "gnutls.el" t t) | 531 | (declare-function gnutls-negotiate "gnutls.el" t t) |
| 532 | 532 | ||
| 533 | (defun url-http--insert-file-helper (buffer url &optional visit) | ||
| 534 | (with-current-buffer buffer | ||
| 535 | (when (bound-and-true-p url-http-response-status) | ||
| 536 | ;; Don't signal an error if VISIT is non-nil, because | ||
| 537 | ;; 'insert-file-contents' doesn't. This is required to | ||
| 538 | ;; support, e.g., 'browse-url-emacs', which is a fancy way of | ||
| 539 | ;; visiting the HTML source of a URL: in that case, we want to | ||
| 540 | ;; display a file buffer even if the URL does not exist and | ||
| 541 | ;; 'url-retrieve-synchronously' returns 404 or whatever. | ||
| 542 | (unless (or visit | ||
| 543 | (and (>= url-http-response-status 200) | ||
| 544 | (< url-http-response-status 300))) | ||
| 545 | (let ((desc (nth 2 (assq url-http-response-status url-http-codes)))) | ||
| 546 | (kill-buffer buffer) | ||
| 547 | ;; Signal file-error per bug#16733. | ||
| 548 | (signal 'file-error (list url desc))))))) | ||
| 549 | |||
| 533 | (defun url-http-parse-headers () | 550 | (defun url-http-parse-headers () |
| 534 | "Parse and handle HTTP specific headers. | 551 | "Parse and handle HTTP specific headers. |
| 535 | Return t if and only if the current buffer is still active and | 552 | Return t if and only if the current buffer is still active and |