From 8a41f8f558bbba73e4a59c72c71039c48ecfac92 Mon Sep 17 00:00:00 2001 From: Ray Miller Date: Mon, 23 Jun 2025 09:49:50 +0100 Subject: [PATCH] Updates to quadlet generation * Define quadlets directly, without use of a macro * Allow override of the quadlet install directory --- ordo/action/quadlet.scm | 47 +++++++++++++++++++++++------------------ 1 file changed, 26 insertions(+), 21 deletions(-) diff --git a/ordo/action/quadlet.scm b/ordo/action/quadlet.scm index b1f79e7..c4b65c2 100644 --- a/ordo/action/quadlet.scm +++ b/ordo/action/quadlet.scm @@ -12,14 +12,14 @@ create-image create-build)) -(define quadlet-dir "/etc/containers/systemd") +(define system-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 service-options install-options) +(define (quadlet quadlet-type name description unit-options quadlet-options service-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) @@ -27,27 +27,32 @@ ,@(if (null? install-options) '() (list (cons "Install" 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 - #:key name description - (quadlet-options '()) - (unit-options '()) - (service-options '()) - (install-options default-install-options)) - (fs:install-file conn - #:path (file-name-join* quadlet-dir (string-append name suffix)) - #:content (build-quadlet quadlet-type name description quadlet-options unit-options service-options install-options)))))) +(define* (create-network conn #:key name description network (unit '()) (service '()) (install default-install-options) (quadlet-dir system-quadlet-dir)) + (fs:install-file conn + #:path (file-name-join* quadlet-dir (string-append name ".network")) + #:content (quadlet "Network" name description unit network service install))) -(define-quadlet-type create-network "Network" ".network" default-install-options) +(define* (create-pod conn #:key name description pod (unit '()) (service '()) (install default-install-options) (quadlet-dir system-quadlet-dir)) + (fs:install-file conn + #:path (file-name-join* quadlet-dir (string-append name ".pod")) + #:content (quadlet "Pod" name description unit pod service install))) -(define-quadlet-type create-pod "Pod" ".pod" default-install-options) +(define* (create-container conn #:key name description container (unit '()) (service '()) (install default-install-options) (quadlet-dir system-quadlet-dir)) + (fs:install-file conn + #:path (file-name-join* quadlet-dir (string-append name ".container")) + #:content (quadlet "Container" name description unit container service install))) -(define-quadlet-type create-container "Container" ".container" default-install-options) +(define* (create-volume conn #:key name description volume (unit '()) (service '()) (install '()) (quadlet-dir system-quadlet-dir)) + (fs:install-file conn + #:path (file-name-join* quadlet-dir (string-append name ".volume")) + #:content (quadlet "Volume" name description unit volume service install))) -(define-quadlet-type create-volume "Volume" ".volume" '()) +(define* (create-build conn #:key name description build (unit '()) (service '()) (install '()) (quadlet-dir system-quadlet-dir)) + (fs:install-file conn + #:path (file-name-join* quadlet-dir (string-append name ".build")) + #:content (quadlet "Build" name description unit build service install))) -(define-quadlet-type create-build "Build" ".build" '()) - -(define-quadlet-type create-image "Image" ".image" '()) +(define* (create-image conn #:key name description image (unit '()) (service '()) (install '()) (quadlet-dir system-quadlet-dir)) + (fs:install-file conn + #:path (file-name-join* quadlet-dir (string-append name ".image")) + #:content (quadlet "Image" name description unit image service install)))