From 68ea71d0f020f2726e3c56c1ec491d0af734b3a4 Mon Sep 17 00:00:00 2001
From: Juho Snellman <jsnell@iki.fi>
Date: Sun, 3 Sep 2006 01:55:03 +0000
Subject: [PATCH] 0.9.16.16:         Add bsd tar support to ASDF-INSTALL
 (patch by "bsd1628", sbcl-devel         "Changes to
 ASDf-INSTALL to support NetBSD tar" on 2006-08-04).

---
 NEWS                                |    1 +
 contrib/asdf-install/installer.lisp |   53 ++++++++++++++++++++++-------------
 version.lisp-expr                   |    2 +-
 3 files changed, 36 insertions(+), 20 deletions(-)

diff --git a/NEWS b/NEWS
index 1d13184..52e46fd 100644
--- a/NEWS
+++ b/NEWS
@@ -18,6 +18,7 @@ changes in sbcl-0.9.17 (0.9.99?) relative to sbcl-0.9.16:
     (reported by Marco Monteiro)
   * bug fix: The :PTY argument for RUN-PROGRAM will now work on 
     systems with Unix98 pty semantics.
+  * bug fix: ASDF-INSTALL will now work with bsd tar.
 
 changes in sbcl-0.9.16 relative to sbcl-0.9.15:
   * feature: implemented the READER-METHOD-CLASS and
diff --git a/contrib/asdf-install/installer.lisp b/contrib/asdf-install/installer.lisp
index db89bf4..e20d6cf 100644
--- a/contrib/asdf-install/installer.lisp
+++ b/contrib/asdf-install/installer.lisp
@@ -254,29 +254,44 @@
     (when (> response 0)
       (elt *locations* (1- response)))))
 
+(defparameter *tar-program*
+  (or #+darwin "gnutar"
+      "tar"))
+
+(defun get-tar-directory (packagename)
+  (let* ((tar (with-output-to-string (o)
+                (or
+                 (sb-ext:run-program *tar-program*
+                                     (list "-tzf" (namestring packagename))
+                                     :output o
+                                     :search t
+                                     :wait t)
+                 (error "can't list archive"))))
+         (first-line (subseq tar 0 (position #\newline tar))))
+    (if (find #\/ first-line)
+        (subseq first-line 0 (position #\/ first-line))
+        first-line)))
+
+(defun untar-package (source packagename)
+  (with-output-to-string (o)
+    (or
+     (sb-ext:run-program *tar-program*
+                         (list "-C" (namestring source)
+                               "-xzvf" (namestring packagename))
+                         :output o
+                         :search t
+                         :wait t)
+     (error "can't untar"))))
+
 (defun install-package (source system packagename)
   "Returns a list of asdf system names for installed asdf systems"
   (ensure-directories-exist source)
-    (ensure-directories-exist system)
-  (let* ((tar
-          (with-output-to-string (o)
-            (or
-             (sb-ext:run-program #-darwin "tar"
-                                 #+darwin "gnutar"
-                                 (list "-C" (namestring source)
-                                       "-xzvf" (namestring packagename))
-                                 :output o
-                                 :search t
-                                 :wait t)
-             (error "can't untar"))))
-         (dummy (princ tar))
-         (pos-slash (position #\/ tar))
+  (ensure-directories-exist system)
+  (let* ((tdir (get-tar-directory packagename))
          (*default-pathname-defaults*
-          (merge-pathnames
-           (make-pathname :directory
-                          `(:relative ,(subseq tar 0 pos-slash)))
-           source)))
-    (declare (ignore dummy))
+          (merge-pathnames (make-pathname :directory `(:relative ,tdir))
+                           source)))
+    (princ (untar-package source packagename))
     (loop for asd in (directory
                       (make-pathname :name :wild :type "asd"))
           do (let ((target (merge-pathnames
diff --git a/version.lisp-expr b/version.lisp-expr
index f2dca4d..3e55064 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.16.15"
+"0.9.16.16"
-- 
1.7.10.4