| 1 | (in-package #:asdf-install) |
|---|
| 2 | |
|---|
| 3 | (defun directorify (name) |
|---|
| 4 | ;; input name may or may not have a trailing #\/, but we know we |
|---|
| 5 | ;; want a directory |
|---|
| 6 | (let ((path (pathname name))) |
|---|
| 7 | (if (pathname-name path) |
|---|
| 8 | (merge-pathnames |
|---|
| 9 | (make-pathname :directory `(:relative ,(pathname-name path)) |
|---|
| 10 | :name "") |
|---|
| 11 | path) |
|---|
| 12 | path))) |
|---|
| 13 | |
|---|
| 14 | #+:digitool |
|---|
| 15 | (defparameter *home-volume-name* |
|---|
| 16 | (second (pathname-directory (truename (user-homedir-pathname)))) |
|---|
| 17 | "Digitool MCL retains the OS 9 convention that ALL volumes have a |
|---|
| 18 | name which includes the startup volume. OS X doesn't know about this. |
|---|
| 19 | This figures in the home path and in the normalization for system |
|---|
| 20 | namestrings.") |
|---|
| 21 | |
|---|
| 22 | (defvar *proxy* (get-env-var "http_proxy")) |
|---|
| 23 | |
|---|
| 24 | (defvar *proxy-user* nil) |
|---|
| 25 | |
|---|
| 26 | (defvar *proxy-passwd* nil) |
|---|
| 27 | |
|---|
| 28 | (defvar *trusted-uids* nil) |
|---|
| 29 | |
|---|
| 30 | (defvar *verify-gpg-signatures* t |
|---|
| 31 | "Can be t, nil, or :unknown-locations. If true, then the signature of all packages will be checked. If nil, then no signatures will be checked. If :unkown-locations, then only packages whose location is not a prefix of any `*safe-url-prefixes*` will be tested.") |
|---|
| 32 | |
|---|
| 33 | (defvar *safe-url-prefixes* nil) |
|---|
| 34 | |
|---|
| 35 | (defvar *preferred-location* nil) |
|---|
| 36 | |
|---|
| 37 | (defvar *cclan-mirror* |
|---|
| 38 | (or (get-env-var "CCLAN_MIRROR") |
|---|
| 39 | "http://ftp.linux.org.uk/pub/lisp/cclan/")) |
|---|
| 40 | |
|---|
| 41 | #+(or :win32 :mswindows) |
|---|
| 42 | (defvar *cygwin-bin-directory* |
|---|
| 43 | (pathname "C:\\PROGRA~1\\Cygwin\\bin\\")) |
|---|
| 44 | |
|---|
| 45 | #+(or :win32 :mswindows) |
|---|
| 46 | (defvar *cygwin-bash-program* |
|---|
| 47 | "C:\\PROGRA~1\\Cygwin\\bin\\bash.exe") |
|---|
| 48 | |
|---|
| 49 | ;; bin first |
|---|
| 50 | (defvar *shell-search-paths* '((:absolute "bin") |
|---|
| 51 | (:absolute "usr" "bin") |
|---|
| 52 | (:absolute "usr" "local" "bin") |
|---|
| 53 | (:absolute "opt" "local" "bin")) |
|---|
| 54 | "A list of places to look for shell commands.") |
|---|
| 55 | |
|---|
| 56 | (defvar *gnu-tar-program* |
|---|
| 57 | #-(or :netbsd :freebsd :solaris :sunos) "tar" |
|---|
| 58 | #+(or :netbsd :freebsd :solaris :sunos) "gtar" |
|---|
| 59 | "Path to the GNU tar program") |
|---|
| 60 | |
|---|
| 61 | (eval-when (:compile-toplevel :load-toplevel :execute) |
|---|
| 62 | (defparameter *supported-defsystems* |
|---|
| 63 | (list :mk-defsystem |
|---|
| 64 | :asdf |
|---|
| 65 | |
|---|
| 66 | ;; Add others. |
|---|
| 67 | ;; #+lispworks :common-defsystem |
|---|
| 68 | ;; #+gbbopen :mini-module |
|---|
| 69 | )) |
|---|
| 70 | (unless (some (lambda (defsys-tag) |
|---|
| 71 | (member defsys-tag *features*)) |
|---|
| 72 | *features*) |
|---|
| 73 | (error "ASDF-INSTALL requires one of the following \"defsystem\" utilities to work: ~A" |
|---|
| 74 | *supported-defsystems*))) |
|---|
| 75 | |
|---|
| 76 | (defvar *asdf-install-dirs* |
|---|
| 77 | (directorify (or #+sbcl (get-env-var "SBCL_HOME") |
|---|
| 78 | (get-env-var "ASDF_INSTALL_DIR") |
|---|
| 79 | (make-pathname :directory |
|---|
| 80 | `(:absolute |
|---|
| 81 | #+digitool ,*home-volume-name* |
|---|
| 82 | "usr" "local" "asdf-install"))))) |
|---|
| 83 | |
|---|
| 84 | (defvar *private-asdf-install-dirs* |
|---|
| 85 | #+:sbcl |
|---|
| 86 | (merge-pathnames (make-pathname :directory '(:relative ".sbcl")) |
|---|
| 87 | (truename (user-homedir-pathname))) |
|---|
| 88 | #-:sbcl |
|---|
| 89 | (cond ((get-env-var "PRIVATE_ASDF_INSTALL_DIR") |
|---|
| 90 | (directorify (get-env-var "PRIVATE_ASDF_INSTALL_DIR"))) |
|---|
| 91 | (t |
|---|
| 92 | (merge-pathnames (make-pathname |
|---|
| 93 | :directory '(:relative ".asdf-install-dir")) |
|---|
| 94 | (truename (user-homedir-pathname)))))) |
|---|
| 95 | |
|---|
| 96 | (defparameter *locations* |
|---|
| 97 | `((,(merge-pathnames (make-pathname :directory '(:relative "site")) |
|---|
| 98 | *asdf-install-dirs*) |
|---|
| 99 | ,(merge-pathnames (make-pathname :directory '(:relative "site-systems")) |
|---|
| 100 | *asdf-install-dirs*) |
|---|
| 101 | "System-wide install") |
|---|
| 102 | (,(merge-pathnames (make-pathname :directory '(:relative "site")) |
|---|
| 103 | *private-asdf-install-dirs*) |
|---|
| 104 | ,(merge-pathnames (make-pathname :directory '(:relative "systems")) |
|---|
| 105 | *private-asdf-install-dirs*) |
|---|
| 106 | "Personal installation"))) |
|---|
| 107 | |
|---|
| 108 | (defvar *tar-extractors* |
|---|
| 109 | '(extract-using-tar)) |
|---|
| 110 | |
|---|
| 111 | (defvar *systems-installed-this-time* nil |
|---|
| 112 | "Used during installation propagation \(see *propagate-installation*\) to keep track off which systems have been installed during the current call to install.") |
|---|
| 113 | |
|---|
| 114 | (defvar *propagate-installation* nil |
|---|
| 115 | "If true, then every required system will be re-asdf-installed.") |
|---|
| 116 | |
|---|
| 117 | (defvar *temporary-directory* |
|---|
| 118 | (pathname-sans-name+type (user-homedir-pathname))) |
|---|
| 119 | |
|---|
| 120 | #+abcl |
|---|
| 121 | (eval-when (:load-toplevel) |
|---|
| 122 | (require 'asdf) |
|---|
| 123 | (dolist (location *locations*) |
|---|
| 124 | (pushnew (second location) asdf:*central-registry*))) |
|---|