(defun print-json-simple (value)
(typecase value
- (list (print-json-list (dolist (i value) (print-json-simple i))))
- (hash-table (print-json-map (maphash (lambda (k v)
- (print-json-mapping k
- (print-json-simple v)))
- value)))
+ ((and vector (not string))
+ (print-json-list
+ (dotimes (i (length value)) (print-json-simple (aref value i)))))
+ (null
+ (princ "null"))
+ (list
+ (print-json-map
+ (dolist (i value)
+ (print-json-mapping (car i)
+ (print-json-simple (cdr i))))))
+ (hash-table
+ (print-json-map
+ (maphash (lambda (k v)
+ (print-json-mapping k
+ (print-json-simple v)))
+ value)))
(t
(print-json-itemstart)
(etypecase value
(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))))))))
(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"))
:predicate (lambda (h)
- (member role (hostprop h :server))))))))
+ (find role (hostprop h :server))))))))
;;;----- That's all, folks --------------------------------------------------
:hypervisor :kvm
:os :debian
:location house
- :server (:multihome :ntp))
+ :server #(:multihome :ntp))
(defhost radius
:vm-host ibanez
:os :debian
- :server (:router :dns :syslog :vpn))
+ :server #(:router :dns :syslog :vpn))
(defhost roadstar
:vm-host ibanez
:os :debian
- :server (:multihome :dns :ftp :http :nfs :www-cache :rsync :munin))
+ :server #(:multihome :dns :ftp :http :nfs :www-cache :rsync :munin))
(defhost jem
:vm-host ibanez
:os :debian
- :server (:multihome :login :rsync :http :nfs :mail))
+ :server #(:multihome :login :rsync :http :nfs :mail))
(defhost artist
:vm-host ibanez
:os :debian
- :server (:router :login :http :rsync :mail))
+ :server #(:router :login :http :rsync :mail))
;; Other servers.
(defhost vampire
:os :debian
:location house
- :server (:router :ntp :vpn :nfs))
+ :server #(:router :ntp :vpn :nfs))
(defhost groove
:os :debian
:location house
- :server (:http))
+ :server #(:http))
;; Clients.
:hypervisor :kvm
:os :debian
:location jump
- :server (:multihome :ntp))
+ :server #(:multihome :ntp))
(defhost precision
:vm-host fender
:os :debian
- :server (:router :dns :vpn))
+ :server #(:router :dns :vpn))
(defhost telecaster
:vm-host fender
:os :debian
- :server (:multihome :dns :ftp :http :rsync :munin :nfs))
+ :server #(:multihome :dns :ftp :http :rsync :munin :nfs))
(defhost stratocaster
:vm-host fender
:os :debian
- :server (:multihome :login :rsync :http :nfs :mail-hub))
+ :server #(:multihome :login :rsync :http :nfs :mail-hub))
(defhost jazz
:vm-host fender
:os :debian
- :server (:multihome :login :http :mail :vpn))
+ :server #(:multihome :login :http :mail :vpn))
;;;----- That's all, folks --------------------------------------------------