diff options
| author | Christopher Baines <mail@cbaines.net> | 2022-04-16 09:48:11 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2022-04-17 20:39:16 +0100 |
| commit | 3f732ba58b1720410aeaff0b87e3dd0e54a6fa5d (patch) | |
| tree | 960b7b18a153ff2868d9b655b670484a5a860f28 /scripts | |
| parent | b15e3e5b7fe5a7397b06948c6982454862642f65 (diff) | |
| download | nar-herder-3f732ba58b1720410aeaff0b87e3dd0e54a6fa5d.tar nar-herder-3f732ba58b1720410aeaff0b87e3dd0e54a6fa5d.tar.gz | |
Support passing a log-level to the nar-herder server
This means that you can disable the output of requests by specifying a
log-level of INFO or greater.
Since the nar-herder may respond to so many requests, logging each one
is a bit excessive.
Diffstat (limited to 'scripts')
| -rw-r--r-- | scripts/nar-herder.in | 36 |
1 files changed, 30 insertions, 6 deletions
diff --git a/scripts/nar-herder.in b/scripts/nar-herder.in index 0f4f7f2..fd4b7b4 100644 --- a/scripts/nar-herder.in +++ b/scripts/nar-herder.in @@ -60,6 +60,9 @@ (nar-herder mirror) (nar-herder server)) +(define %valid-log-levels + '(DEBUG INFO WARN ERROR)) + (define %base-options (list (option '("database") #t #f (lambda (opt name arg result) @@ -161,12 +164,26 @@ (lambda (opt name arg result) (alist-cons 'mirror arg - (alist-delete 'mirror result)))))) + (alist-delete 'mirror result)))) + + (option '("log-level") #t #f + (lambda (opt name arg result) + (alist-cons 'log-level + (let ((level (string->symbol (string-upcase arg)))) + (if (member level %valid-log-levels) + level + (error + (simple-format #f "unknown log level ~A\nvalid levels are: ~A\n" + level + %valid-log-levels)))) + (alist-delete 'log-level result)))))) (define %server-option-defaults '((port . 8080) (host . "0.0.0.0") + (log-level . 'DEBUG) + (storage-limit . "none") (recent-changes-limit . 32768))) @@ -282,6 +299,13 @@ (open-log! lgr) (set-default-logger! lgr) + (let ((log-level (assq-ref opts 'log-level))) + (let loop ((levels %valid-log-levels)) + (when (and (not (null? levels)) + (not (eq? (car levels) log-level))) + (disable-log-level! lgr (car levels)) + (loop (cdr levels))))) + (unless (null? unknown-arguments) (simple-format (current-error-port) "unknown arguments: ~A\n" @@ -319,8 +343,7 @@ (simple-format port "~A\n" (getpid)))))) (when (not (file-exists? (assq-ref opts 'database-dump))) - (simple-format (current-error-port) - "dumping database...\n") + (log-msg 'INFO "dumping database...") (dump-database database (assq-ref opts 'database-dump))) (start-recent-change-removal-and-database-dump-thread @@ -353,12 +376,13 @@ #f))) opts))) - (simple-format (current-error-port) - "starting server\n") + (log-msg 'INFO "starting server, listening on " + (assq-ref opts 'host) ":" (assq-ref opts 'port)) (run-server (make-request-handler database canonical-storage #:ttl (assq-ref opts 'narinfo-ttl) - #:negative-ttl (assq-ref opts 'narinfo-negative-ttl)) + #:negative-ttl (assq-ref opts 'narinfo-negative-ttl) + #:logger lgr) #:host (assq-ref opts 'host) #:port (assq-ref opts 'port)))))) |