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

Update modules to work with interceptors

Browse source
This commit is contained in:
Ray Miller 2025-01-25 15:46:12 +00:00
parent 0f6744ad30
commit d79dbadded
Signed by: ray
GPG key ID: 043F786C4CD681B8
14 changed files with 115 additions and 173 deletions
Download patch file Download diff file Expand all files Collapse all files

5
bin/ordo.sh Executable file
View file

@ -0,0 +1,5 @@
#!/usr/bin/env bash
MODULES_DIR=$( cd -- "$( dirname -- "${BASH_SOURCE[0]}" )/../modules" &> /dev/null && pwd )
exec guile -L "${MODULES_DIR}" --no-auto-compile -e '(@ (ordo cli) main)' -- "$@"

43
bin/play.scm
View file

@ -1,43 +0,0 @@
#!/usr/bin/env -S guile --no-auto-compile -e main -s
!#
(use-modules (srfi srfi-11)
(ice-9 getopt-long)
(ice-9 format)
(ordo util filesystem))
(define (tar . args)
(unless (zero? (apply system* "tar" args))
(error (format #f "Non-zero exit from tar ~a" args))))
(define* (usage #:optional errmsg)
(with-output-to-port (current-error-port)
(lambda ()
(when errmsg
(format #t "Error: ~a~%~%" errmsg))
(display "Usage: play -t TARGET PLAYBOOK")
(newline)))
(exit (if errmsg EXIT_FAILURE EXIT_SUCCESS)))
(define (process-options args)
(let* ((option-spec '((help (single-char #\h) (value #f))
(target (single-char #\t) (value #t) (required? #t))))
(options (getopt-long args option-spec))
(help-wanted (option-ref options 'help #f))
(target (option-ref options 'target #f))
(args (option-ref options '() '())))
(cond
(help-wanted (usage))
((not (= 1 (length args)))
(usage "Expected exactly one playbook")))
(values (canonicalize-path (car args)) target)))
(define (main args)
(let-values (((playbook-path target) (process-options args)))
(define playbook (load playbook-path))
(define top-dir (dirname (dirname (current-filename))))
(call-with-temporary-directory
(lambda (tmp-dir)
(define tarball (string-append tmp-dir "/payload.tar"))
(tar "--create" "--file" tarball "--directory" top-dir "modules" "bin")
(tar "--append" "--file" tarball "--transform" "s/.*/playbook.scm/" playbook-path)
(tar "tf" tarball)))))

48
examples/interceptor.scm
View file

@ -1,33 +1,31 @@
(use-modules
(ice-9 filesystem)
(srfi srfi-2)
(srfi srfi-71)
(logging logger)
(ordo connection)
(ordo playbook)
(ordo play)
(ordo interceptor)
(ordo interceptor install-file)
(ordo interceptor create-tmp-dir)
(ordo interceptor stat-file)
(ordo interceptor user-info)
(ordo interceptor debug)
(ordo logger))
(ordo interceptor debug))
(define chain
(list (connection-interceptor (local-connection))
(create-tmp-dir #:register 'tmp-dir)
(user-info)
(debug-vars 'user-info)
(install-file
"install-hello"
#:path (let-vars (tmp-dir) (file-name-join* tmp-dir "hello.txt"))
#:content "Hello, world!\n"
#:register 'hello)
(stat-file
"stat-hello"
#:path (let-vars (hello) hello)
#:register 'hello-stat)
(debug-vars 'hello 'hello-stat)))
(setup-logging #:level 'INFO)
(execute (init-context) chain)
(shutdown-logging)
(playbook
#:name "Test some basic filesystem operations"
#:vars '((file-content . "This is shadowed by the play variable."))
#:plays (list (play
#:name "Basic filesystem operations"
#:host "localhost"
#:vars '((file-content . "Hello, world!\n"))
#:interceptors (list (create-tmp-dir #:register 'tmp-dir)
(user-info)
(debug-vars 'user-info)
(install-file
"install-hello"
#:path (let-vars (tmp-dir) (file-name-join* tmp-dir "hello.txt"))
#:content (let-vars (file-content) file-content)
#:register 'hello)
(stat-file
"stat-hello"
#:path (let-vars (hello) hello)
#:register 'hello-stat)
(debug-vars)))))

3
examples/inventory.scm
View file

@ -1,4 +1,5 @@
(use-modules (ordo))
(use-modules (ordo inventory)
(ordo connection))
(add-host! "little-rascal"
(local-connection)

10
modules/ordo.scm
View file

@ -1,10 +0,0 @@
(define-module (ordo)
#:use-module (ice-9 match)
#:use-module (ordo playbook)
#:use-module (ordo play)
#:use-module (ordo task)
#:use-module (ordo handler)
#:use-module (ordo connection)
#:use-module (ordo context)
#:use-module (ordo logger)
#:re-export (add-host! local-connection ssh-connection current-connection run playbook play task handler $))

18
modules/ordo/cli.scm
View file

@ -1,16 +1,20 @@
(define-module (ordo cli)
#:use-module (ice-9 filesystem)
#:use-module (ice-9 match)
#:use-module (logging logger)
#:use-module (ordo logger)
#:use-module (ordo context)
#:use-module (ordo playbook)
#:declarative? #f
#:export (main))
(define (main args)
(match-let (((_ inventory-path playbook-path) args))
(setup-logging #:level 'DEBUG)
(init-context!)
(load inventory-path)
(let ((playbook (load playbook-path)))
(run-playbook playbook))
(quit)))
(let ((inventory-path (expand-file-name inventory-path))
(playbook-path (expand-file-name playbook-path)))
(setup-logging #:level 'INFO)
(load inventory-path)
(log-msg 'DEBUG "Loaded inventory: " inventory-path)
(let ((playbook (load playbook-path)))
(log-msg 'DEBUG "Loaded playbook: " playbook-path)
(run-playbook playbook))
(quit))))

9
modules/ordo/condition.scm
View file

@ -1,6 +1,7 @@
(define-module (ordo condition)
#:use-module (srfi srfi-71)
#:use-module (ordo context)
#:use-module (ordo connection)
#:use-module (ordo interceptor)
#:use-module (ordo action filesystem))
(define-public (cond:any preds)
@ -25,15 +26,15 @@
(define-public (cond:command-available? cmd-name)
(lambda (ctx)
(let ((_ rc (run "which" `(,cmd-name))))
(let ((_ rc (run (context-connection ctx) "which" cmd-name)))
(zero? rc))))
(define-public (cond:directory? path)
(lambda (ctx)
(let ((st ((action:stat path) ctx)))
(let ((st (fs:stat (context-connection ctx) path)))
(and st (string=? "directory" (assoc-ref st 'file-type))))))
(define-public (cond:regular-file? path)
(lambda (ctx)
(let ((st ((action:stat path) ctx)))
(let ((st (fs:stat (context-connection ctx) path)))
(and st (string=? "regular-file" (assoc-ref st 'file-type))))))

21
modules/ordo/connection.scm
View file

@ -9,16 +9,15 @@
#:use-module (ordo connection local)
#:use-module (ordo connection ssh)
#:use-module (ordo connection sudo)
#:use-module (ordo interceptor)
#:use-module (ordo util flatten)
#:use-module (ordo util shell-quote)
#:use-module (ordo util keyword-args)
#:export (connection-interceptor
connection?
#:export (connection?
local-connection
ssh-connection
call-with-connection
run))
run)
#:re-export (conn:setup conn:teardown))
(define (connection? c)
(is-a? c <connection>))
@ -68,17 +67,3 @@
(make-external-error)
(make-exception-with-message (format #f "Non-zero exit (~a) from ~a" rc prog)))))
(values (return out) rc)))))
(define* (connection-interceptor c #:key sudo? sudo-user sudo-password)
"Interceptor to manage the current connection."
(interceptor
"manage-connection"
#:enter (lambda (ctx)
(let ((c (if sudo?
(make <sudo-connection> #:connection c #:become-user sudo-user #:become-password sudo-password)
c)))
(conn:setup c)
(set-context-connection! ctx c)))
#:leave (lambda (ctx)
(and=> (context-connection ctx) conn:teardown)
(set-context-connection! ctx #f))))

8
modules/ordo/interceptor.scm
View file

@ -32,7 +32,7 @@
(make-exception-with-irritants name)))))
(define-record-type <context>
(make-context connection vars stack queue terminators error suppressed)
(make-context vars stack queue terminators error suppressed)
context?
(connection context-connection set-context-connection!)
(vars context-vars set-context-vars!)
@ -42,14 +42,12 @@
(error context-error set-context-error!)
(suppressed context-suppressed set-context-suppressed!))
(define* (init-context #:key conn (vars '()))
(define* (init-context #:key (vars '()))
"Initialize a context with optional connection and vars."
(for-each check-var-name (map car vars))
(make-context
;; connection
conn
;; vars
(alist->hash-table vars equal?)
(alist->hash-table vars eqv?)
;; stack
'()
;; queue

22
modules/ordo/interceptor/connection.scm Normal file
View file

@ -0,0 +1,22 @@
(define-module (ordo interceptor connection)
#:use-module (oop goops)
#:use-module (ordo interceptor)
#:use-module (ordo connection)
#:use-module (ordo connection sudo)
#:export (connection))
(define* (connection c #:key sudo? sudo-user sudo-password)
"Interceptor to manage the current connection."
(define (cleanup ctx)
(and=> (context-connection ctx) conn:teardown)
(set-context-connection! ctx #f))
(interceptor
"connection"
#:enter (lambda (ctx)
(let ((c (if sudo?
(make <sudo-connection> #:connection c #:become-user sudo-user #:become-password sudo-password)
c)))
(conn:setup c)
(set-context-connection! ctx c)))
#:leave cleanup
#:error cleanup))

3
modules/ordo/interceptor/user-info.scm
View file

@ -4,6 +4,7 @@
#:use-module (srfi srfi-145)
#:use-module (ordo connection)
#:use-module (ordo interceptor)
#:use-module (ordo util shell-quote)
#:export (user-info))
(define (parse-id s)
@ -33,7 +34,7 @@
(let* ((conn (context-connection ctx))
(id (run conn "id"
#:check? #t #:return (compose parse-id car)))
(pwent (run conn "getent" "passwd" (assoc-ref id #:user-name)
(pwent (run conn "getent" "passwd" (string-shell-quote (assoc-ref id #:user-name))
#:check? #t #:return (compose parse-passwd-entry car))))
(var-set! ctx register (fold (lambda (key alist)
(acons key (assoc-ref pwent key) alist))

23
modules/ordo/host.scm → modules/ordo/inventory.scm
View file

@ -1,15 +1,18 @@
(define-module (ordo host)
(define-module (ordo inventory)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (ordo connection)
#:use-module ((ordo connection) #:select (local-connection))
#:export (make-host
host?
host-name
host-connection
host-tags
add-host!
resolve-hosts))
(define *inventory* '())
(define-record-type <host>
(make-host name connection tags)
host?
@ -17,6 +20,10 @@
(connection host-connection)
(tags host-tags))
(define (add-host! name connection . tags)
(set! *inventory* (cons (make-host name connection tags)
*inventory*)))
(define (tagged-all? wanted-tags)
(lambda (h)
(lset= equal? wanted-tags (lset-intersection equal? (host-tags h) wanted-tags))))
@ -29,11 +36,11 @@
(lambda (h)
(string=? (host-name h) hostname)))
(define (resolve-hosts inventory)
(define resolve-hosts
(match-lambda
("localhost" (list (or (find (named? "localhost") inventory)
("localhost" (list (or (find (named? "localhost") *inventory*)
(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))))
((? 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*))))

62
modules/ordo/play.scm
View file

@ -3,12 +3,10 @@
#:use-module (srfi srfi-26)
#:use-module (logging logger)
#:use-module (ordo connection)
#:use-module (ordo context)
#:use-module (ordo task)
#:use-module (ordo handler)
#:use-module (ordo context)
#:use-module (ordo host)
#:use-module (ordo facts)
#:use-module (ordo interceptor)
#:use-module (ordo interceptor connection)
#:use-module (ordo inventory)
#:use-module (ordo util flatten)
#:export (play
play?
play-host
@ -16,13 +14,11 @@
play-sudo-user
play-sudo-password
play-vars
play-tasks
play-handlers
play-gather-facts
play-interceptors
run-play))
(define-record-type <play>
(make-play name host sudo? sudo-user sudo-password vars gather-facts tasks handlers)
(make-play name host sudo? sudo-user sudo-password vars interceptors)
play?
(name play-name)
(host play-host)
@ -30,42 +26,24 @@
(sudo-user play-sudo-user)
(sudo-password play-sudo-password)
(vars play-vars)
(tasks play-tasks)
(handlers play-handlers)
(gather-facts play-gather-facts))
(interceptors play-interceptors))
(define* (play name #:key host (sudo? #f) (sudo-user #f) (sudo-password #f) (vars '()) (gather-facts #t) . more)
(let ((tasks (filter task? more))
(handlers (filter handler? more)))
(make-play name host sudo? sudo-user sudo-password vars gather-facts tasks handlers)))
(define* (play #:key name host (sudo? #f) (sudo-user #f) (sudo-password #f) (vars '()) (interceptors '()))
(make-play name host sudo? sudo-user sudo-password vars interceptors))
(define (run-play p)
(define (run-play p playbook-vars)
(log-msg 'NOTICE "Running play: " (play-name p))
(let ((hosts ((resolve-hosts (current-inventory)) (play-host p))))
(let ((hosts (resolve-hosts (play-host p))))
(if (null? hosts)
(log-msg 'WARN "No hosts matched: " (play-host p))
(for-each (lambda (h) (run-host-play p h)) hosts))))
(for-each (lambda (h) (run-host-play p h playbook-vars)) hosts))))
(define (run-host-play p h)
(define (run-host-play p h playbook-vars)
(log-msg 'NOTICE "Running play: " (play-name p) " on host: " (host-name h))
(call-with-connection
(host-connection h)
(play-sudo? p)
(play-sudo-user p)
(play-sudo-password p)
(lambda (conn)
(dynamic-wind
(lambda ()
(set-current-connection! conn)
(set-current-host! (host-name h))
(init-play-vars! (play-vars p)))
(lambda ()
(when (play-gather-facts p) (gather-facts))
(for-each run-task (play-tasks p))
(for-each run-handler
(filter (compose play-triggered? handler-name) (play-handlers p))))
(lambda ()
(set-current-connection! #f)
(set-current-host! #f)
(reset-play-vars!)
(reset-play-triggers!))))))
(let ((chain (flatten (cons (connection (host-connection h)
#:sudo? (play-sudo? p)
#:sudo-user (play-sudo-user p)
#:sudo-password (play-sudo-password p))
(play-interceptors p))))
(ctx (init-context #:vars (append (play-vars p) playbook-vars))))
(execute ctx chain)))

13
modules/ordo/playbook.scm
View file

@ -1,8 +1,8 @@
(define-module (ordo playbook)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
#:use-module (logging logger)
#:use-module (ordo play)
#:use-module (ordo context)
#:export (playbook
playbook?
playbook-name
@ -17,15 +17,10 @@
(vars playbook-vars)
(plays playbook-plays))
(define* (playbook name #:key (vars '()) . plays)
(define* (playbook #:key name (vars '()) plays)
(make-playbook name vars plays))
(define (run-playbook pb)
(log-msg 'NOTICE "Running playbook: " (playbook-name pb))
(dynamic-wind
(lambda ()
(init-playbook-vars! (playbook-vars pb)))
(lambda ()
(for-each run-play (playbook-plays pb)))
(lambda ()
(reset-playbook-vars!))))
(for-each (cut run-play <> (playbook-vars pb))
(playbook-plays pb)))