make-logger: support specification of events to propagate
Events to propagate to a parent are described in the same way as events to receive for a log receiver. The default is still to propagate all events to the parent, which corresponds to a propagation specification of 'debug. Making a propagation-filtering specification built-in, instead of allowing arbitrary filter functions, keeps `log-level?` efficient and avoid hooks that might be implemented by untrusted code.
This commit is contained in:
Matthew Flatt
parent
83b4595741
commit
159c82fc4a
|
|
@ -84,13 +84,26 @@ otherwise.}
|
|||
|
||||
|
||||
@defproc[(make-logger [name (or/c symbol? #f) #f]
|
||||
[parent (or/c logger? #f) #f])
|
||||
[parent (or/c logger? #f) #f]
|
||||
[propagate-level (or/c 'none 'fatal 'error 'warning 'info 'debug) 'debug]
|
||||
[propagate-name (or/c #f symbol?) #f]
|
||||
... ...)
|
||||
logger?]{
|
||||
|
||||
Creates a new @tech{logger} with an optional name and parent.
|
||||
|
||||
The optional @racket[propagate-level] and @racket[propagate-name]
|
||||
arguments constrain the events that are propagated from the new logger
|
||||
to @racket[parent] (when @racket[parent] is not @racket[#f]) in the
|
||||
same way that events are described for a log receiver in
|
||||
@racket[make-log-receiver]. By default, all events are propagated to
|
||||
@racket[parent].
|
||||
|
||||
@history[#:changed "6.1.1.3" @elem{Removed an optional argument to
|
||||
specify a notification callback.}]}
|
||||
specify a notification callback,
|
||||
and added @racket[propagate-level] and
|
||||
@racket[propagate-name] constraints for
|
||||
events to propagate.}]}
|
||||
|
||||
|
||||
@defproc[(logger-name [logger logger?]) (or/c symbol? #f)]{
|
||||
|
|
@ -148,11 +161,8 @@ by @racket[": "] before it is sent to receivers.
|
|||
Reports whether any @tech{log receiver} attached to @racket[logger] or
|
||||
one of its ancestors is interested in @racket[level] events (or
|
||||
potentially lower) or @racket[name]. If @racket[name] is @racket[#f],
|
||||
the result indicates whether any @tech{log receiver} is interested in
|
||||
events at @racket[level] for any name. A true result for
|
||||
@racket[(log-level? logger level name)] implies a true result for
|
||||
@racket[(log-level? logger level #f)], but not vice versa if
|
||||
@racket[name] is a symbol.
|
||||
the result indicates whether a @tech{log receiver} is interested in
|
||||
events at @racket[level] for any name.
|
||||
|
||||
Use this function to avoid work generating an
|
||||
event for @racket[log-message] if no receiver is interested in the
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@
|
|||
|
||||
(test #f logger-name (make-logger))
|
||||
|
||||
(arity-test make-logger 0 2)
|
||||
(arity-test make-logger 0 -1)
|
||||
|
||||
; --------------------
|
||||
|
||||
|
|
@ -100,23 +100,28 @@
|
|||
|
||||
(let ()
|
||||
(define-logger test)
|
||||
(define r (make-log-receiver (current-logger) 'info 'test 'warning))
|
||||
(define r (make-log-receiver (current-logger) 'info 'test2 'warning))
|
||||
(test #t log-level? test-logger 'warning)
|
||||
(test #t log-level? test-logger 'info)
|
||||
(test #t log-level? test-logger 'info 'test)
|
||||
(test #t log-level? test-logger 'info 'test2)
|
||||
(test #f log-level? test-logger 'info 'not-test)
|
||||
(test #f log-level? test-logger 'debug 'test)
|
||||
(test #f log-level? test-logger 'debug 'test2)
|
||||
(test 'info log-max-level test-logger)
|
||||
(test 'info log-max-level test-logger 'test)
|
||||
(test 'info log-max-level test-logger 'test2)
|
||||
(test 'warning log-max-level test-logger 'not-test)
|
||||
(define r2 (make-log-receiver (current-logger) 'warning 'test 'info))
|
||||
(test #t log-level? test-logger 'info 'test)
|
||||
;; Retain receiver to avoid GC influence on tests
|
||||
(test #f sync/timeout 0 r))
|
||||
|
||||
(let ()
|
||||
(define-logger test)
|
||||
(define r2 (make-log-receiver (current-logger) 'warning 'test3 'info))
|
||||
(test #f log-level? test-logger 'info 'test3)
|
||||
(test #t log-level? test-logger 'info 'not-test)
|
||||
(test #f log-level? test-logger 'debug 'test)
|
||||
(test #f log-level? test-logger 'debug 'test3)
|
||||
(test 'info log-max-level test-logger)
|
||||
(test 'info log-max-level test-logger 'test)
|
||||
(test 'warning log-max-level test-logger 'test3)
|
||||
(test 'info log-max-level test-logger 'not-test)
|
||||
(test #f sync/timeout 0 r)
|
||||
;; Retain receiver to avoid GC influence on tests
|
||||
(test #f sync/timeout 0 r2))
|
||||
|
||||
; ----------------------------------------
|
||||
|
|
@ -170,6 +175,57 @@
|
|||
(log-message l 'info 'sub "hey" #f)
|
||||
(test '#(info "sub: hey" #f sub) sync/timeout 0 r))
|
||||
|
||||
;; --------------------
|
||||
;; Check logger propagate constraints
|
||||
|
||||
(let ()
|
||||
(define l (make-logger))
|
||||
(define l2 (make-logger #f l 'error))
|
||||
(define l3 (make-logger #f l2 'warning 'test 'info))
|
||||
(define l32 (make-logger #f l2 'info 'test 'warning))
|
||||
|
||||
(define r (make-log-receiver l 'debug))
|
||||
(test #f sync/timeout 0 r)
|
||||
|
||||
(log-message l 'debug "debug message" #f)
|
||||
(test #t vector? (sync/timeout 0 r))
|
||||
|
||||
(define r2 (make-log-receiver l2 'info))
|
||||
(test (void) log-message l2 'warning "warning message not propagated" #f)
|
||||
(test #f sync/timeout 0 r)
|
||||
(test #t vector? (sync/timeout 0 r2))
|
||||
|
||||
(test (void) log-message l3 'error "error message propagated" #f)
|
||||
(test #t vector? (sync/timeout 0 r))
|
||||
(test #t vector? (sync/timeout 0 r2))
|
||||
|
||||
(test (void) log-message l3 'info "info message partially propagated" #f)
|
||||
(test #f sync/timeout 0 r)
|
||||
(test #t vector? (sync/timeout 0 r2))
|
||||
|
||||
(test (void) log-message l3 'info 'test "info message not propagated" #f)
|
||||
(test #f sync/timeout 0 r)
|
||||
(test #f sync/timeout 0 r2)
|
||||
|
||||
(test 'debug log-max-level l)
|
||||
(test 'info log-max-level l2)
|
||||
(test 'info log-max-level l3)
|
||||
|
||||
(define r22 (make-log-receiver l2 'debug))
|
||||
(test 'debug log-max-level l)
|
||||
(test 'debug log-max-level l2)
|
||||
(test 'info log-max-level l3)
|
||||
(test 'warning log-max-level l3 'test)
|
||||
(test 'info log-max-level l3 'not-test)
|
||||
(test 'info log-max-level l32)
|
||||
(test 'warning log-max-level l32 'not-test)
|
||||
(test 'info log-max-level l32 'test)
|
||||
|
||||
;; Retain receivers to avoid GC influence on tests
|
||||
(test #f sync/timeout 0 r)
|
||||
(test #f sync/timeout 0 r2)
|
||||
(test #f sync/timeout 0 r22))
|
||||
|
||||
; --------------------
|
||||
|
||||
(report-errs)
|
||||
|
|
|
|||
|
|
@ -727,7 +727,7 @@ void scheme_init_error(Scheme_Env *env)
|
|||
GLOBAL_NONCM_PRIM("exit", scheme_do_exit, 0, 1, env);
|
||||
GLOBAL_NONCM_PRIM("log-level?", log_level_p, 2, 3, env);
|
||||
GLOBAL_NONCM_PRIM("log-max-level", log_max_level, 1, 2, env);
|
||||
GLOBAL_NONCM_PRIM("make-logger", make_logger, 0, 2, env);
|
||||
GLOBAL_NONCM_PRIM("make-logger", make_logger, 0, -1, env);
|
||||
GLOBAL_NONCM_PRIM("make-log-receiver", make_log_reader, 2, -1, env);
|
||||
|
||||
GLOBAL_PRIM_W_ARITY("log-message", log_message, 4, 6, env);
|
||||
|
|
@ -3458,19 +3458,12 @@ static int extract_max_spec_level(Scheme_Object *level_spec, Scheme_Object *name
|
|||
void update_want_level(Scheme_Logger *logger, Scheme_Object *name)
|
||||
{
|
||||
Scheme_Log_Reader *lr;
|
||||
Scheme_Object *stack = NULL, *queue, *b, *prev;
|
||||
Scheme_Logger *parent = logger, *orig_logger = logger;
|
||||
int want_level, level;
|
||||
|
||||
while (parent) {
|
||||
stack = scheme_make_raw_pair((Scheme_Object *)parent, stack);
|
||||
parent = parent->parent;
|
||||
}
|
||||
Scheme_Object *queue, *b, *prev;
|
||||
Scheme_Logger *parent = logger;
|
||||
int want_level, level, ceiling_level = SCHEME_LOG_DEBUG;
|
||||
|
||||
want_level = 0;
|
||||
while (stack) {
|
||||
parent = (Scheme_Logger *)SCHEME_CAR(stack);
|
||||
|
||||
while (parent) {
|
||||
queue = parent->readers;
|
||||
prev = NULL;
|
||||
while (queue) {
|
||||
|
|
@ -3479,8 +3472,12 @@ void update_want_level(Scheme_Logger *logger, Scheme_Object *name)
|
|||
lr = (Scheme_Log_Reader *)SCHEME_BOX_VAL(b);
|
||||
if (lr) {
|
||||
level = extract_max_spec_level(lr->level, name);
|
||||
if (level > ceiling_level)
|
||||
level = ceiling_level;
|
||||
if (level > want_level)
|
||||
want_level = level;
|
||||
if (want_level >= ceiling_level)
|
||||
break;
|
||||
prev = queue;
|
||||
} else {
|
||||
if (prev)
|
||||
|
|
@ -3498,7 +3495,17 @@ void update_want_level(Scheme_Logger *logger, Scheme_Object *name)
|
|||
if (level > want_level)
|
||||
want_level = level;
|
||||
|
||||
stack = SCHEME_CDR(stack);
|
||||
if (parent->propagate_level)
|
||||
level = extract_max_spec_level(parent->propagate_level, name);
|
||||
else
|
||||
level = SCHEME_LOG_DEBUG;
|
||||
if (level <= ceiling_level)
|
||||
ceiling_level = level;
|
||||
|
||||
if (want_level >= ceiling_level)
|
||||
break;
|
||||
|
||||
parent = parent->parent;
|
||||
}
|
||||
|
||||
if (!name) {
|
||||
|
|
@ -3508,8 +3515,6 @@ void update_want_level(Scheme_Logger *logger, Scheme_Object *name)
|
|||
# define WANT_NAME_LEVEL_CACHE_SIZE 8
|
||||
int i;
|
||||
|
||||
logger = orig_logger;
|
||||
|
||||
b = logger->want_name_level_cache;
|
||||
if (!b) {
|
||||
b = scheme_make_vector(3 * WANT_NAME_LEVEL_CACHE_SIZE, scheme_make_integer(-1));
|
||||
|
|
@ -3783,6 +3788,11 @@ void scheme_log_name_pfx_message(Scheme_Logger *logger, int level, Scheme_Object
|
|||
queue = SCHEME_CDR(queue);
|
||||
}
|
||||
|
||||
if (logger->parent && logger->propagate_level) {
|
||||
if (extract_spec_level(logger->propagate_level, name) < level)
|
||||
break;
|
||||
}
|
||||
|
||||
logger = logger->parent;
|
||||
}
|
||||
}
|
||||
|
|
@ -3991,10 +4001,42 @@ log_max_level(int argc, Scheme_Object *argv[])
|
|||
}
|
||||
}
|
||||
|
||||
static Scheme_Object *get_levels_and_names(const char *who, int i, int argc, Scheme_Object **argv,
|
||||
int default_lvl)
|
||||
{
|
||||
int lvl;
|
||||
Scheme_Object *level = scheme_null, *last = NULL;
|
||||
|
||||
for (; i < argc; i += 2) {
|
||||
lvl = extract_level(who, 1, i, argc, argv);
|
||||
if ((i+1) < argc) {
|
||||
if (SCHEME_FALSEP(argv[i+1]))
|
||||
default_lvl = lvl;
|
||||
else {
|
||||
if (!SCHEME_SYMBOLP(argv[i+1]))
|
||||
scheme_wrong_contract(who, "(or/c symbol? #f)", i+1, argc, argv);
|
||||
level = scheme_make_pair(argv[i+1], level);
|
||||
if (!last) last = level;
|
||||
level = scheme_make_pair(scheme_make_integer(lvl), level);
|
||||
}
|
||||
} else {
|
||||
default_lvl = lvl;
|
||||
}
|
||||
}
|
||||
|
||||
if (last)
|
||||
SCHEME_CDR(last) = scheme_make_integer(default_lvl);
|
||||
else
|
||||
level = scheme_make_integer(default_lvl);
|
||||
|
||||
return level;
|
||||
}
|
||||
|
||||
static Scheme_Object *
|
||||
make_logger(int argc, Scheme_Object *argv[])
|
||||
{
|
||||
Scheme_Logger *parent, *logger;
|
||||
Scheme_Object *propagate_level;
|
||||
|
||||
if (argc) {
|
||||
if (!SCHEME_FALSEP(argv[0]) && !SCHEME_SYMBOLP(argv[0]))
|
||||
|
|
@ -4013,11 +4055,17 @@ make_logger(int argc, Scheme_Object *argv[])
|
|||
} else
|
||||
parent = NULL;
|
||||
|
||||
propagate_level = get_levels_and_names("make-logger", 2, argc, argv,
|
||||
SCHEME_LOG_DEBUG);
|
||||
|
||||
logger = scheme_make_logger(parent,
|
||||
(argc
|
||||
? (SCHEME_FALSEP(argv[0]) ? NULL : argv[0])
|
||||
: NULL));
|
||||
|
||||
|
||||
if (parent)
|
||||
logger->propagate_level = propagate_level;
|
||||
|
||||
return (Scheme_Object *)logger;
|
||||
}
|
||||
|
||||
|
|
@ -4076,34 +4124,13 @@ make_log_reader(int argc, Scheme_Object *argv[])
|
|||
Scheme_Logger *logger;
|
||||
Scheme_Log_Reader *lr;
|
||||
Scheme_Object *sema, *q;
|
||||
int default_lvl = 0, lvl, i;
|
||||
Scheme_Object *level = scheme_null, *last = NULL;
|
||||
Scheme_Object *level;
|
||||
|
||||
if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_logger_type))
|
||||
scheme_wrong_contract("make-log-receiver", "logger?", 0, argc, argv);
|
||||
logger = (Scheme_Logger *)argv[0];
|
||||
|
||||
for (i = 1; i < argc; i += 2) {
|
||||
lvl = extract_level("make-log-receiver", 1, i, argc, argv);
|
||||
if ((i+1) < argc) {
|
||||
if (SCHEME_FALSEP(argv[i+1]))
|
||||
default_lvl = lvl;
|
||||
else {
|
||||
if (!SCHEME_SYMBOLP(argv[i+1]))
|
||||
scheme_wrong_contract("make-log-receiver", "(or/c symbol? #f)", i+1, argc, argv);
|
||||
level = scheme_make_pair(argv[i+1], level);
|
||||
if (!last) last = level;
|
||||
level = scheme_make_pair(scheme_make_integer(lvl), level);
|
||||
}
|
||||
} else {
|
||||
default_lvl = lvl;
|
||||
}
|
||||
}
|
||||
|
||||
if (last)
|
||||
SCHEME_CDR(last) = scheme_make_integer(default_lvl);
|
||||
else
|
||||
level = scheme_make_integer(default_lvl);
|
||||
level = get_levels_and_names("make-log-receiver", 1, argc, argv, 0);
|
||||
|
||||
lr = MALLOC_ONE_TAGGED(Scheme_Log_Reader);
|
||||
lr->so.type = scheme_log_reader_type;
|
||||
|
|
|
|||
|
|
@ -3008,6 +3008,7 @@ static int mark_logger_MARK(void *p, struct NewGC *gc) {
|
|||
gcMARK2(l->timestamp, gc);
|
||||
gcMARK2(l->syslog_level, gc);
|
||||
gcMARK2(l->stderr_level, gc);
|
||||
gcMARK2(l->propagate_level, gc);
|
||||
gcMARK2(l->readers, gc);
|
||||
return
|
||||
gcBYTES_TO_WORDS(sizeof(Scheme_Logger));
|
||||
|
|
@ -3021,6 +3022,7 @@ static int mark_logger_FIXUP(void *p, struct NewGC *gc) {
|
|||
gcFIXUP2(l->timestamp, gc);
|
||||
gcFIXUP2(l->syslog_level, gc);
|
||||
gcFIXUP2(l->stderr_level, gc);
|
||||
gcFIXUP2(l->propagate_level, gc);
|
||||
gcFIXUP2(l->readers, gc);
|
||||
return
|
||||
gcBYTES_TO_WORDS(sizeof(Scheme_Logger));
|
||||
|
|
|
|||
|
|
@ -1211,6 +1211,7 @@ mark_logger {
|
|||
gcMARK2(l->timestamp, gc);
|
||||
gcMARK2(l->syslog_level, gc);
|
||||
gcMARK2(l->stderr_level, gc);
|
||||
gcMARK2(l->propagate_level, gc);
|
||||
gcMARK2(l->readers, gc);
|
||||
size:
|
||||
gcBYTES_TO_WORDS(sizeof(Scheme_Logger));
|
||||
|
|
|
|||
|
|
@ -3697,6 +3697,7 @@ struct Scheme_Logger {
|
|||
intptr_t *timestamp, local_timestamp; /* determines when want_level is up-to-date */
|
||||
Scheme_Object *syslog_level; /* (list* <level-int> <name-sym> ... <level-int>) */
|
||||
Scheme_Object *stderr_level;
|
||||
Scheme_Object *propagate_level; /* can be NULL */
|
||||
Scheme_Object *readers; /* list of (cons (make-weak-box <reader>) <sema>) */
|
||||
};
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user