procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add support for package signature checking.

Browse source 
* lisp/emacs-lisp/package.el (url-http-file-exists-p)
(epg-make-context, epg-context-set-home-directory)
(epg-verify-string, epg-context-result-for)
(epg-signature-status, epg-signature-to-string)
(epg-check-configuration, epg-configuration)
(epg-import-keys-from-file): Declare.
(package-check-signature): New user option.
(package-unsigned-archives): New user option.
(package-desc): Add `signed' field.
(package-load-descriptor): Set `signed' field if .signed file exists.
(package--archive-file-exists-p): New function.
(package--check-signature): New function.
(package-install-from-archive): Check package signature.
(package--download-one-archive): Check archive signature.
(package-delete): Remove .signed file.
(package-import-keyring): New command.
(package-refresh-contents): Import default keyring.
(package-desc-status): Add "unsigned" status.
(describe-package-1, package-menu--print-info)
(package-menu-mark-delete, package-menu--find-upgrades)
(package-menu--status-predicate): Support "unsigned" status.

* test/automated/data/package/signed/archive-contents:
* test/automated/data/package/signed/archive-contents.sig:
* test/automated/data/package/signed/signed-good-1.0.el:
* test/automated/data/package/signed/signed-good-1.0.el.sig:
* test/automated/data/package/signed/signed-bad-1.0.el:
* test/automated/data/package/signed/signed-bad-1.0.el.sig:
* test/automated/data/package/key.pub:
* test/automated/data/package/key.sec: New files.

* test/automated/package-test.el (package-test-update-listing)
(package-test-update-archives, package-test-describe-package):
Adjust to package.el change.
(package-test-signed): New test.
This commit is contained in:
Daiki Ueno 2013-10-03 16:11:27 +09:00
parent 0a858ebfc5
commit acbadd0046
12 changed files with 376 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
lisp/ChangeLog
View file

@ -1,3 +1,28 @@
2013-10-03 Daiki Ueno <ueno@gnu.org>
Add support for package signature checking.
* emacs-lisp/package.el (url-http-file-exists-p)
(epg-make-context, epg-context-set-home-directory)
(epg-verify-string, epg-context-result-for)
(epg-signature-status, epg-signature-to-string)
(epg-check-configuration, epg-configuration)
(epg-import-keys-from-file): Declare.
(package-check-signature): New user option.
(package-unsigned-archives): New user option.
(package-desc): Add `signed' field.
(package-load-descriptor): Set `signed' field if .signed file exists.
(package--archive-file-exists-p): New function.
(package--check-signature): New function.
(package-install-from-archive): Check package signature.
(package--download-one-archive): Check archive signature.
(package-delete): Remove .signed file.
(package-import-keyring): New command.
(package-refresh-contents): Import default keyring.
(package-desc-status): Add "unsigned" status.
(describe-package-1, package-menu--print-info)
(package-menu-mark-delete, package-menu--find-upgrades)
(package-menu--status-predicate): Support "unsigned" status.
2013-10-03 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/cconv.el (cconv-convert, cconv-analyse-form): Adjust for

196
lisp/emacs-lisp/package.el
View file

