(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")))
(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))
(socket-connect
s (car (host-ent-addresses (get-host-by-name (url-host (or *proxy* url)))))
(url-port (or *proxy* url)))
- (let ((stream (socket-make-stream s :input t :output t :buffering :full)))
+ (let ((stream (socket-make-stream s :input t :output t :buffering :full :external-format :iso-8859-1)))
;; we are exceedingly unportable about proper line-endings here.
;; Anyone wishing to run this under non-SBCL should take especial care
(format stream "GET ~A HTTP/1.0~%Host: ~A~%Cookie: CCLAN-SITE=~A~%~%"
(format t "Downloading ~A bytes from ~A ..."
(if length length "some unknown number of") url)
(force-output)
- (with-open-file (o file-name :direction :output)
+ (with-open-file (o file-name :direction :output :external-format :iso-8859-1)
(if length
(let ((buf (make-array length
:element-type
- (stream-element-type stream) )))
+ (stream-element-type stream))))
(read-sequence buf stream)
(write-sequence buf o))
(sb-executable:copy-stream stream o))))
(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)
(return))))))
+
(defun verify-gpg-signature/url (url file-name)
(destructuring-bind (response headers stream)
(url-connection (concatenate 'string url ".asc"))
(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
(unless restart-p (return))))))))
(one-iter packages)))
(let ((p (merge-pathnames "trusted-uids.lisp" *dot-sbcl*)))
- (with-open-file (out p :direction :output)
+ (ensure-directories-exist p)
+ (with-open-file (out p :direction :output :if-exists :supersede)
(with-standard-io-syntax
(prin1 *trusted-uids* out))))
(dolist (l *temporary-files*)
(when (probe-file l) (delete-file l))))))
+
+(defun uninstall (system &optional (prompt t))
+ (let* ((asd (asdf:system-definition-pathname system))
+ (system (asdf:find-system system))
+ (dir (asdf::pathname-sans-name+type
+ (asdf::resolve-symlinks asd))))
+ (when (or (not prompt)
+ (y-or-n-p
+ "Delete system ~A~%asd file: ~A~%sources: ~A~%Are you sure?"
+ system asd dir))
+ (delete-file asd)
+ (asdf:run-shell-command "rm -r ~A" (namestring dir)))))
+
+;;; some day we will also do UPGRADE, but we need to sort out version
+;;; numbering a bit better first