From 7f5ec3ac2955f0bc38dae1962bcf10a74c358bc5 Mon Sep 17 00:00:00 2001 From: Ray Miller Date: Mon, 20 Jan 2025 10:42:15 +0000 Subject: [PATCH] Use context instead of global vars --- examples/install-aws-cli.scm | 10 +-- modules/ordo.scm | 5 +- modules/ordo/cli.scm | 8 +- modules/ordo/connection.scm | 2 +- modules/ordo/context.scm | 152 +++++++++++++++++++++++++++++++++++ modules/ordo/facts.scm | 7 +- modules/ordo/handler.scm | 5 +- modules/ordo/host.scm | 39 +++++++++ modules/ordo/inventory.scm | 54 ------------- modules/ordo/play.scm | 52 ++++++------ modules/ordo/playbook.scm | 2 +- modules/ordo/task.scm | 8 +- modules/ordo/vars.scm | 104 ------------------------ 13 files changed, 243 insertions(+), 205 deletions(-) create mode 100644 modules/ordo/context.scm create mode 100644 modules/ordo/host.scm delete mode 100644 modules/ordo/inventory.scm delete mode 100644 modules/ordo/vars.scm diff --git a/examples/install-aws-cli.scm b/examples/install-aws-cli.scm index 3844110..1e1f273 100644 --- a/examples/install-aws-cli.scm +++ b/examples/install-aws-cli.scm @@ -2,8 +2,9 @@ (ice-9 filesystem) (ordo)) -(define* (install-aws-cli conn #:key (url "https://awscli.amazonaws.com/awscli-exe-linux-x86_64.zip") update? install-dir bin-dir) - (let ((tmp-dir (run conn "mktemp" "-d" #:return car #:check? #t))) +(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 () @@ -22,8 +23,7 @@ (play "Test play" #:host "localhost" (task "Install AWS CLI" - (lambda (c) - (install-aws-cli c - #:update? #t + (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")))))) diff --git a/modules/ordo.scm b/modules/ordo.scm index b978821..7c3741f 100644 --- a/modules/ordo.scm +++ b/modules/ordo.scm @@ -5,7 +5,6 @@ #:use-module (ordo task) #:use-module (ordo handler) #:use-module (ordo connection) - #:use-module (ordo inventory) - #:use-module (ordo vars) + #:use-module (ordo context) #:use-module (ordo logger) - #:re-export (add-host! local-connection ssh-connection run playbook play task handler $)) + #:re-export (add-host! local-connection ssh-connection current-connection run playbook play task handler $)) diff --git a/modules/ordo/cli.scm b/modules/ordo/cli.scm index 3d4497c..519e3f1 100644 --- a/modules/ordo/cli.scm +++ b/modules/ordo/cli.scm @@ -1,7 +1,7 @@ (define-module (ordo cli) #:use-module (ice-9 match) #:use-module (ordo logger) - #:use-module (ordo vars) + #:use-module (ordo context) #:use-module (ordo playbook) #:declarative? #f #:export (main)) @@ -9,8 +9,8 @@ (define (main args) (match-let (((_ inventory-path playbook-path) args)) (setup-logging #:level 'DEBUG) - (init-command-line-vars! '()) + (init-context!) (load inventory-path) - ;; (let ((playbook (load playbook-path))) - ;; (run-playbook playbook)) + (let ((playbook (load playbook-path))) + (run-playbook playbook)) (quit))) diff --git a/modules/ordo/connection.scm b/modules/ordo/connection.scm index 4e57bda..f5b4c60 100644 --- a/modules/ordo/connection.scm +++ b/modules/ordo/connection.scm @@ -28,7 +28,7 @@ (make #:user user #:host host #:password password #:identity identity #:authenticate-server? authenticate-server?)) -(define* (call-with-connection c proc #:key (sudo? #f) (sudo-user #f) (sudo-password #f)) +(define* (call-with-connection c sudo? sudo-user sudo-password proc) (let ((c (if sudo? (make #:connection c #:become-user sudo-user #:become-password sudo-password) c))) diff --git a/modules/ordo/context.scm b/modules/ordo/context.scm new file mode 100644 index 0000000..2b4dcda --- /dev/null +++ b/modules/ordo/context.scm @@ -0,0 +1,152 @@ +(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 + (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*) '())))) diff --git a/modules/ordo/facts.scm b/modules/ordo/facts.scm index d3d3e6b..9462e7f 100644 --- a/modules/ordo/facts.scm +++ b/modules/ordo/facts.scm @@ -1,6 +1,6 @@ (define-module (ordo facts) #:use-module ((srfi srfi-88) #:select (string->keyword)) - #:use-module (ordo vars) + #:use-module (ordo context) #:use-module (ordo facts user) #:export (gather-facts)) @@ -10,8 +10,9 @@ (assoc-ref src (string->keyword k)))) keys)) -(define (gather-facts conn) - (let* ((id (fact:id conn)) +(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")) diff --git a/modules/ordo/handler.scm b/modules/ordo/handler.scm index 127555e..0a6ebba 100644 --- a/modules/ordo/handler.scm +++ b/modules/ordo/handler.scm @@ -2,6 +2,7 @@ #:use-module (ice-9 match) #:use-module (srfi srfi-9) ; records #:use-module (logging logger) + #:use-module (ordo context) #:export (handler handler? handler-name @@ -17,8 +18,8 @@ (define (handler name action) (make-handler name action)) -(define (run-handler c h) +(define (run-handler h) (match h (($ name action) (log-msg 'NOTICE "Running handler: " name) - (action c)))) + (action (current-connection))))) diff --git a/modules/ordo/host.scm b/modules/ordo/host.scm new file mode 100644 index 0000000..fa19045 --- /dev/null +++ b/modules/ordo/host.scm @@ -0,0 +1,39 @@ +(define-module (ordo host) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (ordo connection) + #:export (make-host + host? + host-name + host-connection + host-tags + resolve-hosts)) + +(define-record-type + (make-host name connection tags) + host? + (name host-name) + (connection host-connection) + (tags host-tags)) + +(define (tagged-all? wanted-tags) + (lambda (h) + (lset= equal? wanted-tags (lset-intersection equal? (host-tags h) wanted-tags)))) + +(define (tagged-any? wanted-tags) + (lambda (h) + (not (null? (lset-intersection equal? (host-tags h) wanted-tags))))) + +(define (named? hostname) + (lambda (h) + (string=? (host-name h) hostname))) + +(define (resolve-hosts inventory) + (match-lambda + ("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)))) diff --git a/modules/ordo/inventory.scm b/modules/ordo/inventory.scm deleted file mode 100644 index a433fa2..0000000 --- a/modules/ordo/inventory.scm +++ /dev/null @@ -1,54 +0,0 @@ -(define-module (ordo inventory) - #:use-module (ice-9 match) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-9) - #:use-module (srfi srfi-69) - #:use-module (logging logger) - #:use-module (ordo connection) - #:export (make-host - host? - host-name - host-connection - host-tags - add-host! - resolve-hosts)) - -(define *hosts* (make-hash-table equal?)) - -(define-record-type - (make-host name connection tags) - host? - (name host-name) - (connection host-connection) - (tags host-tags)) - -(define (add-host! name connection . tags) - (log-msg 'DEBUG "Adding host to inventory: " name) - (hash-table-set! *hosts* name (make-host name connection tags))) - -(define (tagged-all? wanted-tags) - (lambda (h) - (lset= equal? wanted-tags (lset-intersection equal? (host-tags h) wanted-tags)))) - -(define (tagged-any? wanted-tags) - (lambda (h) - (not (null? (lset-intersection equal? (host-tags h) wanted-tags))))) - -(define resolve-hosts - (match-lambda - ("localhost" (list (or (hash-table-ref/default *hosts* "localhost" #f) - (make-host "localhost" (local-connection) '())))) - ((? string? name) (list (hash-table-ref *hosts* name))) - ('all (hash-table-values *hosts*)) - (('every-tag tag . tags) (filter (tagged-all? (cons tag tags)) (hash-table-values *hosts*))) - (('any-tag tag . tags) (filter (tagged-any? (cons tag tags)) (hash-table-values *hosts*))))) - -#! -(define (setup-test-data) - (add-host! "little-rascal" (ssh-connection "ray" "little-rascal") #:linux #:guix) - (add-host! "linux-1" (ssh-connection "root" "linux-1") #:linux) - (add-host! "linux-2" (ssh-connection "root" "linux-2") #:linux) - (add-host! "debian-1" (ssh-connection "root" "debian-1") #:linux #:debian) - (add-host! "debian-2" (ssh-connection "root" "debian-2") #:linux #:debian) - (add-host! "debian-3" (ssh-connection "root" "debian-3") #:linux #:debian #:eu-west-1)) -!# diff --git a/modules/ordo/play.scm b/modules/ordo/play.scm index adf857c..8586425 100644 --- a/modules/ordo/play.scm +++ b/modules/ordo/play.scm @@ -3,10 +3,11 @@ #: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 vars) - #:use-module (ordo inventory) + #:use-module (ordo context) + #:use-module (ordo host) #:use-module (ordo facts) #:export (play play? @@ -40,28 +41,31 @@ (define (run-play p) (log-msg 'NOTICE "Running play: " (play-name p)) - (for-each (lambda (h) (run-host-play p h)) - (resolve-hosts (play-host p)))) + (let ((hosts ((resolve-hosts (current-inventory)) (play-host p)))) + (if (null? hosts) + (log-msg 'WARN "No hosts matched: " (play-host p)) + (for-each (lambda (h) (run-host-play p h)) hosts)))) (define (run-host-play p h) (log-msg 'NOTICE "Running play: " (play-name p) " on host: " (host-name h)) - (dynamic-wind - (lambda () - (init-play-vars! (play-vars p))) - (lambda () - (call-with-connection - (host-connection h) - (lambda (c) - (when (play-gather-facts p) - (gather-facts c)) - (for-each (cut run-task <> c) - (play-tasks p)) - (for-each (cut run-handler <> c) - (filter (compose play-triggered? handler-name) - (play-handlers p)))) - #:sudo? (play-sudo? p) - #:sudo-user (play-sudo-user p) - #:sudo-password (play-sudo-password p))) - (lambda () - (reset-play-vars!) - (reset-play-triggers!)))) + (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!)))))) diff --git a/modules/ordo/playbook.scm b/modules/ordo/playbook.scm index 376510e..b8a1169 100644 --- a/modules/ordo/playbook.scm +++ b/modules/ordo/playbook.scm @@ -2,7 +2,7 @@ #:use-module (srfi srfi-9) #:use-module (logging logger) #:use-module (ordo play) - #:use-module (ordo vars) + #:use-module (ordo context) #:export (playbook playbook? playbook-name diff --git a/modules/ordo/task.scm b/modules/ordo/task.scm index feee5ab..8104b16 100644 --- a/modules/ordo/task.scm +++ b/modules/ordo/task.scm @@ -1,7 +1,7 @@ (define-module (ordo task) #:use-module (srfi srfi-9) #:use-module (logging logger) - #:use-module (ordo vars) + #:use-module (ordo context) #:export (task task? task-name @@ -27,13 +27,13 @@ (define* (task name action #:key (tags '()) (condition (const #t)) (register-play-var #f) (register-playbook-var #f) (triggers '())) (make-task name tags action condition register-play-var register-playbook-var triggers)) -(define (run-task t c) +(define (run-task t) (when (check-filter-tags (task-tags t)) - (if (not ((task-condition t) c)) + (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) c))) + (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) diff --git a/modules/ordo/vars.scm b/modules/ordo/vars.scm deleted file mode 100644 index bef2af4..0000000 --- a/modules/ordo/vars.scm +++ /dev/null @@ -1,104 +0,0 @@ -(define-module (ordo vars) - #:use-module (ice-9 exceptions) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-69) - #:export (init-playbook-vars! - get-playbook-var - set-playbook-var! - reset-playbook-vars! - init-play-vars! - get-play-var - set-play-var! - reset-play-vars! - init-command-line-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)) - -(define not-found (cons 'not-found '())) - -(define (not-found? x) (eq? x not-found)) - -(define *playbook-vars* #f) - -(define (init-playbook-vars! alist) - (set! *playbook-vars* (alist->hash-table alist equal?))) - -(define (get-playbook-var var-name) - (hash-table-ref/default *playbook-vars* var-name not-found)) - -(define (set-playbook-var! var-name val) - (hash-table-set! *playbook-vars* var-name val)) - -(define (reset-playbook-vars!) - (set! *playbook-vars* #f)) - -(define *play-vars* #f) - -(define (init-play-vars! alist) - (set! *play-vars* (alist->hash-table alist equal?))) - -(define (get-play-var var-name) - (hash-table-ref/default *play-vars* var-name not-found)) - -(define (set-play-var! var-name val) - (hash-table-set! *play-vars* var-name val)) - -(define (reset-play-vars!) - (set! *play-vars* #f)) - -(define *command-line-vars* #f) - -(define (init-command-line-vars! alist) - (set! *command-line-vars* (alist->hash-table alist equal?))) - -(define (get-command-line-var var-name) - (hash-table-ref/default *command-line-vars* var-name not-found)) - -(define (set-command-line-var var-name val) - (hash-table-set! *command-line-vars* 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 *play-triggers* '()) - -(define (reset-play-triggers!) - (set! *play-triggers* '())) - -(define (add-play-triggers! triggers) - (set! *play-triggers* (apply lset-adjoin equal? (or *play-triggers* '()) - triggers))) - -(define (play-triggered? trigger) - (member trigger *play-triggers*)) - -(define *filter-tags* '()) - -(define (set-filter-tag! tag) - (set! *filter-tags* (lset-adjoin equal? *filter-tags* tag))) - -(define (reset-filter-tags!) - (set! *filter-tags* '())) - -(define (check-filter-tags tags) - (or (null? *filter-tags*) - (not (null? (lset-intersection eqv? *filter-tags* tags)))))