152 lines
5 KiB
Scheme
152 lines
5 KiB
Scheme
(define-module (ordo context)
|
|
#:use-module (ice-9 exceptions)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (srfi srfi-9)
|
|
#:use-module (srfi srfi-26)
|
|
#:use-module (srfi srfi-69)
|
|
#:use-module (logging logger)
|
|
#:use-module (ordo host)
|
|
#:export (init-context!
|
|
set-current-connection!
|
|
current-connection
|
|
current-host
|
|
set-current-host!
|
|
init-playbook-vars!
|
|
get-playbook-var
|
|
set-playbook-var!
|
|
reset-playbook-vars!
|
|
init-play-vars!
|
|
get-play-var
|
|
set-play-var!
|
|
reset-play-vars!
|
|
get-command-line-var
|
|
set-command-line-var!
|
|
$
|
|
reset-play-triggers!
|
|
add-play-triggers!
|
|
play-triggered?
|
|
set-filter-tag!
|
|
reset-filter-tags!
|
|
check-filter-tags
|
|
add-host!
|
|
current-inventory))
|
|
|
|
(define *current-context* #f)
|
|
|
|
(define-record-type <context>
|
|
(make-context)
|
|
context?
|
|
(connection connection set-connection!)
|
|
(hostname hostname set-hostname!)
|
|
(command-line-vars command-line-vars set-command-line-vars!)
|
|
(play-vars play-vars set-play-vars!)
|
|
(play-triggers play-triggers set-play-triggers!)
|
|
(playbook-vars playbook-vars set-playbook-vars!)
|
|
(filter-tags filter-tags set-filter-tags!)
|
|
(inventory inventory set-inventory!))
|
|
|
|
(define (init-context!)
|
|
(set! *current-context* (make-context)))
|
|
|
|
(define not-found (cons 'not-found '()))
|
|
|
|
(define (not-found? x) (eq? x not-found))
|
|
|
|
(define (set-current-connection! conn)
|
|
(set-connection! *current-context* conn))
|
|
|
|
(define (current-connection)
|
|
(connection *current-context*))
|
|
|
|
(define (set-current-host! hostname)
|
|
(set-hostname! *current-context* hostname))
|
|
|
|
(define (current-host)
|
|
(hostname *current-context*))
|
|
|
|
(define (init-playbook-vars! alist)
|
|
(set-playbook-vars! *current-context* (alist->hash-table alist eqv?)))
|
|
|
|
(define (get-playbook-var var-name)
|
|
(if (playbook-vars *current-context*)
|
|
(hash-table-ref/default (playbook-vars *current-context*) var-name not-found)
|
|
not-found))
|
|
|
|
(define (set-playbook-var! var-name val)
|
|
(unless (playbook-vars *current-context*)
|
|
(set-playbook-vars! *current-context* (make-hash-table eqv?)))
|
|
(hash-table-set! (playbook-vars *current-context*) var-name val))
|
|
|
|
(define (reset-playbook-vars!)
|
|
(set-playbook-vars! *current-context* #f))
|
|
|
|
(define (init-play-vars! alist)
|
|
(set-play-vars! *current-context* (alist->hash-table alist eqv?)))
|
|
|
|
(define (get-play-var var-name)
|
|
(if (play-vars *current-context*)
|
|
(hash-table-ref/default (play-vars *current-context*) var-name not-found)
|
|
not-found))
|
|
|
|
(define (set-play-var! var-name val)
|
|
(unless (play-vars *current-context*)
|
|
(set-play-vars! *current-context* (make-hash-table equal?)))
|
|
(hash-table-set! (play-vars *current-context*) var-name val))
|
|
|
|
(define (reset-play-vars!)
|
|
(set-play-vars! *current-context* #f))
|
|
|
|
(define (get-command-line-var var-name)
|
|
(if (command-line-vars *current-context*)
|
|
(hash-table-ref/default (command-line-vars *current-context*) var-name not-found)
|
|
not-found))
|
|
|
|
(define (set-command-line-var! var-name val)
|
|
(unless (command-line-vars *current-context*)
|
|
(set-command-line-vars! *current-context* (make-hash-table eqv?)))
|
|
(hash-table-set! (command-line-vars *current-context*) var-name val))
|
|
|
|
(define ($ var-name)
|
|
"Try to resolve var-name as a command-line variable, a play variable or a
|
|
playbook variable (in that order). Raise an exception if the variable is not
|
|
found."
|
|
(define (lookup-var procs)
|
|
(if (null? procs)
|
|
(raise-exception (make-exception
|
|
(make-undefined-variable-error)
|
|
(make-exception-with-irritants var-name)))
|
|
(let ((v ((car procs) var-name)))
|
|
(if (not-found? v)
|
|
(lookup-var (cdr procs))
|
|
v))))
|
|
(lookup-var (list get-command-line-var get-play-var get-playbook-var)))
|
|
|
|
(define (reset-play-triggers!)
|
|
(set-play-triggers! *current-context* #f))
|
|
|
|
(define (add-play-triggers! triggers)
|
|
(set-play-triggers! *current-context*
|
|
(apply lset-adjoin equal? (or (play-triggers *current-context*) '())
|
|
triggers)))
|
|
|
|
(define (play-triggered? trigger)
|
|
(and=> (play-triggers *current-context*) (cut member trigger <>)))
|
|
|
|
(define (set-filter-tag! tag)
|
|
(set-filter-tags! *current-context*
|
|
(lset-adjoin equal? (or (filter-tags *current-context*) '()) tag)))
|
|
|
|
(define (reset-filter-tags!)
|
|
(set-filter-tags! *current-context* #f))
|
|
|
|
(define (check-filter-tags tags)
|
|
(or (not (filter-tags *current-context*))
|
|
(not (null? (lset-intersection eqv? (filter-tags *current-context*) tags)))))
|
|
|
|
(define (current-inventory)
|
|
(or (inventory *current-context*) '()))
|
|
|
|
(define (add-host! hostname connection . tags)
|
|
(log-msg 'DEBUG "Adding host to inventory: " hostname)
|
|
(set-inventory! *current-context* (cons (make-host hostname connection tags)
|
|
(or (inventory *current-context*) '()))))
|