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)