Syslog interface cleanup.
This commit is contained in:
parent
fd07c36a40
commit
98de22054e
|
@ -1079,25 +1079,32 @@
|
||||||
(define-interface syslog-interface
|
(define-interface syslog-interface
|
||||||
(export (syslog-option :syntax)
|
(export (syslog-option :syntax)
|
||||||
make-syslog-options
|
make-syslog-options
|
||||||
|
syslog-options->list
|
||||||
syslog-options?
|
syslog-options?
|
||||||
(syslog-options :syntax)
|
(syslog-options :syntax)
|
||||||
syslog-options-on?
|
syslog-options-on?
|
||||||
|
syslog-options=?
|
||||||
|
|
||||||
(syslog-facility :syntax)
|
(syslog-facility :syntax)
|
||||||
syslog-facility?
|
syslog-facility?
|
||||||
|
syslog-facility=?
|
||||||
|
|
||||||
(syslog-level :syntax)
|
(syslog-level :syntax)
|
||||||
syslog-level?
|
syslog-level?
|
||||||
|
syslog-level=?
|
||||||
|
|
||||||
levels->syslog-mask
|
levels->syslog-mask
|
||||||
(syslog-mask :syntax)
|
(syslog-mask :syntax)
|
||||||
|
syslog-mask->levels
|
||||||
syslog-mask-all
|
syslog-mask-all
|
||||||
syslog-mask-upto
|
syslog-mask-upto
|
||||||
syslog-mask-levels-on?
|
syslog-mask-levels-on?
|
||||||
|
syslog-mask?
|
||||||
|
syslog-mask=?
|
||||||
|
|
||||||
open-syslog-channel
|
open-syslog-channel
|
||||||
close-syslog-channel
|
close-syslog-channel
|
||||||
syslog-write
|
|
||||||
|
|
||||||
with-syslog-destination
|
with-syslog-destination
|
||||||
syslog))
|
syslog))
|
||||||
|
|
||||||
|
|
|
@ -21,9 +21,7 @@
|
||||||
syslog-options?
|
syslog-options?
|
||||||
(value syslog-options-value))
|
(value syslog-options-value))
|
||||||
|
|
||||||
(define (syslog-options=? options-1 options-2)
|
(define syslog-options=? eq?)
|
||||||
(= (syslog-options-value options-1)
|
|
||||||
(syslog-options-value options-2)))
|
|
||||||
|
|
||||||
(define-exported-binding "syslog-options-type" :syslog-options)
|
(define-exported-binding "syslog-options-type" :syslog-options)
|
||||||
|
|
||||||
|
@ -37,6 +35,26 @@
|
||||||
|
|
||||||
(define default-syslog-options (make-syslog-options '()))
|
(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)
|
; Simplifying syntax, e.g. (syslog-options delay console)
|
||||||
|
|
||||||
(define-syntax syslog-options
|
(define-syntax syslog-options
|
||||||
|
@ -62,6 +80,8 @@
|
||||||
uucp
|
uucp
|
||||||
local0 local1 local2 local3 local4 local5 local6 local7))
|
local0 local1 local2 local3 local4 local5 local6 local7))
|
||||||
|
|
||||||
|
(define syslog-facility=? eq?)
|
||||||
|
|
||||||
(define default-syslog-facility (syslog-facility user))
|
(define default-syslog-facility (syslog-facility user))
|
||||||
|
|
||||||
(define-exported-binding "syslog-facility-type" :syslog-facility)
|
(define-exported-binding "syslog-facility-type" :syslog-facility)
|
||||||
|
@ -85,6 +105,8 @@
|
||||||
(info #o100)
|
(info #o100)
|
||||||
(debug #o200)))
|
(debug #o200)))
|
||||||
|
|
||||||
|
(define syslog-level=? eq?)
|
||||||
|
|
||||||
(define-exported-binding "syslog-level-type" :syslog-level)
|
(define-exported-binding "syslog-level-type" :syslog-level)
|
||||||
(define-exported-binding "syslog-levels" syslog-levels)
|
(define-exported-binding "syslog-levels" syslog-levels)
|
||||||
|
|
||||||
|
@ -108,6 +130,11 @@
|
||||||
(apply bitwise-ior
|
(apply bitwise-ior
|
||||||
(map syslog-level-mask levels))))
|
(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
|
(define-syntax syslog-mask
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
((syslog-mask name ...)
|
((syslog-mask name ...)
|
||||||
|
@ -216,10 +243,14 @@
|
||||||
|
|
||||||
(define (syslog level message . rest)
|
(define (syslog level message . rest)
|
||||||
(syslog-write level message
|
(syslog-write level message
|
||||||
|
(if (and (not (null? rest))
|
||||||
|
(null? (cdr rest))
|
||||||
|
(syslog-channel? (car rest)))
|
||||||
|
(car rest)
|
||||||
;; this might be a little excessive allocation
|
;; this might be a little excessive allocation
|
||||||
(apply change-syslog-channel
|
(apply change-syslog-channel
|
||||||
(thread-fluid dynamic-syslog-channel)
|
(thread-fluid dynamic-syslog-channel)
|
||||||
rest)))
|
rest))))
|
||||||
|
|
||||||
(define (with-syslog-destination ident options facility mask thunk)
|
(define (with-syslog-destination ident options facility mask thunk)
|
||||||
(let-thread-fluid dynamic-syslog-channel
|
(let-thread-fluid dynamic-syslog-channel
|
||||||
|
|
Loading…
Reference in New Issue