Add support for facts.

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 <play>
-  (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+)

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

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

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)