diff --git a/bin/ordo.sh b/bin/ordo.sh new file mode 100755 index 0000000..9ecc787 --- /dev/null +++ b/bin/ordo.sh @@ -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)' -- "$@" diff --git a/bin/play.scm b/bin/play.scm deleted file mode 100755 index 103e6c7..0000000 --- a/bin/play.scm +++ /dev/null @@ -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))))) diff --git a/examples/interceptor.scm b/examples/interceptor.scm index b0d1631..d01ec6f 100644 --- a/examples/interceptor.scm +++ b/examples/interceptor.scm @@ -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))))) diff --git a/examples/inventory.scm b/examples/inventory.scm index 01c0a25..00bee3e 100644 --- a/examples/inventory.scm +++ b/examples/inventory.scm @@ -1,4 +1,5 @@ -(use-modules (ordo)) +(use-modules (ordo inventory) + (ordo connection)) (add-host! "little-rascal" (local-connection) diff --git a/modules/ordo.scm b/modules/ordo.scm deleted file mode 100644 index 7c3741f..0000000 --- a/modules/ordo.scm +++ /dev/null @@ -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 $)) diff --git a/modules/ordo/cli.scm b/modules/ordo/cli.scm index 519e3f1..0038916 100644 --- a/modules/ordo/cli.scm +++ b/modules/ordo/cli.scm @@ -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)))) diff --git a/modules/ordo/condition.scm b/modules/ordo/condition.scm index 4834ab6..11e559c 100644 --- a/modules/ordo/condition.scm +++ b/modules/ordo/condition.scm @@ -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)))))) diff --git a/modules/ordo/connection.scm b/modules/ordo/connection.scm index 2e4c9b7..d5e3223 100644 --- a/modules/ordo/connection.scm +++ b/modules/ordo/connection.scm @@ -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 )) @@ -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 #: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)))) diff --git a/modules/ordo/interceptor.scm b/modules/ordo/interceptor.scm index 8e9036d..af3a4ec 100644 --- a/modules/ordo/interceptor.scm +++ b/modules/ordo/interceptor.scm @@ -32,7 +32,7 @@ (make-exception-with-irritants name))))) (define-record-type - (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 diff --git a/modules/ordo/interceptor/connection.scm b/modules/ordo/interceptor/connection.scm new file mode 100644 index 0000000..5b80078 --- /dev/null +++ b/modules/ordo/interceptor/connection.scm @@ -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 #:connection c #:become-user sudo-user #:become-password sudo-password) + c))) + (conn:setup c) + (set-context-connection! ctx c))) + #:leave cleanup + #:error cleanup)) diff --git a/modules/ordo/interceptor/user-info.scm b/modules/ordo/interceptor/user-info.scm index 987d1b8..291e5c7 100644 --- a/modules/ordo/interceptor/user-info.scm +++ b/modules/ordo/interceptor/user-info.scm @@ -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)) diff --git a/modules/ordo/host.scm b/modules/ordo/inventory.scm similarity index 65% rename from modules/ordo/host.scm rename to modules/ordo/inventory.scm index fa19045..37294f2 100644 --- a/modules/ordo/host.scm +++ b/modules/ordo/inventory.scm @@ -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 (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*)))) diff --git a/modules/ordo/play.scm b/modules/ordo/play.scm index 8586425..669027a 100644 --- a/modules/ordo/play.scm +++ b/modules/ordo/play.scm @@ -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 - (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))) diff --git a/modules/ordo/playbook.scm b/modules/ordo/playbook.scm index b8a1169..414efbc 100644 --- a/modules/ordo/playbook.scm +++ b/modules/ordo/playbook.scm @@ -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)))