Start to experiment with blueprints
This commit is contained in:
parent
1158efbaa4
commit
c1cb9aa3db
GPG key ID:
043F786C4CD681B8
9 changed files with 174 additions and 367 deletions
|
|
@ -1,60 +1,58 @@
|
|||
(use-modules
|
||||
(ordo blueprint)
|
||||
(ordo core)
|
||||
((ordo action filesystem) #:prefix fs:)
|
||||
((ordo action quadlet) #:prefix quadlet:)
|
||||
((ordo action systemctl) #:prefix systemctl:))
|
||||
|
||||
(define* (install-forgejo #:key (version "11"))
|
||||
(list
|
||||
(task "Install configuration directory"
|
||||
#:action fs:install-dir
|
||||
#:args '(#:path "/etc/forgejo")
|
||||
#:trigger '("Restart pod"))
|
||||
(task "Install timezone configuration"
|
||||
#:action fs:install-file
|
||||
#:args '(#:path "/etc/forgejo/timezone" #:local-src "files/timezone")
|
||||
#:trigger '("Restart pod"))
|
||||
(task "Install localtime configuration"
|
||||
#:action fs:install-file
|
||||
#:args '(#:path "/etc/forgejo/localtime" #:local-src "files/localtime")
|
||||
#:trigger '("Restart pod"))
|
||||
(task "Create data volume quadlet"
|
||||
#:action quadlet:create-volume
|
||||
#:args '(#:name "forgejo" #:description "Forgejo data volume")
|
||||
#:trigger '("Reload systemd" "Restart pod"))
|
||||
(task "Create pod quadlet"
|
||||
#:action quadlet:create-pod
|
||||
#:args '(#:name "forgejo"
|
||||
#:pod ((PodName . "forge")
|
||||
(Volume . "forgejo.volume:U,Z")
|
||||
(PodmanArgs . "--userns auto")))
|
||||
#:trigger '("Reload systemd" "Restart pod"))
|
||||
(task "Create image quadlet"
|
||||
#:action quadlet:create-image
|
||||
#:args `(#:name "forgejo"
|
||||
#:image (Image . ,(format #f "codeberg.org/forgejo/forgejo:~a" version)))
|
||||
#:trigger '("Reload systemd" "Restart pod"))
|
||||
(task "Create container quadlet"
|
||||
#:action quadlet:create-container
|
||||
#:args '(#:name "forgejo"
|
||||
#:container ((Pod . "forgejo.pod")
|
||||
(Image . "forgejo.image")
|
||||
(Network . "services.network")
|
||||
(Volume . "/etc/forgejo/timezone:/etc/timezone:ro,U,Z")
|
||||
(Volume . "/etc/forgejo/localtime:/etc/localtime:ro,U,Z")
|
||||
(Environment . "USER_UID=1000")
|
||||
(Environment . "USER_GID=1000")
|
||||
(Environment . "FORGEJO__service__DISABLE_REGISTRATION=true")
|
||||
(Environment . "FORGEJO__webhook__ALLOWED_HOST_LIST=private")))
|
||||
#:trigger '("Reload systemd" "Restart pod"))
|
||||
(handler "Reload systemd"
|
||||
#:action systemctl:daemon-reload)
|
||||
(handler "Restart pod"
|
||||
#:action systemctl:restart-unit
|
||||
#:args '((#:unit . "forgejo-pod.service")))))
|
||||
(blueprint (format #f "Install forgejo version ~a" version)
|
||||
(task "Install configuration directory"
|
||||
#:action fs:install-dir
|
||||
#:args '(#:path "/etc/forgejo")
|
||||
#:trigger '("Restart pod"))
|
||||
(task "Install timezone configuration"
|
||||
#:action fs:install-file
|
||||
#:args '(#:path "/etc/forgejo/timezone" #:local-src "files/timezone")
|
||||
#:trigger '("Restart pod"))
|
||||
(task "Install localtime configuration"
|
||||
#:action fs:install-file
|
||||
#:args '(#:path "/etc/forgejo/localtime" #:local-src "files/localtime")
|
||||
#:trigger '("Restart pod"))
|
||||
(task "Create data volume quadlet"
|
||||
#:action quadlet:create-volume
|
||||
#:args '(#:name "forgejo" #:description "Forgejo data volume")
|
||||
#:trigger '("Reload systemd" "Restart pod"))
|
||||
(task "Create pod quadlet"
|
||||
#:action quadlet:create-pod
|
||||
#:args '(#:name "forgejo"
|
||||
#:pod ((PodName . "forge")
|
||||
(Volume . "forgejo.volume:U,Z")
|
||||
(PodmanArgs . "--userns auto")))
|
||||
#:trigger '("Reload systemd" "Restart pod"))
|
||||
(task "Create image quadlet"
|
||||
#:action quadlet:create-image
|
||||
#:args `(#:name "forgejo"
|
||||
#:image (Image . ,(format #f "codeberg.org/forgejo/forgejo:~a" version)))
|
||||
#:trigger '("Reload systemd" "Restart pod"))
|
||||
(task "Create container quadlet"
|
||||
#:action quadlet:create-container
|
||||
#:args '(#:name "forgejo"
|
||||
#:container ((Pod . "forgejo.pod")
|
||||
(Image . "forgejo.image")
|
||||
(Network . "services.network")
|
||||
(Volume . "/etc/forgejo/timezone:/etc/timezone:ro,U,Z")
|
||||
(Volume . "/etc/forgejo/localtime:/etc/localtime:ro,U,Z")
|
||||
(Environment . "USER_UID=1000")
|
||||
(Environment . "USER_GID=1000")
|
||||
(Environment . "FORGEJO__service__DISABLE_REGISTRATION=true")
|
||||
(Environment . "FORGEJO__webhook__ALLOWED_HOST_LIST=private")))
|
||||
#:trigger '("Reload systemd" "Restart pod"))
|
||||
(handler "Reload systemd"
|
||||
#:action systemctl:daemon-reload)
|
||||
(handler "Restart pod"
|
||||
#:action systemctl:restart
|
||||
#:args '((#:unit . "forgejo-pod.service")))))
|
||||
|
||||
(playbook "Install Forgejo on limiting-factor"
|
||||
;; #:vars '((forgejo-version . "11.0.2"))
|
||||
(play
|
||||
#:host "limiting-factor"
|
||||
#:become? #t
|
||||
(install-forgejo #:version "11")))
|
||||
(workflow
|
||||
(execute (install-forgejo #:version "11") "root@limiting-factor"))
|
||||
|
|
|
|||
89
ordo/blueprint.scm
Normal file
89
ordo/blueprint.scm
Normal file
|
|
@ -0,0 +1,89 @@
|
|||
#|
|
||||
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 blueprint)
|
||||
#:use-module (ice-9 exceptions)
|
||||
#:use-module (ice-9 format)
|
||||
#:use-module (oop goops)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-235)
|
||||
#:export (<task>
|
||||
task
|
||||
task?
|
||||
task-name
|
||||
task-pre-condititon
|
||||
task-action
|
||||
task-args
|
||||
task-trigger
|
||||
|
||||
<handler>
|
||||
handler
|
||||
handler?
|
||||
handler-name
|
||||
handler-action
|
||||
handler-args
|
||||
|
||||
<blueprint>
|
||||
blueprint
|
||||
blueprint?
|
||||
blueprint-name
|
||||
blueprint-steps
|
||||
blueprint-handlers))
|
||||
|
||||
(define-class <task> ()
|
||||
(name #:init-keyword #:name #:getter task-name)
|
||||
(pre-condition #:init-keyword #:pre-condition #:getter task-pre-condition)
|
||||
(action #:init-keyword #:action #:getter task-action)
|
||||
(args #:init-keyword #:args #:getter task-args)
|
||||
(trigger #:init-keyword #:trigger #:getter task-trigger))
|
||||
|
||||
(define (task . args) (apply make <task> args))
|
||||
(define (task? x) (is-a? x <task>))
|
||||
|
||||
(define-class <handler> ()
|
||||
(name #:init-keyword #:name #:getter handler-name)
|
||||
(action #:init-keyword #:action #:getter handler-action)
|
||||
(args #:init-keyword #:args #:getter handler-args))
|
||||
|
||||
(define (handler . args) (apply make <handler> args))
|
||||
(define (handler? x) (is-a? x <handler>))
|
||||
|
||||
(define-class <blueprint> ()
|
||||
(name #:init-keyword #:name #:getter blueprint-name)
|
||||
(steps #:init-keyword #:steps #:getter blueprint-steps)
|
||||
(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 ((steps (filter (disjoin task? blueprint?) args))
|
||||
(handlers (filter handler? args)))
|
||||
(validate-triggers name (filter task? steps) handlers)
|
||||
(make <blueprint> #:name name #:steps steps #:handlers handlers)))
|
||||
|
|
@ -21,7 +21,6 @@ this program. If not, see <https://www.gnu.org/licenses/>.
|
|||
#:use-module (ordo connection base)
|
||||
#:use-module (ordo connection local)
|
||||
#: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)
|
||||
|
|
@ -32,35 +31,22 @@ this program. If not, see <https://www.gnu.org/licenses/>.
|
|||
ssh-connection
|
||||
call-with-connection
|
||||
remote-cmd)
|
||||
#:re-export (remote-exec with-remote-input-file with-remote-output-file))
|
||||
#:re-export (<connection> remote-exec with-remote-input-file with-remote-output-file))
|
||||
|
||||
(define (connection? c)
|
||||
(is-a? c <connection>))
|
||||
|
||||
(define (local-connection)
|
||||
(make <local-connection>))
|
||||
(define (local-connection . args)
|
||||
(apply make <local-connection> args))
|
||||
|
||||
(define* (ssh-connection host #:key (user (getlogin)) (password #f) (identity #f) (authenticate-server? #t)
|
||||
(sudo? #f) (sudo-user #f) (sudo-password #f))
|
||||
(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 (ssh-connection . args)
|
||||
(apply make <ssh-connection> args))
|
||||
|
||||
(define* (call-with-connection conn proc #:key sudo? sudo-user sudo-password)
|
||||
(let ((conn (deep-clone conn)))
|
||||
(when sudo?
|
||||
(unless (is-a? conn <sudo-connection>)
|
||||
(raise-exception
|
||||
(make-exception
|
||||
(make-programming-error)
|
||||
(make-exception-with-message (format #f "connection ~a does not support sudo" conn)))))
|
||||
(set! (become? conn) sudo?)
|
||||
(set! (become-user conn) sudo-user)
|
||||
(set! (become-password conn) sudo-password))
|
||||
(dynamic-wind
|
||||
(lambda () (setup conn))
|
||||
(lambda () (proc conn))
|
||||
(lambda () (teardown conn)))))
|
||||
(define* (call-with-connection conn proc)
|
||||
(dynamic-wind
|
||||
(lambda () (setup conn))
|
||||
(lambda () (proc conn))
|
||||
(lambda () (teardown conn))))
|
||||
|
||||
(define (remote-cmd conn prog . args)
|
||||
(let* ((args options (break keyword? args))
|
||||
|
|
|
|||
|
|
@ -15,55 +15,26 @@ 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 (oop goops)
|
||||
#:use-module (ordo blueprint)
|
||||
#:use-module (ordo connection)
|
||||
#:use-module (ordo context)
|
||||
#:use-module (ordo handler)
|
||||
#:use-module (ordo inventory)
|
||||
#:use-module (ordo logger)
|
||||
#:use-module (ordo playbook)
|
||||
#:use-module (ordo play)
|
||||
#:use-module (ordo task)
|
||||
#:use-module ((srfi srfi-26) #:select (cut)))
|
||||
#:use-module (srfi srfi-26)
|
||||
#:export (execute))
|
||||
|
||||
(define (run-playbook ctx pb)
|
||||
(log-msg 'NOTICE "Running playbook: " (playbook-name pb))
|
||||
(set-ctx-playbook! ctx pb)
|
||||
(for-each (cut run-play ctx <>) (playbook-plays pb)))
|
||||
(define-method (execute (blueprint <blueprint>) (conn <connection>))
|
||||
#f
|
||||
)
|
||||
|
||||
(define (run-play ctx p)
|
||||
(log-msg 'NOTICE "Running play: " (play-name p))
|
||||
(set-ctx-play! ctx p)
|
||||
(let ((hosts (resolve-hosts (ctx-inventory ctx) (play-host p))))
|
||||
(if (null? hosts)
|
||||
(log-msg 'WARN "No hosts matched: " (play-host p))
|
||||
(for-each (cut run-host-play ctx p <>) hosts))))
|
||||
(define-method (execute (blueprint <blueprint>) (host <host>))
|
||||
(log-msg 'NOTICE "Executing blueprint " (blueprint-name blueprint) " on host " (host-name host))
|
||||
(call-with-connection (host-connection host) (cut execute blueprint <>)))
|
||||
|
||||
(define (run-host-play ctx p h)
|
||||
(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-method (execute (task <task>) (conn <connection>))
|
||||
#f)
|
||||
|
||||
(define (run-task ctx t)
|
||||
(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)
|
||||
(when (member (ctx-triggers ctx) (handler-name h))
|
||||
(log-msg 'NOTICE "Running handler: " (handler-name h))
|
||||
((handler-action h) ctx)))
|
||||
(define-method (execute (task <task>) (host <host>))
|
||||
(log-msg 'NOTICE "Executing task " (task-name task) " on host " (host-name host))
|
||||
(call-with-connection (host-connection host) (cut execute task <>)))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
@ -25,25 +25,23 @@ this program. If not, see <https://www.gnu.org/licenses/>.
|
|||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-9)
|
||||
#:use-module (srfi srfi-69)
|
||||
#:export (host
|
||||
#:export (<host>
|
||||
host
|
||||
host?
|
||||
host-name
|
||||
host-connection
|
||||
host-tags
|
||||
host-vars
|
||||
resolve-hosts
|
||||
load-inventory))
|
||||
|
||||
(define-record-type <host>
|
||||
(make-host name connection tags vars)
|
||||
host?
|
||||
(name host-name)
|
||||
(connection host-connection)
|
||||
(tags host-tags)
|
||||
(vars host-vars))
|
||||
(define-class <host> ()
|
||||
(name #:init-keyword #:name #:getter host-name)
|
||||
(connection #:init-keyword #:connection #:getter host-connection)
|
||||
(tags #:init-keyword #:tags #:getter host-tags))
|
||||
|
||||
(define* (host #:key name connection (tags '()) (vars '()))
|
||||
(make-host name connection tags (alist->hash-table vars)))
|
||||
(define (host? h) (is-a? h <host>))
|
||||
|
||||
(define (host . args) (apply make <host> args))
|
||||
|
||||
(define (tagged-every? wanted-tags)
|
||||
(lambda (h)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
@ -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))))
|
||||
|
|
@ -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")))
|
||||
Loading…
Add table
Add a link
Reference in a new issue