Implement apt interceptors

This commit is contained in:
Ray Miller 2025-01-26 14:30:04 +00:00
parent dd885ce559
commit 1784234385
Signed by: ray
GPG key ID: 043F786C4CD681B8
5 changed files with 72 additions and 48 deletions

17
examples/ubuntu.scm Normal file
View file

@ -0,0 +1,17 @@
(use-modules
(ordo playbook)
(ordo play)
(ordo interceptor)
(ordo interceptor apt))
(playbook
#:name "APT operations"
#:plays (list
(play
#:name "Test APT operations"
;;#:host '(tagged #:ubuntu)
#:host "localhost"
#:interceptors (list
(apt:update)
(apt:dist-upgrade)
(map apt:install (list "curl" "ca-certificates"))))))

View file

@ -1,42 +0,0 @@
(define-module (ordo action apt)
#:use-module ((ordo connection) #:select (run)))
(define noninteractive-env '(("DEBIAN_FRONTEND" . "noninteractive")
("APT_LISTCHANGES_FRONTEND" . "none")))
(define-syntax define-apt-operation
(syntax-rules ()
((define-apt-operation (name args ...) apt-args ...)
(define-public (name conn args ...)
(run conn "apt-get" "-q" "-y" apt-args ... args ... #:env noninteractive-env)))
((define-apt-operation name apt-args ...)
(define-public (name conn)
(run conn "apt-get" "-q" "-y" apt-args ... #:env noninteractive-env)))))
(define-apt-operation apt:update "update")
(define-apt-operation apt:upgrade "upgrade")
(define-apt-operation apt:dist-upgrade "dist-upgrade")
(define-apt-operation (apt:install package-name) "install")
(define-apt-operation (apt:install-minimal package-name) "install" "--no-install-recommends")
(define-apt-operation (apt:reinstall package-name) "reinstall")
(define-apt-operation (apt:remove package-name) "remove")
(define-apt-operation (apt:purge package-name) "purge")
(define-apt-operation (apt:build-dep package-name) "build-dep")
(define-apt-operation apt:clean "clean")
(define-apt-operation apt:autoclean "autoclean")
(define-apt-operation apt:distclean "distclean")
(define-apt-operation apt:autoremove "autoremove")
(define-apt-operation apt:autopurge "autopurge")

View file

@ -49,9 +49,8 @@
(string-join xs " ")))
(define (run conn prog . args)
(let* ((args (flatten args))
(args kwargs (break keyword? args))
(args (remove unspecified? args))
(let* ((args kwargs (break keyword? args))
(args (remove unspecified? (flatten args)))
(pwd (keyword-arg kwargs #:pwd))
(env (keyword-arg kwargs #:env))
(return (keyword-arg kwargs #:return identity))

View file

@ -0,0 +1,49 @@
(define-module (ordo interceptor apt)
#:use-module (ordo interceptor)
#:use-module ((ordo connection) #:select (run)))
(define noninteractive-env '(("DEBIAN_FRONTEND" . "noninteractive")
("APT_LISTCHANGES_FRONTEND" . "none")))
(define-syntax define-apt-interceptor
(syntax-rules ()
((define-apt-interceptor (name arg) apt-args ...)
(define-public (name arg)
(interceptor
(string-append (symbol->string 'name) " " arg)
#:enter (lambda (ctx)
(run (context-connection ctx) "apt-get" "-q" "-y" apt-args ... arg #:env noninteractive-env #:check? #t)))))
((define-apt-interceptor name apt-args ...)
(define-public (name)
(interceptor
(symbol->string 'name)
#:enter (lambda (ctx)
(run (context-connection ctx) "apt-get" "-q" "-y" apt-args ... #:env noninteractive-env #:check? #t)))))))
(define-apt-interceptor apt:update "update")
(define-apt-interceptor apt:upgrade "upgrade")
(define-apt-interceptor apt:dist-upgrade "dist-upgrade")
(define-apt-interceptor (apt:install package-name) "install")
(define-apt-interceptor (apt:install-minimal package-name) "install" "--no-install-recommends")
(define-apt-interceptor (apt:reinstall package-name) "reinstall")
(define-apt-interceptor (apt:remove package-name) "remove")
(define-apt-interceptor (apt:purge package-name) "purge")
(define-apt-interceptor (apt:build-dep package-name) "build-dep")
(define-apt-interceptor apt:clean "clean")
(define-apt-interceptor apt:autoclean "autoclean")
(define-apt-interceptor apt:distclean "distclean")
(define-apt-interceptor apt:autoremove "autoremove")
(define-apt-interceptor apt:autopurge "autopurge")

View file

@ -24,7 +24,7 @@
(set! *inventory* (cons (make-host name connection tags)
*inventory*)))
(define (tagged-all? wanted-tags)
(define (tagged-every? wanted-tags)
(lambda (h)
(lset= equal? wanted-tags (lset-intersection equal? (host-tags h) wanted-tags))))
@ -42,5 +42,6 @@
(make-host "localhost" (local-connection) '()))))
((? string? hostname) (filter (named? hostname) *inventory*))
('all *inventory*)
(('every-tag tag . tags) (filter (tagged-all? (cons tag tags)) *inventory*))
(('any-tag tag . tags) (filter (tagged-any? (cons tag tags)) *inventory*))))
(('tagged tag) (filter (tagged-every? (list tag)) *inventory*))
(('tagged/every tag . tags) (filter (tagged-every? (cons tag tags)) *inventory*))
(('tagged/any tag . tags) (filter (tagged-any? (cons tag tags)) *inventory*))))