PasteRack.org | ||
Paste # 93349 | ||
2019-03-14 09:10:27 | ||
Fork as a new paste. | ||
Paste viewed 522 times. | ||
Tweet | ||
Embed: | ||
(define (batched on-batch #:wait-msec wait #:max-count max-count) (define ch (make-async-channel)) (define (put v) (async-channel-put ch v)) (define exit-sym (gensym 'batched-exit-message-)) (define thd (with-thread (let recur ([vs '()] [count 0] [timer never-evt]) (define v (sync timer ch)) (cond [(equal? v exit-sym) (unless (empty? vs) (on-batch (reverse vs)))] [(equal? v timer) ;timer expired: send accumulated (unless (empty? vs) (on-batch (reverse vs))) (recur '() 0 never-evt)] [(< (add1 count) max-count) ;accumulate and wait (recur (cons v vs) (add1 count) (alarm-evt (+ (current-inexact-milliseconds) wait)))] [else ;max count: send accumulated (on-batch (reverse (cons v vs))) (recur '() 0 never-evt)])))) (plumber-add-flush! (current-plumber) (λ (_flush-handle) (put exit-sym) (sync thd))) put) (when (and (current-log-aws-host) (current-log-aws-region) (current-log-aws-group) (current-log-aws-stream)) ;; Create the receiver first so available earlier in startup (define lls (map string->symbol (string-split (current-log-levels)))) (define receiver (apply make-log-receiver (list* (current-logger) lls))) ;; PutLogEvents has a limit of 5 requests per second (per log stream) ;; so accumulate/batch messages. (define aws-put-one (batched #:wait-msec 2000 #:max-count 1000 aws-put-log-events)) (with-thread (let loop () (match (sync receiver) [(vector level message _v topic) (aws-put-one (hasheq 'message @~a{[@level] @(sanitize message)} 'timestamp (* 1000 (current-seconds))))] [_ (void)]) (loop)))) (define (sanitize s) (regexp-replace* #px"#:pass \".*?\"" s "#:pass \"******\""))