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
|
;;; 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)
;;;; Hosts
(defclass host ()
((hostattrs
:initarg :hostattrs
:reader hostattrs
:documentation "Plist of the host's static informational attributes.")
(propspec
:initarg :propspec
:reader host-propspec
:documentation "Propspec of the properties to be applied to the host."))
(:documentation "Abstract superclass for hosts. Do not instantiate."))
(defclass preprocessed-host (host)
((propspec
:type preprocessed-propspec))
(:documentation
"A host whose :PREPROCESS and :HOSTATTRS subroutines have been run."))
(defclass unpreprocessed-host (host)
((propspec
:type unpreprocessed-propspec))
(:documentation
"A host whose :PREPROCESS and :HOSTATTRS subroutines have not been run."))
(defmethod shallow-copy-host ((host host))
(make-instance (type-of host)
:hostattrs (copy-list (hostattrs host))
:propspec (host-propspec host)))
(defgeneric preprocess-host (host)
(:documentation
"Convert a host into a fresh preprocessed host if necessary, and
unconditionally perform a shallow copy of the plist of static information
attributes, so that implementations of ESTABLISH-CONNECTION can push new
attributes (typically to request prerequisite data) without disturbing host
values higher up the call stack."))
(defmethod preprocess-host ((host preprocessed-host))
(shallow-copy-host host))
(defmethod preprocess-host ((host unpreprocessed-host))
(let ((*host* (make-instance
'preprocessed-host
:hostattrs (copy-list (hostattrs host))
:propspec (preprocess-propspec (host-propspec host)))))
(propappattrs (eval-propspec (host-propspec *host*)))
*host*))
(defun make-host (&key hostattrs propspec)
(make-instance 'unpreprocessed-host
:hostattrs hostattrs :propspec propspec))
(defmethod print-object ((host host) stream)
(format stream "#.~S" `(make-instance
',(type-of host)
:hostattrs ',(slot-value host 'hostattrs)
:propspec ,(slot-value host 'propspec)))
host)
;; return values of the following two functions share structure, and thus are
;; not safe to use except on host objects that were just made, or that are
;; going straight into %CONSFIGURE
(defmethod %union-propspec-into-host
((host unpreprocessed-host) (propspec propspec))
(make-instance 'unpreprocessed-host
:hostattrs (hostattrs host)
:propspec (append-propspecs (host-propspec host) propspec)))
(defmethod %replace-propspec-into-host
((host unpreprocessed-host) (propspec unpreprocessed-propspec))
;; we have to preprocess HOST as functions that call us want the return
;; value to have all the hostattrs it would have were PROPSPEC not to be
;; substituted in
(make-instance 'unpreprocessed-host
:hostattrs (hostattrs (preprocess-host host))
:propspec propspec))
(defmacro defhost (hostname (&key deploy) &body properties)
"Define a host with hostname HOSTNAME and properties PROPERTIES.
HOSTNAME can be a string or a symbol. In either case, the host will get a
static informational property with its hostname as a string, and the symbol
whose name is the hostname will be bound to the host object.
DEPLOY represents the usual way you'll connect to the host to deploy
properties, and if specified, a function named HOSTNAME will be defined to
deploy the host using that connection chain. This is an optional convenience
feature; you can always use DEPLOY and DEPLOY-THESE to apply properties to the
host using an arbitrary chain of connections.
If the first entry in PROPERTIES is a string, it will be considered a
human-readable description of the host. Otherwise, PROPERTIES is an
unevaluated property application specification. Recall that for atomic
entries (PROPERTY . ARGS), PROPERTY refers to the property that symbol names
in the global environment, not whatever it may name in the current dynamic
and/or lexical environments. Property application specifications cannot
close over globally anonymous properties.
The order of PROPERTIES matters: deployments will apply properties to the host
in the order specified here, so later properties implicitly depend on earlier
ones. In addition, static informational attributes set by later properties
are allowed to override any attributes with the same name set by earlier
entries."
(let (hostname-sym attrs)
(etypecase hostname
(string (setq hostname-sym (intern hostname)))
(symbol (setq hostname-sym hostname
hostname (string-downcase (symbol-name hostname)))))
(push hostname (getf attrs :hostname))
(when (stringp (car properties))
(push (pop properties) (getf attrs :desc)))
`(progn
(declaim (type host ,hostname-sym))
(defparameter ,hostname-sym
(make-host :hostattrs ',attrs :propspec (props seqprops ,@properties))
,(car (getf attrs :desc)))
,@(and deploy
`((defdeploy ,hostname-sym (,deploy ,hostname-sym)))))))
|
