From 38115b8a573779fdc775b57a2395a8e94fdce197 Mon Sep 17 00:00:00 2001 From: Ray Miller Date: Thu, 29 May 2025 16:57:26 +0100 Subject: [PATCH] Implement logger --- ordo.scm | 18 +++++++++++------ ordo/cli/run.scm | 10 +++++----- ordo/inventory.scm | 48 ++++++++++++++++++++++++++++++++++++++++++++++ ordo/logger.scm | 29 ++++++++++++++++++++++++++++ 4 files changed, 94 insertions(+), 11 deletions(-) create mode 100644 ordo/inventory.scm create mode 100644 ordo/logger.scm diff --git a/ordo.scm b/ordo.scm index 38a1697..ddc878a 100755 --- a/ordo.scm +++ b/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))) - (match (full-command options) - (("ordo" "run") - (run:handler options)) - (_ (emit-help options))))) + (dynamic-wind + (lambda () + (setup-logging! #:level (option-ref options 'log-level))) + (lambda () + (match (full-command options) + (("ordo" "run") + (run:handler options)) + (_ (emit-help options)))) + (lambda () + (shutdown-logging!))))) diff --git a/ordo/cli/run.scm b/ordo/cli/run.scm index 4098047..efbc8cc 100644 --- a/ordo/cli/run.scm +++ b/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) + )) diff --git a/ordo/inventory.scm b/ordo/inventory.scm new file mode 100644 index 0000000..c89f5ec --- /dev/null +++ b/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 + (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*)))) diff --git a/ordo/logger.scm b/ordo/logger.scm new file mode 100644 index 0000000..a4b6927 --- /dev/null +++ b/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 )) + (handler (make #: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))