Merge branch wip/interceptors into main

bin/ordo.sh

@@ -2,5 +2,4 @@
 
 MODULES_DIR=$( cd -- "$( dirname -- "${BASH_SOURCE[0]}" )/../modules" &> /dev/null && pwd )
 
-# guile -L modules --no-auto-compile -e '(@ (ordo cli) main)' -- $PWD/examples/inventory.scm $PWD/examples/basic.scm
 exec guile -L "${MODULES_DIR}" --no-auto-compile -e '(@ (ordo cli) main)' -- "$@"

bin/play.scm

@@ -1,43 +0,0 @@
-#!/usr/bin/env -S guile --no-auto-compile -e main -s
-!#
-(use-modules (srfi srfi-11)
-             (ice-9 getopt-long)
-             (ice-9 format)
-             (ordo util filesystem))
-
-(define (tar . args)
-  (unless (zero? (apply system* "tar" args))
-    (error (format #f "Non-zero exit from tar ~a" args))))
-
-(define* (usage #:optional errmsg)
-  (with-output-to-port (current-error-port)
-    (lambda ()
-      (when errmsg
-        (format #t "Error: ~a~%~%" errmsg))
-      (display "Usage: play -t TARGET PLAYBOOK")
-      (newline)))
-  (exit (if errmsg EXIT_FAILURE EXIT_SUCCESS)))
-
-(define (process-options args)
-  (let* ((option-spec '((help   (single-char #\h) (value #f))
-                        (target (single-char #\t) (value #t) (required? #t))))
-         (options (getopt-long args option-spec))
-         (help-wanted (option-ref options 'help #f))
-         (target (option-ref options 'target #f))
-         (args   (option-ref options '() '())))
-    (cond
-     (help-wanted (usage))
-     ((not (= 1 (length args)))
-      (usage "Expected exactly one playbook")))
-    (values (canonicalize-path (car args)) target)))
-
-(define (main args)
-  (let-values (((playbook-path target) (process-options args)))
-    (define playbook (load playbook-path))
-    (define top-dir (dirname (dirname (current-filename))))
-    (call-with-temporary-directory
-     (lambda (tmp-dir)
-       (define tarball (string-append tmp-dir "/payload.tar"))
-       (tar "--create" "--file" tarball "--directory" top-dir "modules" "bin")
-       (tar "--append" "--file" tarball "--transform" "s/.*/playbook.scm/" playbook-path)
-       (tar "tf" tarball)))))

examples/install-aws-cli.scm

@@ -1,33 +1,41 @@
 (use-modules
  (ice-9 filesystem)
- (ordo))
+ (srfi srfi-71)
+ (ordo playbook)
+ (ordo play)
+ (ordo interceptor)
+ (ordo connection)
+ (ordo interceptor create-tmp-dir)
+ (ordo interceptor require-commands)
+ (ordo interceptor user-info)
+ (ordo interceptor download)
+ (ordo interceptor unzip)
+ (ordo interceptor command))
 
+;; This example shows that a function can act a bit like an ansible role by
+;; returning a list of interceptors to be added to the caller's interceptor
+;; chain. (The list will be flattened to construct the final chain.)
 (define* (install-aws-cli #:key (url "https://awscli.amazonaws.com/awscli-exe-linux-x86_64.zip") update? install-dir bin-dir)
-  (let* ((conn (current-connection))
-         (tmp-dir (run conn "mktemp" "-d" #:return car #:check? #t)))
-    (dynamic-wind
-      (const #t)
-      (lambda ()
-        (let ((zipfile (file-name-join* tmp-dir (file-basename url))))
-          (run conn "wget" "-O" zipfile url #:check? #t)
-          (run conn "unzip" zipfile "-d" tmp-dir #:check? #t)
-          (run conn (file-name-join* tmp-dir "aws" "install")
-               (when install-dir `("-i" ,install-dir))
-               (when bin-dir `("-b" ,bin-dir))
-               (when update? "-u")
-               #:check? #t)))
-      (lambda ()
-        (run conn "rm" "-rf" tmp-dir)))))
+  (list (require-commands "wget" "unzip")
+        (create-tmp-dir #:register 'aws-cli-tmp)
+        (download "download-aws-cli" #:url url #:target-dir (var aws-cli-tmp) #:register 'aws-cli-zipfile)
+        (unzip "extract-aws-cli" #:file-name (var aws-cli-zipfile) #:target-dir (var aws-cli-tmp))
+        (command "run-aws-cli-installer"
+                 (list
+                  (let-vars (aws-cli-tmp) (file-name-join* aws-cli-tmp "aws" "install"))
+                  (when install-dir `("-i" ,install-dir))
+                  (when bin-dir `("-b" ,bin-dir))
+                  (when update? "-u")
+                  #:check? #t))))
 
 (playbook
  #:name "Test Playbook"
  #:plays (list
           (play
-           #:name "Test play"
+           #:name "Install AWS CLI"
            #:host "localhost"
-           #:tasks (list
-                    (task #:name "Install AWS CLI"
-                          #:action (lambda ()
-                                     (install-aws-cli #:update? #t
-                                                      #:install-dir (file-name-join* ($ #:fact.home-dir) ".local" "aws-cli")
-                                                      #:bin-dir (file-name-join* ($ #:fact.home-dir) ".local" "bin"))))))))
+           #:interceptors (list
+                           (user-info)
+                           (install-aws-cli #:update? #t
+                                            #:install-dir (let-vars (user-info) (file-name-join* (assoc-ref user-info #:home-dir) ".local" "aws-cli"))
+                                            #:bin-dir (let-vars (user-info) (file-name-join* (assoc-ref user-info  #:home-dir) ".local" "bin")))))))

examples/interceptor.scm

@@ -0,0 +1,34 @@
+(use-modules
+ (ice-9 filesystem)
+ (ordo playbook)
+ (ordo play)
+ (ordo interceptor)
+ (ordo interceptor install-file)
+ (ordo interceptor create-tmp-dir)
+ (ordo interceptor stat-file)
+ (ordo interceptor user-info)
+ (ordo interceptor command)
+ (ordo interceptor debug))
+
+(playbook
+ #:name "Test some basic filesystem operations"
+ #:vars '((file-content . "This is shadowed by the play variable."))
+ #:plays (list (play
+                #:name "Basic filesystem operations"
+                #:host "localhost"
+                #:vars '((file-content . "Hello, world!\n"))
+                #:interceptors (list (create-tmp-dir #:register 'tmp-dir)
+                                     (user-info)
+                                     (debug-vars 'user-info)
+                                     (install-file
+                                      "install-hello"
+                                      #:path (let-vars (tmp-dir) (file-name-join* tmp-dir "hello.txt"))
+                                      #:content (var file-content)
+                                      #:register 'hello)
+                                     (stat-file
+                                      "stat-hello"
+                                      #:path (var hello)
+                                      #:register 'hello-stat)
+                                     (command "list-tmp-dir" (list "ls" "-l" (var tmp-dir) #:check? #t) #:register 'dir-list)
+                                     (command "list-root-dir" (list "ls" "-l" "/root" #:check? #f) #:register 'root-list)
+                                     (debug-vars)))))

examples/inventory.scm

@@ -1,4 +1,5 @@
-(use-modules (ordo))
+(use-modules (ordo inventory)
+             (ordo connection))
 
 (add-host! "little-rascal"
            (local-connection)

examples/ubuntu.scm

@@ -0,0 +1,15 @@
+(use-modules
+ (ordo playbook)
+ (ordo play)
+ (ordo interceptor apt))
+
+(playbook
+ #:name "APT operations"
+ #:plays (list
+          (play
+           #:name "Test APT operations"
+           #:host '(tagged/any #:ubuntu #:debian)
+           #:interceptors (list
+                           (apt:update)
+                           (apt:dist-upgrade)
+                           (map apt:install (list "curl" "ca-certificates"))))))

modules/ordo.scm

@@ -1,10 +0,0 @@
-(define-module (ordo)
-  #:use-module (ice-9 match)
-  #:use-module (ordo playbook)
-  #:use-module (ordo play)
-  #:use-module (ordo task)
-  #:use-module (ordo handler)
-  #:use-module (ordo connection)
-  #:use-module (ordo context)
-  #:use-module (ordo logger)
-  #:re-export (add-host! local-connection ssh-connection current-connection run playbook play task handler $))

modules/ordo/action/apt.scm

@@ -1,42 +0,0 @@
-(define-module (ordo action apt)
-  #:use-module ((ordo connection) #:select (run)))
-
-(define noninteractive-env '(("DEBIAN_FRONTEND" . "noninteractive")
-                             ("APT_LISTCHANGES_FRONTEND" . "none")))
-
-(define-syntax define-apt-operation
-  (syntax-rules ()
-    ((define-apt-operation (name args ...) apt-args ...)
-     (define-public (name conn args ...)
-       (run conn "apt-get" "-q" "-y" apt-args ... args ... #:env noninteractive-env)))
-    ((define-apt-operation name apt-args ...)
-     (define-public (name conn)
-       (run conn "apt-get" "-q" "-y" apt-args ... #:env noninteractive-env)))))
-
-(define-apt-operation apt:update "update")
-
-(define-apt-operation apt:upgrade "upgrade")
-
-(define-apt-operation apt:dist-upgrade "dist-upgrade")
-
-(define-apt-operation (apt:install package-name) "install")
-
-(define-apt-operation (apt:install-minimal package-name) "install" "--no-install-recommends")
-
-(define-apt-operation (apt:reinstall package-name) "reinstall")
-
-(define-apt-operation (apt:remove package-name) "remove")
-
-(define-apt-operation (apt:purge package-name) "purge")
-
-(define-apt-operation (apt:build-dep package-name) "build-dep")
-
-(define-apt-operation apt:clean "clean")
-
-(define-apt-operation apt:autoclean "autoclean")
-
-(define-apt-operation apt:distclean "distclean")
-
-(define-apt-operation apt:autoremove "autoremove")
-
-(define-apt-operation apt:autopurge "autopurge")

modules/ordo/action/quadlet.scm

@@ -0,0 +1,41 @@
+(define-module (ordo action quadlet)
+  #:use-module (ice-9 filesystem)
+  #:use-module (ini)
+  #:use-module (logging logger)
+  #:use-module (ordo connection)
+  #:use-module (ordo action filesystem)
+  #:export (create-network-quadlet))
+
+(define quadlet-dir "/etc/containers/systemd")
+
+(define default-install-options '(("WantedBy" . "multi-user.target default.target")))
+
+(define (scm->ini-string data)
+  (with-output-to-string (lambda () (scm->ini data))))
+
+(define (build-quadlet quadlet-type name description unit-options quadlet-options install-options)
+  (let* ((description (or description (string-append "Podman " (string-downcase quadlet-type) " " name)))
+         (data `(("Unit" ("Description" . ,description) ,@unit-options)
+                 (,(string-titlecase quadlet-type) ,@quadlet-options)
+                 ("Install" ,@(or install-options default-install-options)))))
+    (scm->ini-string data)))
+
+(define-syntax define-quadlet-type
+  (syntax-rules ()
+    ((define-quadlet-type function-name quadlet-type suffix default-install-options)
+     (define* (function-name conn name #:key description (quadlet-options '()) (unit-options '()) (install-options default-install-options))
+       (fs:install-file conn
+                        (file-name-join* quadlet-dir (string-append name suffix))
+                        #:content (build-quadlet quadlet-type name description quadlet-options unit-options install-options))))))
+
+(define-quadlet-type create-network-quadlet "Network" ".network" default-install-options)
+
+(define-quadlet-type create-pod-quadlet "Pod" ".pod" default-install-options)
+
+(define-quadlet-type create-container-quadlet "Container" ".container" default-install-options)
+
+(define-quadlet-type create-volume-quadlet "Volume" ".volume" '())
+
+(define-quadlet-type create-build-quadlet "Build" ".build" '())
+
+(define-quadlet-type create-image-quadlet "Image" ".image" '())

modules/ordo/cli.scm

@@ -3,7 +3,6 @@
   #:use-module (ice-9 match)
   #:use-module (logging logger)
   #:use-module (ordo logger)
-  #:use-module (ordo context)
   #:use-module (ordo playbook)
   #:declarative? #f
   #:export (main))
@@ -12,9 +11,7 @@
   (match-let (((_ inventory-path playbook-path) args))
     (let ((inventory-path (expand-file-name inventory-path))
           (playbook-path (expand-file-name playbook-path)))
-      (setup-logging #:level 'DEBUG)
-      (log-msg 'DEBUG "Initializing context")
-      (init-context!)
+      (setup-logging #:level 'INFO)
       (load inventory-path)
       (log-msg 'DEBUG "Loaded inventory: " inventory-path)
       (let ((playbook (load playbook-path)))

modules/ordo/condition.scm

@@ -1,6 +1,7 @@
 (define-module (ordo condition)
   #:use-module (srfi srfi-71)
-  #:use-module (ordo context)
+  #:use-module (ordo connection)
+  #:use-module (ordo interceptor)
   #:use-module (ordo action filesystem))
 
 (define-public (cond:any preds)
@@ -25,15 +26,15 @@
 
 (define-public (cond:command-available? cmd-name)
   (lambda (ctx)
-    (let ((_ rc (run "which" `(,cmd-name))))
+    (let ((_ rc (run (context-connection ctx) "which" cmd-name)))
       (zero? rc))))
 
 (define-public (cond:directory? path)
   (lambda (ctx)
-    (let ((st ((action:stat path) ctx)))
+    (let ((st (fs:stat (context-connection ctx) path)))
       (and st (string=? "directory" (assoc-ref st 'file-type))))))
 
 (define-public (cond:regular-file? path)
   (lambda (ctx)
-    (let ((st ((action:stat path) ctx)))
+    (let ((st (fs:stat (context-connection ctx) path)))
       (and st (string=? "regular-file" (assoc-ref st 'file-type))))))

modules/ordo/connection.scm

@@ -50,9 +50,8 @@
     (string-join xs " ")))
 
 (define (run conn prog . args)
-  (let* ((args (flatten args))
-         (args kwargs (break keyword? args))
-         (args (remove unspecified? args))
+  (let* ((args kwargs (break keyword? args))
+         (args (remove unspecified? (flatten args)))
          (pwd (keyword-arg kwargs #:pwd))
          (env (keyword-arg kwargs #:env))
          (return (keyword-arg kwargs #:return identity))

modules/ordo/context.scm

@@ -1,152 +0,0 @@
-(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*) '()))))

modules/ordo/facts.scm

@@ -1,19 +0,0 @@
-(define-module (ordo facts)
-  #:use-module ((srfi srfi-88) #:select (string->keyword))
-  #:use-module (ordo context)
-  #:use-module (ordo facts user)
-  #:export (gather-facts))
-
-(define (set-facts! src keys)
-  (for-each (lambda (k)
-              (set-play-var! (string->keyword (string-append "fact." k))
-                             (assoc-ref src (string->keyword k))))
-            keys))
-
-(define (gather-facts)
-  (let* ((conn (current-connection))
-         (id (fact:id conn))
-         (user-name (assoc-ref id #:user-name))
-         (pwent (fact:pwent conn user-name)))
-    (set-facts! id '("user-name" "user-id" "group-name" "group-id" "groups"))
-    (set-facts! pwent '("gecos" "home-dir" "shell"))))

modules/ordo/facts/user.scm

@@ -1,32 +0,0 @@
-(define-module (ordo facts user)
-  #:use-module (rx irregex)
-  #:use-module (srfi srfi-1)
-  #:use-module (ordo connection)
-  #:export (fact:id
-            fact:pwent))
-
-(define (parse-id-output s)
-  (let ((data (reverse (irregex-fold (irregex '(seq (=> id integer) "(" (=> name (+ alphanumeric)) ")"))
-                                     (lambda (_ m accum)
-                                       (cons `((#:id . ,(string->number (irregex-match-substring m 'id)))
-                                               (#:name . ,(irregex-match-substring m 'name)))
-                                             accum))
-                                     '()
-                                     s))))
-    `((#:user-id . ,(assoc-ref (first data) #:id))
-      (#:user-name . ,(assoc-ref (first data) #:name))
-      (#:group-id . ,(assoc-ref (second data) #:id))
-      (#:group-name . ,(assoc-ref (second data) #:name))
-      (#:groups . ,(drop data 2)))))
-
-(define (fact:id conn)
-  (run conn "id" #:check? #t #:return (compose parse-id-output car)))
-
-(define (parse-passwd-entry s)
-  (map cons
-       '(#:user-name #:password #:user-id #:group-id #:gecos #:home-dir #:shell)
-       (string-split s #\:)))
-
-(define (fact:pwent conn user-name)
-  (run conn "getent" "passwd" user-name
-       #:check? #t #:return (compose parse-passwd-entry car)))

modules/ordo/handler.scm

@@ -1,25 +0,0 @@
-(define-module (ordo handler)
-  #:use-module (ice-9 match)
-  #:use-module (srfi srfi-9) ; records
-  #:use-module (logging logger)
-  #:use-module (ordo context)
-  #:export (handler
-            handler?
-            handler-name
-            handler-action
-            run-handler))
-
-(define-record-type <handler>
-  (make-handler name action)
-  handler?
-  (name handler-name)
-  (action handler-action))
-
-(define (handler name action)
-  (make-handler name action))
-
-(define (run-handler h)
-  (match h
-    (($ <handler> name action)
-     (log-msg 'NOTICE "Running handler: " name)
-     (action (current-connection)))))

modules/ordo/interceptor.scm

@@ -0,0 +1,226 @@
+(define-module (ordo interceptor)
+  #:use-module (ice-9 exceptions)
+  #:use-module (logging logger)
+  #:use-module (srfi srfi-1)   ; list utils
+  #:use-module (srfi srfi-9)   ; records
+  #:use-module (srfi srfi-26)  ; cut
+  #:use-module (srfi srfi-69)  ; hash tables
+  #:use-module (srfi srfi-71)  ; extended let
+  #:use-module (srfi srfi-145) ; assume
+  #:export (interceptor
+            init-context
+            context-connection
+            set-context-connection!
+            context-error
+            set-context-error!
+            context-suppressed
+            context-vars
+            set-context-vars!
+            var-ref
+            var-set!
+            var-delete!
+            let-vars
+            var
+            expand-vars
+            delayed-var-ref?
+            terminate-when
+            execute))
+
+(define (check-var-name name)
+  (unless (symbol? name)
+    (raise-exception (make-exception
+                      (make-assertion-failure)
+                      (make-exception-with-message "Variable name should be a symbol")
+                      (make-exception-with-irritants name)))))
+
+(define-record-type <context>
+  (make-context vars stack queue terminators error suppressed)
+  context?
+  (connection context-connection set-context-connection!)
+  (vars context-vars set-context-vars!)
+  (stack context-stack set-context-stack!)
+  (queue context-queue set-context-queue!)
+  (terminators context-terminators set-context-terminators!)
+  (error context-error set-context-error!)
+  (suppressed context-suppressed set-context-suppressed!))
+
+(define* (init-context #:key (vars '()))
+  "Initialize a context with optional connection and vars."
+  (for-each check-var-name (map car vars))
+  (make-context
+   ;; vars
+   (alist->hash-table vars eqv?)
+   ;; stack
+   '()
+   ;; queue
+   '()
+   ;; terminators
+   '()
+   ;; error
+   #f
+   ;; suppressed errors
+   '()))
+
+(define (var-set! ctx name value)
+  (check-var-name name)
+  (log-msg 'DEBUG "Setting variable " name " to " value)
+  (hash-table-set! (context-vars ctx) name value))
+
+(define* (var-ref ctx name #:optional default)
+  (check-var-name name)
+  (log-msg 'DEBUG "Getting variable " name " with default " default)
+  (hash-table-ref/default (context-vars ctx) name default))
+
+(define (var-delete! ctx name)
+  (check-var-name name)
+  (log-msg 'DEBUG "Deleting variable " name)
+  (hash-table-delete! (context-vars ctx) name))
+
+(define-syntax let-vars
+  (syntax-rules ()
+    ((let-vars (var-name ...) expr exprs ...)
+     (lambda (ctx)
+       #((delayed-var-ref? . #t))
+       (let ((var-name (hash-table-ref (context-vars ctx) 'var-name)) ...)
+         expr
+         exprs ...)))))
+
+(define-syntax var
+  (syntax-rules ()
+    ((var var-name)
+     (let-vars (var-name) var-name))))
+
+(define (delayed-var-ref? v)
+  (and (procedure? v) (procedure-property v 'delayed-var-ref?)))
+
+(define-syntax expand-vars
+  (syntax-rules ()
+    ((expand-vars ctx v ...)
+     (values (if (delayed-var-ref? v) (v ctx) v) ...))))
+
+(define-record-type <interceptor>
+  (make-interceptor name enter leave error)
+  interceptor?
+  (name interceptor-name)
+  (enter interceptor-enter)
+  (leave interceptor-leave)
+  (error interceptor-error))
+
+(define* (interceptor name #:key enter leave error)
+  (assume (string? name) "interceptor name should be a string" name)
+  (make-interceptor name enter leave error))
+
+(define-exception-type &interceptor-error &error
+  make-interceptor-error
+  interceptor-error?
+  (interceptor-name interceptor-error-interceptor-name)
+  (stage interceptor-error-stage)
+  (cause interceptor-error-cause))
+
+(define (enqueue ctx interceptors)
+  "Add interceptors to the context."
+  (unless (every interceptor? interceptors)
+    (error "invalid interceptors"))
+  (set-context-queue! ctx interceptors))
+
+(define (terminate ctx)
+  "Remove all remaining interceptors from the queue, short-circuiting the
+   enter stage and running the leave stage."
+  (set-context-queue! ctx '()))
+
+(define (check-terminators ctx)
+  "Check the context terminators and possibly trigger early termination."
+  (let loop ((terminators (context-terminators ctx)))
+    (unless (null? terminators)
+      (let ((t (car terminators)))
+        (if (t ctx)
+            (terminate ctx)
+            (loop (cdr terminators)))))))
+
+(define (try-enter ctx t)
+  "Run the interceptor's #:enter function."
+  (let ((handler (interceptor-enter t)))
+    (when handler
+      (log-msg 'NOTICE "Running #:enter function for " (interceptor-name t))
+      (with-exception-handler
+          (lambda (e)
+            (set-context-error! ctx (make-interceptor-error (interceptor-name t) #:enter e)))
+        (lambda () (handler ctx))
+        #:unwind? #t))))
+
+(define (try-leave ctx t)
+  "Run the interceptor's #:leave function."
+  (let ((handler (interceptor-leave t)))
+    (when handler
+      (log-msg 'NOTICE "Running #:leave function for " (interceptor-name t))
+      (with-exception-handler
+          (lambda (e)
+            (set-context-error! ctx
+                                (make-interceptor-error (interceptor-name t) #:leave e)))
+        (lambda () (handler ctx))
+        #:unwind? #t))))
+
+(define (try-error ctx t err)
+  "Run the interceptor's #:error function."
+  (let ((handler (interceptor-error t)))
+    (when handler
+      (log-msg 'NOTICE "Running #:error function for " (interceptor-name t))
+      (with-exception-handler
+          (lambda (e)
+            (log-msg 'WARN "error handler for interceptor '" (interceptor-name t) "' threw error: " e)
+            (set-context-suppressed! ctx
+                                     (cons (make-interceptor-error (interceptor-name t) #:error e)
+                                           (context-suppressed ctx))))
+        (lambda () (handler ctx))
+        #:unwind? #t))))
+
+(define (execute-leave ctx)
+  "Run all the #:leave functions in the queue."
+  (unless (null? (context-queue ctx))
+    (let ((t (car (context-queue ctx)))
+          (err (context-error ctx)))
+      ;; Run the error or leave handler, according to whether or not we are
+      ;; handling an error
+      (if err
+          (try-error ctx t err)
+          (try-leave ctx t))
+      ;; Remove the current interceptor from the queue and add it to the stack
+      (set-context-stack! ctx (cons t (context-stack ctx)))
+      (set-context-queue! ctx (cdr (context-queue ctx)))
+      ;; Carry on down the chain
+      (execute-leave ctx))))
+
+(define (execute-enter ctx)
+  "Run all the #:enter functions in the queue."
+  (if (null? (context-queue ctx))
+      ;; Prepare to leave
+      (set-context-queue! ctx (context-stack ctx))
+      (let ((t (car (context-queue ctx))))
+        ;; Run the enter handler for the interceptor
+        (try-enter ctx t)
+        ;; Remove the current interceptor from the queue and add it to the stack
+        (set-context-stack! ctx (cons t (context-stack ctx)))
+        (set-context-queue! ctx (cdr (context-queue ctx)))
+        (if (context-error ctx)
+            ;; If an error was caught, abort the enter phase and set up to run the leave phase
+            (begin
+              (set-context-queue! ctx (context-stack ctx))
+              (set-context-stack! ctx '()))
+            ;; Otherwise, check for early termination or carry on down the chain
+            (begin
+              (check-terminators ctx)
+              (execute-enter ctx))))))
+
+(define (terminate-when ctx pred)
+  "Add a predicate for a termination condition to exit the #:enter chain early."
+  (set-context-terminators! ctx (cons pred (context-terminators ctx))))
+
+(define (execute ctx interceptors)
+  "Execute all the interceptors on the given context."
+  (log-msg 'DEBUG "Enqueuing interceptors: " (map interceptor-name interceptors))
+  (enqueue ctx interceptors)
+  (log-msg 'DEBUG "Starting #:enter chain: " (map interceptor-name (context-queue ctx)))
+  (execute-enter ctx)
+  (log-msg 'DEBUG "Starting #:leave chain: " (map interceptor-name (context-queue ctx)))
+  (execute-leave ctx)
+  (and=> (context-error ctx) raise-exception))

modules/ordo/interceptor/apt.scm

@@ -0,0 +1,49 @@
+(define-module (ordo interceptor apt)
+  #:use-module (ordo interceptor)
+  #:use-module ((ordo connection) #:select (run)))
+
+(define noninteractive-env '(("DEBIAN_FRONTEND" . "noninteractive")
+                             ("APT_LISTCHANGES_FRONTEND" . "none")))
+
+(define-syntax define-apt-interceptor
+  (syntax-rules ()
+    ((define-apt-interceptor (name arg) apt-args ...)
+     (define-public (name arg)
+       (interceptor
+        (string-append (symbol->string 'name) " " arg)
+        #:enter (lambda (ctx)
+                  (run (context-connection ctx) "apt-get" "-q" "-y" apt-args ... arg #:env noninteractive-env #:check? #t)))))
+    ((define-apt-interceptor name apt-args ...)
+     (define-public (name)
+       (interceptor
+        (symbol->string 'name)
+        #:enter (lambda (ctx)
+                  (run (context-connection ctx) "apt-get" "-q" "-y" apt-args ... #:env noninteractive-env #:check? #t)))))))
+
+(define-apt-interceptor apt:update "update")
+
+(define-apt-interceptor apt:upgrade "upgrade")
+
+(define-apt-interceptor apt:dist-upgrade "dist-upgrade")
+
+(define-apt-interceptor (apt:install package-name) "install")
+
+(define-apt-interceptor (apt:install-minimal package-name) "install" "--no-install-recommends")
+
+(define-apt-interceptor (apt:reinstall package-name) "reinstall")
+
+(define-apt-interceptor (apt:remove package-name) "remove")
+
+(define-apt-interceptor (apt:purge package-name) "purge")
+
+(define-apt-interceptor (apt:build-dep package-name) "build-dep")
+
+(define-apt-interceptor apt:clean "clean")
+
+(define-apt-interceptor apt:autoclean "autoclean")
+
+(define-apt-interceptor apt:distclean "distclean")
+
+(define-apt-interceptor apt:autoremove "autoremove")
+
+(define-apt-interceptor apt:autopurge "autopurge")

modules/ordo/interceptor/command.scm

@@ -0,0 +1,22 @@
+(define-module (ordo interceptor command)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-145)
+  #:use-module (ordo interceptor)
+  #:use-module (ordo connection)
+  #:use-module (ordo util flatten)
+  #:export (command))
+
+(define* (command name prog-and-args #:key register)
+  (assume (string? name) "interceptor name should be a string" name)
+  (assume (list? prog-and-args) "prog-and-args should be a list" prog-and-args)
+  (assume (or (not register) (symbol? register)) "register should be a symbol" register)
+  (interceptor
+   name
+   #:enter (lambda (ctx)
+             (let ((prog-and-args (map (lambda (v) (expand-vars ctx v)) (flatten prog-and-args))))
+               (pk prog-and-args)
+               (call-with-values
+                   (lambda () (apply run (context-connection ctx) prog-and-args))
+                 (lambda result
+                   (when register
+                     (var-set! ctx register result))))))))

modules/ordo/interceptor/connection.scm

@@ -0,0 +1,22 @@
+(define-module (ordo interceptor connection)
+  #:use-module (oop goops)
+  #:use-module (ordo interceptor)
+  #:use-module (ordo connection)
+  #:use-module (ordo connection sudo)
+  #:export (connection))
+
+(define* (connection c #:key sudo? sudo-user sudo-password)
+  "Interceptor to manage the current connection."
+  (define (cleanup ctx)
+    (and=> (context-connection ctx) conn:teardown)
+    (set-context-connection! ctx #f))
+  (interceptor
+   "connection"
+   #:enter (lambda (ctx)
+             (let ((c (if sudo?
+                          (make <sudo-connection> #:connection c #:become-user sudo-user #:become-password sudo-password)
+                          c)))
+               (conn:setup c)
+               (set-context-connection! ctx c)))
+   #:leave cleanup
+   #:error cleanup))

modules/ordo/interceptor/create-tmp-dir.scm

@@ -0,0 +1,19 @@
+(define-module (ordo interceptor create-tmp-dir)
+  #:use-module (srfi srfi-2)
+  #:use-module (srfi srfi-145)
+  #:use-module (ordo interceptor)
+  #:use-module (ordo action filesystem)
+  #:export (create-tmp-dir))
+
+(define* (create-tmp-dir #:key (register 'tmp-dir))
+  (assume (symbol? register) "register should be a symbol" register)
+  (define (cleanup ctx)
+    (and-let* ((tmp-dir (var-ref ctx register)))
+      (fs:remove (context-connection ctx) tmp-dir #:recurse? #t)
+      (var-delete! ctx register)))
+  (interceptor
+   (format #f "create-tmp-dir ~a" register)
+   #:enter (lambda (ctx)
+             (var-set! ctx register (fs:create-tmp-dir (context-connection ctx))))
+   #:leave cleanup
+   #:error cleanup))

modules/ordo/interceptor/debug.scm

@@ -0,0 +1,16 @@
+(define-module (ordo interceptor debug)
+  #:use-module (ice-9 pretty-print)
+  #:use-module ((srfi srfi-1) #:select (concatenate))
+  #:use-module ((srfi srfi-69) #:select (hash-table-keys))
+  #:use-module (ordo interceptor)
+  #:export (debug-vars))
+
+(define (debug-vars . var-names)
+  (interceptor
+   "debug-vars"
+   #:enter (lambda (ctx)
+             (let ((var-names (if (null? var-names)
+                                  (hash-table-keys (context-vars ctx))
+                                  var-names)))
+               (pretty-print (map (lambda (v) (list v (var-ref ctx v 'not-found)))
+                                  var-names))))))

modules/ordo/interceptor/download.scm

@@ -0,0 +1,22 @@
+(define-module (ordo interceptor download)
+  #:use-module (ice-9 filesystem)
+  #:use-module (srfi srfi-71)
+  #:use-module (srfi srfi-145)
+  #:use-module (ordo interceptor)
+  #:use-module (ordo connection)
+  #:export (download))
+
+(define* (download name #:key url target-dir register)
+  (assume (string? name) "interceptor name should be a string" name)
+  (assume (or (string? url) (delayed-var-ref? url)) "url is required and should be a string" url)
+  (assume (or (not register) (symbol? register)) "register should be a symbol" register)
+  (interceptor
+   name
+   #:enter (lambda (ctx)
+             (let* ((url target-dir (expand-vars ctx url target-dir))
+                    (file-name (file-name-join* target-dir (file-basename url))))
+               (run (context-connection ctx) "wget" "-O" file-name url #:check? #t)
+               (when register
+                 (var-set! ctx register file-name))))
+   #:leave (lambda (ctx) (when register (var-delete! ctx register)))
+   #:error (lambda (ctx) (when register (var-delete! ctx register)))))

modules/ordo/interceptor/install-file.scm

@@ -0,0 +1,28 @@
+(define-module (ordo interceptor install-file)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-145)
+  #:use-module (ordo interceptor)
+  #:use-module (ordo action filesystem)
+  #:export (install-file))
+
+(define* (install-file name #:key path owner group mode content
+                       local-src remote-src backup? register)
+  (assume path "install path is required")
+  (assume (or (not register) (symbol? register)) "register should be a symbol" register)
+  (assume (= 1 (length (filter identity (list content local-src remote-src))))
+          "exactly one of content, local-src, or remote-src is required")
+  (interceptor
+   name
+   #:enter (lambda (ctx)
+             (let ((path (expand-vars ctx path)))
+               (fs:install-file (context-connection ctx)
+                                path
+                                #:owner (expand-vars ctx owner)
+                                #:group (expand-vars ctx group)
+                                #:mode (expand-vars ctx mode)
+                                #:content (expand-vars ctx content)
+                                #:local-src (expand-vars ctx local-src)
+                                #:remote-src (expand-vars ctx remote-src)
+                                #:backup? (expand-vars ctx backup?))
+               (when register
+                 (var-set! ctx register path))))))

modules/ordo/interceptor/require-commands.scm

@@ -0,0 +1,28 @@
+(define-module (ordo interceptor require-commands)
+  #:use-module (ice-9 exceptions)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-71)
+  #:use-module (srfi srfi-145)
+  #:use-module (ordo interceptor)
+  #:use-module (ordo connection)
+  #:export (require-commands))
+
+(define-exception-type &missing-command-error &external-error
+  make-missing-command-error
+  missing-command-error?
+  (command-name missing-command-error-command-name))
+
+(define (require-commands . commands)
+  (assume (every string? commands) "commands should be strings" commands)
+  (interceptor
+   (string-append "require-commands " (string-join commands ","))
+   #:enter (lambda (ctx)
+             (for-each (lambda (cmd)
+                         (let ((out rc (run (context-connection ctx) "which" cmd)))
+                           (unless (zero? rc)
+                             (if (string-contains (car out) (format #f "which: no ~a in" cmd))
+                                 (raise-exception (make-missing-command-error cmd))
+                                 (raise-exception (make-exception
+                                                   (make-external-error)
+                                                   (make-exception-with-message (string-append "error running which: " (car out)))))))))
+                       commands))))

modules/ordo/interceptor/stat-file.scm

@@ -0,0 +1,17 @@
+(define-module (ordo interceptor stat-file)
+  #:use-module (srfi srfi-145)
+  #:use-module (ordo interceptor)
+  #:use-module (ordo action filesystem)
+  #:export (stat-file))
+
+(define* (stat-file name #:key path register)
+  (assume (string? name) "name is required and should be a string" name)
+  (assume path "path is required" path)
+  (assume (or (not register) (symbol? register)) "register should be a symbol" register)
+  (interceptor
+   name
+   #:enter (lambda (ctx)
+             (let* ((path (expand-vars ctx path))
+                    (st (fs:stat (context-connection ctx) path)))
+               (when register
+                 (var-set! ctx register st))))))

modules/ordo/interceptor/unzip.scm

@@ -0,0 +1,16 @@
+(define-module (ordo interceptor unzip)
+  #:use-module (srfi srfi-71)
+  #:use-module (srfi srfi-145)
+  #:use-module (ordo interceptor)
+  #:use-module (ordo connection)
+  #:export (unzip))
+
+(define* (unzip name #:key file-name target-dir)
+  (assume (string? name) "interceptor name is required and should be a string" name)
+  (assume (or (string? file-name) (delayed-var-ref? file-name)) "file-name is required and should be a string" file-name)
+  (assume (or (string? target-dir) (delayed-var-ref? target-dir)) "target-dir is required and should be a string" target-dir)
+  (interceptor
+   name
+   #:enter (lambda (ctx)
+             (let ((file-name target-dir (expand-vars ctx file-name target-dir)))
+               (run (context-connection ctx) "unzip" file-name "-d" target-dir #:check? #t)))))

modules/ordo/interceptor/user-info.scm

@@ -0,0 +1,44 @@
+(define-module (ordo interceptor user-info)
+  #:use-module (rx irregex)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-145)
+  #:use-module (ordo connection)
+  #:use-module (ordo interceptor)
+  #:use-module (ordo util shell-quote)
+  #:export (user-info))
+
+(define (parse-id s)
+  (let ((data (reverse (irregex-fold (irregex '(seq (=> id integer) "(" (=> name (+ alphanumeric)) ")"))
+                                     (lambda (_ m accum)
+                                       (cons `((#:id . ,(string->number (irregex-match-substring m 'id)))
+                                               (#:name . ,(irregex-match-substring m 'name)))
+                                             accum))
+                                     '()
+                                     s))))
+    `((#:user-id . ,(assoc-ref (first data) #:id))
+      (#:user-name . ,(assoc-ref (first data) #:name))
+      (#:group-id . ,(assoc-ref (second data) #:id))
+      (#:group-name . ,(assoc-ref (second data) #:name))
+      (#:groups . ,(drop data 2)))))
+
+(define (parse-passwd-entry s)
+  (map cons
+       '(#:user-name #:password #:user-id #:group-id #:gecos #:home-dir #:shell)
+       (string-split s #\:)))
+
+(define* (user-info #:key (register 'user-info))
+  (assume (symbol? register) "register should be a symbol" register)
+  (interceptor
+   "user-info"
+   #:enter (lambda (ctx)
+             (let* ((conn (context-connection ctx))
+                    (id (run conn "id"
+                             #:check? #t #:return (compose parse-id car)))
+                    (pwent (run conn "getent" "passwd" (string-shell-quote (assoc-ref id #:user-name))
+                                #:check? #t #:return (compose parse-passwd-entry car))))
+               (var-set! ctx register (fold (lambda (key alist)
+                                              (acons key (assoc-ref pwent key) alist))
+                                            id
+                                            (list #:gecos #:home-dir #:shell)))))
+   #:leave (lambda (ctx) (var-delete! ctx register))
+   #:error (lambda (ctx) (var-delete! ctx register))))

modules/ordo/inventory.scm

@@ -1,15 +1,18 @@
-(define-module (ordo host)
+(define-module (ordo inventory)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
-  #:use-module (ordo connection)
+  #:use-module ((ordo connection) #:select (local-connection))
   #:export (make-host
             host?
             host-name
             host-connection
             host-tags
+            add-host!
             resolve-hosts))
 
+(define *inventory* '())
+
 (define-record-type <host>
   (make-host name connection tags)
   host?
@@ -17,7 +20,11 @@
   (connection host-connection)
   (tags host-tags))
 
-(define (tagged-all? wanted-tags)
+(define (add-host! name connection . tags)
+  (set! *inventory* (cons (make-host name connection tags)
+                          *inventory*)))
+
+(define (tagged-every? wanted-tags)
   (lambda (h)
     (lset= equal? wanted-tags (lset-intersection equal? (host-tags h) wanted-tags))))
 
@@ -29,11 +36,12 @@
   (lambda (h)
     (string=? (host-name h) hostname)))
 
-(define (resolve-hosts inventory)
+(define resolve-hosts
   (match-lambda
-    ("localhost" (list (or (find (named? "localhost") inventory)
+    ("localhost" (list (or (find (named? "localhost") *inventory*)
                            (make-host "localhost" (local-connection) '()))))
-    ((? string? hostname) (filter (named? hostname) inventory))
-    ('all inventory)
-    (('every-tag tag . tags) (filter (tagged-all? (cons tag tags)) inventory))
-    (('any-tag tag . tags) (filter (tagged-any? (cons tag tags)) inventory))))
+    ((? 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*))))

modules/ordo/play.scm

@@ -3,12 +3,10 @@
   #:use-module (srfi srfi-26)
   #:use-module (logging logger)
   #:use-module (ordo connection)
-  #:use-module (ordo context)
-  #:use-module (ordo task)
-  #:use-module (ordo handler)
-  #:use-module (ordo context)
-  #:use-module (ordo host)
-  #:use-module (ordo facts)
+  #:use-module (ordo interceptor)
+  #:use-module (ordo interceptor connection)
+  #:use-module (ordo inventory)
+  #:use-module (ordo util flatten)
   #:export (play
             play?
             play-host
@@ -16,13 +14,11 @@
             play-sudo-user
             play-sudo-password
             play-vars
-            play-tasks
-            play-handlers
-            play-gather-facts
+            play-interceptors
             run-play))
 
 (define-record-type <play>
-  (make-play name host sudo? sudo-user sudo-password vars gather-facts tasks handlers)
+  (make-play name host sudo? sudo-user sudo-password vars interceptors)
   play?
   (name play-name)
   (host play-host)
@@ -30,41 +26,24 @@
   (sudo-user play-sudo-user)
   (sudo-password play-sudo-password)
   (vars play-vars)
-  (tasks play-tasks)
-  (handlers play-handlers)
-  (gather-facts play-gather-facts))
+  (interceptors play-interceptors))
 
-;; TODO: argument validation
-(define* (play #:key name host (sudo? #f) (sudo-user #f) (sudo-password #f) (vars '()) (gather-facts #t) tasks (handlers '()))
-  (make-play name host sudo? sudo-user sudo-password vars gather-facts tasks handlers))
+(define* (play #:key name host (sudo? #f) (sudo-user #f) (sudo-password #f) (vars '()) (interceptors '()))
+  (make-play name host sudo? sudo-user sudo-password vars interceptors))
 
-(define (run-play p)
+(define (run-play p playbook-vars)
   (log-msg 'NOTICE "Running play: " (play-name p))
-  (let ((hosts ((resolve-hosts (current-inventory)) (play-host p))))
+  (let ((hosts (resolve-hosts (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 (lambda (h) (run-host-play p h playbook-vars)) hosts))))
 
-(define (run-host-play p h)
+(define (run-host-play p h playbook-vars)
   (log-msg 'NOTICE "Running play: " (play-name p) " on host: " (host-name h))
-  (call-with-connection
-   (host-connection h)
-   (play-sudo? p)
-   (play-sudo-user p)
-   (play-sudo-password p)
-   (lambda (conn)
-     (dynamic-wind
-       (lambda ()
-         (set-current-connection! conn)
-         (set-current-host! (host-name h))
-         (init-play-vars! (play-vars p)))
-       (lambda ()
-         (when (play-gather-facts p) (gather-facts))
-         (for-each run-task (play-tasks p))
-         (for-each run-handler
-                   (filter (compose play-triggered? handler-name) (play-handlers p))))
-       (lambda ()
-         (set-current-connection! #f)
-         (set-current-host! #f)
-         (reset-play-vars!)
-         (reset-play-triggers!))))))
+  (let ((chain (flatten (cons (connection (host-connection h)
+                                          #:sudo? (play-sudo? p)
+                                          #:sudo-user (play-sudo-user p)
+                                          #:sudo-password (play-sudo-password p))
+                              (play-interceptors p))))
+        (ctx (init-context #:vars (append (play-vars p) playbook-vars))))
+    (execute ctx chain)))

modules/ordo/playbook.scm

@@ -1,8 +1,8 @@
 (define-module (ordo playbook)
   #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-26)
   #:use-module (logging logger)
   #:use-module (ordo play)
-  #:use-module (ordo context)
   #:export (playbook
             playbook?
             playbook-name
@@ -17,16 +17,10 @@
   (vars playbook-vars)
   (plays playbook-plays))
 
-;; TODO: argument validation
 (define* (playbook #:key name (vars '()) plays)
   (make-playbook name vars plays))
 
 (define (run-playbook pb)
   (log-msg 'NOTICE "Running playbook: " (playbook-name pb))
-  (dynamic-wind
-    (lambda ()
-      (init-playbook-vars! (playbook-vars pb)))
-    (lambda ()
-      (for-each run-play (playbook-plays pb)))
-    (lambda ()
-      (reset-playbook-vars!))))
+  (for-each (cut run-play <> (playbook-vars pb))
+            (playbook-plays pb)))

modules/ordo/task.scm

@@ -1,53 +0,0 @@
-(define-module (ordo task)
-  #:use-module (ice-9 exceptions)
-  #:use-module (srfi srfi-9)
-  #:use-module (logging logger)
-  #:use-module (ordo context)
-  #:export (task
-            task?
-            task-name
-            task-tags
-            task-action
-            task-condition
-            task-register-play-var
-            task-register-playbook-var
-            task-triggers
-            run-task))
-
-(define-record-type <task>
-  (make-task name tags action condition register-play-var register-playbook-var triggers)
-  task?
-  (name task-name)
-  (tags task-tags)
-  (action task-action)
-  (condition task-condition)
-  (register-play-var task-register-play-var)
-  (register-playbook-var task-register-playbook-var)
-  (triggers task-triggers))
-
-(define-syntax assert
-  (syntax-rules ()
-    ((assert expr message irritant)
-     (unless expr
-       (raise-exception (make-exception
-                         (make-assertion-failure)
-                         (make-exception-with-message message)
-                         (make-exception-with-irritants irritant)))))))
-
-(define* (task #:key name action (tags '()) (condition (const #t)) (register-play-var #f) (register-playbook-var #f) (triggers '()))
-  (assert (and name (string? name)) "#:name is required and must be a string" name)
-  (assert (and action (procedure? action)) "#:action is required and must be a procedure" action)
-  (make-task name tags action condition register-play-var register-playbook-var triggers))
-
-(define (run-task t)
-  (when (check-filter-tags (task-tags t))
-    (if (not ((task-condition t)))
-        (log-msg 'NOTICE "Skipping task: " (task-name t) " (precondition not met)")
-        (begin
-          (log-msg 'NOTICE "Running task: " (task-name t))
-          (let ((result ((task-action t))))
-            (when (task-register-play-var t)
-              (set-play-var! (task-register-play-var t) result))
-            (when (task-register-playbook-var t)
-              (set-playbook-var! (task-register-playbook-var t) result))
-            (add-play-triggers! (task-triggers t)))))))