aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2019-05-18 18:32:47 -0400
committerStefan Monnier2019-05-18 18:32:47 -0400
commit5f9671e57ee99cfe4653b2cb6aca16d52f9a5c53 (patch)
treed1e0690d4cb44460f544800a493ecadd6b7d4671
parent2a5705761ea8204441862d59d5fd72a94f5d592a (diff)
downloademacs-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.el113
-rw-r--r--lisp/url/url-handlers.el31
-rw-r--r--lisp/url/url-http.el17
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.
301BUFFER should be a complete URL buffer as returned by `url-retrieve'. 301BUFFER should be a complete URL buffer as returned by `url-retrieve'.
302If the headers specify a coding-system, it is applied to the body before it is inserted. 302If the headers specify a coding-system (and current buffer is multibyte),
303it is applied to the body before it is inserted.
303Returns a list of the form (SIZE CHARSET), where SIZE is the size in bytes 304Returns a list of the form (SIZE CHARSET), where SIZE is the size in bytes
304of the inserted text and CHARSET is the charset that was specified in the header, 305of the inserted text and CHARSET is the charset that was specified in the header,
305or nil if none was found. 306or 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.
535Return t if and only if the current buffer is still active and 552Return t if and only if the current buffer is still active and