Lisp: Change Lisp-to-JSON conventions.

[distorted-ansible] / hosts / host-defs.lisp

;;; -*-lisp-*-

(cl:in-package #:ansible-inventory-user)

;; Set `:vm-role' and `:guests' properties based on `:vm-host' backlinks from
;; guests, and propagate `:location' and `:hypervisor' back to the guests.
(defhook (prio-props)
  (dohosts (host)
    (multiple-value-bind (vmhost foundp) (hostprop host :vm-host)
      (when foundp
	(hostprop-default vmhost :vm-role :host)
	(hostprop-default host :vm-role :guest)
	(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))))))))

;; Define groups for hosts, guests, clients, and servers.
(defhook (prio-groups)
  (defgroup vm-hosts :predicate (host) (eq (hostprop host :vm-role) :host))
  (defgroup vm-guests :predicate (host) (eq (hostprop host :vm-role) :guest))
  (defgroup servers :predicate (host) (hostpropp host :server))
  (defgroup clients :predicate (host) (hostpropp host :client)))

;; For each VM host, define a group for its guests.
(defhook (prio-groups)
  (dohosts (host)
    (when (eq (hostprop host :vm-role) :host)
      (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.
(defhook (prio-groups)
  (let ((oses nil))
    (dohosts (host)
      (multiple-value-bind (os foundp) (hostprop host :os)
	(when foundp (pushnew os oses))))
    (dolist (os-mut oses)
      (let ((os os-mut))
	(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)
      (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"))
		   :predicate (lambda (h)
				(find role (hostprop h :server))))))))

;;;----- That's all, folks --------------------------------------------------