chiark - git - mdw - distorted-ansible/blob - hosts/host-defs.lisp

   1 ;;; -*-lisp-*-
   2
   3 ;; Set `:vm-role' and `:guests' properties based on `:vm-host' backlinks from
   4 ;; guests, and propagate `:location' and `:hypervisor' back to the guests.
   5 (defhook (prio-props)
   6   (dohosts (host)
   7     (multiple-value-bind (vmhost foundp) (hostprop host :vm-host)
   8       (when foundp
   9         (hostprop-default vmhost :vm-role :host)
  10         (hostprop-default host :vm-role :guest)
  11         (pushnew host (hostprop vmhost :guests))
  12         (dolist (prop '(:location :hypervisor))
  13           (multiple-value-bind (value foundp) (hostprop vmhost prop)
  14             (when foundp (hostprop-default host prop value))))))))
  15
  16 ;; Define groups for hosts, guests, clients, and servers.
  17 (defhook (prio-groups)
  18   (defgroup vm-hosts :predicate (host) (eq (hostprop host :vm-role) :host))
  19   (defgroup vm-guests :predicate (host) (eq (hostprop host :vm-role) :guest))
  20   (defgroup servers :predicate (host) (hostpropp host :server))
  21   (defgroup clients :predicate (host) (hostpropp host :client)))
  22
  23 ;; For each VM host, define a group for its guests.
  24 (defhook (prio-groups)
  25   (dohosts (host)
  26     (when (eq (hostprop host :vm-role) :host)
  27       (add-group (intern (concatenate 'string (string host) "-guests"))
  28                  :predicate (lambda (h) (eql (hostprop h :vm-host) host))))))
  29
  30 ;; For each `:os' flavour, define a group of hosts running it.
  31 (defhook (prio-groups)
  32   (let ((oses nil))
  33     (dohosts (host)
  34       (multiple-value-bind (os foundp) (hostprop host :os)
  35         (when foundp (pushnew os oses))))
  36     (dolist (os-mut oses)
  37       (let ((os os-mut))
  38         (add-group (intern (concatenate 'string (string os) "-hosts"))
  39                    :predicate (lambda (h) (eql (hostprop h :os) os)))))))
  40
  41 ;; For each ROLE listed in a `:server' list, define a `ROLE-servers' group.
  42 (defhook (prio-groups)
  43   (let ((server-roles nil))
  44     (dohosts (host)
  45       (dolist (role (hostprop host :server))
  46         (pushnew role server-roles)))
  47     (dolist (r server-roles)
  48       (let ((role r))
  49         (add-group (intern (concatenate 'string (string role) "-servers"))
  50                    :predicate (lambda (h)
  51                                 (member role (hostprop h :server))))))))
  52
  53 ;;;----- That's all, folks --------------------------------------------------