aboutsummaryrefslogtreecommitdiff
path: root/src/connection/sbcl.lisp
blob: 640854db5da724abe7f4db5cdd2c3741fd20e889 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
;;; Consfigurator -- Lisp declarative configuration management system

;;; Copyright (C) 2021  Sean Whitton <spwhitton@spwhitton.name>

;;; 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 <http://www.gnu.org/licenses/>.

(in-package :consfigurator.connection.sbcl)
(named-readtables:in-readtable :consfigurator)

(defproplist sbcl-available :posix ()
  (:check
   (zerop (mrun :for-exit "command" "-v" "sbcl")))
  (os:typecase
      (debianlike (apt:installed "sbcl"))))

(defmethod establish-connection ((type (eql :sbcl)) remaining &key)
  (when (lisp-connection-p)
    (warn
     "Looks like you might be starting a fresh Lisp image directly from the root
Lisp. This can mean that prerequisite data gets extracted from encrypted
stores and stored unencrypted under ~~/.cache, and as such is not
recommended."))
  (ignoring-hostattrs (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
        (failed-change
	 "~&Remote Lisp failed; stderr was:~%~%~A~&~%Program we sent:~%~%~A"
         err forms))
      (inform t "  Output was:" :fresh-line nil)
      (with-indented-inform (inform t (lines out)))))
  nil)