From bd1d90d876c07dbbfac74f6a2b55d879843fc9cc Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 22 Mar 2021 08:56:43 -0700 Subject: rename :DEBIAN-SBCL -> :SBCL & use a property to install sbcl Unconditionally calling apt was actually the only Debian-specific thing about the connection type. Signed-off-by: Sean Whitton --- src/connection/debian-sbcl.lisp | 41 --------------------------------- src/connection/sbcl.lisp | 51 +++++++++++++++++++++++++++++++++++++++++ src/connection/sudo.lisp | 4 ++-- src/data/asdf.lisp | 15 ++++++------ src/package.lisp | 8 ++++--- 5 files changed, 65 insertions(+), 54 deletions(-) delete mode 100644 src/connection/debian-sbcl.lisp create mode 100644 src/connection/sbcl.lisp (limited to 'src') diff --git a/src/connection/debian-sbcl.lisp b/src/connection/debian-sbcl.lisp deleted file mode 100644 index c5daa5e..0000000 --- a/src/connection/debian-sbcl.lisp +++ /dev/null @@ -1,41 +0,0 @@ -;;; Consfigurator -- Lisp declarative configuration management system - -;;; Copyright (C) 2021 Sean Whitton - -;;; This file is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3, or (at your option) -;;; any later version. - -;;; This file is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. - -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see . - -(in-package :consfigurator.connection.debian-sbcl) -(named-readtables:in-readtable :consfigurator) - -(defmethod establish-connection ((type (eql :debian-sbcl)) remaining &key) - (mrun "which sbcl >/dev/null 2>&1 || apt-get -y install sbcl") - (request-lisp-systems) - (upload-all-prerequisite-data) - (inform t "Waiting for remote Lisp to exit, this may take some time ... ") - (force-output) - (multiple-value-bind (program forms) - (continue-deploy*-program remaining) - (multiple-value-bind (out err exit) - (run :may-fail :input program - "sbcl" "--noinform" "--noprint" - "--disable-debugger" - "--no-sysinit" "--no-user-init") - (inform t "done." :fresh-line nil) - (unless (zerop exit) - ;; print FORMS not PROGRAM because latter might contain sudo passwords - (error "~%~%Remote Lisp failed; we sent~%~%~A~%~%and stderr was:~%~A" - forms err)) - (inform t " Output was:" :fresh-line nil) - (with-indented-inform (inform t (lines out))))) - nil) diff --git a/src/connection/sbcl.lisp b/src/connection/sbcl.lisp new file mode 100644 index 0000000..4ed465c --- /dev/null +++ b/src/connection/sbcl.lisp @@ -0,0 +1,51 @@ +;;; Consfigurator -- Lisp declarative configuration management system + +;;; Copyright (C) 2021 Sean Whitton + +;;; This file is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3, or (at your option) +;;; any later version. + +;;; This file is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. + +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see . + +(in-package :consfigurator.connection.sbcl) +(named-readtables:in-readtable :consfigurator) + +(defprop sbcl-available :posix () + (:check + (zerop (mrun :for-exit "command" "-v" "sbcl"))) + (:apply + (typecase (class-of (get-hostattrs-car :os)) + (os:debianlike + (ignoring-hostattrs (apt:installed "sbcl"))) + (t + (failed-change "Do not know how to install SBCL on this OS."))))) + +(defmethod establish-connection ((type (eql :sbcl)) remaining &key) + (sbcl-available) + (request-lisp-systems) + (upload-all-prerequisite-data) + (inform t "Waiting for remote Lisp to exit, this may take some time ... ") + (force-output) + (multiple-value-bind (program forms) + (continue-deploy*-program remaining) + (multiple-value-bind (out err exit) + (run :may-fail :input program + "sbcl" "--noinform" "--noprint" + "--disable-debugger" + "--no-sysinit" "--no-user-init") + (inform t "done." :fresh-line nil) + (unless (zerop exit) + ;; print FORMS not PROGRAM because latter might contain sudo passwords + (error "~%~%Remote Lisp failed; we sent~%~%~A~%~%and stderr was:~%~A" + forms err)) + (inform t " Output was:" :fresh-line nil) + (with-indented-inform (inform t (lines out))))) + nil) diff --git a/src/connection/sudo.lisp b/src/connection/sudo.lisp index 3c7c633..5e2dbf9 100644 --- a/src/connection/sudo.lisp +++ b/src/connection/sudo.lisp @@ -34,8 +34,8 @@ ;; passwords needed for establishing the remaining hops. Depending on how the ;; connection type feeds instructions to the remote Lisp image, this may ;; involve writing your sudo password to a file under ~/.cache on the machine -;; which runs the remote Lisp image. At least :debian-sbcl avoids this by -;; sending your password in on stdin. +;; which runs the remote Lisp image. At least :sbcl avoids this by sending +;; your password in on stdin. ;; TODO Let's require the user pass :PASSWD or :NOPASSWD to indicate whether ;; we'll query prerequisite data sources and always try to send a password on diff --git a/src/data/asdf.lisp b/src/data/asdf.lisp index 2d61c49..51ac344 100644 --- a/src/data/asdf.lisp +++ b/src/data/asdf.lisp @@ -21,14 +21,13 @@ ;; could we have both :asdf-monolithic and :asdf-something_else where in the ;; latter we filter out the names of systems already known to be available on ;; the remote side, so those don't need to be uploaded? for example, the -;; :debian-sbcl connection type can try to install them with apt on the remote -;; side, then ask asdf for a concatenated source for everything excluding -;; those. if asdf can't be asked to do that, maybe we can ask it to produce -;; one file per system, and then we eliminate those we don't want and -;; concatenate the result ourselves. maybe we can create a fake system object -;; based on the real one, remove some deps from it according to a known -;; mapping of systems to Debian package names, then ask asdf to concatenate -;; that system +;; :sbcl connection type can try to install them with apt on the remote side, +;; then ask asdf for a concatenated source for everything excluding those. if +;; asdf can't be asked to do that, maybe we can ask it to produce one file per +;; system, and then we eliminate those we don't want and concatenate the +;; result ourselves. maybe we can create a fake system object based on the +;; real one, remove some deps from it according to a known mapping of systems +;; to Debian package names, then ask asdf to concatenate that system (defmethod register-data-source ((type (eql :asdf)) &key) (cons #'asdf-data-source-check #'get-path-to-concatenated-system)) diff --git a/src/package.lisp b/src/package.lisp index 856399d..b8fad64 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -198,9 +198,6 @@ (:use #:cl #:consfigurator #:alexandria) (:export #:local-connection)) -(defpackage :consfigurator.connection.debian-sbcl - (:use #:cl #:consfigurator)) - (defpackage :consfigurator.connection.chroot (:use #:cl #:consfigurator #:cffi)) @@ -272,6 +269,11 @@ #:uses-local-cacher #:standard-sources.list)) +(defpackage :consfigurator.connection.sbcl + (:use #:cl #:consfigurator) + (:local-nicknames (#:os #:consfigurator.property.os) + (#:apt #:consfigurator.property.apt))) + (defpackage :consfigurator.property.user (:use #:cl #:consfigurator) (:local-nicknames (#:os #:consfigurator.property.os)) -- cgit v1.2.3