From 58d071a26c0ebc210e958b3bc263ab6b207463dc Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sun, 18 Sep 2016 16:34:02 -0400 Subject: [PATCH 1/4] Additional (failing) test for ELPA+allow-insecure --- test/el-get-tests.el | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/test/el-get-tests.el b/test/el-get-tests.el index 27199535..fcedb9ff 100644 --- a/test/el-get-tests.el +++ b/test/el-get-tests.el @@ -149,6 +149,24 @@ John.Doe-123_@example.com")) ;; TODO check for error message? (should-error (el-get-insecure-check "dummy" url) :type 'error)))) +(ert-deftest el-get-insecure-elpa () + (el-get-with-temp-home + (require 'package-x) ; create local package archive + (let* ((el-get-allow-insecure nil) + (pkg 'el-get-test-package) + (package-archive-upload-base (expand-file-name "pkg-repo" user-emacs-directory)) + (package-archives nil) + (el-get-sources + `((:name package :post-init nil) ; avoid adding other repos + (:name el-get-test-package + :type elpa + :repo ("test-repo" . ,package-archive-upload-base) + :features el-get-test-package)))) + (make-directory package-archive-upload-base t) + (package-upload-file (expand-file-name "pkgs/el-get-test-package.el" + el-get-test-files-dir)) + (el-get 'sync 'el-get-test-package)))) + (defconst secure-urls '("https://example.com" "ssh://example.com" "git+ssh://example.com/" From c00a03a26fd8cf1bc9537eb87fdc1e8bb27be692 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 8 Oct 2016 22:00:41 -0400 Subject: [PATCH 2/4] Fix secure URL checking for :type elpa * el-get-methods.el (el-get-insecure-check): Also consider URLs satisfying `file-name-absolute-p' to be secure. `package-archives' uses absolute file names *without* file:// prefix, so we have allow this too. * methods/el-get-elpa.el (el-get-elpa-package-id): (el-get-elpa-package-archive-base): New compat functions. * methods/el-get-elpa.el (el-get-elpa-install): Call `el-get-insecure-check' after ensuring `package-archive-contents' is initialized. --- el-get-methods.el | 17 ++++++++++------- methods/el-get-elpa.el | 25 +++++++++++++++++++------ test/el-get-tests.el | 9 ++++----- 3 files changed, 33 insertions(+), 18 deletions(-) diff --git a/el-get-methods.el b/el-get-methods.el index 69626e12..658989e0 100644 --- a/el-get-methods.el +++ b/el-get-methods.el @@ -27,8 +27,8 @@ (defun el-get-insecure-check (package url) "Raise an error if it's not safe to install PACKAGE from URL. -When `el-get-allow-insecure' is non-nil, check if either of the -following is true and retun nil: +When `el-get-allow-insecure' is non-nil, check if any of the +following are true: - URL's protocol is in `el-get-secure-protocols' @@ -38,6 +38,8 @@ following is true and retun nil: - URL starts with username, i.e. 'username@example.com', also known as SCP-like syntax +- URL satisfies `file-name-absolute-p' + - PACKAGE definition has a non-empty :checksum" (unless el-get-allow-insecure (assert (stringp url) nil "URL is nil, can't decide if it's safe to install package '%s'" package) @@ -46,11 +48,12 @@ following is true and retun nil: (if (fboundp 'string-blank-p) (string-blank-p checksum) (string-match-p "\\`[ \t\n\r]*\\'" checksum))))) - (when (and (not (string-match "\\`file:///" url)) - (not (car (member 0 (mapcar (lambda (secure-proto) - (let ((proto-rx (concat "\\`" (regexp-quote secure-proto) "://"))) - (string-match-p proto-rx url))) el-get-secure-protocols)))) - (not (string-match "\\`[-_\.A-Za-z0-9]+@" url))) + (unless (or (string-match "\\`file:///" url) + (file-name-absolute-p url) + (car (member 0 (mapcar (lambda (secure-proto) + (let ((proto-rx (concat "\\`" (regexp-quote secure-proto) "://"))) + (string-match-p proto-rx url))) el-get-secure-protocols))) + (string-match "\\`[-_\.A-Za-z0-9]+@" url)) ;; With not empty :checksum, we can rely on `el-get-post-install' calling ;; `el-get-verify-checksum' for security. (unless (not checksum-empty) diff --git a/methods/el-get-elpa.el b/methods/el-get-elpa.el index 34fe8ff0..f6460721 100644 --- a/methods/el-get-elpa.el +++ b/methods/el-get-elpa.el @@ -44,16 +44,24 @@ ALIST-ELEM should be an element from `package-alist' or (mapc #'package-delete descs) ;; Otherwise, just delete the package directory. (delete-directory (el-get-elpa-package-directory pkg) 'recursive)))) + + (defun el-get-elpa-package-id (pkg) + "A compat utility function." + ;; In 24.4+ we have a list of descs, earlier versions just use the + ;; name (a symbol) to specify the package. + (let* ((descs (cdr (assq pkg package-archive-contents)))) + (if (listp descs) (car descs) pkg))) + + (defun el-get-elpa-package-archive-base (pkg) + "Compat wrapper for `package-archive-base'." + (package-archive-base (el-get-elpa-package-id pkg))) + (defun el-get-elpa-install-package (pkg have-deps-p) "A wrapper for package.el installion. Installs the 1st available version. If HAVE-DEPS-P skip package.el's dependency computations." - (let* ((pkg-avail (assq pkg package-archive-contents)) - (descs (cdr pkg-avail)) - ;; In 24.4+ we have a list of descs, earlier versions just - ;; have a single package name - (to-install (if (listp descs) (car descs) pkg))) + (let ((to-install (el-get-elpa-package-id pkg))) (if have-deps-p (package-download-transaction (list to-install)) (package-install to-install))))) @@ -152,7 +160,6 @@ the recipe, then return nil." ;; Prepend elpa-repo to `package-archives' for new package.el (package-archives (append (when elpa-repo (list elpa-repo)) (when (boundp 'package-archives) package-archives)))) - (el-get-insecure-check package url) (unless (and elpa-dir (file-directory-p elpa-dir)) ;; package-install does these only for interactive calls @@ -167,6 +174,12 @@ the recipe, then return nil." (car elpa-new-repo) (cdr elpa-new-repo)))) (package-read-all-archive-contents))) + ;; We can only get the url after `package-archive-contents' is + ;; initialized. + (setq url (or (cdr elpa-repo) + (el-get-elpa-package-archive-base package))) + (el-get-insecure-check package url) + ;; TODO: should we refresh and retry once if package-install fails? ;; package-install generates autoloads, byte compiles (let (emacs-lisp-mode-hook fundamental-mode-hook prog-mode-hook) diff --git a/test/el-get-tests.el b/test/el-get-tests.el index fcedb9ff..cb0bf759 100644 --- a/test/el-get-tests.el +++ b/test/el-get-tests.el @@ -34,6 +34,7 @@ error. Following variables are bound to temporal values: * `user-emacs-directory' +* `package-user-dir' * `el-get-dir' * `el-get-status-file' * `el-get-status-cache' @@ -41,6 +42,7 @@ Following variables are bound to temporal values: (declare (debug t)) `(let* ((user-emacs-directory (make-temp-file "emacs.d.el-get-testing" 'dir "/")) + (package-user-dir (locate-user-emacs-file "elpa")) (el-get-dir (mapconcat #'file-name-as-directory `(,user-emacs-directory "el-get") "")) (el-get-status-file (concat el-get-dir ".status.el")) @@ -155,13 +157,10 @@ John.Doe-123_@example.com")) (let* ((el-get-allow-insecure nil) (pkg 'el-get-test-package) (package-archive-upload-base (expand-file-name "pkg-repo" user-emacs-directory)) - (package-archives nil) + (package-archives `(("test-repo" . ,package-archive-upload-base))) (el-get-sources `((:name package :post-init nil) ; avoid adding other repos - (:name el-get-test-package - :type elpa - :repo ("test-repo" . ,package-archive-upload-base) - :features el-get-test-package)))) + (:name el-get-test-package :type elpa)))) (make-directory package-archive-upload-base t) (package-upload-file (expand-file-name "pkgs/el-get-test-package.el" el-get-test-files-dir)) From e9fe611373361057dedfb886de7a88497f368fae Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 8 Oct 2016 22:28:58 -0400 Subject: [PATCH 3/4] test/travis-ci.sh (prereqs): Download package-x.el --- test/travis-ci.sh | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/travis-ci.sh b/test/travis-ci.sh index 1ba40557..0ed5fb7c 100644 --- a/test/travis-ci.sh +++ b/test/travis-ci.sh @@ -22,7 +22,8 @@ prereqs() { fi if ! emacs -Q --batch --eval "(require 'package)" ; then pkg_compat23=https://raw.githubusercontent.com/mirrors/emacs/ba08b24186711eaeb3748f3d1f23e2c2d9ed0d09 - curl -LO $pkg_compat23/lisp/emacs-lisp/package.el + curl -LO $pkg_compat23/lisp/emacs-lisp/package.el \ + -O $pkg_compat23/lisp/emacs-lisp/package-x.el fi) } From df9541a4d3af1ea96ff38543dfaef6d42261cab9 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 8 Oct 2016 22:36:09 -0400 Subject: [PATCH 4/4] Fix `message' advice used in tests * test/el-get-tests.el (el-get-test-catch-output): Handle the (message nil) case. --- test/el-get-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/el-get-tests.el b/test/el-get-tests.el index cb0bf759..24bb90d7 100644 --- a/test/el-get-tests.el +++ b/test/el-get-tests.el @@ -11,7 +11,7 @@ (when noninteractive (defadvice message (around el-get-test-catch-output activate) "redirect all `message' output to `el-get-test-output-buffer'." - (if el-get-test-output-buffer + (if (and el-get-test-output-buffer (ad-get-arg 0)) (with-current-buffer el-get-test-output-buffer (insert (apply #'format (ad-get-args 0)) "\n")) ad-do-it))