From 0f6744ad30b995485f42602af73be18f6fc973d3 Mon Sep 17 00:00:00 2001 From: Ray Miller Date: Sat, 25 Jan 2025 14:41:37 +0000 Subject: [PATCH] Improvements to interceptors --- examples/interceptor.scm | 36 ++--- modules/ordo/action/quadlet.scm | 41 ++++++ modules/ordo/context.scm | 152 -------------------- modules/ordo/facts.scm | 19 --- modules/ordo/facts/user.scm | 32 ----- modules/ordo/handler.scm | 25 ---- modules/ordo/interceptor.scm | 52 ++++--- modules/ordo/interceptor/create-tmp-dir.scm | 19 +++ modules/ordo/interceptor/debug.scm | 4 +- modules/ordo/interceptor/errors.scm | 14 -- modules/ordo/interceptor/install-file.scm | 28 ++++ modules/ordo/interceptor/stat-file.scm | 17 +++ modules/ordo/interceptor/tmp-dir.scm | 20 --- modules/ordo/interceptor/user-info.scm | 43 ++++++ modules/ordo/task.scm | 48 ------- 15 files changed, 203 insertions(+), 347 deletions(-) create mode 100644 modules/ordo/action/quadlet.scm delete mode 100644 modules/ordo/context.scm delete mode 100644 modules/ordo/facts.scm delete mode 100644 modules/ordo/facts/user.scm delete mode 100644 modules/ordo/handler.scm create mode 100644 modules/ordo/interceptor/create-tmp-dir.scm delete mode 100644 modules/ordo/interceptor/errors.scm create mode 100644 modules/ordo/interceptor/install-file.scm create mode 100644 modules/ordo/interceptor/stat-file.scm delete mode 100644 modules/ordo/interceptor/tmp-dir.scm create mode 100644 modules/ordo/interceptor/user-info.scm delete mode 100644 modules/ordo/task.scm diff --git a/examples/interceptor.scm b/examples/interceptor.scm index cedff3f..b0d1631 100644 --- a/examples/interceptor.scm +++ b/examples/interceptor.scm @@ -1,30 +1,32 @@ (use-modules (ice-9 filesystem) + (srfi srfi-2) + (srfi srfi-71) (logging logger) (ordo connection) (ordo interceptor) - (ordo interceptor tmp-dir) + (ordo interceptor install-file) + (ordo interceptor create-tmp-dir) + (ordo interceptor stat-file) + (ordo interceptor user-info) (ordo interceptor debug) - (ordo action filesystem) (ordo logger)) (define chain (list (connection-interceptor (local-connection)) - (tmp-dir-interceptor #:tmp-dir) - (interceptor - "install hello" - #:enter (lambda (ctx) - (fs:install-file (context-connection ctx) - (file-name-join* (var-ref ctx #:tmp-dir) "hello.txt") - #:content "Hello, world!\n")) - #:register #:hello) - (interceptor - "stat hello" - #:enter (lambda (ctx) - (fs:stat (context-connection ctx) (var-ref ctx #:hello))) - #:register #:hello-stat) - (debug-vars-interceptor #:hello #:hello-stat) - (debug-vars-interceptor))) + (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 "Hello, world!\n" + #:register 'hello) + (stat-file + "stat-hello" + #:path (let-vars (hello) hello) + #:register 'hello-stat) + (debug-vars 'hello 'hello-stat))) (setup-logging #:level 'INFO) (execute (init-context) chain) diff --git a/modules/ordo/action/quadlet.scm b/modules/ordo/action/quadlet.scm new file mode 100644 index 0000000..e1d3f2e --- /dev/null +++ b/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" '()) diff --git a/modules/ordo/context.scm b/modules/ordo/context.scm deleted file mode 100644 index 2b4dcda..0000000 --- a/modules/ordo/context.scm +++ /dev/null @@ -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 - (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 deleted file mode 100644 index 9462e7f..0000000 --- a/modules/ordo/facts.scm +++ /dev/null @@ -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")))) diff --git a/modules/ordo/facts/user.scm b/modules/ordo/facts/user.scm deleted file mode 100644 index 80ce865..0000000 --- a/modules/ordo/facts/user.scm +++ /dev/null @@ -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))) diff --git a/modules/ordo/handler.scm b/modules/ordo/handler.scm deleted file mode 100644 index 0a6ebba..0000000 --- a/modules/ordo/handler.scm +++ /dev/null @@ -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 - (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 - (($ name action) - (log-msg 'NOTICE "Running handler: " name) - (action (current-connection))))) diff --git a/modules/ordo/interceptor.scm b/modules/ordo/interceptor.scm index d899769..8e9036d 100644 --- a/modules/ordo/interceptor.scm +++ b/modules/ordo/interceptor.scm @@ -1,11 +1,12 @@ (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-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 @@ -18,14 +19,16 @@ var-ref var-set! var-delete! + let-vars + expand-vars terminate-when execute)) (define (check-var-name name) - (unless (keyword? name) + (unless (symbol? name) (raise-exception (make-exception (make-assertion-failure) - (make-exception-with-message "Variable name should be a keyword") + (make-exception-with-message "Variable name should be a symbol") (make-exception-with-irritants name))))) (define-record-type @@ -73,18 +76,34 @@ (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 expand-vars + (syntax-rules () + ((expand-vars ctx v ...) + (values (if (and (procedure? v) (procedure-property v 'delayed-var-ref?)) + (v ctx) + v) + ...)))) + (define-record-type - (make-interceptor name enter leave error register) + (make-interceptor name enter leave error) interceptor? (name interceptor-name) (enter interceptor-enter) (leave interceptor-leave) - (error interceptor-error) - (register interceptor-register)) + (error interceptor-error)) -(define* (interceptor name #:key enter leave error register) - "Create an interceptor with optional enter, leave, and error functions." - (make-interceptor name enter leave error register)) +(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 @@ -120,11 +139,8 @@ (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 () - (let ((result (handler ctx))) - (and=> (interceptor-register t) (cut var-set! ctx <> result)))) + (set-context-error! ctx (make-interceptor-error (interceptor-name t) #:enter e))) + (lambda () (handler ctx)) #:unwind? #t)))) (define (try-leave ctx t) diff --git a/modules/ordo/interceptor/create-tmp-dir.scm b/modules/ordo/interceptor/create-tmp-dir.scm new file mode 100644 index 0000000..b35cf49 --- /dev/null +++ b/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)) diff --git a/modules/ordo/interceptor/debug.scm b/modules/ordo/interceptor/debug.scm index ca4707a..025f9b8 100644 --- a/modules/ordo/interceptor/debug.scm +++ b/modules/ordo/interceptor/debug.scm @@ -3,9 +3,9 @@ #:use-module ((srfi srfi-1) #:select (concatenate)) #:use-module ((srfi srfi-69) #:select (hash-table-keys)) #:use-module (ordo interceptor) - #:export (debug-vars-interceptor)) + #:export (debug-vars)) -(define (debug-vars-interceptor . var-names) +(define (debug-vars . var-names) (interceptor "debug-vars" #:enter (lambda (ctx) diff --git a/modules/ordo/interceptor/errors.scm b/modules/ordo/interceptor/errors.scm deleted file mode 100644 index 7dbf012..0000000 --- a/modules/ordo/interceptor/errors.scm +++ /dev/null @@ -1,14 +0,0 @@ -(define-module (ordo interceptor errors) - #:use-module (logging logger) - #:use-module (srfi srfi-26) - #:use-module (ordo interceptor) - #:export (errors-interceptor)) - -(define (errors-interceptor) - "Interceptor to log (and clear) the context error. This will allow any - earlier #:leave handlers in the chain to run normally." - (interceptor - "handle-errors" - #:error (lambda (ctx) - (and=> (context-error ctx) (cut log-msg 'ERROR <>)) - (set-context-error! ctx #f)))) diff --git a/modules/ordo/interceptor/install-file.scm b/modules/ordo/interceptor/install-file.scm new file mode 100644 index 0000000..3732fa2 --- /dev/null +++ b/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)))))) diff --git a/modules/ordo/interceptor/stat-file.scm b/modules/ordo/interceptor/stat-file.scm new file mode 100644 index 0000000..42b4668 --- /dev/null +++ b/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)))))) diff --git a/modules/ordo/interceptor/tmp-dir.scm b/modules/ordo/interceptor/tmp-dir.scm deleted file mode 100644 index f1d0acd..0000000 --- a/modules/ordo/interceptor/tmp-dir.scm +++ /dev/null @@ -1,20 +0,0 @@ -(define-module (ordo interceptor tmp-dir) - #:use-module (ice-9 format) - #:use-module (ordo connection) - #:use-module (ordo interceptor) - #:export (tmp-dir-interceptor)) - -(define (tmp-dir-interceptor var-name) - (define (create-tmp-dir ctx) - (run (context-connection ctx) "mktemp" "--directory" #:check? #t #:return car)) - (define (cleanup-tmp-dir ctx) - (and=> (var-ref ctx var-name #f) - (lambda (dir-name) - (run (context-connection ctx) "rm" "-rf" dir-name))) - (var-delete! ctx var-name)) - (interceptor - (format #f "manage-tmp-dir ~a" var-name) - #:enter create-tmp-dir - #:register var-name - #:leave cleanup-tmp-dir - #:error cleanup-tmp-dir)) diff --git a/modules/ordo/interceptor/user-info.scm b/modules/ordo/interceptor/user-info.scm new file mode 100644 index 0000000..987d1b8 --- /dev/null +++ b/modules/ordo/interceptor/user-info.scm @@ -0,0 +1,43 @@ +(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) + #: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" (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)))) diff --git a/modules/ordo/task.scm b/modules/ordo/task.scm deleted file mode 100644 index 0b62d8d..0000000 --- a/modules/ordo/task.scm +++ /dev/null @@ -1,48 +0,0 @@ -(define-module (ordo task) - #: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 - (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* (%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-syntax task - (syntax-rules () - ((task (f args ...) kwargs ...) - (%task (symbol->string 'f) (lambda () (f args ...) kwargs ...))) - ((task name (f args ...) kwargs ...) - (%task name (lambda () (f args ...)) kwargs ...)))) - -(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)))))))