X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fasdf-install%2Finstaller.lisp;h=d17d7e1bcdf5988f2133ab517d85d299cad5f1e3;hb=ded744f74ab2f1a97679ad4f91e0eb8d995daef2;hp=5e7f970bd0ff8b69730c4f5c96d9c68190d7b24e;hpb=1e9a538c32223df9132c1e7fb2b67a2129c40a8d;p=sbcl.git diff --git a/contrib/asdf-install/installer.lisp b/contrib/asdf-install/installer.lisp index 5e7f970..d17d7e1 100644 --- a/contrib/asdf-install/installer.lisp +++ b/contrib/asdf-install/installer.lisp @@ -11,9 +11,9 @@ (let ((path (pathname name))) (if (pathname-name path) (merge-pathnames - (make-pathname :directory `(:relative ,(pathname-name path)) - :name "") - path) + (make-pathname :directory `(:relative ,(pathname-name path))) + (make-pathname :directory (pathname-directory path) + :host (pathname-host path))) path))) (defvar *sbcl-home* (directorify (posix-getenv "SBCL_HOME"))) @@ -99,7 +99,7 @@ (defun url-port (url) (assert (string-equal url "http://" :end1 7)) (let ((port-start (position #\: url :start 7))) - (if port-start (parse-integer url :start port-start :junk-allowed t) 80))) + (if port-start (parse-integer url :start (1+ port-start) :junk-allowed t) 80))) (defun url-connection (url) (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)) @@ -163,7 +163,7 @@ (restart-case (verify-gpg-signature/url url file-name) (skip-gpg-check (&rest rest) - :report "Don't ckeck GPG signature for this package" + :report "Don't check GPG signature for this package" nil))))) (defun read-until-eof (stream) @@ -249,7 +249,8 @@ (let* ((tar (with-output-to-string (o) (or - (sb-ext:run-program "tar" + (sb-ext:run-program #-darwin "tar" + #+darwin "gnutar" (list "-C" (namestring source) "-xzvf" (namestring packagename)) :output o @@ -327,7 +328,7 @@ (one-iter packages))) (let ((p (merge-pathnames "trusted-uids.lisp" *dot-sbcl*))) (ensure-directories-exist p) - (with-open-file (out p :direction :output) + (with-open-file (out p :direction :output :if-exists :supersede) (with-standard-io-syntax (prin1 *trusted-uids* out)))) (dolist (l *temporary-files*)