Spawn new process with ADDR_NO_RANDOMIZE personality if not already set
[sxemacs] / lisp / package-get.el
index c598773..fc84f54 100644 (file)
@@ -210,59 +210,14 @@ as a local directory."
 ;;;###autoload
 (defcustom package-get-download-sites
   `(,@(when package-get-have-curl
-       '(("SXEmacs XE pkg mirror"
-        "downloads.sxemacs.org" "xemacs-pkgs/packages" "http")))
-    ("US (Main XEmacs Site)"
-     "ftp.xemacs.org" "pub/xemacs/packages" "ftp")
-    ;; In alphabetical order of Country, our mirrors...
-    ;; Timing out
-    ("Belgium (be.xemacs.org)"
-     "ftp.be.xemacs.org" "xemacs/packages" "ftp")
-    ("Canada (ca.xemacs.org)"
-     "ftp.ca.xemacs.org" "pub/Mirror/xemacs/packages" "ftp")
-    ("Denmark (dk.xemacs.org)"
-     "ftp.dk.xemacs.org" "xemacs/packages" "ftp")
-    ("France (fr.xemacs.org)"
-     "ftp.fr.xemacs.org" "pub/xemacs/packages" "ftp")
-    ;; Temporary errors?
-    ("France (mirror.cict.fr)"
-     "mirror.cict.fr" "xemacs/packages" "ftp")
-    ("France (pasteur.fr)"
-     "ftp.pasteur.fr" "pub/computing/xemacs/packages" "ftp")
-    ;; Very outdated, experimental not updated since 2013
-    ("Germany (de.xemacs.org)"
-     "ftp.de.xemacs.org" "pub/ftp.xemacs.org/tux/xemacs/packages" "ftp")
-    ;; Timing out
-    ("Greece (gr.xemacs.org)"
-     "ftp.gr.xemacs.org" "mirrors/XEmacs/ftp/packages" "ftp")
-    ("Ireland (heanet.ie)"
-     "ftp.heanet.ie" "mirrors/ftp.xemacs.org/packages" "ftp")
-    ;; Timing out
-    ("Italy (it.xemacs.org)"
-     "ftp.it.xemacs.org" "unix/packages/XEMACS/packages" "ftp")
-    ;; Timing out
-    ("Japan (dti.ad.jp)"
-     "ftp.dti.ad.jp" "pub/unix/editor/xemacs/packages" "ftp")
-    ("Norway (no.xemacs.org)"
-     "ftp.no.xemacs.org" "pub/xemacs/packages" "ftp")
-    ("Portugal (pt.xemacs.org)"
-     "ftp.pt.xemacs.org" "pub/MIRRORS/ftp.xemacs.org/packages" "ftp")
-    ;; Timing out
-    ("Russia (ru.xemacs.org)"
-     "ftp.ru.xemacs.org" "pub/emacs/xemacs/packages" "ftp")
-    ("Saudi Arabia (sa.xemacs.org)"
-     "ftp.sa.xemacs.org" "pub/xemacs.org/packages" "ftp")
-    ("Sweden (se.xemacs.org)"
-     "ftp.se.xemacs.org" "pub/gnu/xemacs/packages" "ftp")
-    ("Switzerland (ch.xemacs.org)"
-     "ftp.ch.xemacs.org" "mirror/xemacs/packages" "ftp")
-    ("Taiwan (ftp.tw.xemacs.org)"
-     "ftp.tw.xemacs.org" "Unix/Editors/XEmacs/packages" "ftp")
-    ("UK (uk.xemacs.org)"
-     "ftp.uk.xemacs.org" "sites/ftp.xemacs.org/pub/xemacs/packages" "ftp")
-    ("US (ibiblio.org)"
-     "mirrors.ibiblio.org" "pub/mirrors/xemacs/packages" "ftp")
-    )
+       ;; HTTP Sites
+       '(("SXEmacs Main Site (HTTP)"
+          "downloads.sxemacs.org" "xemacs-pkgs/packages" "http")
+         ))
+      ;; FTP Sites
+      ("SXEmacs Main Site (FTP)"
+       "ftp.sxemacs.org" "pub/packages" "ftp")
+      )
   "*List of remote sites available for downloading packages.
 
 List format is '(site-description site-name directory-on-site url-scheme).
@@ -277,76 +232,6 @@ package download sites."
                       host-name directory url-scheme))
   :group 'package-get)
 
-;;;###autoload
-(defcustom package-get-pre-release-download-sites
-  `(,@(when package-get-have-curl
-       '(("SXEmacs XE pkg Pre-Releases" "downloads.sxemacs.org"
-         "xemacs-pkgs/beta/experimental/packages" "http")))
-    ("US Pre-Releases (Main XEmacs Site)" "ftp.xemacs.org"
-     "pub/xemacs/beta/experimental/packages" "ftp")
-    ;; In alphabetical order of Country, our mirrors...
-    ;; Timing out
-    ("Belgium Pre-Releases (be.xemacs.org)" "ftp.be.xemacs.org"
-     "xemacs/beta/experimental/packages" "ftp")
-    ("Canada Pre-Releases (ca.xemacs.org)" "ftp.ca.xemacs.org"
-     "pub/Mirror/xemacs/beta/experimental/packages" "ftp")
-    ("Denmark Pre-Releases (dk.xemacs.org)" "ftp.dk.xemacs.org"
-     "xemacs/beta/experimental/packages" "ftp")
-    ("France Pre-Releases (fr.xemacs.org)" "ftp.fr.xemacs.org"
-     "pub/xemacs/beta/experimental/packages" "ftp")
-    ; Was a month out of date as of 2013-04-12, hopefully not a sign
-    ; it is no longer updating.
-    ("France Pre-Releases (mirror.cict.fr)" "mirror.cict.fr"
-     "xemacs/beta/experimental/packages" "ftp")
-    ("France Pre-Releases (pasteur.fr)" "ftp.pasteur.fr"
-     "pub/computing/xemacs/beta/experimental/packages" "ftp")
-    ;; Very outdated, experimental not updated since 2013
-    ("Germany Pre-Releases (de.xemacs.org)" "ftp.de.xemacs.org"
-     "pub/ftp.xemacs.org/tux/xemacs/beta/experimental/packages" "ftp")
-    ;; Timing out
-    ("Greece Pre-Releases (gr.xemacs.org)" "ftp.gr.xemacs.org"
-     "mirrors/XEmacs/ftp/beta/experimental/packages" "ftp")
-    ("Ireland Pre-Releases (heanet.ie)" "ftp.heanet.ie"
-     "mirrors/ftp.xemacs.org/beta/experimental/packages" "ftp")
-    ;; Timing out
-    ("Italy Pre-Releases (it.xemacs.org)" "ftp.it.xemacs.org"
-     "unix/packages/XEMACS/beta/experimental/packages" "ftp")
-    ; Was out of date as at 2013-04-12.  Hopefully not a sign they are
-    ; no longer updating.
-    ;; Timing out
-    ("Japan Pre-Releases (dti.ad.jp)" "ftp.dti.ad.jp"
-     "pub/unix/editor/xemacs/beta/experimental/packages" "ftp")
-    ("Norway Pre-Releases (no.xemacs.org)" "ftp.no.xemacs.org"
-     "pub/xemacs/beta/experimental/packages" "ftp")
-    ("Portugal Pre-Releases (pt.xemacs.org)" "ftp.pt.xemacs.org"
-     "pub/MIRRORS/ftp.xemacs.org/beta/experimental/packages" "ftp")
-    ("Saudi Arabia Pre-Releases (sa.xemacs.org)" "ftp.sa.xemacs.org"
-     "pub/xemacs.org/beta/experimental/packages" "ftp")
-    ("Sweden Pre-Releases (se.xemacs.org)" "ftp.se.xemacs.org"
-     "pub/gnu/xemacs/beta/experimental/packages" "ftp")
-    ("Switzerland Pre-Releases (ch.xemacs.org)" "ftp.ch.xemacs.org"
-     "mirror/xemacs/beta/experimental/packages" "ftp")
-    ("Taiwan Pre-Releases (ftp.tw.xemacs.org)" "ftp.tw.xemacs.org"
-     "Unix/Editors/XEmacs/beta/experimental/packages" "ftp")
-    ("UK Pre-Releases (uk.xemacs.org)" "ftp.uk.xemacs.org"
-     "sites/ftp.xemacs.org/pub/xemacs/beta/experimental/packages" "ftp")
-    ("US Pre-Releases (ibiblio.org)" "mirrors.ibiblio.org"
-     "pub/mirrors/xemacs/beta/experimental/packages" "ftp")
-    )
-  "*List of remote sites available for downloading \"Pre-Release\" packages.
-
-List format is '(site-description site-name directory-on-site url-scheme).
-SITE-DESCRIPTION is a textual description of the site.  SITE-NAME is
-the internet address of the download site.  DIRECTORY-ON-SITE is the
-directory on the site in which packages may be found.  URL-SCHEME is
-the protocol such as `http', `ftp', etc.  This variable is used to
-initialize `package-get-remote', the variable actually used to specify
-package download sites."
-  :tag "Pre-Release Package download sites"
-  :type '(repeat (list (string :tag "Name")
-                      host-name directory url-scheme))
-  :group 'package-get)
-
 ;;;###autoload
 (defcustom package-get-site-release-download-sites nil
   "*List of remote sites available for downloading \"Site Release\" packages.
@@ -495,11 +380,12 @@ if different."
   "Update the package-get database file with entries from DB-FILE.
 Unless FORCE-CURRENT is non-nil never try to update the database."
   (interactive
-   (let ((dflt (package-get-locate-index-file nil)))
+   (let* ((dflt (package-get-locate-index-file nil))
+         (match (not (string-match #r"^\(https?\|s?ftp\)://" dflt))))
      (list (read-file-name "Load package-get database: "
                           (file-name-directory dflt)
                           dflt
-                          t
+                          match
                           (file-name-nondirectory dflt)))))
   (setq db-file (expand-file-name (or db-file
                                      (package-get-locate-index-file
@@ -509,7 +395,7 @@ Unless FORCE-CURRENT is non-nil never try to update the database."
             (format "Package-get database file `%s' does not exist" db-file)))
   (if (not (file-readable-p db-file))
       (error 'file-error
-            (format "Package-get database file `%s' not readable" db-file)))
+             (format "Package-get database file `%s' not readable" db-file)))
   (let ((buf (get-buffer-create "*package database*")))
     (unwind-protect
        (save-excursion
@@ -517,7 +403,9 @@ Unless FORCE-CURRENT is non-nil never try to update the database."
          (erase-buffer buf)
          (insert-file-contents-literally db-file)
          (package-get-update-base-from-buffer buf)
-         (if (file-remote-p db-file)
+         (if (or (file-remote-p db-file)
+                 (and (string-match #r"^\(https?\|s?ftp\)://" db-file)
+                      package-get-have-curl))
              (package-get-maybe-save-index db-file)))
       (kill-buffer buf))))
 
@@ -1003,11 +891,9 @@ successfully installed but errors occurred during initialization, or
                         (package-get-info package 'size)))
                 (setq full-package-filename dest-filename))
 
-              ;; Using EFS
               ;; If the file exists on the remote system ...
-              ((and (not package-get-have-curl)
-                    (file-exists-p (package-get-remote-filename
-                                    search-dir current-filename)))
+              ((file-exists-p (package-get-remote-filename
+                               search-dir current-filename))
                ;; Get it
                (setq full-package-filename dest-filename)
                (message "Retrieving package `%s' ..."
@@ -1015,16 +901,7 @@ successfully installed but errors occurred during initialization, or
                (sit-for 0)
                (copy-file (package-get-remote-filename search-dir
                                                        current-filename)
-                          full-package-filename t))
-
-              ;; Using ffi-curl
-              (package-get-have-curl
-               (setq full-package-filename dest-filename)
-               (message "Retrieving package `%s' ..." current-filename)
-               (declare-fboundp
-                (curl:download (package-get-remote-filename search-dir
-                                                            current-filename)
-                               full-package-filename))))
+                          full-package-filename t)))
 
              ;; If we found it, we're done.
              (if (and full-package-filename
@@ -1173,7 +1050,9 @@ The url scheme to use in this case is from (third search).
 
 If (car search) is nil, (cadr search is interpreted as a local
 directory)."
-  (if (file-remote-p filename)
+  (if (or (file-remote-p filename)
+         (and (string-match #r"^\(https?\|s?ftp\)://" filename)
+              package-get-have-curl))
       filename
     (let ((site (car search))
          (dir (cadr search))