Syslog interface cleanup.
This commit is contained in:
parent
fd07c36a40
commit
98de22054e
|
@ -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))
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue