Prevent log interaction with a lock.
Don't do a DNS lookup for log entries.
This commit is contained in:
parent
5e1193c60a
commit
24214819dc
|
@ -52,6 +52,7 @@
|
||||||
|
|
||||||
(define *http-log?* #t)
|
(define *http-log?* #t)
|
||||||
(define *http-log-port* #f)
|
(define *http-log-port* #f)
|
||||||
|
(define *http-log-lock* (make-lock))
|
||||||
|
|
||||||
(define (init-http-log!)
|
(define (init-http-log!)
|
||||||
(set! *http-log-port* (current-error-port)))
|
(set! *http-log-port* (current-error-port)))
|
||||||
|
@ -59,9 +60,10 @@
|
||||||
(define (http-log fmt . args)
|
(define (http-log fmt . args)
|
||||||
(if *http-log?*
|
(if *http-log?*
|
||||||
(begin
|
(begin
|
||||||
|
(obtain-lock *http-log-lock*)
|
||||||
(apply format *http-log-port* fmt args)
|
(apply format *http-log-port* fmt args)
|
||||||
(force-output *http-log-port*)
|
(force-output *http-log-port*)
|
||||||
)))
|
(release-lock *http-log-lock*))))
|
||||||
|
|
||||||
|
|
||||||
;;; (httpd path-handler [port server-root-dir])
|
;;; (httpd path-handler [port server-root-dir])
|
||||||
|
@ -187,11 +189,15 @@
|
||||||
(let ((line (read-crlf-line)))
|
(let ((line (read-crlf-line)))
|
||||||
|
|
||||||
;; Blat out some logging info.
|
;; Blat out some logging info.
|
||||||
(if *http-log?*
|
(if *http-log?*
|
||||||
(let* ((addr (socket-remote-address sock))
|
(call-with-values
|
||||||
(host (host-name-or-ip addr)))
|
(lambda ()
|
||||||
(http-log "~a: ~a~%" host line)))
|
(socket-address->internet-address (socket-remote-address sock)))
|
||||||
|
(lambda (host-address service-port)
|
||||||
|
(http-log "~a: ~a~%"
|
||||||
|
(format-internet-host-address host-address)
|
||||||
|
line))))
|
||||||
|
|
||||||
(if (eof-object? line)
|
(if (eof-object? line)
|
||||||
(fatal-syntax-error "EOF while parsing request.")
|
(fatal-syntax-error "EOF while parsing request.")
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue