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

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