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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
|
;;; Consfigurator -- Lisp declarative configuration management system
;;; Copyright (C) 2020-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)
;;;; Connections
;; global value gets set in connection/local.lisp, but the symbol is not
;; exported as it should only get bound by DEPLOY*
(defvar *connection* nil
"Object representing the currently active connection.
Connections dynamically bind this variable and then apply properties. Its
global value should be regarded as a constant.")
;; generic function operating on keywords which identify connection types
(defgeneric establish-connection (type remaining &key)
(:documentation
"Within the context of the current connection, connect to HOST by
establishing a new connection of type TYPE.
Either starts a Lisp image somewhere else, tells it to continue establishing
REMAINING (by telling it to call DEPLOY* with arguments obtained by (locally)
evaluating (list (or REMAINING '(:local)) *host*)), and returns nil, or
returns a object suitable to be the value of *CONNECTION*.
Any implementation which hands over to a remote Lisp image will need to
upload any prerequisite data required by the deployment."))
(defclass connection ()
((parent
:initform *connection*
:documentation
"The value of *CONNECTION* at the time this connection was established.")))
(defclass lisp-connection (connection) ())
(defclass posix-connection (connection) ())
;;; generic functions to operate on subclasses of CONNECTION
(defgeneric connection-run (connection cmd &optional input)
(:documentation "Subroutine to run shell commands on the host.
INPUT is a string to send to the shell command's stdin, or a stream which will
be emptied into the shell command's stdin.
Implementations can specialise on both the CONNECTION and INPUT arguments, if
they need to handle streams and strings differently.
Returns (values OUT EXIT) where OUT is merged stdout and stderr and EXIT is
the exit code. Should not signal any error condition just because EXIT is
non-zero."))
(defmethod connection-run :around ((connection connection) cmd &optional input)
(declare (ignore cmd input))
(let ((*connection* (slot-value connection 'parent)))
(call-next-method)))
(defgeneric connection-readfile (connection path)
(:documentation "Subroutine to read the contents of files on the host."))
(defmethod connection-readfile :around ((connection connection) path)
(declare (ignore path))
(let ((*connection* (slot-value connection 'parent)))
(call-next-method)))
;; only functional difference between WRITEFILE AND upload is what args they
;; take: a string vs. a path. for a given connection type, they may have same
;; or different implementations.
(defgeneric connection-writefile (connection path input)
(:documentation
"Subroutine to replace/create the contents of files on the host.
INPUT is the new contents of the file or a stream which will produce it.
Implementations can specialise on both the CONNECTION and INPUT arguments, if
they need to handle streams and strings differently."))
(defmethod connection-writefile :around ((connection connection) path contents)
(declare (ignore path contents))
(let ((*connection* (slot-value connection 'parent)))
(call-next-method)))
(defgeneric connection-upload (connection from to)
(:documentation "Subroutine to upload files to the host.
Only used, internally, for uploading prerequisite data, and only to caches."))
(defmethod connection-upload :around ((connection connection) from to)
(declare (ignore from to))
(let ((*connection* (slot-value connection 'parent)))
(call-next-method)))
(defgeneric connection-teardown (connection)
(:documentation "Subroutine to disconnect from the host."))
(defmethod connection-teardown :around ((connection connection))
(let ((*connection* (slot-value connection 'parent)))
(call-next-method)))
;; many connection types don't need anything to be done to disconnect
(defmethod connection-teardown ((connection connection))
(values))
;;;; Functions to access the slots of the current connection
;; Used by properties and by implementations of ESTABLISH-CONNECTION. This is
;; the only code that ever call CONNECTION-RUN, CONNECTION-READFILE and
;; CONNECTION-WRITEFILE directly (except that it might make sense for
;; implementations of CONNECTION-READFILE and CONNECTION-WRITEFILE to call
;; their corresponding implementation of CONNECTION-RUN).
(define-condition connection-run-failed (error)
((stdout :initarg stdout :reader stdout)
(stderr :initarg stderr :reader stderr)
(exit-code :initarg exit-code :reader exit-code)))
(defun run (&rest args)
"Synchronous execution of shell commands using the current connection.
ARGS can contain keyword-value pairs (and singular keywords) to specify
aspects of this function's behaviour, and remaining elements of ARGS are the
shell command and its parameters, or, as a special case, a single string
specifying the shell command, with any necessary escaping already performed.
It is recommended that all keywords and corresponding values come first,
followed by argument(s) specifying the shell command to execute.
Keyword arguments accepted:
- :for-exit / :may-fail -- don't signal an error condition if the command
does not exit nonzero, usually because it is being called partly or only
for its exit code
- :input INPUT -- pass the contents of the string or stream INPUT on stdin
- :env ENVIRONMENT -- where ENVIRONMENT is a plist specifying environment
variable names and values, use env(1) to set these variables when running
the command.
Returns command's stdout, stderr and exit code."
(let (cmd input may-fail env (stderr (mktemp)))
(loop for arg = (pop args)
do (case arg
(:for-exit (setq may-fail t))
(:may-fail (setq may-fail t))
(:input (setq input (pop args)))
(:env (setq env (pop args)))
(t (push arg cmd)))
while args
finally (nreversef cmd))
(setq cmd (if (cdr cmd) (escape-sh-command cmd) (car cmd)))
(loop while env
collect (format nil "~A=~A" (symbol-name (pop env)) (pop env))
into accum
finally
(when accum
(setq cmd (format nil "env ~A ~A"
(escape-sh-command accum)
cmd))))
(unwind-protect
(multiple-value-bind (out exit)
(connection-run *connection*
(format nil "( ~A ) 2>~A" cmd stderr)
input)
(let ((err (readfile stderr)))
(if (or may-fail (= exit 0))
(values out err exit)
(error 'connection-run-failed
:stdout out :stderr err :exit-code exit))))
(connection-run *connection* (format nil "rm -f ~A" stderr)))))
(defun mktemp ()
"Make a temporary file on the remote side."
(multiple-value-bind (out exit)
;; mktemp(1) is not POSIX; the only POSIX way is this m4 way,
;; apparently, but even though m4(1) is POSIX it seems like it could
;; often be absent, so have a fallback. Avoid passing any arguments to
;; mktemp(1) as these may differ on different platforms.
(connection-run
*connection*
"echo 'mkstemp('${TMPDIR:-/tmp}'/tmp.XXXXXX)' | m4 2>/dev/null || mktemp")
(if (= exit 0)
(car (lines out))
(error 'connection-run-failed :exit-code exit))))
(defun runlines (&rest args)
(lines (apply #'run args)))
(defun readfile (&rest args)
(apply #'connection-readfile *connection* args))
(defun writefile (&rest args)
(apply #'connection-writefile *connection* args))
|
