Implement logger

ordo.scm

@@ -8,7 +8,7 @@
              (ice-9 format)
              (ice-9 match)
              ((ordo cli run) #:prefix run:)
-             (srfi srfi-1))
+             (ordo logger))
 
 (define config
   (configuration
@@ -20,7 +20,7 @@
      (setting
       (name 'log-level)
       (handler string->symbol)
-      (test symbol?)
+      (test valid-log-level?)
       (default 'NOTICE)
       (example "DEBUG|INFO|NOTICE|WARN|ERROR")
       (synopsis "Log level"))))
@@ -36,7 +36,13 @@
 
 (define (main cmd-line)
   (let ((options (getopt-config-auto cmd-line config)))
+    (dynamic-wind
+      (lambda ()
+        (setup-logging! #:level (option-ref options 'log-level)))
+      (lambda ()
         (match (full-command options)
           (("ordo" "run")
            (run:handler options))
-      (_ (emit-help options)))))
+          (_ (emit-help options))))
+      (lambda ()
+        (shutdown-logging!)))))

ordo/cli/run.scm

@@ -1,6 +1,7 @@
 (define-module (ordo cli run)
   #:use-module (config)
   #:use-module (config api)
+  #:use-module (ordo logger)
   #:use-module (srfi srfi-1)
   #:export (config handler))
 
@@ -41,8 +42,7 @@
    (synopsis "Run a playbook")))
 
 (define (handler options)
-  (format #t "run:handler log-level=~a inventory=~a tags=~a playbook=~a~%"
-          (option-ref options 'log-level)
-          (option-ref options 'inventory)
-          (option-ref options 'tag)
-          (option-ref options '(playbook))))
+  (let ((inventory (option-ref options 'inventory))
+        (playbook (option-ref options '(playbook))))
+    (log-msg 'INFO "Running playbook " playbook " with inventory " inventory)
+    ))

ordo/inventory.scm

@@ -0,0 +1,48 @@
+(define-module (ordo inventory)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  ;; #:use-module ((ordo connection) #:select (local-connection)) TODO: implement connections
+  #: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?
+  (name host-name)
+  (connection host-connection)
+  (tags host-tags))
+
+(define (add-host! name connection . tags)
+  (set! *inventory* (cons (make-host name connection tags)
+                          *inventory*)))
+
+(define (tagged-every? 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
+  (match-lambda
+    ("localhost" (list (or (find (named? "localhost") *inventory*)
+                           ;;(make-host "localhost" (local-connection) '()) ;; TODO: needs connections
+                           )))
+    ((? string? hostname) (filter (named? hostname) *inventory*))
+    ('all *inventory*)
+    (('tagged tag) (filter (tagged-every? (list tag)) *inventory*))
+    (('tagged/every tag . tags) (filter (tagged-every? (cons tag tags)) *inventory*))
+    (('tagged/any tag . tags) (filter (tagged-any? (cons tag tags)) *inventory*))))

ordo/logger.scm

@@ -0,0 +1,29 @@
+(define-module (ordo logger)
+  #:use-module (oop goops)
+  #:use-module ((srfi srfi-1) #:select (take-while member))
+  #:use-module ((srfi srfi-26) #:select (cut))
+  #:use-module (logging logger)
+  #:use-module (logging port-log)
+  #:export (setup-logging!
+            shutdown-logging!
+            valid-log-level?)
+  #:re-export (log-msg))
+
+(define log-levels '(DEBUG INFO NOTICE WARN ERROR))
+
+(define (valid-log-level? level)
+  (member level log-levels eq?))
+
+(define* (setup-logging! #:key (level 'INFO))
+  (let ((logger (make <logger>))
+        (handler (make <port-log> #:port (current-error-port))))
+    (for-each (cut disable-log-level! handler <>)
+              (take-while (negate (cut equal? level <>)) log-levels))
+    (add-handler! logger handler)
+    (set-default-logger! logger)
+    (open-log! logger)))
+
+(define (shutdown-logging!)
+  (flush-log)  ; since no args, it uses the default
+  (close-log!) ; ditto
+  (set-default-logger! #f))