81 lines
2.8 KiB
Scheme
81 lines
2.8 KiB
Scheme
#|
|
|
This file is part of Ordo.
|
|
|
|
Copyright (C) 2025 Ray Miller
|
|
|
|
This program is free software: you can redistribute it and/or modify it under
|
|
the terms of the GNU General Public License as published by the Free Software
|
|
Foundation, version 3.
|
|
|
|
This program is distributed in the hope that it will be useful, but WITHOUT ANY
|
|
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
|
|
PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License along with
|
|
this program. If not, see <https://www.gnu.org/licenses/>.
|
|
|#
|
|
|
|
(define-module (ordo inventory)
|
|
#:use-module (ice-9 eval-string)
|
|
#:use-module (ice-9 match)
|
|
#:use-module (ice-9 textual-ports)
|
|
#:use-module (oop goops)
|
|
#:use-module ((ordo connection) #:select (local-connection))
|
|
#:use-module (ordo logger)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (srfi srfi-69)
|
|
#:export (host
|
|
host?
|
|
host-name
|
|
host-connection
|
|
host-tags
|
|
host-vars
|
|
resolve-hosts
|
|
load-inventory))
|
|
|
|
(define-class <host> ()
|
|
(name #:init-keyword #:name #:getter host-name)
|
|
(connection #:init-keyword #:connection #:getter host-connection)
|
|
(tags #:init-keyword #:tags #:getter host-tags #:init-form (list))
|
|
(vars #:init-keyword #:vars #:getter host-vars #:init-form (list)))
|
|
|
|
(define-method (initialize (object <host>) initargs)
|
|
(next-method)
|
|
(slot-set! object 'vars (alist->hash-table (slot-ref object 'vars))))
|
|
|
|
(define (host . args)
|
|
(apply make <host> args))
|
|
|
|
(define (host? x)
|
|
(is-a? x <host>))
|
|
|
|
(define (tagged-every? wanted-tags)
|
|
(lambda (h)
|
|
(lset= equal? wanted-tags (lset-intersection equal? (host-tags h) wanted-tags))))
|
|
|
|
(define (tagged-any? wanted-tags)
|
|
(lambda (h)
|
|
(not (null? (lset-intersection equal? (host-tags h) wanted-tags)))))
|
|
|
|
(define (named? hostname)
|
|
(lambda (h)
|
|
(string=? (host-name h) hostname)))
|
|
|
|
(define (resolve-hosts inventory expr)
|
|
(match expr
|
|
("localhost" (list (or (find (named? "localhost") inventory)
|
|
(make <host> #:name "localhost" #:connection (local-connection)))))
|
|
((? string? hostname) (filter (named? hostname) inventory))
|
|
('all inventory)
|
|
(('tagged tag) (filter (tagged-every? (list tag)) inventory))
|
|
(('tagged/every tag . tags) (filter (tagged-every? (cons tag tags)) inventory))
|
|
(('tagged/any tag . tags) (filter (tagged-any? (cons tag tags)) inventory))))
|
|
|
|
(define (load-inventory filename)
|
|
(log-msg 'INFO "Loading inventory " filename)
|
|
(let* ((inventory (eval-string (call-with-input-file filename get-string-all)
|
|
#:file filename))
|
|
(inventory (if (list? inventory) inventory '())))
|
|
(when (null? inventory)
|
|
(log-msg 'NOTICE "Inventory is empty, only localhost will be available"))
|
|
inventory))
|