@ -206,6 +206,7 @@ If VERSION is nil, the package is not loaded (it is \"disabled\")."
(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,22 @@ contrast, `package-user-dir' contains packages for personal use."
: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")
(defcustom package-unsigned-archives nil
"A list of archives which do not use package signature."
:type '(repeat (string :tag "Archive name"))
:risky t
:group 'package
:version "24.1")
(defvar package--default-summary "No description available.")
(cl-defstruct (package-desc
@ -340,7 +357,9 @@ Slots:
`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 +367,8 @@ Slots:
kind
archive
dir
extras)
extras
signed)
;; Pseudo fields.
(defun package-desc-full-name (pkg-desc)
@ -428,7 +448,8 @@ This is, approximately, the inverse of `version-to-list'.
(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 +457,8 @@ This is, approximately, the inverse of `version-to-list'.
(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 +789,87 @@ It will move point to somewhere in the headers."
(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 file location)))))
(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 (location file)
"Check signature of the current buffer.
GnuPG keyring is located under \"gnupg\" in `package-user-dir'."
(let ((context (epg-make-context 'OpenPGP))
(homedir (expand-file-name "gnupg" package-user-dir))
(sig-file (concat file ".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)))
good-signatures)))
(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))))
(let* ((location (package-archive-base pkg-desc))
(file (concat (package-desc-full-name pkg-desc)
(package-desc-suffix pkg-desc)))
(sig-file (concat file ".sig"))
good-signatures pkg-descs)
(package--with-work-buffer location file
(package-unpack pkg-desc))))
(if (and package-check-signature
(not (member (package-desc-archive pkg-desc)
package-unsigned-archives)))
(if (package--archive-file-exists-p location sig-file)
(setq good-signatures (package--check-signature location file))
(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 good-signatures
;; Write out good signatures into NAME-VERSION.signed file.
(write-region (mapconcat #'epg-signature-to-string good-signatures "\n")
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)
@ -1104,6 +1201,10 @@ The file can either be a tar file or an Emacs Lisp file."
(error "Package `%s' is a system package, not deleting"
(package-desc-full-name pkg-desc))
(delete-directory dir t t)
;; Remove NAME-VERSION.signed file.
(let ((signed-file (concat dir ".signed")))
(if (file-exists-p signed-file)
(delete-file signed-file)))
;; Update package-alist.
(let* ((name (package-desc-name pkg-desc)))
(delete pkg-desc (assq name package-alist)))
@ -1118,16 +1219,50 @@ The file can either be a tar file or an Emacs Lisp file."
ARCHIVE should be a cons cell of the form (NAME . LOCATION),
similar to an entry in `package-alist'. Save the cached copy to
\"archives/NAME/archive-contents\" in `package-user-dir'."
(let* ((dir (expand-file-name (format "archives/%s" (car archive))
package-user-dir)))
(let ((dir (expand-file-name (format "archives/%s" (car archive))
package-user-dir))
(sig-file (concat file ".sig"))
good-signatures)
(package--with-work-buffer (cdr archive) file
;; Check signature of archive-contents, if desired.
(if (and package-check-signature
(not (member archive package-unsigned-archives)))
(if (package--archive-file-exists-p (cdr archive) sig-file)
(setq good-signatures (package--check-signature (cdr archive)
file))
(unless (eq package-check-signature 'allow-unsigned)
(error "Unsigned archive `%s'"
(car archive)))))
;; Read the retrieved buffer to make sure it is valid (e.g. it
;; may fetch a URL redirect page).
(when (listp (read buffer))
(make-directory dir t)
(setq buffer-file-name (expand-file-name file dir))
(let ((version-control 'never))
(save-buffer))))))
(save-buffer))))
(when good-signatures
;; Write out good signatures into archive-contents.signed file.
(write-region (mapconcat #'epg-signature-to-string good-signatures "\n")
nil
(expand-file-name (concat file ".signed") dir)))))
(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))
;;;###autoload
(defun package-import-keyring (&optional file)
"Import keys from FILE."
(interactive "fFile: ")
(setq file (expand-file-name file))
(let ((context (epg-make-context 'OpenPGP))
(homedir (expand-file-name "gnupg" package-user-dir)))
(make-directory homedir t)
(epg-context-set-home-directory context homedir)
(message "Importing %s..." (file-name-nondirectory file))
(epg-import-keys-from-file context file)
(message "Importing %s...done" (file-name-nondirectory file))))
;;;###autoload
(defun package-refresh-contents ()
@ -1138,6 +1273,14 @@ makes them available for download."
;; FIXME: Do it asynchronously.
(unless (file-exists-p package-user-dir)
(make-directory package-user-dir t))
(let ((default-keyring (expand-file-name "package-keyring.gpg"
data-directory)))
(if (file-exists-p default-keyring)
(condition-case-unless-debug error
(progn
(epg-check-configuration (epg-configuration))
(package-import-keyring default-keyring))
(error (message "Cannot import default keyring: %S" (cdr error))))))
(dolist (archive package-archives)
(condition-case-unless-debug nil
(package--download-one-archive archive "archive-contents")
@ -1209,7 +1352,8 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
(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 "))
@ -1222,7 +1366,9 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
'font-lock-face 'font-lock-builtin-face)
"."))
(pkg-dir
(insert (propertize (capitalize status) ;FIXME: Why comment-face?
(insert (propertize (if (equal status "unsigned")
"Installed"
(capitalize status)) ;FIXME: Why comment-face?
'font-lock-face 'font-lock-comment-face))
(insert " in `")
;; Todo: Add button for uninstalling.
@ -1233,9 +1379,11 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
(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 +1597,8 @@ package PKG-DESC, add one. The alist is keyed with PKG-DESC."
(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 +1612,9 @@ package PKG-DESC, add one. The alist is keyed with PKG-DESC."
(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 +1624,9 @@ package PKG-DESC, add one. The alist is keyed with PKG-DESC."
(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 +1685,7 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])."
(`"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 +1724,7 @@ If optional arg BUTTON is non-nil, describe its associated package."
(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)))
@ -1624,7 +1778,7 @@ If optional arg BUTTON is non-nil, describe its associated package."
;; ENTRY is (PKG-DESC [NAME VERSION STATUS DOC])
(let ((pkg-desc (car entry))
(status (aref (cadr entry) 2)))
(cond ((equal status "installed")
(cond ((member status '("installed" "unsigned"))
(push pkg-desc installed))
((member status '("available" "new"))
(push (cons (package-desc-name pkg-desc) pkg-desc)
@ -1738,6 +1892,8 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm."
((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)

16
test/ChangeLog
View file

@ -1,3 +1,19 @@
2013-10-03 Daiki Ueno <ueno@gnu.org>
* automated/data/package/signed/archive-contents:
* automated/data/package/signed/archive-contents.sig:
* automated/data/package/signed/signed-good-1.0.el:
* automated/data/package/signed/signed-good-1.0.el.sig:
* automated/data/package/signed/signed-bad-1.0.el:
* automated/data/package/signed/signed-bad-1.0.el.sig:
* automated/data/package/key.pub:
* automated/data/package/key.sec: New files.
* automated/package-test.el (package-test-update-listing)
(package-test-update-archives, package-test-describe-package):
Adjust to package.el change.
(package-test-signed): New test.
2013-10-01 Dmitry Gutov <dgutov@yandex.ru>
* automated/package-test.el: Update all cases to use :url instead

18
test/automated/data/package/key.pub Normal file
View file

@ -0,0 +1,18 @@
-----BEGIN PGP PUBLIC KEY BLOCK-----
Version: GnuPG v1.4.14 (GNU/Linux)
mQENBFJNB8gBCACfbtpvYrM8V1HM0KFlIwatcEJugHqwOHpr/Z9mrCW0fxyQAW/d
2L+3QVNsN9Tz/K9lLcBUgeR7rhVEzHNqhmhNj/HnikwGqXbIofhp+QbZmBKnAlCz
d77kg8K9lozHtfTkm1gX/7DdPzQKmgi7WOzzi2395wGubeqJLvYaEcqVbI0Eob+E
3CzRjNy/e/Tf3TJRW5etTcdZN6LVuIY7tNCHqlQZTwyycON/hfLTX6cLCnzDsqm/
NxCuwn9aqP9aGRGfIu7Y+If3zTymvrXEPUN98OEID814bOKdx0uVTZRiSMbvuTGI
8uMa/kpGX/78rqI61gbZV51RFoU7pT2tzwY/ABEBAAG0HkouIFIuIEhhY2tlciA8
anJoQGV4YW1wbGUuY29tPokBOAQTAQIAIgUCUk0HyAIbAwYLCQgHAwIGFQgCCQoL
BBYCAwECHgECF4AACgkQtpVAhgkYletuhQf+JAyHYhTZNxjq0UYlikuLX8EtYbXX
PB+03J0B73SMzEai5XsiTU2ADxqxwr7pveVK1INf+IGLiiXBlQq+4DSOvQY4xLfp
58jTOYRV1ECvlXK/JtvVOwufXREADaydf9l/MUxA5G2PPBWIuQknh3ysPSsx68OJ
SzNHFwklLn0DKc4WloE/GLDpTzimnCg7QGzuUo3Iilpjdy8EvTdI5d3jx/mGJIwI
goB+YZgyxSPM+GjDwh5DEwD7OexNqqa7RynnmU0epmlYyi9UufCHLwgiiEIzjpWi
6+iF+CQ45ZAKncovByenIUv73J3ImOudrsskeAHBmahljv1he6uV9Egj2Q==
=b5Kg
-----END PGP PUBLIC KEY BLOCK-----

33
test/automated/data/package/key.sec Normal file
View file

@ -0,0 +1,33 @@
-----BEGIN PGP PRIVATE KEY BLOCK-----
Version: GnuPG v1.4.14 (GNU/Linux)
lQO+BFJNB8gBCACfbtpvYrM8V1HM0KFlIwatcEJugHqwOHpr/Z9mrCW0fxyQAW/d
2L+3QVNsN9Tz/K9lLcBUgeR7rhVEzHNqhmhNj/HnikwGqXbIofhp+QbZmBKnAlCz
d77kg8K9lozHtfTkm1gX/7DdPzQKmgi7WOzzi2395wGubeqJLvYaEcqVbI0Eob+E
3CzRjNy/e/Tf3TJRW5etTcdZN6LVuIY7tNCHqlQZTwyycON/hfLTX6cLCnzDsqm/
NxCuwn9aqP9aGRGfIu7Y+If3zTymvrXEPUN98OEID814bOKdx0uVTZRiSMbvuTGI
8uMa/kpGX/78rqI61gbZV51RFoU7pT2tzwY/ABEBAAH+AwMCKCCpPNXkXuVgF7cz
eByuvgIO7wImDYGOdJqsASSzV4q0u1acnGtlxg7WphKDF9RnC5+1ZZ1ZcrBcv2uJ
xZm2jHdjqM3FmgQTN70GVzO1nKEur2wxlKotG4Q+8BtaRDwHdKpQFk+QW9aInH3C
BkNWTK97iFwZaoUGxKuRJb35qjMe3SsDE7kdbtOqO+tOeppRVeOOZCn7F33ir/6i
j2gmIME6LFDzvBi6YAyMBSh90Ak70HJINt0QfXlZf5MtX1NaxaEcnsRmwwcNqxh9
JvcC9q4WrR92NhHCHI+lOsAe7hbwo/VkwRjSSx0HdKkx6kvdcNj/9LeX/jykzLvg
kEqvAqT4Jmk57W2seqvpNcAO+eUVrJ5D1OR6khsUtikPp2pQH5MDXJDGcie+ZAFb
w6BwoWBDBjooKtfuP0LKqrdtJG2JLe6yhBhWvfqHPBlUU1SsA7a5aTCLo8FiqgEI
Kyy60zMx/2Mi48oN1a/mAoV1MTWLhOVUWJlIHM7nVLj1OaX0316LcLX/uTLTq40p
apHKwERanzY7f8ROiv/Fa/J+9cCsfOLKfjFAjpBVUVoOb39HsyS/vvkGMY4kgaD6
K6r9JPdsaoYvsLkxk5HyHF7Mk2uS1z1EIArD2/3lRiX6ag+IU1Nl3XDkgfZj06K3
juS84dGF8CmN49uOEjzAJAQZH9jTs5OKzUuZhGJF+gt0L78vLOoKRr8bu1N1GPqU
wnS908HWruXzjJl1CAhnuCa8FnDaU+tmEKjYpWuelx85kolpMW7LT5gOFZr84MIj
Kq3Rt2hU6qQ7Cdy1ep531YKkmyh9Y4l/Tgir1OtnQQqtNuwHI497l7qAUnKZBBHZ
guApjS9BoHsRXkw2mgDssZ+khOwj/xJm876nFSiQeCD0aIbU/4zJ9e2HUOJAZI1r
d7QeSi4gUi4gSGFja2VyIDxqcmhAZXhhbXBsZS5jb20+iQE4BBMBAgAiBQJSTQfI
AhsDBgsJCAcDAgYVCAIJCgsEFgIDAQIeAQIXgAAKCRC2lUCGCRiV626FB/4kDIdi
FNk3GOrRRiWKS4tfwS1htdc8H7TcnQHvdIzMRqLleyJNTYAPGrHCvum95UrUg1/4
gYuKJcGVCr7gNI69BjjEt+nnyNM5hFXUQK+Vcr8m29U7C59dEQANrJ1/2X8xTEDk
bY88FYi5CSeHfKw9KzHrw4lLM0cXCSUufQMpzhaWgT8YsOlPOKacKDtAbO5SjciK
WmN3LwS9N0jl3ePH+YYkjAiCgH5hmDLFI8z4aMPCHkMTAPs57E2qprtHKeeZTR6m
aVjKL1S58IcvCCKIQjOOlaLr6IX4JDjlkAqdyi8HJ6chS/vcnciY652uyyR4AcGZ
qGWO/WF7q5X0SCPZ
=5FZK
-----END PGP PRIVATE KEY BLOCK-----

7
test/automated/data/package/signed/archive-contents Normal file
View file

@ -0,0 +1,7 @@
(1
(signed-good .
[(1 0)
nil "A package with good signature" single])
(signed-bad .
[(1 0)
nil "A package with bad signature" single]))

BIN
test/automated/data/package/signed/archive-contents.sig Normal file
View file

Binary file not shown.

33
test/automated/data/package/signed/signed-bad-1.0.el Normal file
View file

@ -0,0 +1,33 @@
;;; signed-bad.el --- A single-file package with bad signature
;; Author: J. R. Hacker <jrh@example.com>
;; Version: 1.0
;; Keywords: frobnicate
;; URL: http://doodles.au
;;; Commentary:
;; This package provides a minor mode to frobnicate and/or bifurcate
;; any flanges you desire. To activate it, type "C-M-r M-3 butterfly"
;; and all your dreams will come true.
;;; Code:
(defgroup signed-bad nil "Simply a file"
:group 'lisp)
(defcustom signed-bad-super-sunday t
"How great is this?"
:type 'boolean
:group 'signed-bad)
(defvar signed-bad-sudo-sandwich nil
"Make a sandwich?")
;;;###autoload
(define-minor-mode signed-bad-mode
"It does good things to stuff")
(provide 'signed-bad)
;;; signed-bad.el ends here

BIN
test/automated/data/package/signed/signed-bad-1.0.el.sig Normal file
View file

Binary file not shown.

33
test/automated/data/package/signed/signed-good-1.0.el Normal file
View file

@ -0,0 +1,33 @@
;;; signed-good.el --- A single-file package with good signature
;; Author: J. R. Hacker <jrh@example.com>
;; Version: 1.0
;; Keywords: frobnicate
;; URL: http://doodles.au
;;; Commentary:
;; This package provides a minor mode to frobnicate and/or bifurcate
;; any flanges you desire. To activate it, type "C-M-r M-3 butterfly"
;; and all your dreams will come true.
;;; Code:
(defgroup signed-good nil "Simply a file"
:group 'lisp)
(defcustom signed-good-super-sunday t
"How great is this?"
:type 'boolean
:group 'signed-good)
(defvar signed-good-sudo-sandwich nil
"Make a sandwich?")
;;;###autoload
(define-minor-mode signed-good-mode
"It does good things to stuff")
(provide 'signed-good)
;;; signed-good.el ends here

BIN
test/automated/data/package/signed/signed-good-1.0.el.sig Normal file
View file

Binary file not shown.

39
test/automated/package-test.el
View file

@ -254,7 +254,7 @@ Must called from within a `tar-mode' buffer."
(should (package-installed-p 'simple-single))
(switch-to-buffer "*Packages*")
(goto-char (point-min))
(should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t))
(should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+unsigned" nil t))
(goto-char (point-min))
(should-not (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+\\(available\\|new\\)" nil t))
(kill-buffer buf))))
@ -276,7 +276,7 @@ Must called from within a `tar-mode' buffer."
;; New version should be available and old version should be installed
(goto-char (point-min))
(should (re-search-forward "^\\s-+simple-single\\s-+1.4\\s-+new" nil t))
(should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t))
(should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+unsigned" nil t))
(goto-char (point-min))
(should (re-search-forward "^\\s-+new-pkg\\s-+1.0\\s-+\\(available\\|new\\)" nil t))
@ -307,9 +307,9 @@ Must called from within a `tar-mode' buffer."
(with-fake-help-buffer
(describe-package 'simple-single)
(goto-char (point-min))
(should (search-forward "simple-single is an installed package." nil t))
(should (search-forward "simple-single is an unsigned package." nil t))
(should (search-forward
(format "Status: Installed in `%s/'."
(format "Status: Installed in `%s/' (unsigned)."
(expand-file-name "simple-single-1.3" package-user-dir))
nil t))
(should (search-forward "Version: 1.3" nil t))
@ -347,6 +347,37 @@ Must called from within a `tar-mode' buffer."
(should (search-forward "This is a bare-bones readme file for the multi-file"
nil t)))))
(ert-deftest package-test-signed ()
"Test verifying package signature."
:expected-result (condition-case nil
(progn
(epg-check-configuration (epg-configuration))
:passed)
(error :failed))
(let* ((keyring (expand-file-name "key.pub" package-test-data-dir))
(package-test-data-dir
(expand-file-name "data/package/signed" package-test-file-dir)))
(with-package-test ()
(package-initialize)
(package-import-keyring keyring)
(package-refresh-contents)
(should (package-install 'signed-good))
(should-error (package-install 'signed-bad))
;; Check if the installed package status is updated.
(let ((buf (package-list-packages)))
(package-menu-refresh)
(should (re-search-forward "^\\s-+signed-good\\s-+1\\.0\\s-+installed"
nil t)))
;; Check if the package description is updated.
(with-fake-help-buffer
(describe-package 'signed-good)
(goto-char (point-min))
(should (search-forward "signed-good is an installed package." nil t))
(should (search-forward
(format "Status: Installed in `%s/'."
(expand-file-name "signed-good-1.0" package-user-dir))
nil t))))))
(provide 'package-test)
;;; package-test.el ends here