Now a Lisp list is assumed to be an alist, and printed as a JSON
mapping; a JSON list is produced from a Lisp vector. Also, `nil' is now
mapped to JSON `null'.
* Implement these changes in `print-json-simple'.
* Change the lists in `hosts.lisp' to be vectors.
* Modify `host-defs.lisp' to handle vectors instead of lists.
(defun print-json-simple (value)
(typecase value
(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
(t
(print-json-itemstart)
(etypecase value
(when foundp
(hostprop-default vmhost :vm-role :host)
(hostprop-default host :vm-role :guest)
(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))))))))
(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)
(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)
(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 --------------------------------------------------
;;;----- That's all, folks --------------------------------------------------
:hypervisor :kvm
:os :debian
:location house
:hypervisor :kvm
:os :debian
:location house
- :server (:multihome :ntp))
+ :server #(:multihome :ntp))
(defhost radius
:vm-host ibanez
:os :debian
(defhost radius
:vm-host ibanez
:os :debian
- :server (:router :dns :syslog :vpn))
+ :server #(:router :dns :syslog :vpn))
(defhost roadstar
:vm-host ibanez
:os :debian
(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
(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
(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
;; Other servers.
(defhost vampire
:os :debian
:location house
- :server (:router :ntp :vpn :nfs))
+ :server #(:router :ntp :vpn :nfs))
(defhost groove
:os :debian
:location house
(defhost groove
:os :debian
:location house
:hypervisor :kvm
:os :debian
:location jump
:hypervisor :kvm
:os :debian
:location jump
- :server (:multihome :ntp))
+ :server #(:multihome :ntp))
(defhost precision
:vm-host fender
:os :debian
(defhost precision
:vm-host fender
:os :debian
- :server (:router :dns :vpn))
+ :server #(:router :dns :vpn))
(defhost telecaster
:vm-host fender
:os :debian
(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
(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
(defhost jazz
:vm-host fender
:os :debian
- :server (:multihome :login :http :mail :vpn))
+ :server #(:multihome :login :http :mail :vpn))
;;;----- That's all, folks --------------------------------------------------
;;;----- That's all, folks --------------------------------------------------