diff --git a/modules/ordo.scm b/modules/ordo.scm index 3813bf1..3a35d84 100644 --- a/modules/ordo.scm +++ b/modules/ordo.scm @@ -2,6 +2,7 @@ #:use-module (ice-9 exceptions) #:use-module (logging logger) #:use-module (ordo connection) + #:use-module (ordo facts) #:use-module (srfi srfi-1) ; list utils #:use-module (srfi srfi-9) ; records #:use-module (srfi srfi-26) ; cut @@ -27,6 +28,7 @@ playbook-plays run-playbook $ + $$ register-play-var register-playbook-var)) @@ -67,6 +69,10 @@ variable (in that order). Raise an exception if the variable is not found." v))))) (lookup-var var-name (list +play-vars+ +playbook-vars+))) +(define ($$ . keys) + "Look up nested keys in gathered facts." + (apply get-fact (hash-table-ref +play-vars+ #:ordo-facts) keys)) + (define +triggers+ #f) (define (add-triggers triggers) @@ -106,18 +112,19 @@ variable (in that order). Raise an exception if the variable is not found." (make-handler name action)) (define-record-type - (make-play name connection vars tasks handlers) + (make-play name connection vars gather-facts tasks handlers) play? (name play-name) (connection play-connection) (vars play-vars) (tasks play-tasks) - (handlers play-handlers)) + (handlers play-handlers) + (gather-facts play-gather-facts)) -(define* (play name #:key connection (vars '()) . more) +(define* (play name #:key connection (vars '()) (gather-facts #t) . more) (let ((tasks (filter task? more)) (handlers (filter handler? more))) - (make-play name connection vars tasks handlers))) + (make-play name connection vars gather-facts tasks handlers))) (define (run-play p) (log-msg 'NOTICE "Running play " (play-name p)) @@ -126,6 +133,8 @@ variable (in that order). Raise an exception if the variable is not found." (set! +play-vars+ (alist->hash-table (play-vars p) equal?)) (init-connection! (play-connection p))) (lambda () + (when (play-gather-facts p) + (hash-table-set! +play-vars+ #:ordo-facts (gather-facts (play-connection p)))) (for-each (cut run-task <> (play-connection p)) (play-tasks p)) (for-each (lambda (h) (when (member (handler-name h) +triggers+) diff --git a/modules/ordo/facts.scm b/modules/ordo/facts.scm new file mode 100644 index 0000000..6138c59 --- /dev/null +++ b/modules/ordo/facts.scm @@ -0,0 +1,18 @@ +(define-module (ordo facts) + #:use-module (ordo facts user) + #:export (gather-facts + get-fact)) + +(define (get-fact facts . keys) + (cond + ((null? keys) facts) + ((list? facts) (let ((facts (assoc-ref facts (car keys)))) + (apply get-fact facts (cdr keys)))) + (else #f))) + +(define (gather-facts conn) + (let* ((id (fact:id conn)) + (user-name (get-fact id #:user #:name)) + (pwent (fact:pwent conn user-name))) + `((#:id . ,id) + (#:pwent . ,pwent)))) diff --git a/modules/ordo/facts/user.scm b/modules/ordo/facts/user.scm new file mode 100644 index 0000000..fb4fa72 --- /dev/null +++ b/modules/ordo/facts/user.scm @@ -0,0 +1,31 @@ +(define-module (ordo facts user) + #:use-module (rx irregex) + #:use-module (srfi srfi-1) ; list utils + #:use-module (srfi srfi-2) ; and-let* + #:use-module (ordo connection) + #:export (fact:id + fact:pwent)) + +(define (parse-id-output s) + (let ((data (reverse (irregex-fold (irregex '(seq (=> id integer) "(" (=> name (+ alphanumeric)) ")")) + (lambda (_ m accum) + (cons `((#:id . ,(string->number (irregex-match-substring m 'id))) + (#:name . ,(irregex-match-substring m 'name))) + accum)) + '() + s)))) + `((#:user . ,(first data)) + (#:group . ,(second data)) + (#:groups . ,(drop data 2))))) + +(define (fact:id conn) + (run conn "id" #:check? #t #:return (compose parse-id-output car))) + +(define (parse-passwd-entry s) + (map cons + '(#:user-name #:password #:user-id #:group-id #:gecos #:home-dir #:shell) + (string-split s #\:))) + +(define (fact:pwent conn user-name) + (run conn "getent" "passwd" user-name + #:check? #t #:return (compose parse-passwd-entry car))) diff --git a/tryme.scm b/tryme.scm index d866f04..75d622a 100644 --- a/tryme.scm +++ b/tryme.scm @@ -24,16 +24,12 @@ (playbook "Test Playbook" (play "Test play" #:connection (local-connection) - (task "Get home directory" - (lambda (c) (run c "sh" "-c" "[ -n \"$HOME\" ] && echo $HOME" #:check? #t #:return car)) - #:register (register-play-var 'home-dir) - #:tags '(#:always)) (task "Install AWS CLI" (lambda (c) (install-aws-cli c #:update? #t - #:install-dir (file-name-join* ($ 'home-dir) ".local" "aws-cli") - #:bin-dir (file-name-join* ($ 'home-dir) ".local" "bin"))))))) + #:install-dir (file-name-join* ($$ #:pwent #:home-dir) ".local" "aws-cli") + #:bin-dir (file-name-join* ($$ #:pwent #:home-dir) ".local" "bin"))))))) (setup-logging) (run-playbook test-playbook)