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 | (defparameter *asdf-install-verbose* t) |
---|
121 | (export '*asdf-install-verbose*) |
---|
122 | |
---|
123 | #+abcl |
---|
124 | (eval-when (:load-toplevel) |
---|
125 | (require 'asdf) |
---|
126 | (dolist (location *locations*) |
---|
127 | (let |
---|
128 | ((asdf-designator (second location))) |
---|
129 | (format *asdf-install-verbose* "~&;;Adding ~A to ASDF.~%" asdf-designator) |
---|
130 | (pushnew asdf-designator asdf:*central-registry*)))) |
---|
131 | |
---|