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

Basic functionality for play and playbook

Browse source
This commit is contained in:
Ray Miller 2025-06-07 16:25:31 +01:00
parent 00c5c91b11
commit 49571984c2
Signed by: ray
GPG key ID: 043F786C4CD681B8
7 changed files with 131 additions and 60 deletions
Download patch file Download diff file Expand all files Collapse all files

10
examples/inventory.scm
View file

@ -2,7 +2,7 @@
(ordo inventory))
(list
(host #:name "localhost"
(host #:name "little-rascal"
#:connection (local-connection)
#:tags '(#:linux #:guix))
@ -15,5 +15,9 @@
#:tags '(#:linux #:coreos))
(host #:name "control-surface"
#:connection (ssh-connection "control-surface")
#:tags '(#:linux #:debian)))
#:connection (ssh-connection "control-surface" #:user "ray")
#:tags '(#:linux #:debian))
(host #:name "cargo-cult"
#:connection (ssh-connection "cargo-cult" #:user "ray")
#:tags '(#:linux #:synology)))

11
examples/playbook.scm
View file

@ -5,4 +5,13 @@
#:vars '((foo . 1) (bar . "baz"))
#:plays (list
(play #:name "Example play"
#:host "localhost")))
#:host "localhost"
#:tasks (list
(task #:name "First task"
#:action (const #t))
(task #:name "Second task"
#:action (lambda (conn)
(trigger-handler! 'foo))))
#:handlers (list
(handler #:name 'foo
#:action (const #f))))))

6
ordo/connection.scm
View file

@ -40,9 +40,11 @@ this program. If not, see <https://www.gnu.org/licenses/>.
(define (local-connection)
(make <local-connection>))
(define* (ssh-connection host #:key (user (getlogin)) (password #f) (identity #f) (authenticate-server? #t))
(define* (ssh-connection host #:key (user (getlogin)) (password #f) (identity #f) (authenticate-server? #t)
(sudo? #f) (sudo-user #f) (sudo-password #f))
(make <ssh-connection> #:user user #:host host #:password password
#:identity identity #:authenticate-server? authenticate-server?))
#:identity identity #:authenticate-server? authenticate-server?
#:sudo? sudo? #:sudo-user sudo-user #:sudo-password sudo-password))
(define* (call-with-connection conn proc #:key sudo? sudo-user sudo-password)
(let ((conn (deep-clone conn)))

18
ordo/context.scm
View file

@ -16,6 +16,9 @@ this program. If not, see <https://www.gnu.org/licenses/>.
|#
(define-module (ordo context)
#:use-module (ice-9 exceptions)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-69))
;;
@ -64,3 +67,18 @@ this program. If not, see <https://www.gnu.org/licenses/>.
(define-public (host-var-set! key value)
(hash-table-set! (*host-vars*) key value))
;;
;; Play handlers
;;
(define-public *play-handlers* (make-parameter #f))
(define-public *play-triggers* (make-parameter #f))
(define-public (trigger-handler! handler-name)
(let ((ix (list-index (cut equal? handler-name <>) (*play-handlers*))))
(if ix
(bitvector-set-bit! (*play-triggers*) ix)
(raise-exception
(make-exception
(make-programming-error)
(make-exception-with-message (format #f "no such handler: ~a" handler-name)))))))

29
ordo/inventory.scm
View file

@ -23,6 +23,7 @@ this program. If not, see <https://www.gnu.org/licenses/>.
#:use-module ((ordo connection) #:select (local-connection))
#:use-module (ordo logger)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-69)
#:export (host
host?
@ -33,21 +34,16 @@ this program. If not, see <https://www.gnu.org/licenses/>.
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-record-type <host>
(make-host name connection tags vars)
host?
(name host-name)
(connection host-connection)
(tags host-tags)
(vars host-vars))
(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* (host #:key name connection (tags '()) (vars '()))
(make-host name connection tags (alist->hash-table vars)))
(define (tagged-every? wanted-tags)
(lambda (h)
@ -64,12 +60,13 @@ this program. If not, see <https://www.gnu.org/licenses/>.
(define (resolve-hosts inventory expr)
(match expr
("localhost" (list (or (find (named? "localhost") inventory)
(make <host> #:name "localhost" #:connection (local-connection)))))
(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))))
(('tagged/any tag . tags) (filter (tagged-any? (cons tag tags)) inventory))
((. hostnames) (filter (lambda (h) (member (host-name h) hostnames string=?)) inventory))))
(define (load-inventory filename)
(log-msg 'INFO "Loading inventory " filename)

89
ordo/play.scm
View file

@ -16,12 +16,12 @@ this program. If not, see <https://www.gnu.org/licenses/>.
|#
(define-module (ordo play)
#:use-module (oop goops)
#:use-module (ordo connection)
#:use-module (ordo context)
#:use-module (ordo inventory)
#:use-module (ordo logger)
#:use-module (ordo util flatten)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-69)
#:export (play
@ -31,43 +31,86 @@ this program. If not, see <https://www.gnu.org/licenses/>.
play-sudo-user
play-sudo-password
play-vars
play-actions
play-tasks
play-handlers
run-play))
run-play
task
task?
task-name
task-pre-condition
task-action
run-task
handler
handler?
handler-name
handler-action))
(define-class <play> ()
(name #:init-keyword #:name #:getter play-name)
(host #:init-keyword #:host #:getter play-host)
(sudo? #:init-keyword #:sudo? #:getter play-sudo? #:init-value #f)
(sudo-user #:init-keyword #:sudo-user #:getter play-sudo-user #:init-value #f)
(sudo-password #:init-keyword #:sudo-password #:getter play-sudo-password #:init-value #f)
(vars #:init-keyword #:vars #:getter play-vars #:init-form (list))
(actions #:init-keyword #:actions #:getter play-actions #:init-form (list))
(handlers #:init-keyword #:handlers #:getter play-handlers #:init-form (list)))
(define-record-type <play>
(make-play name host sudo? sudo-user sudo-password vars tasks handlers)
play?
(name play-name)
(host play-host)
(sudo? play-sudo?)
(sudo-user play-sudo-user)
(sudo-password play-sudo-password)
(vars play-vars)
(tasks play-tasks)
(handlers play-handlers))
(define-method (initialize (object <play>) initargs)
(next-method)
(slot-set! object 'vars (alist->hash-table (slot-ref object 'vars))))
(define* (play #:key name host (sudo? #f) (sudo-user #f) (sudo-password #f) (vars '()) (tasks '()) (handlers '()))
(make-play name host sudo? sudo-user sudo-password (alist->hash-table vars) tasks handlers))
(define (play . args)
(apply make <play> args))
(define-record-type <task>
(make-task name action pre-condition)
task?
(name task-name)
(pre-condition task-pre-condition)
(action task-action))
(define* (task #:key name action (pre-condition (const #t)))
(make-task name action pre-condition))
(define (run-task t conn)
(if ((task-pre-condition t) conn)
(begin
(log-msg 'NOTICE "Running task " (task-name t))
((task-action t) conn))
(log-msg 'NOTICE "Skipping task " (task-name t) ": pre-condition not met")))
(define-record-type <handler>
(make-handler name action)
handler?
(name handler-name)
(action handler-action))
(define* (handler #:key name action)
(make-handler name action))
(define (run-handler h conn)
(log-msg 'NOTICE "Running handler: " (handler-name h))
((handler-action h) conn))
(define (run-play p)
(log-msg 'NOTICE "Running play: " (play-name p))
(parameterize ((*play-vars* (play-vars p)))
(parameterize ((*play-handlers* (map handler-name (play-handlers p)))
(*play-vars* (play-vars p)))
(let ((hosts (resolve-hosts (*inventory*) (play-host p))))
(if (null? hosts)
(log-msg 'WARN "No hosts matched: " (play-host p))
(for-each (lambda (h) (run-host-play p h)) hosts)))))
(for-each (cut run-host-play p <>) hosts)))))
(define (run-host-play p h)
(log-msg 'NOTICE "Running play: " (play-name p) " on host: " (host-name h))
(parameterize ((*host-vars* (host-vars h)))
(log-msg 'NOTICE "Running play on host: " (host-name h))
(parameterize ((*host-vars* (host-vars h))
(*play-triggers* (make-bitvector (length (play-handlers p)) #f)))
(call-with-connection
(host-connection h)
(lambda (conn)
#f
)
(for-each (cut run-task <> conn) (play-tasks p))
(for-each (lambda (h i)
(when (bitvector-bit-set? (*play-triggers*) i)
(run-handler h conn)))
(play-handlers p) (iota (length (play-handlers p)))))
#:sudo? (play-sudo? p)
#:sudo-user (play-sudo-user p)
#:sudo-password (play-sudo-password p))))

28
ordo/playbook.scm
View file

@ -18,10 +18,10 @@ this program. If not, see <https://www.gnu.org/licenses/>.
(define-module (ordo playbook)
#:use-module (ice-9 eval-string)
#:use-module (ice-9 textual-ports)
#:use-module (oop goops)
#:use-module (ordo context)
#:use-module (ordo logger)
#:use-module (ordo play)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-69)
#:export (<playbook>
@ -32,22 +32,20 @@ this program. If not, see <https://www.gnu.org/licenses/>.
playbook-plays
load-playbook
run-playbook)
#:re-export (play))
#:re-export (play
task
handler
trigger-handler!))
(define-class <playbook> ()
(name #:init-keyword #:name #:getter playbook-name)
(vars #:init-keyword #:vars #:getter playbook-vars)
(plays #:init-keyword #:plays #:getter playbook-plays))
(define-record-type <playbook>
(make-playbook name vars plays)
playbook?
(name playbook-name)
(vars playbook-vars)
(plays playbook-plays))
(define-method (initialize (object <playbook>) initargs)
(next-method)
(slot-set! object 'vars (alist->hash-table (slot-ref object 'vars))))
(define (playbook . args)
(apply make <playbook> args))
(define (playbook? p)
(is-a? p <playbook>))
(define* (playbook #:key name (vars '()) (plays '()))
(make-playbook name (alist->hash-table vars) plays))
(define (load-playbook filename)
(log-msg 'INFO "Loading playbook " filename)