diff --git a/scsh/scsh-interfaces.scm b/scsh/scsh-interfaces.scm index 5daf19a..28a31b7 100644 --- a/scsh/scsh-interfaces.scm +++ b/scsh/scsh-interfaces.scm @@ -1079,25 +1079,32 @@ (define-interface syslog-interface (export (syslog-option :syntax) make-syslog-options + syslog-options->list syslog-options? (syslog-options :syntax) syslog-options-on? + syslog-options=? (syslog-facility :syntax) syslog-facility? + syslog-facility=? (syslog-level :syntax) syslog-level? + syslog-level=? levels->syslog-mask (syslog-mask :syntax) + syslog-mask->levels syslog-mask-all syslog-mask-upto syslog-mask-levels-on? + syslog-mask? + syslog-mask=? open-syslog-channel close-syslog-channel - syslog-write with-syslog-destination syslog)) + diff --git a/scsh/syslog.scm b/scsh/syslog.scm index 5c77aa2..6571976 100644 --- a/scsh/syslog.scm +++ b/scsh/syslog.scm @@ -21,9 +21,7 @@ syslog-options? (value syslog-options-value)) -(define (syslog-options=? options-1 options-2) - (= (syslog-options-value options-1) - (syslog-options-value options-2))) +(define syslog-options=? eq?) (define-exported-binding "syslog-options-type" :syslog-options) @@ -37,6 +35,26 @@ (define default-syslog-options (make-syslog-options '())) +(define (make-mask-record->list get-value get-mask record-vector) + (lambda (mask-record) + (let ((value (get-value mask-record)) + (n-syslog-options (vector-length record-vector))) + (let loop ((i 0) (list '())) + (cond + ((>= i n-syslog-options) + list) + ((zero? (bitwise-and value + (get-mask (vector-ref record-vector i)))) + (loop (+ 1 i) list)) + (else + (loop (+ 1 i) (cons (vector-ref record-vector i) + list)))))))) + +(define syslog-options->list + (make-mask-record->list syslog-options-value + syslog-option-mask + the-syslog-options)) + ; Simplifying syntax, e.g. (syslog-options delay console) (define-syntax syslog-options @@ -62,6 +80,8 @@ uucp local0 local1 local2 local3 local4 local5 local6 local7)) +(define syslog-facility=? eq?) + (define default-syslog-facility (syslog-facility user)) (define-exported-binding "syslog-facility-type" :syslog-facility) @@ -85,6 +105,8 @@ (info #o100) (debug #o200))) +(define syslog-level=? eq?) + (define-exported-binding "syslog-level-type" :syslog-level) (define-exported-binding "syslog-levels" syslog-levels) @@ -108,6 +130,11 @@ (apply bitwise-ior (map syslog-level-mask levels)))) +(define syslog-mask->levels + (make-mask-record->list syslog-mask-value + syslog-level-mask + syslog-levels)) + (define-syntax syslog-mask (syntax-rules () ((syslog-mask name ...) @@ -216,10 +243,14 @@ (define (syslog level message . rest) (syslog-write level message - ;; this might be a little excessive allocation - (apply change-syslog-channel - (thread-fluid dynamic-syslog-channel) - rest))) + (if (and (not (null? rest)) + (null? (cdr rest)) + (syslog-channel? (car rest))) + (car rest) + ;; this might be a little excessive allocation + (apply change-syslog-channel + (thread-fluid dynamic-syslog-channel) + rest)))) (define (with-syslog-destination ident options facility mask thunk) (let-thread-fluid dynamic-syslog-channel