X-Git-Url: https://git.distorted.org.uk/~mdw/distorted-ansible/blobdiff_plain/23ba7445f087430d96914f81d15a4fa8a305ebfa..HEAD:/hosts/host-defs.lisp

diff --git a/hosts/host-defs.lisp b/hosts/host-defs.lisp
index 5e6039b..1b69df6 100644
--- a/hosts/host-defs.lisp
+++ b/hosts/host-defs.lisp
@@ -10,7 +10,12 @@
       (when foundp
 	(hostprop-default vmhost :vm-role :host)
 	(hostprop-default host :vm-role :guest)
-	(pushnew host (hostprop vmhost :guests))
+	(let ((guests (or (hostprop vmhost :guests)
+			  (setf (hostprop vmhost :guests)
+				(make-array 16
+					    :adjustable t
+					    :fill-pointer 0)))))
+	  (vector-push-extend host guests))
 	(dolist (prop '(:location :hypervisor))
 	  (multiple-value-bind (value foundp) (hostprop vmhost prop)
 	    (when foundp (hostprop-default host prop value))))))))
@@ -26,7 +31,7 @@
 (defhook (prio-groups)
   (dohosts (host)
     (when (eq (hostprop host :vm-role) :host)
-      (add-group (intern (concatenate 'string (string host) "-guests"))
+      (add-group (intern (concatenate 'string (string host) "-GUESTS"))
 		 :predicate (lambda (h) (eql (hostprop h :vm-host) host))))))
 
 ;; For each `:os' flavour, define a group of hosts running it.
@@ -37,19 +42,19 @@
 	(when foundp (pushnew os oses))))
     (dolist (os-mut oses)
       (let ((os os-mut))
-	(add-group (intern (concatenate 'string (string os) "-hosts"))
+	(add-group (intern (concatenate 'string (string os) "-HOSTS"))
 		   :predicate (lambda (h) (eql (hostprop h :os) os)))))))
 
 ;; For each ROLE listed in a `:server' list, define a `ROLE-servers' group.
 (defhook (prio-groups)
   (let ((server-roles nil))
     (dohosts (host)
-      (dolist (role (hostprop host :server))
-	(pushnew role server-roles)))
+      (map 'nil (lambda (role) (pushnew role server-roles))
+	   (hostprop host :server)))
     (dolist (r server-roles)
       (let ((role r))
-	(add-group (intern (concatenate 'string (string role) "-servers"))
+	(add-group (intern (concatenate 'string (string role) "-SERVERS"))
 		   :predicate (lambda (h)
-				(member role (hostprop h :server))))))))
+				(find role (hostprop h :server))))))))
 
 ;;;----- That's all, folks --------------------------------------------------