From 78beb037e741f718023e2013e3973d56b77f53ab Mon Sep 17 00:00:00 2001 From: Ray Miller Date: Sat, 5 Jul 2025 16:29:59 +0100 Subject: [PATCH] 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 | 11 +++---- ordo/action/filesystem.scm | 4 +-- ordo/action/quadlet.scm | 2 +- ordo/action/remote-cmd.scm | 27 +++++++++++++++++ ordo/action/systemctl.scm | 2 +- ordo/connection.scm | 25 ++-------------- ordo/connection/base.scm | 2 ++ ordo/connection/local.scm | 3 ++ ordo/connection/ssh.scm | 6 ++++ ordo/core.scm | 61 ++++++++++++++++---------------------- ordo/inventory.scm | 24 +++++++-------- 11 files changed, 84 insertions(+), 83 deletions(-) create mode 100644 ordo/action/remote-cmd.scm diff --git a/examples/uptime.scm b/examples/uptime.scm index 2a4340d..1afda2a 100644 --- a/examples/uptime.scm +++ b/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")) - -;; IDEA: have load-inventory! set an *inventory* parameter and remove the execute methods -;; that take a argument, making this implicit. +;;(setup-logging! #:level 'DEBUG) +;;(load-inventory! "examples/inventory.scm") +;;(execute uptime 'all '()) diff --git a/ordo/action/filesystem.scm b/ordo/action/filesystem.scm index bb87ae3..789a20f 100644 --- a/ordo/action/filesystem.scm +++ b/ordo/action/filesystem.scm @@ -23,8 +23,8 @@ this program. If not, see . #: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 connection base) + #:use-module (ordo action remote-cmd) + #:use-module ((ordo connection base) #:select (with-remote-output-file)) #:export (create-tmp-dir install-dir install-file diff --git a/ordo/action/quadlet.scm b/ordo/action/quadlet.scm index 883baf0..24607e6 100644 --- a/ordo/action/quadlet.scm +++ b/ordo/action/quadlet.scm @@ -19,7 +19,7 @@ this program. If not, see . #: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 diff --git a/ordo/action/remote-cmd.scm b/ordo/action/remote-cmd.scm new file mode 100644 index 0000000..dbb14a5 --- /dev/null +++ b/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))))) diff --git a/ordo/action/systemctl.scm b/ordo/action/systemctl.scm index d8b5eeb..e61229b 100644 --- a/ordo/action/systemctl.scm +++ b/ordo/action/systemctl.scm @@ -16,7 +16,7 @@ this program. If not, see . |# (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?) diff --git a/ordo/connection.scm b/ordo/connection.scm index 5b22034..f729bf9 100644 --- a/ordo/connection.scm +++ b/ordo/connection.scm @@ -23,16 +23,11 @@ this program. If not, see . #: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 - remote-cmd) - #:re-export ( remote-exec with-remote-input-file with-remote-output-file)) + call-with-connection)) (define (connection? c) (is-a? c )) @@ -44,6 +39,7 @@ this program. If not, see . (apply make 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 ) @@ -58,20 +54,3 @@ this program. If not, see . (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))))) diff --git a/ordo/connection/base.scm b/ordo/connection/base.scm index d853fdb..330c8f9 100644 --- a/ordo/connection/base.scm +++ b/ordo/connection/base.scm @@ -23,6 +23,7 @@ this program. If not, see . #:use-module (ordo util shell-quote) #:use-module ((srfi srfi-1) #:select (remove)) #:export ( + describe setup teardown build-command @@ -32,6 +33,7 @@ this program. If not, see . (define-generic setup) (define-generic teardown) +(define-generic describe) (define-generic build-command) (define-generic remote-exec) (define-generic with-remote-input-file) diff --git a/ordo/connection/local.scm b/ordo/connection/local.scm index c4d39ae..7df9676 100644 --- a/ordo/connection/local.scm +++ b/ordo/connection/local.scm @@ -25,6 +25,9 @@ this program. If not, see . (define-class ()) +(define-method (describe (c )) + (format #f "local-connection (sudo=~a)" (become? c))) + (define-method (remote-exec (c ) (command )) (let* ((port (open-input-pipe command)) (output (read-lines port)) diff --git a/ordo/connection/ssh.scm b/ordo/connection/ssh.scm index b659926..bb3635d 100644 --- a/ordo/connection/ssh.scm +++ b/ordo/connection/ssh.scm @@ -39,6 +39,12 @@ this program. If not, see . (session) (sftp-session)) +(define-method (describe (c )) + (format #f "ssh ~a@~a (sudo=~a)" + (ssh-connection-user c) + (ssh-connection-host c) + (become? c))) + (define-method (setup (c )) (unless (slot-bound? c 'session) (let ((s (make-session #:user (ssh-connection-user c) #:host (ssh-connection-host c)))) diff --git a/ordo/core.scm b/ordo/core.scm index 74e69ec..52e9cd7 100644 --- a/ordo/core.scm +++ b/ordo/core.scm @@ -21,6 +21,7 @@ this program. If not, see . #: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 . blueprint-tasks blueprint-handlers - - workflow - workflow-steps - - step - execute)) -(define-generic execute) +(define-generic execute%) (define-class () (name #:init-keyword #:name #:getter task-name) @@ -70,7 +65,8 @@ this program. If not, see . (define (task . args) (apply make args)) (define (task? x) (is-a? x )) -(define-method (execute (task ) (conn )) +(define-method (execute% (task ) (conn )) + (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 . (log-msg 'NOTICE (task-name task) " - " result)))) (log-msg 'NOTICE (task-name task) " - SKIPPED"))) -(define-method (execute (task ) (host ) (options )) +(define-method (execute% (task ) (host ) (options )) (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 . (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 ) target (options )) +(define-method (execute% (task ) target (options )) (let-keywords options #t ((continue-on-error? #f)) @@ -103,10 +99,12 @@ this program. If not, see . (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))) - (execute task host options))) + (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))) + (execute% task host options))) (resolve-hosts target)))) (define-class () @@ -117,7 +115,7 @@ this program. If not, see . (define (handler . args) (apply make args)) (define (handler? x) (is-a? x )) -(define-method (execute (handler ) (conn )) +(define-method (execute% (handler ) (conn )) (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 ) (conn )) +(define-method (execute% (blueprint ) (conn )) (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 ) (host ) (options )) +(define-method (execute% (blueprint ) (host ) (options )) (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 ) target (options )) +(define-method (execute% (blueprint ) target (options )) (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)) - (execute blueprint host options) + (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))) + (execute% blueprint host options))) (resolve-hosts target)))) -;; (define-class () -;; (steps #:init-keyword #:steps #:getter workflow-steps)) - -;; (define* (step #:key action target continue-on-err?) -;; (lambda (resolver) -;; (execute action resolver target continue-on-err?))) - -;; (define (workflow . steps) -;; (make #:steps steps)) - -;; (define-method (execute (wf ) (resolver )) -;; (for-each (lambda (step) (step resolver)) (workflow-steps wf))) +(define (execute task-or-blueprint target . options) + (execute% task-or-blueprint target options)) diff --git a/ordo/inventory.scm b/ordo/inventory.scm index 6e8f990..d82e161 100644 --- a/ordo/inventory.scm +++ b/ordo/inventory.scm @@ -23,8 +23,6 @@ this program. If not, see . #:use-module ((ordo connection) #:select (local-connection)) #:use-module (ordo logger) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-9) - #:use-module (srfi srfi-69) #:export ( defhost host? @@ -44,6 +42,17 @@ this program. If not, see . (define (host? h) (is-a? h )) +(define (defhost name . args) + (let ((host (apply make #: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 . (('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 #: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")))