mirror of
https://github.com/roswell/roswell.git
synced 2026-09-10 07:16:17 -04:00
84 lines
3.3 KiB
Common Lisp
84 lines
3.3 KiB
Common Lisp
(roswell:include "util-install")
|
|
(defpackage :roswell.install.quicklisp
|
|
(:use :cl :roswell.install :roswell.util :roswell.locations))
|
|
(in-package :roswell.install.quicklisp)
|
|
|
|
(defun quicklisp-help (argv)
|
|
(format *error-output* "no options for quicklisp~%")
|
|
(cons t argv))
|
|
|
|
(defun quicklisp-patch (path)
|
|
(with-open-file (out (ensure-directories-exist (merge-pathnames "local-init/roswell.lisp" path))
|
|
:direction :output :if-exists :supersede)
|
|
(format out "(roswell:include \"patch-quicklisp\")~%")))
|
|
|
|
(defun quicklisp-argv-parse (argv)
|
|
(set-opt "download.uri" (format nil "~A~A" (quicklisp-uri) "quicklisp.lisp"))
|
|
(set-opt "download.archive" (merge-pathnames "archives/quicklisp.lisp" (homedir)))
|
|
(let ((pos (position "--path" (getf argv :argv) :test 'equal)))
|
|
(and pos (ignore-errors (nth (1+ pos) (getf argv :argv)))
|
|
(set-opt "quicklisp" (nth (1+ pos) (getf argv :argv)))))
|
|
(cons t argv))
|
|
|
|
(defun quicklisp-download (argv)
|
|
(if (or (not (probe-file (opt "download.archive")))
|
|
(opt "download.force"))
|
|
(progn
|
|
(format t "~&Downloading archive: ~A~%" (opt "download.uri"))
|
|
(download (opt "download.uri") (opt "download.archive")))
|
|
(format t "~&Skip downloading ~A.~%Specify 'download.force=t' to download again.~%"
|
|
(opt "download.uri")))
|
|
(cons (not (opt "without-install")) argv))
|
|
|
|
(defun quicklisp-install (argv)
|
|
#-win32
|
|
#+sbcl
|
|
(ignore-errors
|
|
(require :sb-posix)
|
|
(let ((gid (sb-posix:getenv "SUDO_GID")))
|
|
(sb-posix:setgid (parse-integer gid)))
|
|
(let ((uid (sb-posix:getenv "SUDO_UID")))
|
|
(sb-posix:setuid (parse-integer uid))))
|
|
(let*((archive (opt "download.archive"))
|
|
(env (opt "roswellenv"))
|
|
(path (if env
|
|
(merge-pathnames (format nil "env/~A/lisp/quicklisp/" env) (homedir))
|
|
(opt "quicklisp"))))
|
|
(when env
|
|
(setf (config "quicklisp" :where env) env))
|
|
(quicklisp-patch path)
|
|
(cond
|
|
((probe-file (merge-pathnames "setup.lisp" path))
|
|
(format *error-output* "Quicklisp is already setup.~%"))
|
|
(t
|
|
(when (find-package :ql)
|
|
(delete-package :ql)
|
|
(defpackage #:quicklisp
|
|
(:export #:setup))
|
|
(setf (fdefinition (intern (string :setup) (find-package :quicklisp)))
|
|
(lambda())))
|
|
(let ((*standard-output* (make-broadcast-stream)))
|
|
(load archive))
|
|
;; use roswell to download everithing.
|
|
(setf (fdefinition (find-symbol (string :fetch) :qlqs-http))
|
|
(lambda (url file &key (follow-redirects t) quietly
|
|
(maximum-redirects 10))
|
|
"Request URL and write the body of the response to FILE."
|
|
(declare (ignorable url file follow-redirects quietly
|
|
maximum-redirects))
|
|
(download url file)))
|
|
(let ((*standard-output* (make-broadcast-stream)))
|
|
(funcall (intern (string :install) (find-package :quicklisp-quickstart))
|
|
:path path
|
|
:proxy (opt "quicklisp.proxy")
|
|
:client-url (opt "quicklisp.client")
|
|
:dist-url (opt "quicklisp.dist"))))))
|
|
(cons t argv))
|
|
|
|
(defun quicklisp (type)
|
|
(case type
|
|
(:help '(quicklisp-help))
|
|
(:install '(quicklisp-argv-parse
|
|
quicklisp-download
|
|
quicklisp-install))))
|