Spawn new process with ADDR_NO_RANDOMIZE personality if not already set
[sxemacs] / lisp / package-get.el
index 3f650cd..fc84f54 100644 (file)
@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 1998 by Pete Ware
 ;; Copyright (C) 2002 Ben Wing.
-;; Copyright (C) 2003 - 2012 Steve Youngs
+;; Copyright (C) 2003 - 2015 Steve Youngs
 
 ;; Author: Pete Ware <ware@cis.ohio-state.edu>
 ;; Heavy-Modifications: Greg Klanderman <greg@alphatech.com>
@@ -169,209 +169,83 @@ one version of a package available.")
 
 ;;;###autoload
 (defcustom package-get-package-index-file-location
-  (car (split-path (or (getenv "EMACSPACKAGEPATH") user-init-directory)))
+  (car (split-path (or (getenv "EMACSPACKAGEPATH") user-packages-topdir)))
   "*The directory where the package-index file can be found."
   :type 'directory
   :group 'package-get)
 
 ;;;###autoload
-(defcustom package-get-install-to-user-init-directory nil
-  "*If non-nil install packages under `user-init-directory'."
+(defcustom package-get-install-to-user-directory nil
+  "*If non-nil install packages under `user-packages-topdir'."
   :type 'boolean
   :group 'package-get)
 
+(defvaralias 'package-get-install-to-user-init-directory
+  'package-get-install-to-user-directory)
+
 (define-widget 'host-name 'string
   "A Host name."
   :tag "Host")
 
+(define-widget 'url-scheme 'string
+  "A URL protocol scheme."
+  :tag "URL-Scheme")
+
 (defcustom package-get-remote nil
   "*The remote site to contact for downloading packages.
-Format is '(site-name directory-on-site).  As a special case, `site-name'
-can be `nil', in which case `directory-on-site' is treated as a local
-directory."
+
+Format is '(site-name directory-on-site scheme).  As a special case,
+`site-name' can be `nil', in which case `directory-on-site' is treated
+as a local directory."
   :tag "Package repository"
   :type '(set (choice (const :tag "None" nil)
                      (list :tag "Local" (const :tag "Local" nil) directory)
-                     (list :tag "Remote" host-name directory)))
+                     (list :tag "Remote" host-name directory url-scheme)))
   :group 'package-get)
 
+;;;###autoload
+(defvar package-get-have-curl (ignore-errors (require 'ffi-curl))
+  "Non-nil when FFI and curl is available.")
+
 ;;;###autoload
 (defcustom package-get-download-sites
-  '(
-    ;; Main XEmacs Site (ftp.xemacs.org)
-    ("US (Main XEmacs Site)"
-     "ftp.xemacs.org" "pub/xemacs/packages")
-    ;; In alphabetical order of Country, our mirrors...
-    ("Argentina (xmundo.net)" "xemacs.xmundo.net" "pub/mirrors/xemacs/packages")
-    ("Australia (aarnet.edu.au)" "mirror.aarnet.edu.au" "pub/xemacs/packages")
-    ("Australia (au.xemacs.org)" "ftp.au.xemacs.org" "pub/xemacs/packages")
-    ("Austria (at.xemacs.org)" "ftp.at.xemacs.org" "editors/xemacs/packages")
-    ("Belgium (be.xemacs.org)" "ftp.be.xemacs.org" "xemacs/packages")
-    ("Brazil (br.xemacs.org)" "ftp.br.xemacs.org" "pub/xemacs/packages")
-    ("Canada (ca.xemacs.org)" "ftp.ca.xemacs.org" "pub/Mirror/xemacs/packages")
-    ("Canada (nrc.ca)" "ftp.nrc.ca" "pub/packages/editors/xemacs/packages")
-    ;; no anonymous ftp available, uncomment when updating website
-    ;; with
-    ;; xemacs-builds/adrian/website/package-get-2-download-sites.el
-;     ("Chile (cl.xemacs.org)" "ftp.cl.xemacs.org" "packages")
-    ("China (ftp.cn.xemacs.org)" "ftp.cn.xemacs.org" "pub/xemacs/packages")
-    ("Czech Republic (cz.xemacs.org)" "ftp.cz.xemacs.org" "MIRRORS/ftp.xemacs.org/pub/xemacs/packages")
-    ("Denmark (dk.xemacs.org)" "ftp.dk.xemacs.org" "xemacs/packages")
-    ("Finland (fi.xemacs.org)" "ftp.fi.xemacs.org" "pub/mirrors/ftp.xemacs.org/pub/tux/xemacs/packages")
-    ("France (fr.xemacs.org)" "ftp.fr.xemacs.org" "pub/xemacs/packages")
-    ("France (mirror.cict.fr)" "mirror.cict.fr" "xemacs/packages")
-    ("France (pasteur.fr)" "ftp.pasteur.fr" "pub/computing/xemacs/packages")
-    ("Germany (de.xemacs.org)" "ftp.de.xemacs.org" "pub/ftp.xemacs.org/tux/xemacs/packages")
-    ("Greece (gr.xemacs.org)" "ftp.gr.xemacs.org" "mirrors/XEmacs/ftp/packages")
-    ("Hong Kong (hk.xemacs.org)" "ftp.hk.xemacs.org" "pub/xemacsftp/packages")
-    ("Ireland (ie.xemacs.org)" "ftp.ie.xemacs.org" "mirrors/ftp.xemacs.org/pub/xemacs/packages")
-    ("Ireland (heanet.ie)" "ftp.heanet.ie" "mirrors/ftp.xemacs.org/packages")
-    ("Italy (it.xemacs.org)" "ftp.it.xemacs.org" "unix/packages/XEMACS/packages")
-    ("Japan (dti.ad.jp)" "ftp.dti.ad.jp" "pub/unix/editor/xemacs/packages")
-;   ("Japan (jaist.ac.jp)" "ftp.jaist.ac.jp" "pub/GNU/xemacs/packages")
-    ("Japan (jp.xemacs.org)" "ftp.jp.xemacs.org" "pub/text/xemacs/packages")
-;   ("Japan (nucba.ac.jp)" "mirror.nucba.ac.jp" "mirror/xemacs/packages")
-    ("Korea (kr.xemacs.org)" "ftp.kr.xemacs.org" "pub/tools/emacs/xemacs/packages")
-    ("Netherlands (nl.xemacs.org)" "ftp.nl.xemacs.org" "pub/xemacs/ftp/packages")
-    ;; no anonymous ftp available, uncomment when updating website
-    ;; with
-    ;; xemacs-builds/adrian/website/package-get-2-download-sites.el
-;     ("Netherlands (xemacsftp.digimirror.nl)" "xemacsftp.digimirror.nl" "packages")
-    ("Norway (no.xemacs.org)" "ftp.no.xemacs.org" "pub/xemacs/packages")
-    ("Portugal (pt.xemacs.org)" "ftp.pt.xemacs.org" "pub/MIRRORS/ftp.xemacs.org/packages")
-    ("Russia (ru.xemacs.org)" "ftp.ru.xemacs.org" "pub/emacs/xemacs/packages")
-    ("Saudi Arabia (sa.xemacs.org)" "ftp.sa.xemacs.org" "pub/xemacs.org/packages")
-    ("Sweden (se.xemacs.org)" "ftp.se.xemacs.org" "pub/gnu/xemacs/packages")
-    ("Switzerland (ch.xemacs.org)" "ftp.ch.xemacs.org" "mirror/xemacs/packages")
-    ("Taiwan (ftp.tw.xemacs.org)" "ftp.tw.xemacs.org" "Unix/Editors/XEmacs/packages")
-    ("UK (uk.xemacs.org)" "ftp.uk.xemacs.org" "sites/ftp.xemacs.org/pub/xemacs/packages")
-    ("US (ibiblio.org)" "mirrors.ibiblio.org" "pub/mirrors/xemacs/packages")
-    ("US (us.xemacs.org)" "ftp.us.xemacs.org" "pub/mirrors/xemacs/packages")
-    )
+  `(,@(when package-get-have-curl
+       ;; 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).
-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.
-This variable is used to initialize `package-get-remote', the
-variable actually used to specify package download sites."
-  :tag "Package download sites"
-  :type '(repeat (list (string :tag "Name") host-name directory))
-  :group 'package-get)
 
-;;;###autoload
-(defcustom package-get-pre-release-download-sites
-  '(
-    ;; Main XEmacs Site (ftp.xemacs.org)
-    ("US Pre-Releases (Main XEmacs Site)" "ftp.xemacs.org"
-     "pub/xemacs/beta/experimental/packages")
-    ;; In alphabetical order of Country, our mirrors...
-    ("Argentina Pre-Releases (xmundo.net)" "xemacs.xmundo.net"
-     "pub/mirrors/xemacs/beta/experimental/packages")
-    ("Australia Pre-Releases (aarnet.edu.au)" "mirror.aarnet.edu.au"
-     "pub/xemacs/beta/experimental/packages")
-    ("Australia Pre-Releases (au.xemacs.org)" "ftp.au.xemacs.org"
-     "pub/xemacs/beta/experimental/packages")
-    ("Austria Pre-Releases (at.xemacs.org)" "ftp.at.xemacs.org"
-     "editors/xemacs/beta/experimental/packages")
-    ("Belgium Pre-Releases (be.xemacs.org)" "ftp.be.xemacs.org"
-     "xemacs/beta/experimental/packages")
-    ("Brazil Pre-Releases (br.xemacs.org)" "ftp.br.xemacs.org"
-     "pub/xemacs/xemacs-21.5/experimental/packages")
-    ("Canada Pre-Releases (ca.xemacs.org)" "ftp.ca.xemacs.org"
-     "pub/Mirror/xemacs/beta/experimental/packages")
-    ("Canada Pre-Releases (nrc.ca)" "ftp.nrc.ca"
-     "pub/packages/editors/xemacs/beta/experimental/packages")
-    ;; no anonymous ftp available, uncomment when updating website
-    ;; with
-    ;; xemacs-builds/adrian/website/package-get-2-download-sites.el
-;     ("Chile Pre-Releases (cl.xemacs.org)" "ftp.cl.xemacs.org"
-;      "beta/experimental/packages")
-    ("China Pre-Releases (ftp.cn.xemacs.org)" "ftp.cn.xemacs.org"
-     "pub/xemacs/beta/experimental/packages")
-    ("Czech Republic Pre-Releases (cz.xemacs.org)" "ftp.cz.xemacs.org"
-     "MIRRORS/ftp.xemacs.org/pub/xemacs/xemacs-21.5/experimental/packages")
-    ("Denmark Pre-Releases (dk.xemacs.org)" "ftp.dk.xemacs.org"
-     "xemacs/beta/experimental/packages")
-    ("Finland Pre-Releases (fi.xemacs.org)" "ftp.fi.xemacs.org"
-     "pub/mirrors/ftp.xemacs.org/pub/tux/xemacs/beta/experimental/packages")
-    ("France Pre-Releases (fr.xemacs.org)" "ftp.fr.xemacs.org"
-     "pub/xemacs/beta/experimental/packages")
-    ("France Pre-Releases (mirror.cict.fr)" "mirror.cict.fr"
-     "xemacs/beta/experimental/packages")
-    ("France Pre-Releases (pasteur.fr)" "ftp.pasteur.fr"
-     "pub/computing/xemacs/beta/experimental/packages")
-    ("Germany Pre-Releases (de.xemacs.org)" "ftp.de.xemacs.org"
-     "pub/ftp.xemacs.org/tux/xemacs/beta/experimental/packages")
-    ("Greece Pre-Releases (gr.xemacs.org)" "ftp.gr.xemacs.org"
-     "mirrors/XEmacs/ftp/beta/experimental/packages")
-    ("Hong Kong Pre-Releases (hk.xemacs.org)" "ftp.hk.xemacs.org"
-     "pub/xemacsftp/beta/experimental/packages")
-    ("Ireland Pre-Releases (ie.xemacs.org)" "ftp.ie.xemacs.org"
-     "mirrors/ftp.xemacs.org/pub/xemacs/beta/experimental/packages")
-    ("Ireland Pre-Releases (heanet.ie)" "ftp.heanet.ie"
-     "mirrors/ftp.xemacs.org/beta/experimental/packages")
-    ("Italy Pre-Releases (it.xemacs.org)" "ftp.it.xemacs.org"
-     "unix/packages/XEMACS/beta/experimental/packages")
-    ("Japan Pre-Releases (dti.ad.jp)" "ftp.dti.ad.jp"
-     "pub/unix/editor/xemacs/beta/experimental/packages")
-;   ("Japan Pre-Releases (jaist.ac.jp)" "ftp.jaist.ac.jp"
-;    "pub/GNU/xemacs/beta/experimental/packages")
-    ("Japan Pre-Releases (jp.xemacs.org)" "ftp.jp.xemacs.org"
-     "pub/text/xemacs/beta/experimental/packages")
-    ("Korea Pre-Releases (kr.xemacs.org)" "ftp.kr.xemacs.org"
-     "pub/tools/emacs/xemacs/beta/experimental/packages")
-    ("Netherlands Pre-Releases (nl.xemacs.org)" "ftp.nl.xemacs.org"
-     "pub/xemacs/ftp/beta/experimental/packages")
-    ;; no anonymous ftp available, uncomment when updating website
-    ;; with
-    ;; xemacs-builds/adrian/website/package-get-2-download-sites.el
-;     ("Netherlands Pre-Releases (xemacsftp.digimirror.nl)" "xemacsftp.digimirror.nl"
-;      "beta/experimental/packages")
-    ("Norway Pre-Releases (no.xemacs.org)" "ftp.no.xemacs.org"
-     "pub/xemacs/beta/experimental/packages")
-    ("Portugal Pre-Releases (pt.xemacs.org)" "ftp.pt.xemacs.org"
-     "pub/MIRRORS/ftp.xemacs.org/beta/experimental/packages")
-    ("Russia Pre-Releases (ru.xemacs.org)" "ftp.ru.xemacs.org"
-     "pub/emacs/xemacs/beta/experimental/packages")
-    ("Saudi Arabia Pre-Releases (sa.xemacs.org)" "ftp.sa.xemacs.org"
-     "pub/xemacs.org/beta/experimental/packages")
-    ("Sweden Pre-Releases (se.xemacs.org)" "ftp.se.xemacs.org"
-     "pub/gnu/xemacs/beta/experimental/packages")
-    ("Switzerland Pre-Releases (ch.xemacs.org)" "ftp.ch.xemacs.org"
-     "mirror/xemacs/beta/experimental/packages")
-    ("Taiwan Pre-Releases (ftp.tw.xemacs.org)" "ftp.tw.xemacs.org"
-     "Unix/Editors/XEmacs/beta/experimental/packages")
-    ("UK Pre-Releases (uk.xemacs.org)" "ftp.uk.xemacs.org"
-     "sites/ftp.xemacs.org/pub/xemacs/beta/experimental/packages")
-    ("US Pre-Releases (ibiblio.org)" "mirrors.ibiblio.org"
-     "pub/mirrors/xemacs/beta/experimental/packages")
-    ("US Pre-Releases (us.xemacs.org)" "ftp.us.xemacs.org"
-     "pub/mirrors/xemacs/beta/experimental/packages")
-    )
-  "*List of remote sites available for downloading \"Pre-Release\" packages.
-List format is '(site-description site-name directory-on-site).
-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.
-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))
+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 "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
+(defcustom package-get-site-release-download-sites nil
   "*List of remote sites available for downloading \"Site Release\" packages.
-List format is '(site-description site-name directory-on-site).
-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.
-This variable is used to initialize `package-get-remote', the
-variable actually used to specify package download sites."
+
+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 "Site Release Package download sites"
-  :type '(repeat (list (string :tag "Name") host-name directory))
+  :type '(repeat (list (string :tag "Name")
+                      host-name directory url-scheme))
   :group 'package-get)
 
 (defcustom package-get-remove-copy t
@@ -491,7 +365,7 @@ if different."
                            (md5 (current-buffer)))))
        (when (not (file-writable-p location))
          (if (y-or-n-p (format "Sorry, %s is read-only, can I use %s? "
-                               location user-init-directory))
+                               location user-packages-topdir))
              (setq location (expand-file-name
                              package-get-base-filename
                              package-get-package-index-file-location))
@@ -506,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
@@ -520,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
@@ -528,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))))
 
@@ -935,6 +812,7 @@ successfully installed but errors occurred during initialization, or
         (latest (package-get-info-prop this-package 'version))
         (installed (package-get-key package :version))
         (found nil)
+        (host nil)
         (search-dir package-get-remote)
         (base-filename (package-get-info-prop this-package 'filename))
         (package-status t)
@@ -987,7 +865,7 @@ successfully installed but errors occurred during initialization, or
       ;; and copy it into the staging directory.  Then validate
       ;; the checksum.  Finally, install the package.
       (catch 'done
-       (let (search-filenames host dir current-filename dest-filename)
+       (let (search-filenames dir current-filename dest-filename)
          ;; In each search directory ...
          (when search-dir
            (setq host (car search-dir)
@@ -1048,7 +926,8 @@ successfully installed but errors occurred during initialization, or
                          (package-get-info-prop this-package
                                                 'md5sum)))
            (progn
-             (delete-file full-package-filename)
+             (unless (null host)
+               (delete-file full-package-filename))
              (error 'process-error
                     (format "Package %s does not match md5 checksum %s has been deleted"
                             base-filename full-package-filename)))))
@@ -1082,10 +961,12 @@ successfully installed but errors occurred during initialization, or
          (message "Installation of package %s failed." base-filename)
          (sit-for 0)
          (switch-to-buffer package-admin-temp-buffer)
-         (delete-file full-package-filename)
+         ;; null host means a local package mirror
+         (unless (null host)
+           (delete-file full-package-filename))
          (setq package-status nil)))
       (setq found t))
-    (if (and found package-get-remove-copy)
+    (if (and found package-get-remove-copy (not (null host)))
        (delete-file full-package-filename))
     package-status)))
 
@@ -1156,24 +1037,38 @@ Creates `package-get-dir'  if it doesn't exist."
 It first checks if FILENAME already is a remote filename.  If it is
 not, then it uses the (car search) as the remote site-name and the (cadr
 search) as the remote-directory and concatenates filename.  In other
-words
+words:
+
        site-name:remote-directory/filename.
 
-If (car search) is nil, (cadr search is interpreted as  a local directory).
-"
-  (if (file-remote-p filename)
+If ffi-curl has been loaded then this will return a URL style name,
+for example:
+
+        http://site-name/remote-directory/filename
+
+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 (or (file-remote-p filename)
+         (and (string-match #r"^\(https?\|s?ftp\)://" filename)
+              package-get-have-curl))
       filename
-    (let ((dir (cadr search)))
-      (concat (when (car search)
-               (concat
-                (if (string-match "@" (car search))
-                    "/"
-                  "/anonymous@")
-                (car search) ":"))
-             (if (string-match "/$" dir)
-                 dir
-               (concat dir "/"))
-             filename))))
+    (let ((site (car search))
+         (dir (cadr search))
+         (scheme (third search)))
+      (if (and site package-get-have-curl)
+         (concat scheme "://" site "/" dir "/" filename)
+       (concat (when site
+                 (concat
+                  (if (string-match "@" site)
+                      "/"
+                    "/anonymous@")
+                  site ":"))
+               (if (string-match "/$" dir)
+                   dir
+                 (concat dir "/"))
+               filename)))))
 
 (defun package-get-installedp (package version)
   "Determine if PACKAGE with VERSION has already been installed.
@@ -1232,110 +1127,6 @@ lead to Emacs accessing remote sites."
        (intern (substring (symbol-name pkg) 0 (match-beginning 0))))
        t)))
 
