Fixes and simplifications

* 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/uptime.scm

@@ -1,15 +1,12 @@
 (use-modules (ordo core)
              (ordo inventory)
-             (ordo connection)
+             (ordo action remote-cmd)
              (ordo logger)
              (srfi srfi-26))
 
 (define uptime (task #:name "uptime" #:action (cut remote-cmd <> "uptime" #:return car)))
 
-(define flow (workflow
-              (execute uptime "limiting-factor" '(#:sudo #t))))
 
-(define resolver (load-inventory "examples/inventory.scm"))
+;;(setup-logging! #:level 'DEBUG)
-
+;;(load-inventory! "examples/inventory.scm")
-;; IDEA: have load-inventory! set an *inventory* parameter and remove the execute methods
+;;(execute uptime 'all '())
-;; that take a <host-resolver> argument, making this implicit.

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,27 @@
+(define-module (ordo action remote-cmd)
+  #:use-module (ice-9 exceptions)
+  #: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)
+  #:use-module (ordo util keyword-args)
+  #:export (remote-cmd))
+
+(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 '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)))))
+          (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/connection.scm

@@ -23,16 +23,11 @@ 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 (<connection> remote-exec with-remote-input-file with-remote-output-file))
 
 (define (connection? c)
   (is-a? c <connection>))
@@ -44,6 +39,7 @@ this program. If not, see <https://www.gnu.org/licenses/>.
   (apply make <ssh-connection> args))
 
 (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>)
@@ -58,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

@@ -23,6 +23,7 @@ this program. If not, see <https://www.gnu.org/licenses/>.
   #: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)

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

@@ -39,6 +39,12 @@ this program. If not, see <https://www.gnu.org/licenses/>.
   (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)
     (let ((s (make-session #:user (ssh-connection-user c) #:host (ssh-connection-host c))))

ordo/core.scm

@@ -21,6 +21,7 @@ this program. If not, see <https://www.gnu.org/licenses/>.
   #:use-module (ice-9 optargs)
   #:use-module (oop goops)
   #:use-module (ordo connection)
+  #:use-module (ordo connection base)
   #:use-module (ordo inventory)
   #:use-module (ordo logger)
   #:use-module (ordo util flatten)
@@ -50,15 +51,9 @@ this program. If not, see <https://www.gnu.org/licenses/>.
             blueprint-tasks
             blueprint-handlers
 
-            <workflow>
-            workflow
-            workflow-steps
-
-            step
-
             execute))
 
-(define-generic execute)
+(define-generic execute%)
 
 (define-class <task> ()
   (name #:init-keyword #:name #:getter task-name)
@@ -70,7 +65,8 @@ this program. If not, see <https://www.gnu.org/licenses/>.
 (define (task . args) (apply make <task> args))
 (define (task? x) (is-a? x <task>))
 
-(define-method (execute (task <task>) (conn <connection>))
+(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 ((task-action task) conn)))
         (cond
@@ -83,7 +79,7 @@ this program. If not, see <https://www.gnu.org/licenses/>.
           (log-msg 'NOTICE (task-name task) " - " result))))
       (log-msg 'NOTICE (task-name task) " - SKIPPED")))
 
-(define-method (execute (task <task>) (host <host>) (options <list>))
+(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
@@ -92,10 +88,10 @@ this program. If not, see <https://www.gnu.org/licenses/>.
     (sudo-password #f))
    (call-with-connection
     (host-connection host)
-    (cut execute task <> options)
+    (cut execute% task <>)
     #:sudo? sudo? #:sudo-user sudo-user #:sudo-password sudo-password)))
 
-(define-method (execute (task <task>) target (options <list>))
+(define-method (execute% (task <task>) target (options <list>))
   (let-keywords
    options #t
    ((continue-on-error? #f))
@@ -103,10 +99,12 @@ this program. If not, see <https://www.gnu.org/licenses/>.
     (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)))
+              (lambda (e) (log-msg 'ERROR "Failed to execute " (task-name task) " on host " (host-name host) ": " e))
-            (execute task host options)))
+            (lambda ()
+              (execute% task host options))
+            #:unwind? #t))
         (lambda (host)
-          (execute task host options)))
+          (execute% task host options)))
     (resolve-hosts target))))
 
 (define-class <handler> ()
@@ -117,7 +115,7 @@ this program. If not, see <https://www.gnu.org/licenses/>.
 (define (handler . args) (apply make <handler> args))
 (define (handler? x) (is-a? x <handler>))
 
-(define-method (execute (handler <handler>) (conn <connection>))
+(define-method (execute% (handler <handler>) (conn <connection>))
   (log-msg 'NOTICE "Executing handler " (handler-name handler))
   ((handler-action handler) conn))
 
@@ -158,17 +156,17 @@ in which case it is a no-op."
     (when triggered
       (hash-table-set! triggered handler-name #t))))
 
-(define-method (execute (blueprint <blueprint>) (conn <connection>))
+(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)
+    (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)))
+                  (execute% handler conn)))
               (blueprint-handlers blueprint))))
 
-(define-method (execute (blueprint <blueprint>) (host <host>) (options <list>))
+(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
@@ -177,10 +175,10 @@ in which case it is a no-op."
     (sudo-password #f))
    (call-with-connection
     (host-connection host)
-    (cut execute blueprint <>)
+    (cut execute% blueprint <>)
     #:sudo? sudo? #:sudo-user sudo-user #:sudo-password sudo-password)))
 
-(define-method (execute (blueprint <blueprint>) target (options <list>))
+(define-method (execute% (blueprint <blueprint>) target (options <list>))
   (let-keywords
    options #t
    ((continue-on-error? #f))
@@ -188,22 +186,13 @@ in which case it is a no-op."
     (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))
+              (cut log-msg 'ERROR "Failed to execute blueprint " (blueprint-name blueprint) " on host " (host-name host) ": " <>)
-            (execute blueprint host options)
+            (lambda ()
+              (execute% blueprint host options))
             #:unwind? #t))
         (lambda (host)
-          (execute blueprint host options)))
+          (execute% blueprint host options)))
     (resolve-hosts target))))
 
-;; (define-class <workflow> ()
+(define (execute task-or-blueprint target . options)
-;;   (steps #:init-keyword #:steps #:getter workflow-steps))
+  (execute% task-or-blueprint target options))
-
-;; (define* (step #:key action target continue-on-err?)
-;;   (lambda (resolver)
-;;     (execute action resolver target continue-on-err?)))
-
-;; (define (workflow . steps)
-;;   (make <workflow> #:steps steps))
-
-;; (define-method (execute (wf <workflow>) (resolver <host-resolver>))
-;;   (for-each (lambda (step) (step resolver)) (workflow-steps wf)))

ordo/inventory.scm

@@ -23,8 +23,6 @@ this program. If not, see <https://www.gnu.org/licenses/>.
   #:use-module ((ordo connection) #:select (local-connection))
   #:use-module (ordo logger)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-9)
-  #:use-module (srfi srfi-69)
   #:export (<host>
             defhost
             host?
@@ -44,6 +42,17 @@ this program. If not, see <https://www.gnu.org/licenses/>.
 
 (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")))
+
 (define (tagged-every? wanted-tags)
   (lambda (h)
     (lset= equal? wanted-tags (lset-intersection equal? (host-tags h) wanted-tags))))
@@ -66,14 +75,3 @@ this program. If not, see <https://www.gnu.org/licenses/>.
     (('tagged/every tag . tags) (filter (tagged-every? (cons tag tags)) *inventory*))
     (('tagged/any tag . tags) (filter (tagged-any? (cons tag tags)) *inventory*))
     ((. hostnames) (filter (lambda (h) (member (host-name h) hostnames string=?)) *inventory*))))
-
-(define (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")))