Basic functionality for play and playbook

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")
+       #:connection (ssh-connection "control-surface" #:user "ray")
-       #:tags '(#:linux #:debian)))
+       #:tags '(#:linux #:debian))
+
+ (host #:name "cargo-cult"
+       #:connection (ssh-connection "cargo-cult" #:user "ray")
+       #:tags '(#:linux #:synology)))

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))))))

ordo/connection.scm

@@ -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)))

ordo/context.scm

@@ -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)))))))

ordo/inventory.scm

@@ -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> ()
+(define-record-type <host>
-  (name #:init-keyword #:name #:getter host-name)
+  (make-host name connection tags vars)
-  (connection #:init-keyword #:connection #:getter host-connection)
+  host?
-  (tags #:init-keyword #:tags #:getter host-tags #:init-form (list))
+  (name host-name)
-  (vars #:init-keyword #:vars #:getter host-vars #:init-form (list)))
+  (connection host-connection)
+  (tags host-tags)
+  (vars host-vars))
 
-(define-method (initialize (object <host>) initargs)
+(define* (host #:key name connection (tags '()) (vars '()))
-  (next-method)
+  (make-host name connection tags (alist->hash-table vars)))
-  (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 (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)

ordo/play.scm

@@ -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> ()
+(define-record-type <play>
-  (name #:init-keyword #:name #:getter play-name)
+  (make-play name host sudo? sudo-user sudo-password vars tasks handlers)
-  (host #:init-keyword #:host #:getter play-host)
+  play?
-  (sudo? #:init-keyword #:sudo? #:getter play-sudo? #:init-value #f)
+  (name play-name)
-  (sudo-user #:init-keyword #:sudo-user #:getter play-sudo-user #:init-value #f)
+  (host play-host)
-  (sudo-password #:init-keyword #:sudo-password #:getter play-sudo-password #:init-value #f)
+  (sudo? play-sudo?)
-  (vars #:init-keyword #:vars #:getter  play-vars #:init-form (list))
+  (sudo-user play-sudo-user)
-  (actions #:init-keyword #:actions #:getter play-actions #:init-form (list))
+  (sudo-password play-sudo-password)
-  (handlers #:init-keyword #:handlers #:getter play-handlers #:init-form (list)))
+  (vars play-vars)
+  (tasks play-tasks)
+  (handlers play-handlers))
 
-(define-method (initialize (object <play>) initargs)
+(define* (play #:key name host (sudo? #f) (sudo-user #f) (sudo-password #f) (vars '()) (tasks '()) (handlers '()))
-  (next-method)
+  (make-play name host sudo? sudo-user sudo-password (alist->hash-table vars) tasks handlers))
-  (slot-set! object 'vars (alist->hash-table (slot-ref object 'vars))))
 
-(define (play . args)
+(define-record-type <task>
-  (apply make <play> args))
+  (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))
+  (log-msg 'NOTICE "Running play on host: " (host-name h))
-  (parameterize ((*host-vars* (host-vars 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))))

ordo/playbook.scm

@@ -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> ()
+(define-record-type <playbook>
-  (name #:init-keyword #:name #:getter playbook-name)
+  (make-playbook name vars plays)
-  (vars #:init-keyword #:vars #:getter playbook-vars)
+  playbook?
-  (plays #:init-keyword #:plays #:getter playbook-plays))
+  (name playbook-name)
+  (vars playbook-vars)
+  (plays playbook-plays))
 
-(define-method (initialize (object <playbook>) initargs)
+(define* (playbook #:key name (vars '()) (plays '()))
-  (next-method)
+  (make-playbook name (alist->hash-table vars) plays))
-  (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 (load-playbook filename)
   (log-msg 'INFO "Loading playbook " filename)