Changeset 926


Ignore:
Timestamp:
Feb 16, 2005, 8:12:21 PM (16 years ago)
Author:
bryan
Message:

sync with latest asdf-install code.

Location:
trunk/ccl/tools
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/tools/README-OpenMCL.txt

    r505 r926  
    22system-building tools.
    33
    4 The code here is current as of February 7, 2004; you may want
     4The code here is current as of February 1, 2005; you may want
    55to check the originating project's homepages to see if more recent
    66versions are available.
  • trunk/ccl/tools/asdf-install/README

    r503 r926  
    1 Downloads and installs an ASDF system or anything else that looks
    2 convincingly like one, including updating the ASDF:*CENTRAL-REGISTRY*
    3 symlinks for all the toplevel .asd files it contains.  Please read
    4 this file before use: in particular: this is an automatic tool that
    5 downloads and compiles stuff it finds on the 'net.  Please look at the
    6 SECURITY section and be sure you understand the implications
     1Downloads and installs an ASDF or a MK:DEFSYSTEM system or anything
     2else that looks convincingly like one. It updates the
     3ASDF:*CENTRAL-REGISTRY* symlinks for all the toplevel .asd files it
     4contains, and it also MK:ADD-REGISTRY-LOCATION for the appropriate
     5directories for MK:DEFSYSTEM.
     6
     7Please read this file before use: in particular: this is an automatic
     8tool that downloads and compiles stuff it finds on the 'net.  Please
     9look at the SECURITY section and be sure you understand the
     10implications
    711
    812
    913= USAGE
    1014
    11 This can be used either from within an SBCL instance:
     15This can be used either from within a CL implementation:
    1216
    13 * (require 'asdf-install)
    14 * (asdf-install:install 'xlunit) ; for example
     17cl-prompt> (load "/path/to/load-asdf-install.lisp")
     18cl-prompt> (asdf-install:install 'xlunit) ; for example
    1519
    16 or standalone from the shell:
     20With SBCL you can also use the standalone command `sbcl-asdf-install'
     21from the shell:
    1722
    1823$ sbcl-asdf-install xlunit
     24
    1925
    2026Each argument may be -
     
    3137= SECURITY CONCERNS: READ THIS CAREFULLY
    3238
    33 When you invoke asdf-install, you are asking SBCL to download,
    34 compile, and install software from some random site on the web.  Given
    35 that it's indirected through a page on CLiki, any malicious third party
    36 doesn't even need to hack the distribution server to replace the
    37 package with something else: he can just edit the link. 
     39When you invoke asdf-install, you are asking your CL implementation to
     40download, compile, and install software from some random site on the
     41web.  Given that it's indirected through a page on CLiki, any
     42malicious third party doesn't even need to hack the distribution
     43server to replace the package with something else: he can just edit
     44the link.
    3845
    3946For this reason, we encourage package providers to crypto-sign their
     
    6067   preferred/nearest CCLAN node.  See the list at
    6168   http://ww.telent.net/cclan-choose-mirror
     69*ASDF-INSTALL-DIRS*
     70   Set from ASDF_INSTALL_DIR environment variable.  If you are running
     71   SBCL, then *ASDF-INSTALL-DIRS* may be set form the environment variable
     72   SBCL_HOME, which should already be correct for whatever SBCL is
     73   running, if it's been installed correctly.  This is done for
     74   backward compatibility with SBCL installations.
    6275*SBCL-HOME*
    63    Set from $SBCL_HOME environment variable.  This should already be
    64    correct for whatever SBCL is running, if it's been installed correctly
     76   This is actually a symbol macro for *ASDF-INSTALL-DIRS*
    6577*VERIFY-GPG-SIGNATURES*
    6678   Verify GPG signatures for the downloaded packages?
  • trunk/ccl/tools/asdf-install/asdf-install.asd

    r503 r926  
    3232               #+:sbcl
    3333               (:exe-file "loader" :depends-on ("installer"))
     34               (:file "split-sequence")
    3435               (:file "port" :depends-on ("defpackage"))
    3536               #+:digitool
    3637               (:file "digitool" :depends-on ("port"))
    37                (:file "installer" :depends-on ("port" #+:digitool "digitool"))))
     38               (:file "installer" :depends-on ("port" "split-sequence" #+:digitool "digitool"))))
    3839               
    3940(defmethod perform :after ((o load-op) (c (eql (find-system :asdf-install))))
  • trunk/ccl/tools/asdf-install/defpackage.lisp

    r503 r926  
    44  (:use "CL")
    55  (:export
    6    ;; customizable variables
    7    #:*proxy* #:*cclan-mirror* #:*sbcl-home*
    8    #:*verify-gpg-signatures* #:*locations*
     6
     7   ;; Customizable variables.
     8   #:*proxy*
     9   #:*cclan-mirror*
     10   #:*sbcl-home* ; Deprecated.
     11   #:asdf-install-dirs
     12   #:private-asdf-install-dirs
     13
     14   #:*verify-gpg-signatures*
     15   #:*locations*
    916   #:*safe-url-prefixes*
    1017   #:*preferred-location*
    11    #+(or :win32 :mswindows) #:sysdef-source-dir-search
    12    ;; external entry points
    13    #:uninstall #:install))
     18
     19   #+(or :win32 :mswindows)
     20   #:*cygwin-bin-directory*
     21
     22   #+(or :win32 :mswindows)
     23   #:*cygwin-bash-command*
     24
     25   ;; External entry points.   
     26   #:add-locations
     27   #+(and asdf (or :win32 :mswindows))
     28   #:sysdef-source-dir-search
     29   #:uninstall
     30   #:install))
    1431
    1532(defpackage :asdf-install-customize
  • trunk/ccl/tools/asdf-install/doc/index.html

    r503 r926  
    4343    <li><a href="#load-asdf-install">Loading ASDF-INSTALL automatically</a>
    4444  </ol>
     45  <li><a href="#defsystem">Optional: Using MK:DEFSYSTEM instead of (or in addition to) ASDF</a>
    4546  <li><a href="#library">How to install a library</a>
    4647  <ol>
     
    5556  <li><a href="#customize">Customizing ASDF-INSTALL</a>
    5657  <ol>
     58    <li><a href="#*gnu-tar-program*">Special variable <code>*GNU-TAR-PROGRAM*</code></a>
    5759    <li><a href="#*proxy*">Special variable <code>*PROXY*</code></a>
    5860    <li><a href="#*cclan-mirror*">Special variable <code>*CCLAN-MIRROR*</code></a>
     
    6163    <li><a href="#*locations*">Special variable <code>*LOCATIONS*</code></a>
    6264    <li><a href="#*preferred-location*">Special variable <code>*PREFERRED-LOCATION*</code></a>
    63     <li><a href="#asdf-install-dir">Environment variable <code>ASDF-INSTALL-DIR</code></a>
    64     <li><a href="#private-asdf-install-dir">Environment variable <code>PRIVATE-ASDF-INSTALL-DIR</code></a>
     65    <li><a href="#asdf-install-dir">Environment variable <code>ASDF_INSTALL_DIR</code></a>
     66    <li><a href="#private-asdf-install-dir">Environment variable <code>PRIVATE_ASDF_INSTALL_DIR</code></a>
    6567  </ol>
    6668  <li><a href="#trusted-uids">The list of trusted code suppliers</a>
     
    99101implementations in use today.
    100102<p>
    101 (A similar system which precedes ASDF is <a
     103A similar system which precedes ASDF is <a
    102104href="http://www.cliki.net/mk-defsystem">MK:DEFSYSTEM</a>. You don't
    103105need it for ASDF-INSTALL but it won't hurt to have it available for
    104106libraries which aren't aware of ASDF. However, this document makes no
    105107effort to explain how MK:DEFSYSTEM is used. See Henrik Motakef's
    106 article &quot;<a href="http://www.henrik-motakef.de/defsystem.html">Fight The System</a>.&quot;)
     108article &quot;<a href="http://www.henrik-motakef.de/defsystem.html">Fight The System</a>.&quot;
     109<p>
     110<font color=green><em>Update:</em></font> Marco Antoniotti has patched
     111ASDF-INSTALL to make it work with MK:DEFSYSTEM as well. See the <a href="#defsystem">section about MK:DEFSYSTEM</a> below.
    107112
    108113<br>&nbsp;<br><h3><a class=none name="asdf-install">What is ASDF-INSTALL?</a></h3>
     
    137142&quot;portable&quot; version, while still being tested, is currently
    138143available from <a
    139 href="http://weitz.de/files/asdf-install.tgz">http://weitz.de/files/asdf-install.tgz</a>. It
     144href="http://weitz.de/files/asdf-install.tar.gz">http://weitz.de/files/asdf-install.tar.gz</a>. It
    140145will probably be moved to another place like <a
    141146href="http://www.cliki.net/cclan">CCLAN</a> once it's deemed stable enough.
     
    154159you want to be reasonable sure that you're not installing arbitrary
    155160malicious code.)
     161
     162<p>
     163<font><em>Update:</em></font> Beginning with version 0.14.1
     164ASDF-INSTALL is already included with the OpenMCL distribution so
     165OpenMCL basically behaves like SBCL in the following sections. See the
     166OpenMCL docs for details.
    156167
    157168<p>
     
    170181much pretend you're on Unix and <b>skip</b> all the <font
    171182color=green><em>Windows notes</em></font> below.
     183<p>(Update: Alex Mizrahi posted <a href='http://www.google.com/groups?selm=2gacj0Fi7moU1%40uni-berlin.de&output=gplain'>some notes</a> about using the native Win32 version of CLISP to <a href='news://comp.lang.lisp'>comp.lang.lisp</a>. I asked him to send patches but he hasn't sent them yet.)
    172184
    173185<p>
     
    181193<h4><a class=none name="install-asdf">Installing ASDF</a></h4>
    182194
    183 (<a href="#load-asdf">Skip</a> this section if you use SBCL.) <a
     195(<a href="#load-asdf">Skip</a> this section if you use SBCL or AllegroCL 7.0 or higher.) <a
    184196href="http://weitz.de/files/asdf.lisp">Download</a> ASDF and put the
    185197file <code>asdf.lisp</code> in a place where you want it to
     
    254266pre-loaded without changing your image file.)
    255267<p>
    256 If you're using SBCL <em>don't</em> add the line from above but use
     268If you're using SBCL or AllegroCL 7.0 or higher <em>don't</em> add the line from above but use
    257269
    258270<pre>
     
    273285
    274286<pre>
    275 (pushnew "/path/to/your/registry/" asdf:*central-registry*)
     287(pushnew "/path/to/your/registry/" asdf:*central-registry* :test #'equal)
    276288</pre>
    277289
     
    324336
    325337(<a href="#load-asdf-install">Skip</a> this section if you use SBCL.)
    326 <a href="http://weitz.de/files/asdf-install.tgz">Download</a>
     338<a href="http://weitz.de/files/asdf-install.tar.gz">Download</a>
    327339ASDF-INSTALL and unpack the gzipped tar archive into a directory of
    328340your choice. Now create a symlink from the <code>.asd</code> file to your <a href="#registry">registry</a>:
     
    349361
    350362<pre>
    351 (pushnew "/path/where/you/unpacked/asdf-install/" asdf:*central-registry*)
     363(pushnew "/path/where/you/unpacked/asdf-install/" asdf:*central-registry* :test #'equal)
    352364</pre>
    353365
     
    399411href="#uninstall">uninstall</a> older versions.
    400412
     413<br>&nbsp;<br><h3><a class=none name="defsystem">Optional: Using MK:DEFSYSTEM instead of (or in addition to) ASDF</a></h3>
     414
     415<a href="http://www.cliki.net/mk-defsystem">MK:DEFSYSTEM</a> was
     416written by Mark Kantrovitz in the early days of Common Lisp. It
     417precedes ASDF and also works with almost all CL implementations you'll
     418come across. Thanks to the efforts of Marco Antoniotti, ASDF-INSTALL
     419can now also be used with MK:DEFSYSTEM which means that even if the
     420library you want to use doesn't have an ASDF system definition you
     421might be able to install it via ASDF-INSTALL.
     422<p>
     423The recommended setup is to use <em>both</em> ASDF <em>and</em>
     424MK:DEFSYSTEM because this will significantly increase the number of
     425libraries you can install with ASDF-INSTALL.
     426<p>
     427To set up your Lisp environment for this you have to do the following (after reading the sections above):
     428<ul>
     429  <li>Get MK:DEFSYSTEM (version&nbsp;3.4i or higher) from <a href="http://clocc.sourceforge.net/">CLOCC</a>. (You can grab a nightly snapshot or browse the CVS. You only need the file <code>defsystem.lisp</code> from within the <code>src/defsystem-3.x</code> directory.)
     430  <li>To install MK:DEFSYSTEM evaluate the form
     431<pre>
     432(load (compile-file "/path/to/defsystem.lisp"))
     433</pre>
     434  <li>To load MK:DEFSYSTEM automatically each time you start your Lisp put the forms
     435<pre>
     436#-:mk-defsystem (load "/path/to/defsystem")
     437(mk:add-registry-location "/path/to/your/registry/")
     438</pre>
     439      into your initialization file.
     440  <li>Finally, replace the line
     441<pre>
     442#-:asdf-install (asdf:operate 'asdf:load-op :asdf-install)
     443</pre>
     444from <a href="#load-asdf-install">above</a> with the line
     445<pre>
     446#-:asdf-install (load "/path/to/asdf-install/load-asdf-install")
     447</pre>
     448This last step will ensure that ASDF-INSTALL will always be loaded on startup even if you only use MK:DEFSYSTEM and don't have ASDF available.
     449</ul>
     450The following sections should work for you no matter whether you use ASDF, MK:DEFSYSTEM, or both.
     451
    401452<br>&nbsp;<br><h3><a class=none name="library">How to install a library</a></h3>
    402453
    403 Here and in the following sections we assume that you have setup your
     454Here and in the following sections we assume that you have set up your
    404455environment as described in <a
    405456href="#pre"><em>Prerequisites</em></a>.
     
    470521
    471522<pre>
    472 (asdf-install:install &quot;http://weitz.de/files/cl-ppcre.tgz&quot;)
     523(asdf-install:install &quot;http://weitz.de/files/cl-ppcre.tar.gz&quot;)
    473524</pre>
    474525
     
    738789href="http://www.lispworks.com/reference/HyperSpec/Body/11_.htm">package</a>.
    739790
     791<h4><a class=none name="*gnu-tar-program*">Special variable <code>*GNU-TAR-PROGRAM*</code></a></h4>
     792
     793The path to the GNU <code>tar</code> program as a string - the default is <code>&quot;tar&quot;</code>. Changing this variable has no effect if Cygwin is used.
     794
    740795<h4><a class=none name="*proxy*">Special variable <code>*PROXY*</code></a></h4>
    741796
     
    834889the SBCL version of ASDF-INSTALL.
    835890
    836 <h4><a class=none name="asdf-install-dir">Environment variable <code>ASDF-INSTALL-DIR</code></a></h4>
     891<h4><a class=none name="asdf-install-dir">Environment variable <code>ASDF_INSTALL_DIR</code></a></h4>
    837892
    838893The value of this <em>environment variable</em> determines the first element of the initial value of
     
    854909instead.
    855910
    856 <h4><a class=none name="private-asdf-install-dir">Environment variable <code>PRIVATE-ASDF-INSTALL-DIR</code></a></h4>
     911<h4><a class=none name="private-asdf-install-dir">Environment variable <code>PRIVATE_ASDF_INSTALL_DIR</code></a></h4>
    857912
    858913The value of this <em>environment variable</em> determines the second element of the initial value of
     
    897952           #p&quot;/usr/local/lisp/unstable/systems/&quot;
    898953           &quot;Install as unstable&quot;)
    899          asdf-install:<a href="#*locations*">*locations*</a>)
     954         asdf-install:<a href="#*locations*">*locations*</a>
     955         :test #'equal)
    900956
    901957<font color=orange>;; make sure this is also known by ASDF</font>
    902958(pushnew &quot;/usr/local/lisp/unstable/systems/&quot;
    903          asdf:<a href="#*central-registry*">*central-registry*</a>)
     959         asdf:<a href="#*central-registry*">*central-registry*</a>
     960         :test #'equal)
    904961</pre>
    905962
     
    907964
    908965ASDF-INSTALL maintains a list of library authors you trust. This list
    909 is stored in a file <code>trusted-uids.lisp</code> and usually resides in the directory <code>~/.asdf-install-dir/</code> but this can be customized by changing the environment variable <a href="#private-asdf-install-dir"><code>PRIVATE-ASDF-INSTALL-DIR</code></a>. You are not supposed to edit this file manually - new entries are added automatically whenever you choose the <a href="#restart">corresponding restart</a> during the security check.
     966is stored in a file <code>trusted-uids.lisp</code> and usually resides in the directory <code>~/.asdf-install-dir/</code> but this can be customized by changing the environment variable <a href="#private-asdf-install-dir"><code>PRIVATE_ASDF_INSTALL_DIR</code></a>. You are not supposed to edit this file manually - new entries are added automatically whenever you choose the <a href="#restart">corresponding restart</a> during the security check.
    910967
    911968<br>&nbsp;<br><h3><a class=none name="uninstall">How to uninstall a library</a></h3>
     
    931988
    932989<table border=0>
    933 <tr><td colspan=2 valign=top style='white-space:nowrap'>2004-01-28</td><td>Improved MCL support</td></tr>
    934 <tr><td colspan=2 valign=top style='white-space:nowrap'>2004-01-21</td><td>Support for MCL</td></tr>
     990<tr><td colspan=2 valign=top style='white-space:nowrap'>2004-12-29</td><td>Added COPYRIGHT file to distribution.</td></tr>
     991<tr><td colspan=2 valign=top style='white-space:nowrap'>2004-09-13</td><td>Added information about AllegroCL 7.0 and OpenMCL 0.14.1.</td></tr>
     992<tr><td colspan=2 valign=top style='white-space:nowrap'>2004-09-08</td><td>Fixed typo in <code>GET-ENV-VAR</code> and added special variable <code>*GNU-TAR-PROGRAM*</code> (both thanks to Raymond Toy)</td></tr>
     993<tr><td colspan=2 valign=top style='white-space:nowrap'>2004-05-20</td><td>Changed hyphens to underlines in names of environment variables (thanks to Robert P. Goldman)</td></tr>
     994<tr><td colspan=2 valign=top style='white-space:nowrap'>2004-05-19</td><td>Mentioned Alex Mizrahi's notes, added version number for MK:DEFSYSTEM in docs and SPLIT-SEQUENCE dependency in ASDF system definition (thanks to Robert P. Goldman and Robert Lehr)</td></tr>
     995<tr><td colspan=2 valign=top style='white-space:nowrap'>2004-04-28</td><td>Fixed <code>asdf-install.asd</code> so that it still works and you're not forced to use <code>load-asdf-install.lisp</code></td></tr>
     996<tr><td colspan=2 valign=top style='white-space:nowrap'>2004-04-25</td><td>MK:DEFSYSTEM clarification</td></tr>
     997<tr><td colspan=2 valign=top style='white-space:nowrap'>2004-04-24</td><td>Patches by Marco Antoniotti for MK:DEFSYSTEM compatibility</td></tr>
     998<tr><td colspan=2 valign=top style='white-space:nowrap'>2004-03-27</td><td>Bugfixes by Kiyoshi Mizumaru</td></tr>
     999<tr><td colspan=2 valign=top style='white-space:nowrap'>2004-01-28</td><td>Improved MCL support (James Anderson)</td></tr>
     1000<tr><td colspan=2 valign=top style='white-space:nowrap'>2004-01-21</td><td>Support for MCL by James Anderson</td></tr>
    9351001<tr><td colspan=2 valign=top style='white-space:nowrap'>2004-01-16</td><td>Minor edits, Cygwin CLISP support, download location for <code>asdf.fas</code></td></tr>
    9361002<tr><td colspan=2 valign=top style='white-space:nowrap'>2004-01-15</td><td>Preliminary Windows support, described how to uninstall a library, added <code>*PREFERRED-LOCATION*</code>, removed <code>ln</code> bug in CLISP code</td></tr>
    937 <tr><td valign=top style='white-space:nowrap'>2004-01-13</td><td>&nbsp;</td><td>Mentioned OpenMCL support, added some SBCL exceptions, added clarification about Windows, minor edits, changes by Dan Barlow</td></tr>
     1003<tr><td valign=top style='white-space:nowrap'>2004-01-13</td><td>&nbsp;</td><td>Mentioned OpenMCL support (Marco Baringer), added some SBCL exceptions, added clarification about Windows, minor edits, changes by Dan Barlow</td></tr>
    9381004<tr><td colspan=2 valign=top style='white-space:nowrap'>2004-01-12</td><td>Initial version</td></tr>
    9391005</table>
  • trunk/ccl/tools/asdf-install/installer.lisp

    r503 r926  
    22
    33(pushnew :asdf-install *features*)
     4
     5(defun installer-msg (stream format-control &rest format-arguments)
     6  (apply #'format stream ";;; ASDF-INSTALL: ~@?~%" format-control format-arguments))
     7
    48
    59#+:digitool
     
    1216
    1317(defvar *proxy* (get-env-var "http_proxy"))
     18
    1419(defvar *cclan-mirror*
    1520  (or (get-env-var "CCLAN_MIRROR")
    1621      "http://ftp.linux.org.uk/pub/lisp/cclan/"))
     22
     23#+(or :win32 :mswindows)
     24(defvar *cygwin-bin-directory*
     25  (pathname "C:\\PROGRA~1\\Cygwin\\bin\\"))
     26
     27#+(or :win32 :mswindows)
     28(defvar *cygwin-bash-program*
     29  "C:\\PROGRA~1\\Cygwin\\bin\\bash.exe")
     30
     31(defvar *gnu-tar-program*
     32  "tar"
     33  "Path to the GNU tar program")
     34
     35(eval-when (:compile-toplevel :load-toplevel :execute)
     36  (defparameter *supported-defsystems*
     37    (list :mk-defsystem
     38          :asdf
     39
     40          ;; Add others.
     41          ;; #+lispworks :common-defsystem
     42          ))
     43         
     44
     45  (unless (some (lambda (defsys-tag)
     46                  (member defsys-tag *features*))
     47                *features*)
     48    (error "ASDF-INSTALL requires one of the following \"defsystem\" utilities to work."
     49           *supported-defsystems*)))
     50
     51
    1752
    1853(defun directorify (name)
     
    2762        path)))
    2863
    29 (defvar *sbcl-home* (directorify (or (get-env-var "SBCL_HOME")
    30                                      (get-env-var "ASDF_INSTALL_DIR")
    31                                      (make-pathname :directory
    32                                                     `(:absolute
    33                                                       #+digitool ,*home-volume-name*
    34                                                       "usr" "local" "asdf-install")))))
    35 
    36 (defvar *dot-sbcl*
     64(defvar *asdf-install-dirs*
     65  (directorify (or #+sbcl (get-env-var "SBCL_HOME")
     66                   (get-env-var "ASDF_INSTALL_DIR")
     67                   (make-pathname :directory
     68                                  `(:absolute
     69                                    #+digitool ,*home-volume-name*
     70                                    "usr" "local" "asdf-install")))))
     71
     72#+sbcl ; Deprecated.
     73(define-symbol-macro *sbcl-home* *asdf-install-dirs*)
     74
     75
     76(defvar *private-asdf-install-dirs*
    3777  #+:sbcl
    3878  (merge-pathnames (make-pathname :directory '(:relative ".sbcl"))
     
    4484          (merge-pathnames (make-pathname :directory '(:relative ".asdf-install-dir"))
    4585                           (truename (user-homedir-pathname))))))
     86
     87#+sbcl ; Deprecated.
     88(define-symbol-macro *dot-sbcl* *private-asdf-install-dirs*)
     89
    4690
    4791(defvar *trusted-uids* nil)
     
    65109      (t t))))
    66110         
    67 (defvar *locations*
    68   `((,(merge-pathnames (make-pathname :directory '(:relative "site")) *sbcl-home*)
    69      ,(merge-pathnames (make-pathname :directory '(:relative "site-systems")) *sbcl-home*)
     111(defparameter *locations*
     112  `((,(merge-pathnames (make-pathname :directory '(:relative "site"))
     113                       *asdf-install-dirs*)
     114     ,(merge-pathnames (make-pathname :directory '(:relative "site-systems"))
     115                       *asdf-install-dirs*)
    70116     "System-wide install")
    71     (,(merge-pathnames (make-pathname :directory '(:relative "site")) *dot-sbcl*)
    72      ,(merge-pathnames (make-pathname :directory '(:relative "systems")) *dot-sbcl*)
     117    (,(merge-pathnames (make-pathname :directory '(:relative "site"))
     118                       *private-asdf-install-dirs*)
     119     ,(merge-pathnames (make-pathname :directory '(:relative "systems"))
     120                       *private-asdf-install-dirs*)
    73121     "Personal installation")))
    74122
    75 #-:sbcl
    76 (pushnew `(merge-pathnames ,(make-pathname :directory '(:relative "site-systems")) ,*sbcl-home*)
     123
     124#+(and (not :sbcl) :asdf)
     125(pushnew `(merge-pathnames ,(make-pathname :directory '(:relative "site-systems"))
     126                           ,*asdf-install-dirs*)
    77127         asdf:*central-registry*
    78128         :test #'equal)
    79129
    80 #-:sbcl
    81 (pushnew `(merge-pathnames ,(make-pathname :directory '(:relative "systems")) ,*dot-sbcl*)
     130#+(and (not :sbcl) :asdf)
     131(pushnew `(merge-pathnames ,(make-pathname :directory '(:relative "systems"))
     132                           ,*private-asdf-install-dirs*)
    82133         asdf:*central-registry*
    83134         :test #'equal)
    84135
    85 (let* ((*package* (find-package :asdf-install-customize))
    86        (file (probe-file (merge-pathnames
    87                           (make-pathname :name ".asdf-install")
    88                           (truename (user-homedir-pathname))))))
    89   (when file (load file)))
     136#+mk-defsystem
     137(mk:add-registry-location
     138 (merge-pathnames (make-pathname :directory '(:relative "site-systems"))
     139                  *private-asdf-install-dirs*))
     140
     141#+mk-defsystem
     142(mk:add-registry-location
     143 (merge-pathnames (make-pathname :directory '(:relative "systems"))
     144                  *private-asdf-install-dirs*))
     145
     146
     147;;; Fixing the handling of *LOCATIONS*
     148
     149(defun add-locations (loc-name site system-site)
     150  (declare (type string loc-name)
     151           (type pathname site system-site))
     152  #+asdf
     153  (progn
     154    (pushnew site asdf:*central-registry* :test #'equal)
     155    (pushnew system-site asdf:*central-registry* :test #'equal))
     156
     157  #+mk-defsystem
     158  (progn
     159    (mk:add-registry-location site)
     160    (mk:add-registry-location system-site))
     161  (setf *locations*
     162        (append *locations* (list (list site system-site loc-name)))))
     163
     164
     165
     166(eval-when (:load-toplevel :execute)
     167  (let* ((*package* (find-package :asdf-install-customize))
     168         (file (probe-file (merge-pathnames
     169                            (make-pathname :name ".asdf-install")
     170                            (truename (user-homedir-pathname)))))
     171         )
     172    (when file (load file))))
     173
     174
     175;;;---------------------------------------------------------------------------
     176;;; Conditions.
    90177
    91178(define-condition download-error (error)
     
    109196
    110197(define-condition no-signature (gpg-error) ())
     198
    111199(define-condition key-not-found (gpg-error)
    112200  ((key-id :initarg :key-id :reader key-id))
    113201  (:report (lambda (c s)
    114              (format s "No key found for key id 0x~A.  Try some command like ~%  gpg  --recv-keys 0x~A"
     202             (format s "No key found for key id 0x~A. ~
     203                        Try some command like ~%  gpg  --recv-keys 0x~A"
    115204                     (key-id c) (key-id c)))))
    116205
     
    121210             (format s "GPG warns that the key id 0x~A (~A) is not fully trusted"
    122211                     (key-id c) (key-user-name c)))))
     212
    123213(define-condition author-not-trusted (gpg-error)
    124214  ((key-id :initarg :key-id :reader key-id)
     
    128218                     (key-user-name c) (key-id c)))))
    129219 
     220
     221;;;---------------------------------------------------------------------------
     222;;; URL handling.
     223
    130224(defun url-host (url)
    131225  (assert (string-equal url "http://" :end1 7))
     
    138232  (assert (string-equal url "http://" :end1 7))
    139233  (let ((port-start (position #\: url :start 7)))
    140     (if port-start (parse-integer url :start port-start :junk-allowed t) 80)))
     234    (if port-start (parse-integer url :start (1+ port-start) :junk-allowed t) 80)))
    141235
    142236(defun url-connection (url)
    143   (let ((stream (make-stream-from-url url))
     237  (let ((stream (make-stream-from-url (or *proxy* url)))
    144238        (host (url-host url)))
    145239    (format stream "GET ~A HTTP/1.0~C~CHost: ~A~C~CCookie: CCLAN-SITE=~A~C~C~C~C"
     
    188282       stream))))
    189283
     284
    190285(defun download-files-for-package (package-name-or-url file-name)
    191   (let ((url
    192          (if (= (mismatch package-name-or-url "http://") 7)
    193              package-name-or-url
    194              (format nil "http://www.cliki.net/~A?download"
    195                      package-name-or-url))))
     286  (let ((url (if (= (mismatch package-name-or-url "http://") 7)
     287                 package-name-or-url
     288                 (format nil "http://www.cliki.net/~A?download"
     289                         package-name-or-url)))
     290        )
    196291    (destructuring-bind (response headers stream)
    197292        (block got
     
    202297             (close stream)
    203298             (setf url (cdr (assoc :location headers))))))
    204       (if (>= response 400)
    205         (error 'download-error :url url :response response))
    206       (let ((length (parse-integer
    207                      (or (cdr (assoc :content-length headers)) "")
    208                      :junk-allowed t)))
    209         (format t "Downloading ~A bytes from ~A to ~A ..."
    210                 (or length "some unknown number of") url file-name)
     299      (when (>= response 400)
     300        (error 'download-error :url url :response response))
     301      (let ((length (parse-integer (or (cdr (assoc :content-length headers)) "")
     302                                   :junk-allowed t)))
     303        (installer-msg t "Downloading ~A bytes from ~A to ~A ..."
     304                       (or length "some unknown number of")
     305                       url
     306                       file-name)
    211307        (force-output)
    212308        #+:clisp (setf (stream-element-type stream)
    213                          '(unsigned-byte 8))
     309                       '(unsigned-byte 8))
    214310        (with-open-file (o file-name :direction :output
    215                                      #+(or :clisp :digitool (and :lispworks :win32))
    216                                      :element-type
    217                                      #+(or :clisp :digitool (and :lispworks :win32))
    218                                      '(unsigned-byte 8)
    219                                      :if-exists :supersede)
     311                           #+(or :clisp :digitool (and :lispworks :win32))
     312                           :element-type
     313                           #+(or :clisp :digitool (and :lispworks :win32))
     314                           '(unsigned-byte 8)
     315                           :if-exists :supersede)
    220316          #+(or :cmu :digitool)
    221317          (copy-stream stream o)
     
    234330          (verify-gpg-signature/url url file-name)
    235331        (skip-gpg-check (&rest rest)
    236           :report "Don't ckeck GPG signature for this package"
    237           (declare (ignore rest))
    238           nil)))))
     332                        :report "Don't ckeck GPG signature for this package"
     333                        (declare (ignore rest))
     334                        nil)))))
     335
    239336
    240337(defun read-until-eof (stream)
    241338  (with-output-to-string (o)
    242339    (copy-stream stream o)))
     340
    243341 
    244342(defun verify-gpg-signature/string (string file-name)
     
    251349            when (> (mismatch l "[GNUPG:]") 6)
    252350            do (destructuring-bind (_ tag &rest data)
    253                    (asdf::split l)
     351                   (split-sequence:split-sequence-if (lambda (x)
     352                                                       (find x '(#\Space #\Tab)))
     353                                                     l)
    254354               (declare (ignore _))
    255355               (pushnew (cons (intern tag :keyword)
     
    285385         (return))))))
    286386
     387
    287388(defun verify-gpg-signature/url (url file-name)
    288389  (when (verify-gpg-signatures-p url)
     
    313414        (close stream)))))
    314415
     416
     417(define-condition installation-abort (condition)
     418  ()
     419  (:report (lambda (c s)
     420             (declare (ignore c))
     421             (installer-msg s "Installation aborted."))))
     422
     423
    315424(defun where ()
    316   (let ((response (or *preferred-location*             
    317                       (progn
    318                         (format t "Install where?~%")
    319                         (loop for (source system name) in *locations*
    320                               for i from 1
    321                               do (format t "~A) ~A: ~%   System in ~A~%   Files in ~A ~%"
    322                                          i name system source))
    323                         (format t " --> ")
    324                         (force-output)
    325                         (read)))))
    326     (when (> response 0)
    327       (elt *locations* (1- response)))))
    328 
     425  (loop with n-locations = (length *locations*)
     426        for response = (or *preferred-location*             
     427                           (progn
     428                             (format t "Install where?~%")
     429                             (loop for (source system name) in *locations*
     430                                   for i from 0
     431                                   do (format t "~A) ~A: ~%   System in ~A~%   Files in ~A ~%"
     432                                              i name system source))
     433                             (format t "~D) Abort installation.~% --> " n-locations)
     434                             (force-output)
     435                             (read)))
     436        when (and (numberp response)
     437                  (<= 0 response (1- n-locations)))
     438           return (elt *locations* response)
     439        when (and (numberp response)
     440                  (= response n-locations))
     441           do (abort (make-condition 'installation-abort))))
     442
     443
     444;;; install-package --
     445
     446(defun install-package (source system packagename)
     447  "Returns a list of system names (ASDF or MK:DEFSYSTEM) for installed systems."
     448  (ensure-directories-exist source)
     449  (ensure-directories-exist system)
     450  (let* ((tar
     451          (or #-(or :win32 :mswindows)
     452              (return-output-from-program *gnu-tar-program*
     453                                          (list "-C" (namestring (truename source))
     454                                                "-xzvf" (namestring (truename packagename))))
     455              #+(or :win32 :mswindows)
     456              (return-output-from-program *cygwin-bash-program*
     457                                          (list "-l"
     458                                                "-c"
     459                                                (format nil "\"tar -C \\\"`cygpath '~A'`\\\" -xzvf \\\"`cygpath '~A'`\\\"\""
     460                                                        (namestring (truename source))
     461                                                        (namestring (truename packagename)))))
     462              (error "ASDF-INSTALL: can't untar ~S." packagename)))
     463         (pos-slash (or (position #\/ tar)
     464                        (position #\Return tar)
     465                        (position #\Linefeed tar)))
     466         (*default-pathname-defaults*
     467          (merge-pathnames
     468           (make-pathname :directory
     469                          `(:relative ,(subseq tar 0 pos-slash)))
     470           source))
     471         )
     472    (princ tar)
     473    (loop for sysfile in (append
     474                          (directory
     475                           (make-pathname :defaults (print *default-pathname-defaults*)
     476                                          :name :wild
     477                                          :type "asd"))
     478                          (directory
     479                           (make-pathname :defaults (print *default-pathname-defaults*)
     480                                          :name :wild
     481                                          :type "system")))
     482          #-(or :win32 :mswindows)
     483          do
     484          #-(or :win32 :mswindows)
     485          (let ((target (merge-pathnames
     486                         (make-pathname :name (pathname-name sysfile)
     487                                        :type (pathname-type sysfile))
     488                         system)))
     489            (when (probe-file target)
     490              (unlink-file target))
     491            (symlink-files sysfile target))
     492          collect sysfile)))
     493
     494
     495#| Original
    329496(defun install-package (source system packagename)
    330497  "Returns a list of asdf system names for installed asdf systems"
     
    355522    (loop for asd in (directory
    356523                      (make-pathname :defaults (print *default-pathname-defaults*)
    357                                      :name :wild :type "asd"))
     524                                     :name :wild
     525                                     :type "asd"))
    358526          #-(or :win32 :mswindows)
    359527          do
     
    367535            (symlink-files asd target))
    368536          collect (pathname-name asd))))
     537|#
     538
    369539
    370540(defun temp-file-name (p)
     
    377547     #+:clisp (user-homedir-pathname))))
    378548
    379 ;; this is the external entry point
     549
     550;;; install
     551;;; This is the external entry point.
     552
    380553(defun install (&rest packages)
    381554  (let ((*temporary-files* nil)
    382555        (*trusted-uids*
    383          (let ((p (merge-pathnames "trusted-uids.lisp" *dot-sbcl*)))
     556         (let ((p (merge-pathnames "trusted-uids.lisp" *private-asdf-install-dirs*)))
     557           (when (probe-file p)
     558             (with-open-file (f p) (read f)))))
     559        ;; (installed-packages nil)
     560        )
     561    (unwind-protect
     562        (destructuring-bind (source system name) (where)
     563          (declare (ignore name))
     564          (labels ((one-iter (packages)
     565                     (let ((installed-package-sysfiles
     566                            (loop for p in (mapcar #'string packages)
     567                                  unless
     568                                  #+(or :sbcl :alisp) (probe-file p)
     569                                  #-(or :sbcl :alisp) (and (/= (mismatch p "http://") 7)
     570                                                           (probe-file p))
     571                                  do (let ((tmp (temp-file-name p)))
     572                                       (pushnew tmp *temporary-files*)
     573                                       (download-files-for-package p tmp)
     574                                       (setf p tmp))
     575                                  end
     576                                  do (installer-msg t "Installing ~A in ~A, ~A"
     577                                                    p
     578                                                    source
     579                                                    system)
     580                                  append (install-package source
     581                                                          system
     582                                                          p)))
     583                           )
     584                     (dolist (sysfile installed-package-sysfiles)
     585                       (handler-bind
     586                           (
     587                           #+asdf
     588                           (asdf:missing-dependency
     589                            (lambda (c)
     590                              (installer-msg t
     591                                             "Downloading package ~A, required by ~A~%"
     592                                             (asdf::missing-requires c)
     593                                             (asdf:component-name
     594                                              (asdf::missing-required-by c)))
     595                              (one-iter (list
     596                                         (symbol-name
     597                                          (asdf::missing-requires c))))
     598                              (invoke-restart 'retry)))
     599
     600                           #+mk-defsystem
     601                           (make:missing-component
     602                            (lambda (c)
     603                              (installer-msg t
     604                                             "Downloading package ~A, required by ~A~%"
     605                                           (make:missing-component-name c)
     606                                           (pathname-name sysfile) ; This should work.
     607                                           )
     608                              (one-iter (list (make:missing-component-name c)))
     609                              (invoke-restart 'retry)))
     610                            )
     611
     612                         (loop (multiple-value-bind (ret restart-p)
     613                                   (with-simple-restart
     614                                       (retry "Retry installation")
     615                                     (load-system-definition sysfile))
     616                                 (declare (ignore ret))
     617                                 (unless restart-p (return))))
     618                         ))))
     619                   )
     620            (one-iter packages)))
     621      (let ((p (merge-pathnames "trusted-uids.lisp" *private-asdf-install-dirs*)))
     622        (when (probe-file p)
     623          (with-open-file (out p
     624                               :direction :output
     625                               :if-exists :supersede)
     626            (with-standard-io-syntax
     627              (prin1 *trusted-uids* out)))))
     628      (dolist (l *temporary-files* t)
     629        (when (probe-file l) (delete-file l))))))
     630
     631
     632(defun load-system-definition (sysfile)
     633  (declare (type pathname sysfile))
     634  #+asdf
     635  (when (or (string-equal "asd" (pathname-type sysfile))
     636            (string-equal "asdf" (pathname-type sysfile)))
     637    (installer-msg t "Loading system ~S via ASDF." (pathname-name sysfile))
     638    (asdf:operate 'asdf:load-op (pathname-name sysfile)))
     639
     640  #+mk-defsystem
     641  (when (string-equal "system" (pathname-type sysfile))
     642    (installer-msg t "Loading system ~S via MK:DEFSYSTEM." (pathname-name sysfile))
     643    (mk:load-system (pathname-name sysfile))))
     644
     645
     646#| Original.
     647(defun install (&rest packages)
     648  (let ((*temporary-files* nil)
     649        (*trusted-uids*
     650         (let ((p (merge-pathnames "trusted-uids.lisp" *private-asdf-install-dirs*)))
    384651           (when (probe-file p)
    385652             (with-open-file (f p) (read f))))))
    386653    (unwind-protect
    387         (destructuring-bind (source system name) (where)
    388            (declare (ignore name))
    389            (labels ((one-iter (packages)
    390                       (dolist (asd
    391                                 (loop for p in (mapcar 'string packages)
    392                                       unless #+(or :sbcl :alisp)
    393                                              (probe-file p)
    394                                              #-(or :sbcl :alisp)
    395                                              (and (/= (mismatch p "http://") 7)
    396                                                   (probe-file p))
    397                                       do (let ((tmp (temp-file-name p)))
    398                                            (pushnew tmp *temporary-files*)
    399                                            (download-files-for-package p tmp)
    400                                            (setf p tmp))
    401                                       end
    402                                       do (format t "Installing ~A in ~A,~A~%"
    403                                                 p source system)
    404                                       append (install-package source system p)))
    405                         (handler-bind
    406                             ((asdf:missing-dependency
    407                               (lambda (c)
    408                                 (format t
    409                                         "Downloading package ~A, required by ~A~%"
    410                                         (asdf::missing-requires c)
    411                                         (asdf:component-name
    412                                         (asdf::missing-required-by c)))
    413                                 (one-iter (list
    414                                            (symbol-name
    415                                             (asdf::missing-requires c))))
    416                                 (invoke-restart 'retry))))
    417                           (loop
    418                            (multiple-value-bind (ret restart-p)
    419                                (with-simple-restart
    420                                    (retry "Retry installation")
    421                                 (asdf:operate 'asdf:load-op asd))
    422                              (declare (ignore ret))
    423                              (unless restart-p (return))))))))
    424              (one-iter packages)))
    425       (let ((p (merge-pathnames "trusted-uids.lisp" *dot-sbcl*)))
     654        (destructuring-bind (source system name) (where)
     655          (declare (ignore name))
     656          (labels ((one-iter (packages)
     657                     (dolist (asd
     658                              (loop for p in (mapcar 'string packages)
     659                                    unless #+(or :sbcl :alisp)
     660                                    (probe-file p)
     661                                    #-(or :sbcl :alisp)
     662                                    (and (/= (mismatch p "http://") 7)
     663                                         (probe-file p))
     664                                    do (let ((tmp (temp-file-name p)))
     665                                         (pushnew tmp *temporary-files*)
     666                                         (download-files-for-package p tmp)
     667                                         (setf p tmp))
     668                                    end
     669                                    do (format t "Installing ~A in ~A,~A~%"
     670                                              p source system)
     671                                    append (install-package source system p)))
     672                       (handler-bind
     673                           ((asdf:missing-dependency
     674                             (lambda (c)
     675                               (format t
     676                                       "Downloading package ~A, required by ~A~%"
     677                                       (asdf::missing-requires c)
     678                                       (asdf:component-name
     679                                        (asdf::missing-required-by c)))
     680                               (one-iter (list
     681                                          (symbol-name
     682                                           (asdf::missing-requires c))))
     683                               (invoke-restart 'retry))))
     684                         (loop
     685                          (multiple-value-bind (ret restart-p)
     686                              (with-simple-restart
     687                                  (retry "Retry installation")
     688                                (asdf:operate 'asdf:load-op asd))
     689                            (declare (ignore ret))
     690                            (unless restart-p (return))))))))
     691            (one-iter packages)))
     692      (let ((p (merge-pathnames "trusted-uids.lisp" *private-asdf-install-dirs*)))
    426693        (with-open-file (out p :direction :output
    427                                :if-exists :supersede)
     694                             :if-exists :supersede)
    428695          (with-standard-io-syntax
    429696            (prin1 *trusted-uids* out))))
    430697      (dolist (l *temporary-files*)
    431698        (when (probe-file l) (delete-file l))))))
    432 
     699|#
     700
     701
     702;;; uninstall --
     703
     704(defun uninstall (system &optional (prompt t))
     705  #+asdf
     706  (let* ((asd (asdf:system-definition-pathname system))
     707         (system (asdf:find-system system))
     708         (dir (asdf::pathname-sans-name+type
     709               (asdf::resolve-symlinks asd))))
     710    (when (or (not prompt)
     711              (y-or-n-p
     712               "Delete system ~A~%asd file: ~A~%sources: ~A~%Are you sure?"
     713               system asd dir))
     714      #-(or :win32 :mswindows)
     715      (delete-file asd)
     716      (asdf:run-shell-command "rm -r '~A'" (namestring (truename dir)))))
     717
     718  #+mk-defsystem
     719  (multiple-value-bind (sysfile sysfile-exists-p)
     720      (mk:system-definition-pathname system)
     721    (when sysfile-exists-p
     722      (let ((system (ignore-errors (mk:find-system system :error))))
     723        (when system
     724          (when (or (not prompt)
     725                    (y-or-n-p
     726                     "Delete system ~A.~%system file: ~A~%Are you sure?"
     727                     system
     728                     sysfile))
     729            (mk:clean-system system)
     730            (delete-file sysfile)
     731            (dolist (f (mk:files-in-system system))
     732              (delete-file f)))
     733          ))
     734      )))
     735
     736
     737#| Original
    433738(defun uninstall (system &optional (prompt t))
    434739  (let* ((asd (asdf:system-definition-pathname system))
     
    442747      #-(or :win32 :mswindows)
    443748      (delete-file asd)
    444       (asdf:run-shell-command "rm -r '~A'" (system-namestring dir)))))
     749      (asdf:run-shell-command "rm -r '~A'" (namestring (truename dir))))))
     750|#
     751
    445752     
    446753;;; some day we will also do UPGRADE, but we need to sort out version
    447754;;; numbering a bit better first
    448755
    449 #+(or :win32 :mswindows)
     756#+(and :asdf (or :win32 :mswindows))
    450757(defun sysdef-source-dir-search (system)
    451758  (let ((name (asdf::coerce-name system)))
     
    463770          (when (probe-file file)
    464771            (return-from sysdef-source-dir-search file)))))))
     772
     773;;; end of file -- install.lisp --
  • trunk/ccl/tools/asdf-install/port.lisp

    r503 r926  
    1515(defun get-env-var (name)
    1616  #+:sbcl (sb-ext:posix-getenv name)
    17   #+:cmu (cdr (assoc (intern (substitute #\- #\_ name)
     17  #+:cmu (cdr (assoc (intern (substitute #\_ #\- name)
    1818                            :keyword)
    1919                    ext:*environment-list*))
     
    3939    (unless truename
    4040      (setf truename
    41               (translate-logical-pathname (merge-pathnames pathname *default-pathname-defaults*))))
     41              (translate-logical-pathname
     42               (merge-pathnames pathname *default-pathname-defaults*))))
    4243    (let ((directory (pathname-directory truename)))
    4344      (flet ((string-or-nil (value) (when (stringp value) value))
     
    4849                (absolute-p directory)
    4950                (if (root-volume-p directory) (cddr directory) (cdr directory))
    50                 (string-or-nil (pathname-name truename)) (string-or-nil (pathname-type truename)))))))
     51                (string-or-nil (pathname-name truename))
     52                (string-or-nil (pathname-type truename)))))))
    5153
    5254#+:digitool
     
    7476                         :element-type (stream-element-type from))))
    7577    (loop
    76      (let ((pos #-:clisp (read-sequence buf from)
    77                 #+:clisp (ext:read-byte-sequence buf from :no-hang nil)))
     78     (let ((pos #-(or :clisp :cmu) (read-sequence buf from)
     79                #+:clisp (ext:read-byte-sequence buf from :no-hang nil)
     80                #+:cmu (sys:read-n-bytes from buf 0 *stream-buffer-size* nil)))
    7881       (when (zerop pos) (return))
    7982       (write-sequence buf to :end pos)))))
     
    102105    (sb-bsd-sockets:socket-connect
    103106     s (car (sb-bsd-sockets:host-ent-addresses
    104              (sb-bsd-sockets:get-host-by-name (url-host (or *proxy* url)))))
    105      (url-port (or *proxy* url)))
     107             (sb-bsd-sockets:get-host-by-name (url-host url))))
     108     (url-port url))
    106109    (sb-bsd-sockets:socket-make-stream s :input t :output t :buffering :full))
    107110  #+:cmu
Note: See TracChangeset for help on using the changeset viewer.