From 49571984c27b85656bfeea3d346a4d35f6cb8590 Mon Sep 17 00:00:00 2001 From: Ray Miller Date: Sat, 7 Jun 2025 16:25:31 +0100 Subject: [PATCH] Basic functionality for play and playbook --- examples/inventory.scm | 10 +++-- examples/playbook.scm | 11 +++++- ordo/connection.scm | 6 ++- ordo/context.scm | 18 +++++++++ ordo/inventory.scm | 29 ++++++-------- ordo/play.scm | 89 +++++++++++++++++++++++++++++++----------- ordo/playbook.scm | 28 ++++++------- 7 files changed, 131 insertions(+), 60 deletions(-) diff --git a/examples/inventory.scm b/examples/inventory.scm index 7d5b9a9..30a2a78 100644 --- a/examples/inventory.scm +++ b/examples/inventory.scm @@ -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))) diff --git a/examples/playbook.scm b/examples/playbook.scm index 64836f5..631b2a6 100644 --- a/examples/playbook.scm +++ b/examples/playbook.scm @@ -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)))))) diff --git a/ordo/connection.scm b/ordo/connection.scm index 8046bcf..f9b2886 100644 --- a/ordo/connection.scm +++ b/ordo/connection.scm @@ -40,9 +40,11 @@ this program. If not, see . (define (local-connection) (make )) -(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 #: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))) diff --git a/ordo/context.scm b/ordo/context.scm index ff150a0..4a0157b 100644 --- a/ordo/context.scm +++ b/ordo/context.scm @@ -16,6 +16,9 @@ this program. If not, see . |# (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 . (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))))))) diff --git a/ordo/inventory.scm b/ordo/inventory.scm index 669ed8e..354e8e4 100644 --- a/ordo/inventory.scm +++ b/ordo/inventory.scm @@ -23,6 +23,7 @@ this program. If not, see . #: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 . resolve-hosts load-inventory)) -(define-class () - (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 + (make-host name connection tags vars) + host? + (name host-name) + (connection host-connection) + (tags host-tags) + (vars host-vars)) -(define-method (initialize (object ) initargs) - (next-method) - (slot-set! object 'vars (alist->hash-table (slot-ref object 'vars)))) - -(define (host . args) - (apply make args)) - -(define (host? x) - (is-a? x )) +(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 . (define (resolve-hosts inventory expr) (match expr ("localhost" (list (or (find (named? "localhost") inventory) - (make #: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) diff --git a/ordo/play.scm b/ordo/play.scm index ba08ee2..8ef756a 100644 --- a/ordo/play.scm +++ b/ordo/play.scm @@ -16,12 +16,12 @@ this program. If not, see . |# (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 . 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 () - (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 + (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 ) 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 args)) +(define-record-type + (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 + (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)))) diff --git a/ordo/playbook.scm b/ordo/playbook.scm index 44df6a7..122ab6e 100644 --- a/ordo/playbook.scm +++ b/ordo/playbook.scm @@ -18,10 +18,10 @@ this program. If not, see . (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 ( @@ -32,22 +32,20 @@ this program. If not, see . playbook-plays load-playbook run-playbook) - #:re-export (play)) + #:re-export (play + task + handler + trigger-handler!)) -(define-class () - (name #:init-keyword #:name #:getter playbook-name) - (vars #:init-keyword #:vars #:getter playbook-vars) - (plays #:init-keyword #:plays #:getter playbook-plays)) +(define-record-type + (make-playbook name vars plays) + playbook? + (name playbook-name) + (vars playbook-vars) + (plays playbook-plays)) -(define-method (initialize (object ) initargs) - (next-method) - (slot-set! object 'vars (alist->hash-table (slot-ref object 'vars)))) - -(define (playbook . args) - (apply make args)) - -(define (playbook? p) - (is-a? p )) +(define* (playbook #:key name (vars '()) (plays '())) + (make-playbook name (alist->hash-table vars) plays)) (define (load-playbook filename) (log-msg 'INFO "Loading playbook " filename)