diff --git a/examples/forgejo.scm b/examples/forgejo.scm index bada9dd..ad3d44a 100644 --- a/examples/forgejo.scm +++ b/examples/forgejo.scm @@ -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")) diff --git a/ordo/blueprint.scm b/ordo/blueprint.scm new file mode 100644 index 0000000..4b803d1 --- /dev/null +++ b/ordo/blueprint.scm @@ -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 . +|# + +(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-name + task-pre-condititon + task-action + task-args + task-trigger + + + handler + handler? + handler-name + handler-action + handler-args + + + blueprint + blueprint? + blueprint-name + blueprint-steps + blueprint-handlers)) + +(define-class () + (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 args)) +(define (task? x) (is-a? x )) + +(define-class () + (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 args)) +(define (handler? x) (is-a? x )) + +(define-class () + (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 )) + +(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 #:name name #:steps steps #:handlers handlers))) diff --git a/ordo/connection.scm b/ordo/connection.scm index 4c31470..302bffd 100644 --- a/ordo/connection.scm +++ b/ordo/connection.scm @@ -21,7 +21,6 @@ this program. If not, see . #: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 . ssh-connection call-with-connection remote-cmd) - #:re-export (remote-exec with-remote-input-file with-remote-output-file)) + #:re-export ( remote-exec with-remote-input-file with-remote-output-file)) (define (connection? c) (is-a? c )) -(define (local-connection) - (make )) +(define (local-connection . args) + (apply make args)) -(define* (ssh-connection host #:key (user (getlogin)) (password #f) (identity #f) (authenticate-server? #t) - (sudo? #f) (sudo-user #f) (sudo-password #f)) - (make #: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 args)) -(define* (call-with-connection conn proc #:key sudo? sudo-user sudo-password) - (let ((conn (deep-clone conn))) - (when sudo? - (unless (is-a? conn ) - (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)) diff --git a/ordo/core.scm b/ordo/core.scm index d12c7c1..eb2230a 100644 --- a/ordo/core.scm +++ b/ordo/core.scm @@ -15,55 +15,26 @@ You should have received a copy of the GNU General Public License along with this program. If not, see . |# (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 ) (conn )) + #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 ) (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 ) (conn )) + #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 ) (host )) + (log-msg 'NOTICE "Executing task " (task-name task) " on host " (host-name host)) + (call-with-connection (host-connection host) (cut execute task <>))) diff --git a/ordo/handler.scm b/ordo/handler.scm deleted file mode 100644 index 883f734..0000000 --- a/ordo/handler.scm +++ /dev/null @@ -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 . -|# - -(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 - (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)) diff --git a/ordo/inventory.scm b/ordo/inventory.scm index 354e8e4..41b901b 100644 --- a/ordo/inventory.scm +++ b/ordo/inventory.scm @@ -25,25 +25,23 @@ this program. If not, see . #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-69) - #:export (host + #:export ( + host host? host-name host-connection host-tags - host-vars resolve-hosts load-inventory)) -(define-record-type - (make-host name connection tags vars) - host? - (name host-name) - (connection host-connection) - (tags host-tags) - (vars host-vars)) +(define-class () + (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 )) + +(define (host . args) (apply make args)) (define (tagged-every? wanted-tags) (lambda (h) diff --git a/ordo/play.scm b/ordo/play.scm deleted file mode 100644 index 326d5c6..0000000 --- a/ordo/play.scm +++ /dev/null @@ -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 . -|# - -(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 - (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)) diff --git a/ordo/playbook.scm b/ordo/playbook.scm deleted file mode 100644 index b22fc3c..0000000 --- a/ordo/playbook.scm +++ /dev/null @@ -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 . -|# - -(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-name - playbook-vars - playbook-plays - load-playbook - run-playbook)) - -(define-record-type - (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)))) diff --git a/ordo/task.scm b/ordo/task.scm deleted file mode 100644 index 9399317..0000000 --- a/ordo/task.scm +++ /dev/null @@ -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 . -|# - -(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 - (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")))