-;;; FIXME: see comment at end of `pui-bootstrap'
-
-;;;###autoload
-(defun pui-bootstrap ()
-  "Bootstrap the SXEmacs Package Tools.
-
-The Package Tools, under normal circumstances, cannot work until a
-couple of packages are pre-installed by hand.  This function eliminates
-the need to do that.  It uses FFI and libcurl to download and install
-the lastest package index file, the EFS and xemacs-base packages.
-
-Obviously you can't use this if you didn't enable FFI support in your
-SXEmacs or if you don't have libffi on your system.
-
-This isn't designed to replace the existing Package Tools so after
-you have run `pui-bootstrap' once you should then use the normal PUI
-tools, `pui-list-packages' etc."
-  (interactive)
-  ;; A little sanity checking never hurt anybody
-  (when (featurep '(and efs-autoloads xemacs-base-autoloads))
-    (error 'invalid-operation "PUI doesn't need bootstrapping"))
-  (when (and (fboundp 'ffi-defun)
-            (not (featurep '(and ffi ffi-curl))))
-    (require 'ffi-curl))
-  (unless (featurep 'ffi)
-    (error 'unimplemented "FFI"))
-  ;; One last check... has `package-get-remote' been set?
-  (if (not (cdr package-get-remote))
-      (when (y-or-n-p "You haven't set a download site, do you need help ")
-       (declare-fboundp (Info-goto-node "(sxemacs)Bootstrapping PUI")))
-    ;; We should be good to go
-    (let* ((site (car package-get-remote))
-          (dir (cadr package-get-remote))
-          (url (concat "ftp://" site "/" dir "/"))
-          (dldir (temp-directory))
-          (index (expand-file-name package-get-base-filename
-                                   package-get-package-index-file-location))
-          xemacs-base-pkg
-          efs-pkg
-                                       ;status)
-          )
-      ;; Grab the index
-      (message "Retrieving index, please be patient")
-      (declare-fboundp (curl:download (concat url package-get-base-filename) index))
-      (message "Retrieving index, done!")
-      ;; Update the db
-      (set-buffer (find-file-noselect index))
-      (package-get-update-base-from-buffer)
-      (kill-buffer (current-buffer))
-      ;; Get xemacs-base, EFS
-      (setq xemacs-base-pkg (package-get-info 'xemacs-base 'filename))
-      (setq efs-pkg (package-get-info 'efs 'filename))
-      (message "Retrieving %s, please be patient" xemacs-base-pkg)
-      (declare-fboundp (curl:download (concat url xemacs-base-pkg)
-                                     (expand-file-name xemacs-base-pkg dldir)))
-      (message "Retrieving %s, please be patient" efs-pkg)
-      (declare-fboundp (curl:download (concat url efs-pkg)
-                                     (expand-file-name efs-pkg dldir)))
-      (message "Download complete.")
-      ;; Install xemacs-base
-      (if (equal (package-get-info 'xemacs-base 'md5sum)
-                (with-temp-buffer
-                  (insert-file-contents-literally
-                   (expand-file-name xemacs-base-pkg dldir))
-                  (md5 (current-buffer))))
-         (progn
-           (package-admin-add-binary-package
-            (expand-file-name xemacs-base-pkg dldir)
-            (package-admin-get-install-dir 'xemacs-base))
-           (push (file-name-as-directory
-                  (expand-file-name "lisp/xemacs-base"
-                                    (package-admin-get-install-dir 'xemacs-base)))
-                 load-path)
-           (load-file (expand-file-name "lisp/xemacs-base/_pkg.el"
-                                        (package-admin-get-install-dir 'xemacs-base)))
-           (load-file (expand-file-name "lisp/xemacs-base/auto-autoloads.el"
-                                        (package-admin-get-install-dir 'xemacs-base)))
-           (message "xemacs-base package installed"))
-       (delete-file (expand-file-name xemacs-base-pkg dldir))
-       (error "MD5 mismatch, %s deleted" (expand-file-name xemacs-base-pkg dldir)))
-      ;; Install EFS
-      (if (equal (package-get-info 'efs 'md5sum)
-                (with-temp-buffer
-                  (insert-file-contents-literally
-                   (expand-file-name efs-pkg dldir))
-                  (md5 (current-buffer))))
-         (progn
-           (package-admin-add-binary-package
-            (expand-file-name efs-pkg dldir)
-            (package-admin-get-install-dir 'efs))
-           (push (file-name-as-directory
-                  (expand-file-name "lisp/efs"
-                                    (package-admin-get-install-dir 'efs)))
-                 load-path)
-           (load-file (expand-file-name "lisp/efs/_pkg.el"
-                                        (package-admin-get-install-dir 'efs)))
-           (load-file (expand-file-name "lisp/efs/auto-autoloads.el"
-                                        (package-admin-get-install-dir 'efs)))
-           (message "efs package installed"))
-       (delete-file (expand-file-name efs-pkg dldir))
-       (error "MD5 mismatch, %s deleted" (expand-file-name efs-pkg dldir)))
-      (when (y-or-n-p "Install more packages? ")
-       (declare-fboundp (pui-list-packages))))))
-
 (provide 'package-get)
 
 ;; On-load forms