Use context instead of global vars

examples/install-aws-cli.scm

@@ -2,8 +2,9 @@
  (ice-9 filesystem)
  (ordo))
 
-(define* (install-aws-cli conn #:key (url "https://awscli.amazonaws.com/awscli-exe-linux-x86_64.zip") update? install-dir bin-dir)
-  (let ((tmp-dir (run conn "mktemp" "-d" #:return car #:check? #t)))
+(define* (install-aws-cli #:key (url "https://awscli.amazonaws.com/awscli-exe-linux-x86_64.zip") update? install-dir bin-dir)
+  (let* ((conn (current-connection))
+         (tmp-dir (run conn "mktemp" "-d" #:return car #:check? #t)))
     (dynamic-wind
       (const #t)
       (lambda ()
@@ -22,8 +23,7 @@
           (play "Test play"
                 #:host "localhost"
                 (task "Install AWS CLI"
-                      (lambda (c)
-                        (install-aws-cli c
-                                         #:update? #t
+                      (lambda ()
+                        (install-aws-cli #:update? #t
                                          #:install-dir (file-name-join* ($ #:fact.home-dir) ".local" "aws-cli")
                                          #:bin-dir (file-name-join* ($ #:fact.home-dir) ".local" "bin"))))))

modules/ordo.scm

@@ -5,7 +5,6 @@
   #:use-module (ordo task)
   #:use-module (ordo handler)
   #:use-module (ordo connection)
-  #:use-module (ordo inventory)
-  #:use-module (ordo vars)
+  #:use-module (ordo context)
   #:use-module (ordo logger)
-  #:re-export (add-host! local-connection ssh-connection run playbook play task handler $))
+  #:re-export (add-host! local-connection ssh-connection current-connection run playbook play task handler $))

modules/ordo/cli.scm

@@ -1,7 +1,7 @@
 (define-module (ordo cli)
   #:use-module (ice-9 match)
   #:use-module (ordo logger)
-  #:use-module (ordo vars)
+  #:use-module (ordo context)
   #:use-module (ordo playbook)
   #:declarative? #f
   #:export (main))
@@ -9,8 +9,8 @@
 (define (main args)
   (match-let (((_ inventory-path playbook-path) args))
     (setup-logging #:level 'DEBUG)
-    (init-command-line-vars! '())
+    (init-context!)
     (load inventory-path)
-    ;;    (let ((playbook (load playbook-path)))
-    ;;      (run-playbook playbook))
+    (let ((playbook (load playbook-path)))
+      (run-playbook playbook))
     (quit)))

modules/ordo/connection.scm

@@ -28,7 +28,7 @@
   (make <ssh-connection> #:user user #:host host #:password password
         #:identity identity #:authenticate-server? authenticate-server?))
 
-(define* (call-with-connection c proc #:key (sudo? #f) (sudo-user #f) (sudo-password #f))
+(define* (call-with-connection c sudo? sudo-user sudo-password proc)
   (let ((c (if sudo?
                (make <sudo-connection> #:connection c #:become-user sudo-user #:become-password sudo-password)
                c)))

modules/ordo/context.scm

@@ -0,0 +1,152 @@
+(define-module (ordo context)
+  #:use-module (ice-9 exceptions)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-69)
+  #:use-module (logging logger)
+  #:use-module (ordo host)
+  #:export (init-context!
+            set-current-connection!
+            current-connection
+            current-host
+            set-current-host!
+            init-playbook-vars!
+            get-playbook-var
+            set-playbook-var!
+            reset-playbook-vars!
+            init-play-vars!
+            get-play-var
+            set-play-var!
+            reset-play-vars!
+            get-command-line-var
+            set-command-line-var!
+            $
+            reset-play-triggers!
+            add-play-triggers!
+            play-triggered?
+            set-filter-tag!
+            reset-filter-tags!
+            check-filter-tags
+            add-host!
+            current-inventory))
+
+(define *current-context* #f)
+
+(define-record-type <context>
+  (make-context)
+  context?
+  (connection connection set-connection!)
+  (hostname hostname set-hostname!)
+  (command-line-vars command-line-vars set-command-line-vars!)
+  (play-vars play-vars set-play-vars!)
+  (play-triggers play-triggers set-play-triggers!)
+  (playbook-vars playbook-vars set-playbook-vars!)
+  (filter-tags filter-tags set-filter-tags!)
+  (inventory inventory set-inventory!))
+
+(define (init-context!)
+  (set! *current-context* (make-context)))
+
+(define not-found (cons 'not-found '()))
+
+(define (not-found? x) (eq? x not-found))
+
+(define (set-current-connection! conn)
+  (set-connection! *current-context* conn))
+
+(define (current-connection)
+  (connection *current-context*))
+
+(define (set-current-host! hostname)
+  (set-hostname! *current-context* hostname))
+
+(define (current-host)
+  (hostname *current-context*))
+
+(define (init-playbook-vars! alist)
+  (set-playbook-vars! *current-context* (alist->hash-table alist eqv?)))
+
+(define (get-playbook-var var-name)
+  (if (playbook-vars *current-context*)
+      (hash-table-ref/default (playbook-vars *current-context*) var-name not-found)
+      not-found))
+
+(define (set-playbook-var! var-name val)
+  (unless (playbook-vars *current-context*)
+    (set-playbook-vars! *current-context* (make-hash-table eqv?)))
+  (hash-table-set! (playbook-vars *current-context*) var-name val))
+
+(define (reset-playbook-vars!)
+  (set-playbook-vars! *current-context* #f))
+
+(define (init-play-vars! alist)
+  (set-play-vars! *current-context* (alist->hash-table alist eqv?)))
+
+(define (get-play-var var-name)
+  (if (play-vars *current-context*)
+      (hash-table-ref/default (play-vars *current-context*) var-name not-found)
+      not-found))
+
+(define (set-play-var! var-name val)
+  (unless (play-vars *current-context*)
+    (set-play-vars! *current-context* (make-hash-table equal?)))
+  (hash-table-set! (play-vars *current-context*) var-name val))
+
+(define (reset-play-vars!)
+  (set-play-vars! *current-context* #f))
+
+(define (get-command-line-var var-name)
+  (if (command-line-vars *current-context*)
+      (hash-table-ref/default (command-line-vars *current-context*) var-name not-found)
+      not-found))
+
+(define (set-command-line-var! var-name val)
+  (unless (command-line-vars *current-context*)
+    (set-command-line-vars! *current-context* (make-hash-table eqv?)))
+  (hash-table-set! (command-line-vars *current-context*) var-name val))
+
+(define ($ var-name)
+  "Try to resolve var-name as a command-line variable, a play variable or a
+playbook variable (in that order). Raise an exception if the variable is not
+found."
+  (define (lookup-var procs)
+    (if (null? procs)
+        (raise-exception (make-exception
+                          (make-undefined-variable-error)
+                          (make-exception-with-irritants var-name)))
+        (let ((v ((car procs) var-name)))
+          (if (not-found? v)
+              (lookup-var (cdr procs))
+              v))))
+  (lookup-var (list get-command-line-var get-play-var get-playbook-var)))
+
+(define (reset-play-triggers!)
+  (set-play-triggers! *current-context* #f))
+
+(define (add-play-triggers! triggers)
+  (set-play-triggers! *current-context*
+                      (apply lset-adjoin equal? (or (play-triggers *current-context*) '())
+                             triggers)))
+
+(define (play-triggered? trigger)
+  (and=> (play-triggers *current-context*) (cut member trigger <>)))
+
+(define (set-filter-tag! tag)
+  (set-filter-tags! *current-context*
+                    (lset-adjoin equal? (or (filter-tags *current-context*) '()) tag)))
+
+(define (reset-filter-tags!)
+  (set-filter-tags! *current-context* #f))
+
+(define (check-filter-tags tags)
+  (or (not (filter-tags *current-context*))
+      (not (null? (lset-intersection eqv? (filter-tags *current-context*) tags)))))
+
+(define (current-inventory)
+  (or (inventory *current-context*) '()))
+
+(define (add-host! hostname connection . tags)
+  (log-msg 'DEBUG "Adding host to inventory: " hostname)
+  (set-inventory! *current-context* (cons (make-host hostname connection tags)
+                                          (or (inventory *current-context*) '()))))

modules/ordo/facts.scm

@@ -1,6 +1,6 @@
 (define-module (ordo facts)
   #:use-module ((srfi srfi-88) #:select (string->keyword))
-  #:use-module (ordo vars)
+  #:use-module (ordo context)
   #:use-module (ordo facts user)
   #:export (gather-facts))
 
@@ -10,8 +10,9 @@
                              (assoc-ref src (string->keyword k))))
             keys))
 
-(define (gather-facts conn)
-  (let* ((id (fact:id conn))
+(define (gather-facts)
+  (let* ((conn (current-connection))
+         (id (fact:id conn))
          (user-name (assoc-ref id #:user-name))
          (pwent (fact:pwent conn user-name)))
     (set-facts! id '("user-name" "user-id" "group-name" "group-id" "groups"))

modules/ordo/handler.scm

@@ -2,6 +2,7 @@
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-9) ; records
   #:use-module (logging logger)
+  #:use-module (ordo context)
   #:export (handler
             handler?
             handler-name
@@ -17,8 +18,8 @@
 (define (handler name action)
   (make-handler name action))
 
-(define (run-handler c h)
+(define (run-handler h)
   (match h
     (($ <handler> name action)
      (log-msg 'NOTICE "Running handler: " name)
-     (action c))))
+     (action (current-connection)))))

modules/ordo/host.scm

@@ -0,0 +1,39 @@
+(define-module (ordo host)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (ordo connection)
+  #:export (make-host
+            host?
+            host-name
+            host-connection
+            host-tags
+            resolve-hosts))
+
+(define-record-type <host>
+  (make-host name connection tags)
+  host?
+  (name host-name)
+  (connection host-connection)
+  (tags host-tags))
+
+(define (tagged-all? wanted-tags)
+  (lambda (h)
+    (lset= equal? wanted-tags (lset-intersection equal? (host-tags h) wanted-tags))))
+
+(define (tagged-any? wanted-tags)
+  (lambda (h)
+    (not (null? (lset-intersection equal? (host-tags h) wanted-tags)))))
+
+(define (named? hostname)
+  (lambda (h)
+    (string=? (host-name h) hostname)))
+
+(define (resolve-hosts inventory)
+  (match-lambda
+    ("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))))

modules/ordo/inventory.scm

@@ -1,54 +0,0 @@
-(define-module (ordo inventory)
-  #:use-module (ice-9 match)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-9)
-  #:use-module (srfi srfi-69)
-  #:use-module (logging logger)
-  #:use-module (ordo connection)
-  #:export (make-host
-            host?
-            host-name
-            host-connection
-            host-tags
-            add-host!
-            resolve-hosts))
-
-(define *hosts* (make-hash-table equal?))
-
-(define-record-type <host>
-  (make-host name connection tags)
-  host?
-  (name host-name)
-  (connection host-connection)
-  (tags host-tags))
-
-(define (add-host! name connection . tags)
-  (log-msg 'DEBUG "Adding host to inventory: " name)
-  (hash-table-set! *hosts* name (make-host name connection tags)))
-
-(define (tagged-all? wanted-tags)
-  (lambda (h)
-    (lset= equal? wanted-tags (lset-intersection equal? (host-tags h) wanted-tags))))
-
-(define (tagged-any? wanted-tags)
-  (lambda (h)
-    (not (null? (lset-intersection equal? (host-tags h) wanted-tags)))))
-
-(define resolve-hosts
-  (match-lambda
-    ("localhost" (list (or (hash-table-ref/default *hosts* "localhost" #f)
-                           (make-host "localhost" (local-connection) '()))))
-    ((? string? name) (list (hash-table-ref *hosts* name)))
-    ('all (hash-table-values *hosts*))
-    (('every-tag tag . tags) (filter (tagged-all? (cons tag tags)) (hash-table-values *hosts*)))
-    (('any-tag tag . tags) (filter (tagged-any? (cons tag tags)) (hash-table-values *hosts*)))))
-
-#!
-(define (setup-test-data)
-  (add-host! "little-rascal" (ssh-connection "ray" "little-rascal") #:linux #:guix)
-  (add-host! "linux-1" (ssh-connection "root" "linux-1") #:linux)
-  (add-host! "linux-2" (ssh-connection "root" "linux-2") #:linux)
-  (add-host! "debian-1" (ssh-connection "root" "debian-1") #:linux #:debian)
-  (add-host! "debian-2" (ssh-connection "root" "debian-2") #:linux #:debian)
-  (add-host! "debian-3" (ssh-connection "root" "debian-3") #:linux #:debian #:eu-west-1))
-!#

modules/ordo/play.scm

@@ -3,10 +3,11 @@
   #: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 vars)
-  #:use-module (ordo inventory)
+  #:use-module (ordo context)
+  #:use-module (ordo host)
   #:use-module (ordo facts)
   #:export (play
             play?
@@ -40,28 +41,31 @@
 
 (define (run-play p)
   (log-msg 'NOTICE "Running play: " (play-name p))
-  (for-each (lambda (h) (run-host-play p h))
-            (resolve-hosts (play-host p))))
+  (let ((hosts ((resolve-hosts (current-inventory)) (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))))
 
 (define (run-host-play p h)
   (log-msg 'NOTICE "Running play: " (play-name p) " on host: " (host-name h))
-  (dynamic-wind
-    (lambda ()
-      (init-play-vars! (play-vars p)))
-    (lambda ()
-      (call-with-connection
-       (host-connection h)
-       (lambda (c)
-         (when (play-gather-facts p)
-           (gather-facts c))
-         (for-each (cut run-task <> c)
-                   (play-tasks p))
-         (for-each (cut run-handler <> c)
-                   (filter (compose play-triggered? handler-name)
-                           (play-handlers p))))
-       #:sudo? (play-sudo? p)
-       #:sudo-user (play-sudo-user p)
-       #:sudo-password (play-sudo-password p)))
-    (lambda ()
-      (reset-play-vars!)
-      (reset-play-triggers!))))
+  (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!))))))

modules/ordo/playbook.scm

@@ -2,7 +2,7 @@
   #:use-module (srfi srfi-9)
   #:use-module (logging logger)
   #:use-module (ordo play)
-  #:use-module (ordo vars)
+  #:use-module (ordo context)
   #:export (playbook
             playbook?
             playbook-name

modules/ordo/task.scm

@@ -1,7 +1,7 @@
 (define-module (ordo task)
   #:use-module (srfi srfi-9)
   #:use-module (logging logger)
-  #:use-module (ordo vars)
+  #:use-module (ordo context)
   #:export (task
             task?
             task-name
@@ -27,13 +27,13 @@
 (define* (task name action #:key (tags '()) (condition (const #t)) (register-play-var #f) (register-playbook-var #f) (triggers '()))
   (make-task name tags action condition register-play-var register-playbook-var triggers))
 
-(define (run-task t c)
+(define (run-task t)
   (when (check-filter-tags (task-tags t))
-    (if (not ((task-condition t) c))
+    (if (not ((task-condition t)))
         (log-msg 'NOTICE "Skipping task: " (task-name t) " (precondition not met)")
         (begin
           (log-msg 'NOTICE "Running task: " (task-name t))
-          (let ((result ((task-action t) c)))
+          (let ((result ((task-action t))))
             (when (task-register-play-var t)
               (set-play-var! (task-register-play-var t) result))
             (when (task-register-playbook-var t)

modules/ordo/vars.scm

@@ -1,104 +0,0 @@
-(define-module (ordo vars)
-  #:use-module (ice-9 exceptions)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-69)
-  #:export (init-playbook-vars!
-            get-playbook-var
-            set-playbook-var!
-            reset-playbook-vars!
-            init-play-vars!
-            get-play-var
-            set-play-var!
-            reset-play-vars!
-            init-command-line-vars!
-            get-command-line-var
-            set-command-line-var!
-            $
-            reset-play-triggers!
-            add-play-triggers!
-            play-triggered?
-            set-filter-tag!
-            reset-filter-tags!
-            check-filter-tags))
-
-(define not-found (cons 'not-found '()))
-
-(define (not-found? x) (eq? x not-found))
-
-(define *playbook-vars* #f)
-
-(define (init-playbook-vars! alist)
-  (set! *playbook-vars* (alist->hash-table alist equal?)))
-
-(define (get-playbook-var var-name)
-  (hash-table-ref/default *playbook-vars* var-name not-found))
-
-(define (set-playbook-var! var-name val)
-  (hash-table-set! *playbook-vars* var-name val))
-
-(define (reset-playbook-vars!)
-  (set! *playbook-vars* #f))
-
-(define *play-vars* #f)
-
-(define (init-play-vars! alist)
-  (set! *play-vars* (alist->hash-table alist equal?)))
-
-(define (get-play-var var-name)
-  (hash-table-ref/default *play-vars* var-name not-found))
-
-(define (set-play-var! var-name val)
-  (hash-table-set! *play-vars* var-name val))
-
-(define (reset-play-vars!)
-  (set! *play-vars* #f))
-
-(define *command-line-vars* #f)
-
-(define (init-command-line-vars! alist)
-  (set! *command-line-vars* (alist->hash-table alist equal?)))
-
-(define (get-command-line-var var-name)
-  (hash-table-ref/default *command-line-vars* var-name not-found))
-
-(define (set-command-line-var var-name val)
-  (hash-table-set! *command-line-vars* var-name val))
-
-(define ($ var-name)
-  "Try to resolve var-name as a command-line variable, a play variable or a
-playbook variable (in that order). Raise an exception if the variable is not
-found."
-  (define (lookup-var procs)
-    (if (null? procs)
-        (raise-exception (make-exception
-                          (make-undefined-variable-error)
-                          (make-exception-with-irritants var-name)))
-        (let ((v ((car procs) var-name)))
-          (if (not-found? v)
-              (lookup-var (cdr procs))
-              v))))
-  (lookup-var (list get-command-line-var get-play-var get-playbook-var)))
-
-(define *play-triggers* '())
-
-(define (reset-play-triggers!)
-  (set! *play-triggers* '()))
-
-(define (add-play-triggers! triggers)
-  (set! *play-triggers* (apply lset-adjoin equal? (or *play-triggers* '())
-                               triggers)))
-
-(define (play-triggered? trigger)
-  (member trigger *play-triggers*))
-
-(define *filter-tags* '())
-
-(define (set-filter-tag! tag)
-  (set! *filter-tags* (lset-adjoin equal? *filter-tags* tag)))
-
-(define (reset-filter-tags!)
-  (set! *filter-tags* '()))
-
-(define (check-filter-tags tags)
-  (or (null? *filter-tags*)
-      (not (null? (lset-intersection eqv? *filter-tags* tags)))))