ray/ordo
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Updates to quadlet generation

Browse source 
* Define quadlets directly, without use of a macro
* Allow override of the quadlet install directory
This commit is contained in:
Ray Miller 2025-06-23 09:49:50 +01:00
parent 54564ec19f
commit 8a41f8f558
Signed by: ray
GPG key ID: 043F786C4CD681B8
1 changed files with 26 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

47
ordo/action/quadlet.scm
View file

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