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
|
;;; 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)
;;;; Deployments
(defmacro defdeploy (name (connection host) &body additional-properties)
"Define a function which does (DEPLOY CONNECTION HOST ADDITIONAL-PROPERTIES).
You can then eval (NAME) to execute this deployment."
`(defun ,name ()
(deploy ,connection ,host ,@additional-properties)))
(defmacro defdeploy-these (name (connection host) &body properties)
"Define a function which does (DEPLOY-THESE CONNECTION HOST PROPERTIES).
You can then eval (NAME) to execute this deployment."
`(defun ,name ()
(deploy-these ,connection ,host ,@properties)))
(defmacro defhostdeploy (connection host-name)
"Where HOST-NAME names a host as defined with DEFHOST, define a function
which does (deploy CONNECTION (symbol-value HOST)).
You can then eval (HOST-NAME) to execute this deployment.
For example, if you usually deploy properties to athena by SSH,
(defhost athena.silentflame.com
(foo)
(bar)
...)
(defhostdeploy :ssh athena.silentflame.com)
and then you can eval (athena.silentflame.com) to apply athena's properties."
`(defdeploy ,host-name (,connection ,host-name)))
(defmacro deploy (connection host &body additional-properties)
"Establish a connection of type CONNECTION to HOST, and apply each of the
host's usual properties, followed by specified by ADDITIONAL-PROPERTIES, an
unevaluated property application specification.
CONNECTION is either a keyword identifying a connection type, or a list
beginning with such a keyword and followed by keyword arguments required to
establish the connection.
Then HOST has all its usual static informational attributes, plus any set by
ADDITIONAL-PROPERTIES. Static informational attributes set by
ADDITIONAL-PROPERTIES can override the host's usual static informational
attributes, in the same way that later entries in the list of properties
specified in DEFHOST forms can override earlier entries (see DEFHOST's
docstring)."
(once-only (host)
(with-gensyms (propspec new-host)
`(let* ((,propspec ,(props additional-properties))
(,new-host
(make-instance 'host
:attrs (copy-list (slot-value ,host 'hostattrs))
:props (append-propspecs
(slot-value ,host 'propspec)
,propspec))))
(let ((*host* ,new-host))
(eval-propspec-hostattrs ,propspec))
(deploy* ',connection ,new-host)))))
(defmacro deploy-these (connection host &body properties)
"Establish a connection of type CONNECTION to HOST, and apply each of
the properties specified by PROPERTIES, an unevaluated property application
specification (and not the host's usual properties, unless they also appear
in PROPERTIES).
CONNECTION is either a keyword identifying a connection type, or a list
beginning with such a keyword and followed by keyword arguments required to
establish the connection.
This function is useful to apply one or two properties to a host right now,
e.g. at the REPL when when testing new property definitions. If HOST is
usually deployed using a :lisp connection, and the property you are testing
is :posix, you might use a connection type like :ssh so that you can quickly
alternate between redefining your work-in-progress property and attempting to
apply it to HOST.
HOST has all its usual static informational attributes, as set by its usual
properties, plus any set by PROPERTIES. Static informational attributes set
by PROPERTIES can override the host's usual static informational attributes,
in the same way that later entries in the list of properties specified in
DEFHOST forms can override earlier entries (see DEFHOST's docstring)."
(with-gensyms (propspec new-host)
`(let* ((,propspec ,(props properties))
(,new-host (make-instance 'host
:attrs (copy-list
(slot-value ,host 'hostattrs))
:props ,propspec)))
(let ((*host* ,new-host))
(eval-propspec-hostattrs ,propspec))
(deploy* ',connection ,new-host))))
(defvar *last-hop-info* nil
"Plist of information about most recently established connection hop. Can be
used by implementations of ESTABLISH-CONNECTION.")
(defvar *this-hop-info* nil
"Plist which will become the value of *LAST-HOP-INFO*.")
;; this is the main do-work loop for Consfigurator; remote Lisp images are
;; instructed to pick up the remaining work of this loop
(defun deploy* (connections host)
;; make a partial own-copy of HOST so that connections can add new pieces of
;; required prerequisite data; specifically, so that they can request the
;; source code of ASDF systems
(let ((*host* (make-instance 'host
:attrs (copy-list (slot-value host 'hostattrs))
:props (slot-value host 'propspec))))
(labels
((connect (connections)
(destructuring-bind ((type . args) . remaining) connections
(let ((*last-hop-info* *this-hop-info*) *this-hop-info*)
;; implementations of ESTABLISH-CONNECTION return nil if they
;; have handed off to a remote Lisp image
(when-let ((*connection*
(apply #'establish-connection type remaining args)))
(if remaining
(connect remaining)
(apply-propspec (slot-value *host* 'propspec)))
(connection-teardown *connection*)))))
(apply-propspec (propspec)
(when (and (subtypep (class-of *connection*) 'posix-connection)
(eq :lisp (propspec->type propspec)))
(error "Cannot apply :LISP properties using a POSIX connection"))
(eval-propspec propspec)))
(connect (loop for connection in (ensure-cons connections)
collect (apply #'preprocess-connection-args
(ensure-cons connection)))))))
;; these might need to be special-cased in parsing propspecs, because we
;; probably want it to be easy for the user to pass unevaluated propspecs to
;; these, but we want the evaluation to happen in the root Lisp.
;;
;; also, :HOSTATTRS subroutines of these will want to call
;; PREPROCESS-CONNECTION-ARGS in order to substitute in any values from
;; prerequisite data as early as possible
;;
;; One possibility is to allow :hostattrs subroutines to modify the arguments
;; which will get passed to the other routines, by giving them a special var
;; bound to the current propapp. Then they could apply
;; preprocess-connection-args to the arguments. (This suggests that deploy*
;; becomes simply applying the DEPLOYS property to the root Lisp, hrm.)
;;
;; (defprop deploys :posix (connection host &rest additional-properties)
;; "Execute a Consfigurator deployment.
;;
;; Useful to have one host act a controller, applying properties to other hosts.
;; Also useful to set up VMs, chroots, disk images etc. on localhost.")
;;
;; (defprop deploys-these :posix (connection host &rest properties)
;; "Execute a deployment, but replace the properties of host with PROPERTIES.
;; This property is to the DEPLOYS property what the DEPLOY-THESE function is to
;; the DEPLOY function.")
|
