Don't require #:name keyword to create task

* Move remote-cmd from connection to an action module.
* Inventory now populates a global variable instead of returning a list.
* Added a `describe` method to connections.
* Cleaned up execute/continue-on-error etc.
* Removed workflow class.

examples/forgejo.scm

@@ -1,60 +1,57 @@
 (use-modules
+ (ordo core)
  ((ordo action filesystem) #:prefix fs:)
  ((ordo action quadlet) #:prefix quadlet:)
  ((ordo action systemctl) #:prefix systemctl:))
 
 (define* (install-forgejo #:key (version "11"))
-  (list
+  "Create a blueprint to install Forgejo on a CoreOS system"
-   (task "Install configuration directory"
+  (blueprint (format #f "Install forgejo version ~a" version)
-         #:action fs:install-dir
+             (task "Install configuration directory"
-         #:args '(#:path "/etc/forgejo")
+                   #:action fs:install-dir
-         #:trigger '("Restart pod"))
+                   #:args '(#:path "/etc/forgejo")
-   (task "Install timezone configuration"
+                   #:trigger '("Restart pod"))
-         #:action fs:install-file
+             (task "Install timezone configuration"
-         #:args '(#:path "/etc/forgejo/timezone" #:local-src "files/timezone")
+                   #:action fs:install-file
-         #:trigger '("Restart pod"))
+                   #:args '(#:path "/etc/forgejo/timezone" #:local-src "files/timezone")
-   (task "Install localtime configuration"
+                   #:trigger '("Restart pod"))
-         #:action fs:install-file
+             (task "Install localtime configuration"
-         #:args '(#:path "/etc/forgejo/localtime" #:local-src "files/localtime")
+                   #:action fs:install-file
-         #:trigger '("Restart pod"))
+                   #:args '(#:path "/etc/forgejo/localtime" #:local-src "files/localtime")
-   (task "Create data volume quadlet"
+                   #:trigger '("Restart pod"))
-         #:action quadlet:create-volume
+             (task "Create data volume quadlet"
-         #:args '(#:name "forgejo" #:description "Forgejo data volume")
+                   #:action quadlet:create-volume
-         #:trigger '("Reload systemd" "Restart pod"))
+                   #:args '(#:name "forgejo" #:description "Forgejo data volume")
-   (task "Create pod quadlet"
+                   #:trigger '("Reload systemd" "Restart pod"))
-         #:action quadlet:create-pod
+             (task "Create pod quadlet"
-         #:args '(#:name  "forgejo"
+                   #:action quadlet:create-pod
-                  #:pod  ((PodName . "forge")
+                   #:args '(#:name  "forgejo"
-                          (Volume . "forgejo.volume:U,Z")
+                            #:pod  ((PodName . "forge")
-                          (PodmanArgs . "--userns auto")))
+                                    (Volume . "forgejo.volume:U,Z")
-         #:trigger '("Reload systemd" "Restart pod"))
+                                    (PodmanArgs . "--userns auto")))
-   (task "Create image quadlet"
+                   #:trigger '("Reload systemd" "Restart pod"))
-         #:action quadlet:create-image
+             (task "Create image quadlet"
-         #:args `(#:name "forgejo"
+                   #:action quadlet:create-image
-                  #:image (Image . ,(format #f "codeberg.org/forgejo/forgejo:~a" version)))
+                   #:args `(#:name "forgejo"
-         #:trigger '("Reload systemd" "Restart pod"))
+                            #:image (Image . ,(format #f "codeberg.org/forgejo/forgejo:~a" version)))
-   (task "Create container quadlet"
+                   #:trigger '("Reload systemd" "Restart pod"))
-         #:action quadlet:create-container
+             (task "Create container quadlet"
-         #:args '(#:name  "forgejo"
+                   #:action quadlet:create-container
-                  #:container ((Pod . "forgejo.pod")
+                   #:args '(#:name  "forgejo"
-                               (Image . "forgejo.image")
+                            #:container ((Pod . "forgejo.pod")
-                               (Network . "services.network")
+                                         (Image . "forgejo.image")
-                               (Volume . "/etc/forgejo/timezone:/etc/timezone:ro,U,Z")
+                                         (Network . "services.network")
-                               (Volume . "/etc/forgejo/localtime:/etc/localtime:ro,U,Z")
+                                         (Volume . "/etc/forgejo/timezone:/etc/timezone:ro,U,Z")
-                               (Environment . "USER_UID=1000")
+                                         (Volume . "/etc/forgejo/localtime:/etc/localtime:ro,U,Z")
-                               (Environment . "USER_GID=1000")
+                                         (Environment . "USER_UID=1000")
-                               (Environment . "FORGEJO__service__DISABLE_REGISTRATION=true")
+                                         (Environment . "USER_GID=1000")
-                               (Environment . "FORGEJO__webhook__ALLOWED_HOST_LIST=private")))
+                                         (Environment . "FORGEJO__service__DISABLE_REGISTRATION=true")
-         #:trigger '("Reload systemd" "Restart pod"))
+                                         (Environment . "FORGEJO__webhook__ALLOWED_HOST_LIST=private")))
-   (handler "Reload systemd"
+                   #:trigger '("Reload systemd" "Restart pod"))
-            #:action systemctl:daemon-reload)
+             (handler "Reload systemd"
-   (handler "Restart pod"
+                      #:action systemctl:daemon-reload)
-            #:action systemctl:restart-unit
+             (handler "Restart pod"
-            #:args '((#:unit . "forgejo-pod.service")))))
+                      #:action systemctl:restart
+                      #:args '((#:unit . "forgejo-pod.service")))))
 
-(playbook "Install Forgejo on limiting-factor"
+(execute (install-forgejo #:version "11") "limiting-factor" #:sudo? #t)
-          ;; #:vars '((forgejo-version . "11.0.2"))
-          (play
-           #:host "limiting-factor"
-           #:become? #t
-           (install-forgejo #:version "11")))

examples/inventory.scm

@@ -1,23 +1,22 @@
 (use-modules (ordo connection)
              (ordo inventory))
 
-(list
+(defhost "little-rascal"
- (host #:name "little-rascal"
+  #:connection (local-connection)
-       #:connection (local-connection)
+  #:tags '(#:linux #:guix))
-       #:tags '(#:linux #:guix))
 
- (host #:name "limiting-factor"
+(defhost "limiting-factor"
-       #:connection (ssh-connection "limiting-factor" #:user "core")
+  #:connection (ssh-connection #:host "limiting-factor" #:user "core")
-       #:tags '(#:linux #:coreos))
+  #:tags '(#:linux #:coreos))
 
- (host #:name "screw-loose"
+(defhost "screw-loose"
-       #:connection (ssh-connection "screw-loose" #:user "core")
+  #:connection (ssh-connection #:host "screw-loose" #:user "core")
-       #:tags '(#:linux #:coreos))
+  #:tags '(#:linux #:coreos))
 
- (host #:name "control-surface"
+(defhost "control-surface"
-       #:connection (ssh-connection "control-surface" #:user "ray")
+  #:connection (ssh-connection #:host "control-surface" #:user "ray")
-       #:tags '(#:linux #:debian))
+  #:tags '(#:linux #:debian))
 
- (host #:name "cargo-cult"
+(defhost "cargo-cult"
-       #:connection (ssh-connection "cargo-cult" #:user "ray")
+  #:connection (ssh-connection #:host "cargo-cult" #:user "ray")
-       #:tags '(#:linux #:synology)))
+  #:tags '(#:linux #:synology))

examples/uptime.scm

@@ -0,0 +1,8 @@
+(use-modules (ordo core)
+             (ordo action remote-cmd))
+
+(execute (task "uptime"
+               #:action remote-cmd
+               #:args (list "uptime" #:return car #:check? #t))
+         'all
+         #:continue-on-error? #t)

ordo/action/filesystem.scm

@@ -23,8 +23,8 @@ this program. If not, see <https://www.gnu.org/licenses/>.
   #:use-module (srfi srfi-1) ; list utils
   #:use-module (srfi srfi-26) ; cut
   #:use-module (srfi srfi-71) ; extended let
-  #:use-module ((ordo connection) #:select (remote-cmd))
+  #:use-module (ordo action remote-cmd)
-  #:use-module (ordo connection base)
+  #:use-module ((ordo connection base) #:select (with-remote-output-file))
   #:export (create-tmp-dir
             install-dir
             install-file

ordo/action/quadlet.scm

@@ -19,7 +19,7 @@ this program. If not, see <https://www.gnu.org/licenses/>.
   #:use-module (ice-9 filesystem)
   #:use-module (ini)
   #:use-module (logging logger)
-  #:use-module (ordo connection)
+  #:use-module (ordo action remote-cmd)
   #:use-module ((ordo action filesystem) #:prefix fs:)
   #:use-module ((srfi srfi-1) #:select (remove))
   #:export (create-network

ordo/action/remote-cmd.scm

@@ -0,0 +1,29 @@
+(define-module (ordo action remote-cmd)
+  #:use-module (ice-9 exceptions)
+  #:use-module (ice-9 optargs)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-71)
+  #:use-module (ordo connection)
+  #:use-module (ordo connection base)
+  #:use-module (ordo logger)
+  #:use-module (ordo util flatten)
+  #:export (remote-cmd))
+
+(define (remote-cmd conn prog . args)
+  (let ((args options (break keyword? args)))
+    (let-keywords
+     options #t
+     ((return identity)
+      (check? #f))
+     (let ((command (build-command conn prog (remove unspecified? (flatten args)) options)))
+       (log-msg 'DEBUG "Running command: " command " on connection " (describe conn))
+       (let ((out rc (remote-exec conn command)))
+         (log-msg 'DEBUG "Command exit code: " rc)
+         (if check?
+             (if (zero? rc)
+                 (return out)
+                 (raise-exception (make-exception
+                                   (make-external-error)
+                                   (make-exception-with-message (format #f "Non-zero exit (~a) from ~a" rc prog))
+                                   (make-exception-with-irritants out))))
+             (values (return out) rc)))))))

ordo/action/systemctl.scm

@@ -16,7 +16,7 @@ this program. If not, see <https://www.gnu.org/licenses/>.
 |#
 
 (define-module (ordo action systemctl)
-  #:use-module (ordo connection)
+  #:use-module (ordo action remote-cmd)
   #:export (daemon-reload stop start restart reload))
 
 (define* (daemon-reload conn #:key user?)

ordo/cli/run.scm

@@ -16,12 +16,13 @@ this program. If not, see <https://www.gnu.org/licenses/>.
 |#
 
 (define-module (ordo cli run)
+  #:declarative? #f
   #:use-module (config)
   #:use-module (config api)
   #:use-module (ice-9 filesystem)
+  #:use-module (ordo core)
   #:use-module (ordo inventory)
   #:use-module (ordo logger)
-  #:use-module (ordo playbook)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:export (config handler))
@@ -57,12 +58,12 @@ this program. If not, see <https://www.gnu.org/licenses/>.
    (arguments
     (list
      (argument
-      (name 'playbook)
+      (name 'workflow)
       (handler (cut expand-file-name <> #f #t))
+      (example "examples/uptime.scm")
       (test file-exists?))))
-   (synopsis "Run a playbook")))
+   (synopsis "Run a workflow")))
 
 (define (handler options)
-  (let ((inventory (load-inventory (option-ref options 'inventory)))
+  (load-inventory! (option-ref options 'inventory))
-        (playbook (load-playbook (option-ref options '(playbook)))))
+  (load (option-ref options '(workflow))))
-    (run-playbook playbook inventory)))

ordo/connection.scm

@@ -23,30 +23,23 @@ this program. If not, see <https://www.gnu.org/licenses/>.
   #:use-module (ordo connection ssh)
   #:use-module (ordo connection sudo)
   #:use-module (ordo logger)
-  #:use-module (ordo util flatten)
-  #:use-module (ordo util keyword-args)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-71)
   #:export (connection?
             local-connection
             ssh-connection
-            call-with-connection
+            call-with-connection))
-            remote-cmd)
-  #:re-export (remote-exec with-remote-input-file with-remote-output-file))
 
 (define (connection? c)
   (is-a? c <connection>))
 
-(define (local-connection)
+(define (local-connection . args)
-  (make <local-connection>))
+  (apply make <local-connection> args))
 
-(define* (ssh-connection host #:key (user (getlogin)) (password #f) (identity #f) (authenticate-server? #t)
+(define (ssh-connection . args)
-                         (sudo? #f) (sudo-user #f) (sudo-password #f))
+  (apply make <ssh-connection> args))
-  (make <ssh-connection> #:user user #:host host #:password password
-        #: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)
+  (log-msg 'DEBUG "call-with-connection " (describe conn))
   (let ((conn (deep-clone conn)))
     (when sudo?
       (unless (is-a? conn <sudo-connection>)
@@ -61,20 +54,3 @@ this program. If not, see <https://www.gnu.org/licenses/>.
       (lambda () (setup conn))
       (lambda () (proc conn))
       (lambda () (teardown conn)))))
-
-(define (remote-cmd conn prog . args)
-  (let* ((args options (break keyword? args))
-         (args (remove unspecified? (flatten args)))
-         (return (keyword-arg options #:return identity))
-         (check? (keyword-arg options #:check?))
-         (command (build-command conn prog args options)))
-    (log-msg 'INFO "Running command: " command)
-    (let ((out rc (remote-exec conn command)))
-      (log-msg 'INFO "Command exit code: " rc)
-      (if check?
-          (if (zero? rc)
-              (return out)
-              (raise-exception (make-exception
-                                (make-external-error)
-                                (make-exception-with-message (format #f "Non-zero exit (~a) from ~a" rc prog)))))
-          (values (return out) rc)))))

ordo/connection/base.scm

@@ -17,12 +17,13 @@ this program. If not, see <https://www.gnu.org/licenses/>.
 
 (define-module (ordo connection base)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 optargs)
   #:use-module (oop goops)
   #:use-module (ordo util flatten)
-  #:use-module (ordo util keyword-args)
   #:use-module (ordo util shell-quote)
   #:use-module ((srfi srfi-1) #:select (remove))
   #:export (<connection>
+            describe
             setup
             teardown
             build-command
@@ -32,6 +33,7 @@ this program. If not, see <https://www.gnu.org/licenses/>.
 
 (define-generic setup)
 (define-generic teardown)
+(define-generic describe)
 (define-generic build-command)
 (define-generic remote-exec)
 (define-generic with-remote-input-file)
@@ -44,14 +46,17 @@ this program. If not, see <https://www.gnu.org/licenses/>.
 (define-method (teardown (c <connection>)) #t)
 
 (define-method (build-command (c <connection>) (prog-name <string>) (prog-args <list>) (options <list>))
-  (let* ((pwd (keyword-arg options #:pwd))
+  (let-keywords
-         (env (keyword-arg options #:env))
+   options #t
-         (redirect-err? (keyword-arg options #:redirect-err? #t))
+   ((pwd #f)
-         (xs (remove unspecified?
+    (env #f)
+    (shell-quote? #t)
+    (redirect-err? #t))
+   (let ((xs (remove unspecified?
                      (flatten (list "env"
                                     (when pwd (list "--chdir" (string-shell-quote pwd)))
                                     (when env (map (match-lambda ((k . v) (string-append k "=" (string-shell-quote v)))) env))
                                     prog-name
-                                    (map string-shell-quote prog-args)
+                                    (if shell-quote? (map string-shell-quote prog-args) prog-args)
                                     (when redirect-err? "2>&1"))))))
-    (string-join xs " ")))
+     (string-join xs " "))))

ordo/connection/local.scm

@@ -25,6 +25,9 @@ this program. If not, see <https://www.gnu.org/licenses/>.
 
 (define-class <local-connection> (<sudo-connection>))
 
+(define-method (describe (c <local-connection>))
+  (format #f "local-connection (sudo=~a)" (become? c)))
+
 (define-method (remote-exec (c <local-connection>) (command <string>))
   (let* ((port (open-input-pipe command))
          (output (read-lines port))

ordo/connection/ssh.scm

@@ -23,29 +23,40 @@ this program. If not, see <https://www.gnu.org/licenses/>.
   #:use-module (ssh channel)
   #:use-module (ssh auth)
   #:use-module (ssh popen)
-  #:use-module (ssh sftp)
   #:use-module (ordo connection base)
   #:use-module (ordo connection sudo)
   #:use-module (ordo util read-lines)
+  #:use-module (ordo util shell-quote)
   #:export (<ssh-connection>))
 
 (define-class <ssh-connection> (<sudo-connection>)
   (user #:getter ssh-connection-user #:init-keyword #:user)
   (host #:getter ssh-connection-host #:init-keyword #:host)
-  (password #:getter ssh-connection-password #:init-keyword #:password #:init-val #f)
+  (password #:getter ssh-connection-password #:init-keyword #:password #:init-value #f)
-  (identity #:getter ssh-connection-identity #:init-keyword #:identity #:init-val #f)
+  (identity #:getter ssh-connection-identity #:init-keyword #:identity #:init-value #f)
-  (authenticate-server? #:getter ssh-connection-authenticate-server? #:init-keyword #:authenticate-server? #:init-val #t)
+  (timeout #:getter ssh-connection-timeout #:init-keyword #:timeout #:init-value 10)
+  (authenticate-server? #:getter ssh-connection-authenticate-server? #:init-keyword #:authenticate-server? #:init-value #t)
   (session)
   (sftp-session))
 
+(define-method (describe (c <ssh-connection>))
+  (format #f "ssh ~a@~a (sudo=~a)"
+          (ssh-connection-user c)
+          (ssh-connection-host c)
+          (become? c)))
+
 (define-method (setup (c <ssh-connection>))
   (unless (slot-bound? c 'session)
-    (slot-set! c 'session (make-session #:user (ssh-connection-user c) #:host (ssh-connection-host c)))
+    (let ((s (make-session #:user (ssh-connection-user c) #:host (ssh-connection-host c))))
-    (when (ssh-connection-identity c) (session-set! (slot-ref c 'session) 'identity (ssh-connection-identity c))))
+      (session-set! s 'timeout (ssh-connection-timeout c))
+      (when (ssh-connection-identity c)
+        (session-set! s 'identity (ssh-connection-identity c)))
+      (slot-set! c 'session s)))
   (let ((s (slot-ref c 'session)))
     (unless (connected? s)
-      (connect! s)
+      (when (equal? 'error (connect! s))
-      (when (ssh-connection-authenticate-server? s)
+        (error (string-append "Error connecting to " (ssh-connection-host c))))
+      (when (ssh-connection-authenticate-server? c)
         (let ((server-auth (authenticate-server s)))
           (unless (equal? 'ok server-auth)
             (error (format #f "authenticate-server: ~a" server-auth)))))
@@ -53,7 +64,8 @@ this program. If not, see <https://www.gnu.org/licenses/>.
                            (userauth-password! s (ssh-connection-password c))
                            (userauth-public-key/auto! s))))
         (unless (equal? 'success user-auth)
-          (error (format #f "userauth: ~a" user-auth)))))))
+          (error (format #f "userauth: ~a" user-auth))))))
+  (next-method))
 
 (define-method (remote-exec (c <ssh-connection>) (command <string>))
   (let* ((channel (open-remote-input-pipe (slot-ref c 'session) command))
@@ -62,19 +74,21 @@ this program. If not, see <https://www.gnu.org/licenses/>.
     (close channel)
     (values output exit-status)))
 
-(define-method (sftp-session (c <ssh-connection>))
-  (unless (slot-bound? c 'sftp-session)
-    (slot-set! c  'sftp-session (make-sftp-session (session c))))
-  (slot-ref c 'sftp-session))
-
 (define-method (with-remote-input-file (c <ssh-connection>) (filename <string>) (proc <procedure>))
-  (call-with-remote-input-file (sftp-session c) filename proc))
+  (let* ((channel (open-remote-input-pipe (slot-ref c 'session) (string-append "cat " (string-shell-quote filename))))
+         (result (proc channel)))
+    (close channel)
+    result))
 
 (define-method (with-remote-output-file (c <ssh-connection>) (filename <string>) (proc <procedure>))
-  (call-with-remote-output-file (sftp-session c) filename proc))
+  (let* ((channel (open-remote-output-pipe (slot-ref c 'session) (string-append "cat >" (string-shell-quote filename))))
+         (result  (proc channel)))
+    (close channel)
+    result))
 
 (define-method (teardown (c <ssh-connection>))
+  (next-method)
   (when (slot-bound? c 'session)
-    (let ((s (slot-ref c session)))
+    (let ((s (slot-ref c 'session)))
       (when (connected? s)
         (disconnect! s)))))

ordo/connection/sudo.scm

@@ -29,7 +29,7 @@ this program. If not, see <https://www.gnu.org/licenses/>.
             become-password))
 
 (define-class <sudo-connection> (<connection>)
-  (become? #:accessor become? #:init-keyword become? #:init-form #f)
+  (become? #:accessor become? #:init-keyword #:become? #:init-form #f)
   (become-user #:accessor become-user #:init-keyword #:become-user #:init-form #f)
   (become-password #:accessor become-password #:init-keyword #:become-password #:init-form #f)
   (password-tmp-file #:accessor password-tmp-file))
@@ -51,10 +51,10 @@ this program. If not, see <https://www.gnu.org/licenses/>.
     (next-method))
 
    ((and (become-user conn) (become-password conn))
-    (format #f "cat ~a - | sudo -k -S -H -u ~a -- ~a" (string-shell-quote (password-tmp-file conn)) (string-shell-quote (become-user conn)) (next-method)))
+    (format #f "cat ~a | sudo -k -S -H -u ~a -- ~a" (string-shell-quote (password-tmp-file conn)) (string-shell-quote (become-user conn)) (next-method)))
 
    ((become-password conn)
-    (format #f "cat ~a - | sudo -k -S -H -- ~a" (string-shell-quote (password-tmp-file conn)) (next-method)))
+    (format #f "cat ~a | sudo -k -S -H -- ~a" (string-shell-quote (password-tmp-file conn)) (next-method)))
 
    ((become-user conn)
     (format #f "sudo -k -n -H -u ~a -- ~a" (string-shell-quote (become-user conn)) (next-method)))

ordo/core.scm

@@ -14,56 +14,187 @@ PARTICULAR PURPOSE. See the GNU General Public License for more details.
 You should have received a copy of the GNU General Public License along with
 this program. If not, see <https://www.gnu.org/licenses/>.
 |#
+
 (define-module (ordo core)
+  #:use-module (ice-9 exceptions)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 optargs)
+  #:use-module (oop goops)
   #:use-module (ordo connection)
-  #:use-module (ordo context)
+  #:use-module (ordo connection base)
-  #:use-module (ordo handler)
   #:use-module (ordo inventory)
   #:use-module (ordo logger)
-  #:use-module (ordo playbook)
+  #:use-module (ordo util flatten)
-  #:use-module (ordo play)
+  #:use-module (srfi srfi-1)
-  #:use-module (ordo task)
+  #:use-module (srfi srfi-26)
-  #:use-module ((srfi srfi-26) #:select (cut)))
+  #:use-module (srfi srfi-69)
+  #:export (<task>
+            task
+            task?
+            task-name
+            task-pre-condition
+            task-action
+            task-args
+            task-trigger
 
-(define (run-playbook ctx pb)
+            <handler>
-  (log-msg 'NOTICE "Running playbook: " (playbook-name pb))
+            handler
-  (set-ctx-playbook! ctx pb)
+            handler?
-  (for-each (cut run-play ctx <>) (playbook-plays pb)))
+            handler-name
+            handler-action
+            handler-args
 
-(define (run-play ctx p)
+            <blueprint>
-  (log-msg 'NOTICE "Running play: " (play-name p))
+            blueprint
-  (set-ctx-play! ctx p)
+            blueprint?
-  (let ((hosts (resolve-hosts (ctx-inventory ctx) (play-host p))))
+            blueprint-name
-    (if (null? hosts)
+            blueprint-tasks
-        (log-msg 'WARN "No hosts matched: " (play-host p))
+            blueprint-handlers
-        (for-each (cut run-host-play ctx p <>) hosts))))
 
-(define (run-host-play ctx p h)
+            execute))
-  (log-msg 'NOTICE "Running play on host: " (host-name h))
-  (set-ctx-host! ctx h)
-  (call-with-connection
-   (host-connection h)
-   (lambda (conn)
-     (dynamic-wind
-       (lambda ()
-         (set-ctx-connection! ctx conn))
-       (lambda ()
-         (for-each (cut run-task ctx <>) (play-tasks p))
-         (for-each (cut run-handler ctx <>) (play-handlers p)))
-       (lambda ()
-         (set-ctx-connection! ctx #f))))
-   #:sudo? (play-sudo? p)
-   #:sudo-user (play-sudo-user p)
-   #:sudo-password (play-sudo-password p)))
 
-(define (run-task ctx t)
+(define-generic execute%)
-  (if ((task-pre-condition t) ctx)
-      (begin
-        (log-msg 'NOTICE "Running task " (task-name t))
-        ((task-action t) ctx))
-      (log-msg 'NOTICE "Skipping task " (task-name t) ": pre-condition not met")))
 
-(define (run-handler ctx h)
+(define-class <task> ()
-  (when (member (ctx-triggers ctx) (handler-name h))
+  (name #:init-keyword #:name #:getter task-name)
-    (log-msg 'NOTICE "Running handler: " (handler-name h))
+  (pre-condition #:init-keyword #:pre-condition #:init-value (const #t) #:getter task-pre-condition)
-    ((handler-action h) ctx)))
+  (action #:init-keyword #:action #:getter task-action)
+  (args #:init-keyword #:args #:init-form (list) #:getter task-args)
+  (trigger #:init-keyword #:trigger #:init-form (list) #:getter task-trigger))
+
+(define (task name . args) (apply make <task> #:name name args))
+(define (task? x) (is-a? x <task>))
+
+(define-method (execute% (task <task>) (conn <connection>))
+  (log-msg 'DEBUG "execute task " (task-name task) " on connection")
+  (if ((task-pre-condition task) conn)
+      (let ((result (apply (task-action task) conn (map (lambda (a) (if (promise? a) (force a) a)) (task-args task)))))
+        (cond
+         ((equal? result #f)
+          (log-msg 'NOTICE (task-name task) " - OK"))
+         ((equal? result #t)
+          (log-msg 'NOTICE (task-name task) " - CHANGED")
+          (for-each schedule-handler! (task-trigger task)))
+         (else
+          (log-msg 'NOTICE (task-name task) " - " result)))
+        result)
+      (log-msg 'NOTICE (task-name task) " - SKIPPED")))
+
+(define-method (execute% (task <task>) (host <host>) (options <list>))
+  (log-msg 'NOTICE "Executing task " (task-name task) " on host " (host-name host))
+  (let-keywords
+   options #t
+   ((sudo? #f)
+    (sudo-user #f)
+    (sudo-password #f))
+   (call-with-connection
+    (host-connection host)
+    (cut execute% task <>)
+    #:sudo? sudo? #:sudo-user sudo-user #:sudo-password sudo-password)))
+
+(define-method (execute% (task <task>) target (options <list>))
+  (let-keywords
+   options #t
+   ((continue-on-error? #f))
+   (for-each
+    (if continue-on-error?
+        (lambda (host)
+          (with-exception-handler
+              (lambda (e) (log-msg 'ERROR "Failed to execute " (task-name task) " on host " (host-name host) ": " e))
+            (lambda ()
+              (execute% task host options))
+            #:unwind? #t))
+        (lambda (host)
+          (execute% task host options)))
+    (resolve-hosts target))))
+
+(define-class <handler> ()
+  (name #:init-keyword #:name #:getter handler-name)
+  (action #:init-keyword #:action #:getter handler-action)
+  (args #:init-keyword #:args #:init-form (list) #:getter handler-args))
+
+(define (handler . args) (apply make <handler> args))
+(define (handler? x) (is-a? x <handler>))
+
+(define-method (execute% (handler <handler>) (conn <connection>))
+  (log-msg 'NOTICE "Executing handler " (handler-name handler))
+  ((handler-action handler) conn))
+
+(define-class <blueprint> ()
+  (name #:init-keyword #:name #:getter blueprint-name)
+  (tasks #:init-keyword #:tasks #:getter blueprint-tasks)
+  (handlers #:init-keyword #:handlers #:getter blueprint-handlers))
+
+(define (blueprint? x) (is-a? x <blueprint>))
+
+(define (validate-triggers blueprint-name tasks handlers)
+  (let ((handler-names (map handler-name handlers)))
+    (for-each (lambda (task)
+                (for-each (lambda (trigger)
+                            (unless (member trigger handler-names)
+                              (raise-exception
+                               (make-exception
+                                (make-programming-error)
+                                (make-exception-with-message (format #f "Task ~a in blueprint ~a references unknown trigger: ~a"
+                                                                     blueprint-name (task-name task) trigger))))))
+                          (task-trigger task)))
+              tasks)))
+
+(define (blueprint name . args)
+  (let* ((args (flatten args))
+         (tasks (filter task? args))
+         (handlers (filter handler? args)))
+    (validate-triggers name (filter task? tasks) handlers)
+    (make <blueprint> #:name name #:tasks tasks #:handlers handlers)))
+
+(define *triggered-handlers* (make-parameter #f))
+
+(define (schedule-handler! handler-name)
+  "Schedule a handler to be run after all tasks in a blueprint. This function
+may also be called outside of a blueprint (e.g. when a stand-alone task is run),
+in which case it is a no-op."
+  (let ((triggered (*triggered-handlers*)))
+    (when triggered
+      (log-msg 'DEBUG "Scheduling handler: " handler-name)
+      (hash-table-set! triggered handler-name #t))))
+
+(define-method (execute% (blueprint <blueprint>) (conn <connection>))
+  (parameterize ((*triggered-handlers* (make-hash-table)))
+    (log-msg 'NOTICE "Executing blueprint " (blueprint-name blueprint))
+    (for-each (cut execute% <> conn)
+              (blueprint-tasks blueprint))
+    (for-each (lambda (handler)
+                (when (hash-table-ref/default (*triggered-handlers*) (handler-name handler) #f)
+                  (execute% handler conn)))
+              (blueprint-handlers blueprint))))
+
+(define-method (execute% (blueprint <blueprint>) (host <host>) (options <list>))
+  (log-msg 'NOTICE "Executing blueprint " (blueprint-name blueprint) " on host " (host-name host))
+  (let-keywords
+   options #t
+   ((sudo? #f)
+    (sudo-user #f)
+    (sudo-password #f))
+   (call-with-connection
+    (host-connection host)
+    (cut execute% blueprint <>)
+    #:sudo? sudo? #:sudo-user sudo-user #:sudo-password sudo-password)))
+
+(define-method (execute% (blueprint <blueprint>) target (options <list>))
+  (let-keywords
+   options #t
+   ((continue-on-error? #f))
+   (for-each
+    (if continue-on-error?
+        (lambda (host)
+          (with-exception-handler
+              (cut log-msg 'ERROR "Failed to execute blueprint " (blueprint-name blueprint) " on host " (host-name host) ": " <>)
+            (lambda ()
+              (execute% blueprint host options))
+            #:unwind? #t))
+        (lambda (host)
+          (execute% blueprint host options)))
+    (resolve-hosts target))))
+
+(define (execute task-or-blueprint target . options)
+  (execute% task-or-blueprint target options))

ordo/handler.scm

@@ -1,39 +0,0 @@
-#|
-This file is part of Ordo.
-
-Copyright (C) 2025 Ray Miller
-
-This program is free software: you can redistribute it and/or modify it under
-the terms of the GNU General Public License as published by the Free Software
-Foundation, version 3.
-
-This program is distributed in the hope that it will be useful, but WITHOUT ANY
-WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
-PARTICULAR PURPOSE. See the GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along with
-this program. If not, see <https://www.gnu.org/licenses/>.
-|#
-
-(define-module (ordo handler)
-  #:use-module (srfi srfi-9)
-  #:use-module (ordo logger)
-  #:export (make-handler
-            handler?
-            handler-name
-            handler-action
-            handler
-            run-handler))
-
-(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))

ordo/inventory.scm

@@ -23,27 +23,36 @@ 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)
+  #:export (<host>
-  #:use-module (srfi srfi-69)
+            defhost
-  #:export (host
             host?
             host-name
             host-connection
             host-tags
-            host-vars
+
             resolve-hosts
-            load-inventory))
+            load-inventory!))
 
-(define-record-type <host>
+(define *inventory* '())
-  (make-host name connection tags vars)
-  host?
-  (name host-name)
-  (connection host-connection)
-  (tags host-tags)
-  (vars host-vars))
 
-(define* (host #:key name connection (tags '()) (vars '()))
+(define-class <host> ()
-  (make-host name connection tags (alist->hash-table vars)))
+  (name #:init-keyword #:name #:getter host-name)
+  (connection #:init-keyword #:connection #:getter host-connection)
+  (tags #:init-keyword #:tags #:getter host-tags))
+
+(define (host? h) (is-a? h <host>))
+
+(define (defhost name . args)
+  (let ((host (apply make <host> #:name name args)))
+    (set! *inventory* (cons host *inventory*))))
+
+(define (load-inventory! filename)
+  (log-msg 'INFO "Loading inventory " filename)
+  (eval-string (call-with-input-file filename get-string-all)
+               #:file filename)
+  (when (null? *inventory*)
+    (log-msg 'NOTICE "Inventory is empty, only localhost will be available")
+    (defhost "localhost" #:connection (local-connection))))
 
 (define (tagged-every? wanted-tags)
   (lambda (h)
@@ -57,22 +66,11 @@ this program. If not, see <https://www.gnu.org/licenses/>.
   (lambda (h)
     (string=? (host-name h) hostname)))
 
-(define (resolve-hosts inventory expr)
+(define-method (resolve-hosts expr)
   (match expr
-    ("localhost" (list (or (find (named? "localhost") inventory)
+    ((? string? hostname) (filter (named? hostname) *inventory*))
-                           (host #:name "localhost" #:connection (local-connection)))))
+    ('all *inventory*)
-    ((? string? hostname) (filter (named? hostname) inventory))
+    (('tagged tag) (filter (tagged-every? (list tag)) *inventory*))
-    ('all inventory)
+    (('tagged/every tag . tags) (filter (tagged-every? (cons tag tags)) *inventory*))
-    (('tagged tag) (filter (tagged-every? (list tag)) inventory))
+    (('tagged/any tag . tags) (filter (tagged-any? (cons tag tags)) *inventory*))
-    (('tagged/every tag . tags) (filter (tagged-every? (cons tag tags)) inventory))
+    ((. hostnames) (filter (lambda (h) (member (host-name h) hostnames string=?)) *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)
-  (let* ((inventory (eval-string (call-with-input-file filename get-string-all)
-                                 #:file filename))
-         (inventory (if (list? inventory) inventory '())))
-    (when (null? inventory)
-      (log-msg 'NOTICE "Inventory is empty, only localhost will be available"))
-    inventory))

ordo/play.scm

@@ -1,92 +0,0 @@
-#|
-This file is part of Ordo.
-
-Copyright (C) 2025 Ray Miller
-
-This program is free software: you can redistribute it and/or modify it under
-the terms of the GNU General Public License as published by the Free Software
-Foundation, version 3.
-
-This program is distributed in the hope that it will be useful, but WITHOUT ANY
-WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
-PARTICULAR PURPOSE. See the GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along with
-this program. If not, see <https://www.gnu.org/licenses/>.
-|#
-
-(define-module (ordo play)
-  #:use-module (ordo connection)
-  #:use-module (ordo context)
-  #:use-module (ordo handler)
-  #:use-module (ordo inventory)
-  #:use-module (ordo logger)
-  #:use-module (ordo task)
-  #:use-module (ordo util flatten)
-  #:use-module (ordo util keyword-args)
-  #:use-module (srfi srfi-1)  ; lists
-  #:use-module (srfi srfi-9)  ; records
-  #:use-module (srfi srfi-26) ; cut/cute
-  #:use-module (srfi srfi-69) ; hash tables
-  #:use-module (srfi srfi-71) ; extended let
-  #:export (play
-            play?
-            play-host
-            play-sudo?
-            play-sudo-user
-            play-sudo-password
-            play-vars
-            play-tasks
-            play-handlers
-            run-play
-            trigger-handler!))
-
-(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 (play name . args)
-  (let* ((tasks args (partition task? args))
-         (handlers kwargs (partition handler? args)))
-    (make-play name
-               (keyword-arg #:host kwargs)
-               (keyword-arg #:sudo? kwargs)
-               (keyword-arg #:sudo-user kwargs)
-               (keyword-arg #:sudo-password kwargs)
-               (and=> (keyword-arg #:vars kwargs) alist->hash-table)
-               tasks
-               handlers)))
-
-(define (run-play p)
-  (log-msg 'NOTICE "Running play: " (play-name p))
-  (parameterize ((*play* p))
-    (let ((hosts (resolve-hosts (*inventory*) (play-host p))))
-      (if (null? hosts)
-          (log-msg 'WARN "No hosts matched: " (play-host p))
-          (for-each (cut run-host-play p <>) hosts)))))
-
-(define (run-host-play p h)
-  (log-msg 'NOTICE "Running play on host: " (host-name h))
-  (parameterize ((*host* h)
-                 (*triggered-handlers* (make-hash-table)))
-    (call-with-connection
-     (host-connection h)
-     (lambda (conn)
-       (for-each (cut run-task <> conn) (play-tasks p))
-       (for-each (cut run-handler <> conn)
-                 (filter (compose (cut hash-table-ref/default *triggered-handlers* <> #f) handler-name)
-                         (play-handlers p))))
-     #:sudo? (play-sudo? p)
-     #:sudo-user (play-sudo-user p)
-     #:sudo-password (play-sudo-password p))))
-
-(define (trigger-handler! handler-name)
-  (hash-table-set! *triggered-handlers* handler-name #t))

ordo/playbook.scm

@@ -1,61 +0,0 @@
-#|
-This file is part of Ordo.
-
-Copyright (C) 2025 Ray Miller
-
-This program is free software: you can redistribute it and/or modify it under
-the terms of the GNU General Public License as published by the Free Software
-Foundation, version 3.
-
-This program is distributed in the hope that it will be useful, but WITHOUT ANY
-WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
-PARTICULAR PURPOSE. See the GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along with
-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 (ordo context)
-  #:use-module (ordo handler)
-  #:use-module (ordo logger)
-  #:use-module (ordo play)
-  #:use-module (ordo task)
-  #:use-module (ordo util keyword-args)
-  #:use-module (srfi srfi-1)  ; lists
-  #:use-module (srfi srfi-9)  ; records
-  #:use-module (srfi srfi-26) ; cut/cute
-  #:use-module (srfi srfi-69) ; hash tables
-  #:use-module (srfi srfi-71) ; extended let
-  #:export (<playbook>
-            playbook
-            playbook?
-            playbook-name
-            playbook-vars
-            playbook-plays
-            load-playbook
-            run-playbook))
-
-(define-record-type <playbook>
-  (make-playbook name vars plays)
-  playbook?
-  (name playbook-name)
-  (vars playbook-vars)
-  (plays playbook-plays))
-
-(define (playbook name . args)
-  (let ((plays kwargs (partition play? args)))
-    (make-playbook name (alist->hash-table (keyword-arg #:vars kwargs '())) plays)))
-
-(define (load-playbook filename)
-  (log-msg 'INFO "Loading playbook " filename)
-  (eval-string (call-with-input-file filename get-string-all)
-               #:file filename))
-
-(define (run-playbook pb inventory)
-  (log-msg 'NOTICE "Running playbook: " (playbook-name pb))
-  (parameterize ((*inventory* inventory)
-                 (*playbook* pb))
-    (for-each run-play (playbook-plays pb))))

ordo/task.scm

@@ -1,43 +0,0 @@
-#|
-This file is part of Ordo.
-
-Copyright (C) 2025 Ray Miller
-
-This program is free software: you can redistribute it and/or modify it under
-the terms of the GNU General Public License as published by the Free Software
-Foundation, version 3.
-
-This program is distributed in the hope that it will be useful, but WITHOUT ANY
-WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
-PARTICULAR PURPOSE. See the GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along with
-this program. If not, see <https://www.gnu.org/licenses/>.
-|#
-
-(define-module (ordo task)
-  #:use-module (ordo logger)
-  #:use-module (srfi srfi-9)
-  #:export (task
-            task?
-            task-name
-            task-pre-condition
-            task-action
-            run-task))
-
-(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")))

ordo/util/keyword-args.scm

@@ -1,23 +0,0 @@
-#|
-This file is part of Ordo.
-
-Copyright (C) 2025 Ray Miller
-
-This program is free software: you can redistribute it and/or modify it under
-the terms of the GNU General Public License as published by the Free Software
-Foundation, version 3.
-
-This program is distributed in the hope that it will be useful, but WITHOUT ANY
-WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
-PARTICULAR PURPOSE. See the GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along with
-this program. If not, see <https://www.gnu.org/licenses/>.
-|#
-
-(define-module (ordo util keyword-args)
-  #:use-module ((srfi srfi-1) #:select (member))
-  #:export (keyword-arg))
-
-(define* (keyword-arg args kw #:optional (default #f))
-  (or (and=> (member kw args) cadr) default))