Merge: Fix secure URL checking for :type elpa

Close #2477, fix #2467.

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)

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)

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))
@@ -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"))
@@ -149,6 +151,21 @@ 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 `(("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))))
+     (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/"

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)
 }