Start to experiment with blueprints

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
+  (blueprint (format #f "Install forgejo version ~a" version)
-   (task "Install configuration directory"
+             (task "Install configuration directory"
-         #:action fs:install-dir
+                   #:action fs:install-dir
-         #:args '(#:path "/etc/forgejo")
+                   #:args '(#:path "/etc/forgejo")
-         #:trigger '("Restart pod"))
+                   #:trigger '("Restart pod"))
-   (task "Install timezone configuration"
+             (task "Install timezone configuration"
-         #:action fs:install-file
+                   #:action fs:install-file
-         #:args '(#:path "/etc/forgejo/timezone" #:local-src "files/timezone")
+                   #:args '(#:path "/etc/forgejo/timezone" #:local-src "files/timezone")
-         #:trigger '("Restart pod"))
+                   #:trigger '("Restart pod"))
-   (task "Install localtime configuration"
+             (task "Install localtime configuration"
-         #:action fs:install-file
+                   #:action fs:install-file
-         #:args '(#:path "/etc/forgejo/localtime" #:local-src "files/localtime")
+                   #:args '(#:path "/etc/forgejo/localtime" #:local-src "files/localtime")
-         #:trigger '("Restart pod"))
+                   #:trigger '("Restart pod"))
-   (task "Create data volume quadlet"
+             (task "Create data volume quadlet"
-         #:action quadlet:create-volume
+                   #:action quadlet:create-volume
-         #:args '(#:name "forgejo" #:description "Forgejo data volume")
+                   #:args '(#:name "forgejo" #:description "Forgejo data volume")
-         #:trigger '("Reload systemd" "Restart pod"))
+                   #:trigger '("Reload systemd" "Restart pod"))
-   (task "Create pod quadlet"
+             (task "Create pod quadlet"
-         #:action quadlet:create-pod
+                   #:action quadlet:create-pod
-         #:args '(#:name  "forgejo"
+                   #:args '(#:name  "forgejo"
-                  #:pod  ((PodName . "forge")
+                            #:pod  ((PodName . "forge")
-                          (Volume . "forgejo.volume:U,Z")
+                                    (Volume . "forgejo.volume:U,Z")
-                          (PodmanArgs . "--userns auto")))
+                                    (PodmanArgs . "--userns auto")))
-         #:trigger '("Reload systemd" "Restart pod"))
+                   #:trigger '("Reload systemd" "Restart pod"))
-   (task "Create image quadlet"
+             (task "Create image quadlet"
-         #:action quadlet:create-image
+                   #:action quadlet:create-image
-         #:args `(#:name "forgejo"
+                   #:args `(#:name "forgejo"
-                  #:image (Image . ,(format #f "codeberg.org/forgejo/forgejo:~a" version)))
+                            #:image (Image . ,(format #f "codeberg.org/forgejo/forgejo:~a" version)))
-         #:trigger '("Reload systemd" "Restart pod"))
+                   #:trigger '("Reload systemd" "Restart pod"))
-   (task "Create container quadlet"
+             (task "Create container quadlet"
-         #:action quadlet:create-container
+                   #:action quadlet:create-container
-         #:args '(#:name  "forgejo"
+                   #:args '(#:name  "forgejo"
-                  #:container ((Pod . "forgejo.pod")
+                            #:container ((Pod . "forgejo.pod")
-                               (Image . "forgejo.image")
+                                         (Image . "forgejo.image")
-                               (Network . "services.network")
+                                         (Network . "services.network")
-                               (Volume . "/etc/forgejo/timezone:/etc/timezone:ro,U,Z")
+                                         (Volume . "/etc/forgejo/timezone:/etc/timezone:ro,U,Z")
-                               (Volume . "/etc/forgejo/localtime:/etc/localtime:ro,U,Z")
+                                         (Volume . "/etc/forgejo/localtime:/etc/localtime:ro,U,Z")
-                               (Environment . "USER_UID=1000")
+                                         (Environment . "USER_UID=1000")
-                               (Environment . "USER_GID=1000")
+                                         (Environment . "USER_GID=1000")
-                               (Environment . "FORGEJO__service__DISABLE_REGISTRATION=true")
+                                         (Environment . "FORGEJO__service__DISABLE_REGISTRATION=true")
-                               (Environment . "FORGEJO__webhook__ALLOWED_HOST_LIST=private")))
+                                         (Environment . "FORGEJO__webhook__ALLOWED_HOST_LIST=private")))
-         #:trigger '("Reload systemd" "Restart pod"))
+                   #:trigger '("Reload systemd" "Restart pod"))
-   (handler "Reload systemd"
+             (handler "Reload systemd"
-            #:action systemctl:daemon-reload)
+                      #:action systemctl:daemon-reload)
-   (handler "Restart pod"
+             (handler "Restart pod"
-            #:action systemctl:restart-unit
+                      #:action systemctl:restart
-            #:args '((#:unit . "forgejo-pod.service")))))
+                      #:args '((#:unit . "forgejo-pod.service")))))
 
-(playbook "Install Forgejo on limiting-factor"
+(workflow
-          ;; #:vars '((forgejo-version . "11.0.2"))
+ (execute (install-forgejo #:version "11") "root@limiting-factor"))
-          (play
-           #:host "limiting-factor"
-           #:become? #t
-           (install-forgejo #:version "11")))

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 <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)))

ordo/connection.scm

@@ -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)
+(define (local-connection . args)
-  (make <local-connection>))
+  (apply make <local-connection> args))
 
-(define* (ssh-connection host #:key (user (getlogin)) (password #f) (identity #f) (authenticate-server? #t)
+(define (ssh-connection . args)
-                         (sudo? #f) (sudo-user #f) (sudo-password #f))
+  (apply make <ssh-connection> args))
-  (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* (call-with-connection conn proc #:key sudo? sudo-user sudo-password)
+(define* (call-with-connection conn proc)
-  (let ((conn (deep-clone conn)))
+  (dynamic-wind
-    (when sudo?
+    (lambda () (setup conn))
-      (unless (is-a? conn <sudo-connection>)
+    (lambda () (proc conn))
-        (raise-exception
+    (lambda () (teardown conn))))
-         (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 (remote-cmd conn prog . args)
   (let* ((args options (break keyword? args))

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 <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 (srfi srfi-26)
-  #:use-module (ordo play)
+  #:export (execute))
-  #:use-module (ordo task)
-  #:use-module ((srfi srfi-26) #:select (cut)))
 
-(define (run-playbook ctx pb)
+(define-method (execute (blueprint <blueprint>) (conn <connection>))
-  (log-msg 'NOTICE "Running playbook: " (playbook-name pb))
+  #f
-  (set-ctx-playbook! ctx pb)
+  )
-  (for-each (cut run-play ctx <>) (playbook-plays pb)))
 
-(define (run-play ctx p)
+(define-method (execute (blueprint <blueprint>) (host <host>))
-  (log-msg 'NOTICE "Running play: " (play-name p))
+  (log-msg 'NOTICE "Executing blueprint " (blueprint-name blueprint) " on host " (host-name host))
-  (set-ctx-play! ctx p)
+  (call-with-connection (host-connection host) (cut execute blueprint <>)))
-  (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 (run-host-play ctx p h)
+(define-method (execute (task <task>) (conn <connection>))
-  (log-msg 'NOTICE "Running play on host: " (host-name h))
+  #f)
-  (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 (run-task ctx t)
+(define-method (execute (task <task>) (host <host>))
-  (if ((task-pre-condition t) ctx)
+  (log-msg 'NOTICE "Executing task " (task-name task) " on host " (host-name host))
-      (begin
+  (call-with-connection (host-connection host) (cut execute task <>)))
-        (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)))

ordo/handler.scm

@@ -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))

ordo/inventory.scm

@@ -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>
+(define-class <host> ()
-  (make-host name connection tags vars)
+  (name #:init-keyword #:name #:getter host-name)
-  host?
+  (connection #:init-keyword #:connection #:getter host-connection)
-  (name host-name)
+  (tags #:init-keyword #:tags #:getter host-tags))
-  (connection host-connection)
-  (tags host-tags)
-  (vars host-vars))
 
-(define* (host #:key name connection (tags '()) (vars '()))
+(define (host? h) (is-a? h <host>))
-  (make-host name connection tags (alist->hash-table vars)))
+
+(define (host . args) (apply make <host> args))
 
 (define (tagged-every? wanted-tags)
   (lambda (h)

ordo/play.scm

@@ -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))

ordo/playbook.scm

@@ -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))))

ordo/task.scm

@@ -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")))