From: Daiki Ueno <ueno@gnu.org>
To: Eli Zaretskii <eliz@gnu.org>
Cc: emacs-devel@gnu.org
Subject: [PATCHv2] package.el: check tarball signature
Date: Wed, 02 Oct 2013 15:20:03 +0900 [thread overview]
Message-ID: <87mwms9oto.fsf_-_-ueno@gnu.org> (raw)
In-Reply-To: <83d2nqdqui.fsf@gnu.org> (Eli Zaretskii's message of "Mon, 30 Sep 2013 22:58:13 +0300")
[-- Attachment #1: Type: text/plain, Size: 1272 bytes --]
Hi,
Thanks for the suggestion.
(Sorry for the delay, I'm just back from Boston ;-)
Eli Zaretskii <eliz@gnu.org> writes:
> Thanks, but please add a defcustom to disable this check (e.g.,
> because gnupg isn't installed, and isn't going to be).
Done. Now it has package-check-signature option, which can be set
either: nil (no signature verification), t (always check signature), or
allow-unsigned (skip signature verification if no .sig file is provided,
default).
Actually I wondered whether it should be a per-archive option rather
than a global option. But I'd leave it as global, for simplicity.
> In general, I think .sig files are there for those who want to verify
> the packages, but users should not be forced to do that as a
> prerequisite for downloading. (And no, the y-or-n-p question doesn't
> cut it: it's a nuisance to have to answer that question every time.)
Agreed. Removed the y-or-n-p question.
Other than those, I changed a bit:
* display "unsigned" status on the package listing and the description
buffer.
* fixed the verification logic. The .sig file might contain multiple
signatures and it should be considered as verified when one of those
is good.
* import the default keyring from <data-directory>/package-keyring.gpg.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: package-signature.patch --]
[-- Type: text/x-diff, Size: 10519 bytes --]
=== modified file 'lisp/emacs-lisp/package.el'
--- lisp/emacs-lisp/package.el 2013-10-01 15:52:53 +0000
+++ lisp/emacs-lisp/package.el 2013-10-02 05:48:13 +0000
@@ -206,6 +206,7 @@
(defvar Info-directory-list)
(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 lm-header "lisp-mnt" (header))
(declare-function lm-commentary "lisp-mnt" (&optional file))
(defvar url-http-end-of-headers)
@@ -285,6 +286,15 @@
:group 'package
:version "24.1")
+(defcustom package-check-signature 'allow-unsigned
+ "Whether to check package signatures when installing."
+ :type '(choice (const nil :tag "Never")
+ (const allow-unsigned :tag "Allow unsigned")
+ (const t :tag "Check always"))
+ :risky t
+ :group 'package
+ :version "24.1")
+
(defvar package--default-summary "No description available.")
(cl-defstruct (package-desc
@@ -340,7 +350,9 @@
`dir' The directory where the package is installed (if installed),
`builtin' if it is built-in, or nil otherwise.
-`extras' Optional alist of additional keyword-value pairs."
+`extras' Optional alist of additional keyword-value pairs.
+
+`signed' Flag to indicate that the package is signed by provider."
name
version
(summary package--default-summary)
@@ -348,7 +360,8 @@
kind
archive
dir
- extras)
+ extras
+ signed)
;; Pseudo fields.
(defun package-desc-full-name (pkg-desc)
@@ -428,7 +441,8 @@
(defun package-load-descriptor (pkg-dir)
"Load the description file in directory PKG-DIR."
(let ((pkg-file (expand-file-name (package--description-file pkg-dir)
- pkg-dir)))
+ pkg-dir))
+ (signed-file (concat pkg-dir ".signed")))
(when (file-exists-p pkg-file)
(with-temp-buffer
(insert-file-contents pkg-file)
@@ -436,6 +450,8 @@
(let ((pkg-desc (package-process-define-package
(read (current-buffer)) pkg-file)))
(setf (package-desc-dir pkg-desc) pkg-dir)
+ (if (file-exists-p signed-file)
+ (setf (package-desc-signed pkg-desc) t))
pkg-desc)))))
(defun package-load-all-descriptors ()
@@ -766,13 +782,90 @@
(error "Error during download request:%s"
(buffer-substring-no-properties (point) (line-end-position))))))
+(defun package--archive-file-exists-p (location file)
+ (let ((http (string-match "\\`https?:" location)))
+ (if http
+ (progn
+ (require 'url-http)
+ (url-http-file-exists-p (concat location file)))
+ (file-exists-p (expand-file-name location file)))))
+
+(declare-function epg-make-context "epg"
+ (&optional protocol armor textmode include-certs
+ cipher-algorithm
+ digest-algorithm
+ compress-algorithm))
+(declare-function epg-context-set-home-directory "epg" (context directory))
+(declare-function epg-verify-string "epg" (context signature
+ &optional signed-text))
+(declare-function epg-context-result-for "epg" (context name))
+(declare-function epg-signature-status "epg" (signature))
+(declare-function epg-signature-to-string "epg" (signature))
+
+(defun package--check-signature (pkg-desc)
+ "Check signature of a package.
+GnuPG keyring is located under \"gnupg\" in `package-user-dir'."
+ (let ((location (package-archive-base pkg-desc))
+ (context (epg-make-context 'OpenPGP))
+ (homedir (expand-file-name "gnupg" package-user-dir))
+ (sig-file (concat (package-desc-full-name pkg-desc)
+ (package-desc-suffix pkg-desc)
+ ".sig"))
+ sig-content
+ good-signatures)
+ (condition-case-unless-debug error
+ (setq sig-content (package--with-work-buffer location sig-file
+ (buffer-string)))
+ (error "Failed to download %s: %S" sig-file (cdr error)))
+ (epg-context-set-home-directory context homedir)
+ (epg-verify-string context sig-content (buffer-string))
+ ;; The .sig file may contain multiple signatures. Success if one
+ ;; of the signatures is good.
+ (setq good-signatures
+ (delq nil (mapcar (lambda (sig)
+ (if (eq (epg-signature-status sig) 'good)
+ sig))
+ (epg-context-result-for context 'verify))))
+ (if (null good-signatures)
+ (error "Failed to verify signature %s: %S"
+ sig-file
+ (mapcar #'epg-signature-to-string
+ (epg-context-result-for context 'verify))))))
+
(defun package-install-from-archive (pkg-desc)
"Download and install a tar package."
(let ((location (package-archive-base pkg-desc))
(file (concat (package-desc-full-name pkg-desc)
- (package-desc-suffix pkg-desc))))
+ (package-desc-suffix pkg-desc)))
+ (sig-file (concat (package-desc-full-name pkg-desc)
+ (package-desc-suffix pkg-desc)
+ ".sig"))
+ signed pkg-descs)
(package--with-work-buffer location file
- (package-unpack pkg-desc))))
+ (if package-check-signature
+ (if (package--archive-file-exists-p location sig-file)
+ (progn
+ (package--check-signature pkg-desc)
+ (setq signed t))
+ (unless (eq package-check-signature 'allow-unsigned)
+ (error "Unsigned package: `%s'"
+ (package-desc-name pkg-desc)))))
+ (package-unpack pkg-desc))
+ ;; Here the package has been installed successfully, mark it as
+ ;; signed if appropriate.
+ (when signed
+ ;; Create an empty NAME-VERSION.signed file, which indicates the
+ ;; signature of the package was verified on installation.
+ (write-region "" nil (expand-file-name
+ (concat (package-desc-full-name pkg-desc)
+ ".signed")
+ package-user-dir))
+ ;; 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.
+ (setq pkg-descs (cdr (assq (package-desc-name pkg-desc) package-alist)))
+ (if pkg-descs
+ (setf (package-desc-signed (car pkg-descs)) t)))))
(defvar package--initialized nil)
@@ -1145,6 +1238,21 @@
(car archive)))))
(package-read-all-archive-contents))
+(declare-function epg-check-configuration "epg-config"
+ (config &optional minimum-version))
+(declare-function epg-configuration "epg-config" ())
+(declare-function epg-import-keys-from-file "epg" (context keys))
+
+(defun package--import-default-keyring ()
+ (let* ((context (epg-make-context 'OpenPGP))
+ (homedir (expand-file-name "gnupg" package-user-dir))
+ (default-keyring (expand-file-name "package-keyring.gpg"
+ data-directory)))
+ (when (file-exists-p default-keyring)
+ (make-directory homedir t)
+ (epg-context-set-home-directory context homedir)
+ (epg-import-keys-from-file context default-keyring))))
+
;;;###autoload
(defun package-initialize (&optional no-activate)
"Load Emacs Lisp packages, and activate them.
@@ -1157,6 +1265,11 @@
(unless no-activate
(dolist (elt package-alist)
(package-activate (car elt))))
+ (condition-case-unless-debug nil
+ (progn
+ (epg-check-configuration (epg-configuration))
+ (package--import-default-keyring))
+ (error (message "Cannot import default keyring")))
(setq package--initialized t))
\f
@@ -1209,7 +1322,8 @@
(homepage (if desc (cdr (assoc :url (package-desc-extras desc)))))
(built-in (eq pkg-dir 'builtin))
(installable (and archive (not built-in)))
- (status (if desc (package-desc-status desc) "orphan")))
+ (status (if desc (package-desc-status desc) "orphan"))
+ (signed (if desc (package-desc-signed desc))))
(prin1 name)
(princ " is ")
(princ (if (memq (aref status 0) '(?a ?e ?i ?o ?u)) "an " "a "))
@@ -1233,9 +1347,11 @@
(not (package-built-in-p name version)))
(insert "',\n shadowing a "
(propertize "built-in package"
- 'font-lock-face 'font-lock-builtin-face)
- ".")
- (insert "'.")))
+ 'font-lock-face 'font-lock-builtin-face))
+ (insert "'"))
+ (if signed
+ (insert ".")
+ (insert " (unsigned).")))
(installable
(insert (capitalize status))
(insert " from " (format "%s" archive))
@@ -1449,7 +1565,8 @@
(dir (package-desc-dir pkg-desc))
(lle (assq name package-load-list))
(held (cadr lle))
- (version (package-desc-version pkg-desc)))
+ (version (package-desc-version pkg-desc))
+ (signed (package-desc-signed pkg-desc)))
(cond
((eq dir 'builtin) "built-in")
((and lle (null held)) "disabled")
@@ -1463,7 +1580,9 @@
(dir ;One of the installed packages.
(cond
((not (file-exists-p (package-desc-dir pkg-desc))) "deleted")
- ((eq pkg-desc (cadr (assq name package-alist))) "installed")
+ ((eq pkg-desc (cadr (assq name package-alist))) (if signed
+ "installed"
+ "unsigned"))
(t "obsolete")))
(t
(let* ((ins (cadr (assq name package-alist)))
@@ -1473,7 +1592,9 @@
(if (memq name package-menu--new-package-list)
"new" "available"))
((version-list-< version ins-v) "obsolete")
- ((version-list-= version ins-v) "installed")))))))
+ ((version-list-= version ins-v) (if signed
+ "installed"
+ "unsigned"))))))))
(defun package-menu--refresh (&optional packages)
"Re-populate the `tabulated-list-entries'.
@@ -1532,6 +1653,7 @@
(`"held" 'font-lock-constant-face)
(`"disabled" 'font-lock-warning-face)
(`"installed" 'font-lock-comment-face)
+ (`"unsigned" 'font-lock-warning-face)
(_ 'font-lock-warning-face)))) ; obsolete.
(list pkg-desc
(vector (list (symbol-name (package-desc-name pkg-desc))
@@ -1570,7 +1692,7 @@
(defun package-menu-mark-delete (&optional _num)
"Mark a package for deletion and move to the next line."
(interactive "p")
- (if (member (package-menu-get-status) '("installed" "obsolete"))
+ (if (member (package-menu-get-status) '("installed" "obsolete" "unsigned"))
(tabulated-list-put-tag "D" t)
(forward-line)))
@@ -1738,6 +1860,8 @@
((string= sB "available") nil)
((string= sA "installed") t)
((string= sB "installed") nil)
+ ((string= sA "unsigned") t)
+ ((string= sB "unsigned") nil)
((string= sA "held") t)
((string= sB "held") nil)
((string= sA "built-in") t)
[-- Attachment #3: Type: text/plain, Size: 25 bytes --]
Regards,
--
Daiki Ueno
next prev parent reply other threads:[~2013-10-02 6:20 UTC|newest]
Thread overview: 32+ messages / expand[flat|nested] mbox.gz Atom feed top
2013-09-30 19:48 [PATCH] package.el: check tarball signature Daiki Ueno
2013-09-30 19:58 ` Eli Zaretskii
2013-10-02 6:20 ` Daiki Ueno [this message]
2013-10-02 10:43 ` [PATCHv2] " Ted Zlatanov
2013-09-30 21:54 ` [PATCH] " Ted Zlatanov
2013-09-30 22:56 ` Stefan Monnier
2013-10-02 11:17 ` Ted Zlatanov
2013-10-02 7:16 ` Daiki Ueno
2013-10-02 10:41 ` Ted Zlatanov
2013-10-02 12:22 ` Daiki Ueno
2013-10-02 13:53 ` Ted Zlatanov
2013-10-03 3:51 ` Stefan Monnier
2013-10-02 13:15 ` Thien-Thi Nguyen
2013-10-03 3:45 ` Stefan Monnier
2013-10-03 3:52 ` Stefan Monnier
2013-10-03 7:18 ` Daiki Ueno
2013-10-03 14:19 ` Ted Zlatanov
2013-10-03 15:01 ` Stefan Monnier
2013-10-04 19:23 ` Eli Zaretskii
2013-10-04 21:14 ` Ted Zlatanov
2013-10-05 0:34 ` Daiki Ueno
2013-10-05 5:40 ` Stephen J. Turnbull
2013-10-05 10:03 ` Ted Zlatanov
2013-10-05 15:07 ` Stephen J. Turnbull
2013-10-05 21:51 ` Ted Zlatanov
2013-10-05 9:57 ` Ted Zlatanov
2013-10-05 7:09 ` Eli Zaretskii
2013-10-05 10:11 ` Ted Zlatanov
2013-10-05 12:37 ` Eli Zaretskii
2013-10-05 13:53 ` Stefan Monnier
2013-10-04 2:46 ` Daiki Ueno
2013-10-04 16:19 ` Ted Zlatanov
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87mwms9oto.fsf_-_-ueno@gnu.org \
--to=ueno@gnu.org \
--cc=eliz@gnu.org \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.