ray/ordo
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Refactor, implement inventory, add examples

Browse source
This commit is contained in:
Ray Miller 2025-01-19 19:21:35 +00:00
parent d16df7616f
commit 54b6fd0377
Signed by: ray
GPG key ID: 043F786C4CD681B8
17 changed files with 373 additions and 483 deletions
Download patch file Download diff file Expand all files Collapse all files

187
modules/ordo.scm
View file

@ -1,171 +1,22 @@
(define-module (ordo)
#:use-module (ice-9 exceptions)
#:use-module (logging logger)
#:declarative? #f
#:use-module (ice-9 match)
#:use-module (ordo playbook)
#:use-module (ordo play)
#:use-module (ordo task)
#:use-module (ordo handler)
#:use-module (ordo connection)
#:use-module (ordo facts)
#:use-module (srfi srfi-1) ; list utils
#:use-module (srfi srfi-9) ; records
#:use-module (srfi srfi-26) ; cut
#:use-module (srfi srfi-69) ; hash-tables
#:export (task
task-name
task-tags
task-action
task-condition
task-register
task-triggers
run-task
play
play-name
play-vars
play-tasks
play-connection
play-handlers
run-play
playbook
playbook-name
playbook-vars
playbook-plays
run-playbook
$
$$
register-play-var
register-playbook-var))
#:use-module (ordo inventory)
#:use-module (ordo vars)
#:use-module (ordo logger)
#:export (main)
#:re-export (add-host! local-connection ssh-connection run playbook play task handler $))
(define +filter-tags+ '())
(define (check-tags tags)
(or (null? +filter-tags+)
(not (null? (lset-intersection eqv? +filter-tags+ tags)))))
(define +play-vars+ #f)
(define (register-play-var var-name)
(lambda (v)
(log-msg 'DEBUG "Registering play variable " var-name)
(hash-table-set! +play-vars+ var-name v)))
(define +playbook-vars+ #f)
(define (register-playbook-var var-name)
(lambda (v)
(log-msg 'DEBUG "Registering playbook variable " var-name)
(hash-table-set! +playbook-vars+ var-name v)))
(define ($ var-name)
"Try to resolve var-name as a play variable or a playbook
variable (in that order). Raise an exception if the variable is not found."
(define not-found (cons 'not-found '()))
(define (lookup-var var-name vars)
(cond
((null? vars)
(raise-exception (make-exception
(make-undefined-variable-error)
(make-exception-with-irritants var-name))))
((not (car vars)) (lookup-var var-name (cdr vars)))
(else (let ((v (hash-table-ref/default (car vars) var-name not-found)))
(if (eqv? v not-found)
(lookup-var var-name (cdr vars))
v)))))
(lookup-var var-name (list +play-vars+ +playbook-vars+)))
(define ($$ . keys)
"Look up nested keys in gathered facts."
(apply get-fact (hash-table-ref +play-vars+ #:ordo-facts) keys))
(define +triggers+ #f)
(define (add-triggers triggers)
(set! +triggers+ (apply lset-adjoin equal? (or +triggers+ '())
triggers)))
(define-record-type <task>
(make-task name tags action condition register triggers)
task?
(name task-name)
(tags task-tags)
(action task-action)
(condition task-condition)
(register task-register)
(triggers task-triggers))
(define* (task name action #:key (tags '()) (condition (const #t)) (register (const #f)) (triggers '()))
(make-task name tags action condition register triggers))
(define (run-task t c)
(when (check-tags (task-tags t))
(if (not ((task-condition t) c))
(log-msg 'NOTICE "Skipping task " (task-name t) " (precondition not met)")
(begin
(log-msg 'NOTICE "Running task " (task-name t))
(let ((result ((task-action t) c)))
((task-register t) result)
(add-triggers (task-triggers t)))))))
(define-record-type <handler>
(make-handler name action)
handler?
(name handler-name)
(action handler-action))
(define (handler name action)
(make-handler name action))
(define-record-type <play>
(make-play name connection vars gather-facts tasks handlers)
play?
(name play-name)
(connection play-connection)
(vars play-vars)
(tasks play-tasks)
(handlers play-handlers)
(gather-facts play-gather-facts))
(define* (play name #:key connection (vars '()) (gather-facts #t) . more)
(let ((tasks (filter task? more))
(handlers (filter handler? more)))
(make-play name connection vars gather-facts tasks handlers)))
(define (run-play p)
(log-msg 'NOTICE "Running play " (play-name p))
(dynamic-wind
(lambda ()
(set! +play-vars+ (alist->hash-table (play-vars p) equal?))
(init-connection! (play-connection p)))
(lambda ()
(when (play-gather-facts p)
(hash-table-set! +play-vars+ #:ordo-facts (gather-facts (play-connection p))))
(for-each (cut run-task <> (play-connection p)) (play-tasks p))
(for-each (lambda (h)
(when (member (handler-name h) +triggers+)
(log-msg 'INFO "Running handler " (handler-name h))
((handler-action h) (play-connection p))))
(play-handlers p)))
(lambda ()
(set! +play-vars+ #f)
(set! +triggers+ #f)
(close-connection! (play-connection p)))))
(define-record-type <playbook>
(make-playbook name vars plays)
playbook?
(name playbook-name)
(vars playbook-vars)
(plays playbook-plays))
(define* (playbook name #:key (vars '()) . plays)
(make-playbook name vars plays))
(define* (run-playbook pb #:optional (filter-tags '()))
(log-msg 'NOTICE "Running playbook " (playbook-name pb))
(dynamic-wind
(lambda ()
(set! +filter-tags+ filter-tags)
(set! +playbook-vars+ (alist->hash-table (playbook-vars pb) equal?)))
(lambda ()
(for-each run-play (playbook-plays pb)))
(lambda ()
(set! +filter-tags+ '())
(set! +playbook-vars+ #f))))
;; TODO: add validate methods for <task>, <play>, and <playbook>
(define (main args)
(match-let (((_ inventory-path playbook-path) args))
(setup-logging #:level 'DEBUG)
(init-command-line-vars! '())
(load inventory-path)
(let ((playbook (load playbook-path)))
(run-playbook playbook)))
(quit))