scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Use with-lock to obtain/release-locks.

This commit is contained in:
mainzelm 2002-12-29 19:10:10 +00:00
parent c43a8b8f35
commit 9146cb5780
1 changed files with 28 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
scheme/httpd/logging.scm
View File

@ -63,10 +63,10 @@
(set-logging-http-syslog? #t) (set-logging-http-syslog? #t)
(set-logging-http-syslog-proc (set-logging-http-syslog-proc
(lambda (level fmt . args) (lambda (level fmt . args)
(obtain-lock http-syslog-lock) (with-lock http-syslog-lock
(syslog level (lambda ()
(apply format #f fmt args)) (syslog level
(release-lock http-syslog-lock)))) (apply format #f fmt args)))))))
(begin (begin
(set-logging-http-syslog? #f) (set-logging-http-syslog? #f)
(set-logging-http-syslog-proc do-nothing-proc)))) (set-logging-http-syslog-proc do-nothing-proc))))
@ -98,24 +98,23 @@
(define (make-http-log-proc http-log-lock) (define (make-http-log-proc http-log-lock)
(lambda (req status-code) (lambda (req status-code)
(if req (if req
(begin (with-lock http-log-lock
(obtain-lock http-log-lock) (lambda ()
(display (make-CLF (display (make-CLF
(receive (host-address _) (receive (host-address _)
(socket-address->internet-address (socket-address->internet-address
(socket-remote-address (request-socket req))) (socket-remote-address (request-socket req)))
(format-internet-host-address host-address)) (format-internet-host-address host-address))
(request-method req) ; request method (request-method req) ; request method
(uri-path-list->path (uri-path-list->path
(http-url-path (request-url req))) ; requested file (http-url-path (request-url req))) ; requested file
(version->string (request-version req)) ; protocol version (version->string (request-version req)) ; protocol version
status-code status-code
23 ; filesize (unknown) 23 ; filesize (unknown)
(get-header (request-headers req) 'referer) (get-header (request-headers req) 'referer)
(get-header (request-headers req) 'user-agent)) (get-header (request-headers req) 'user-agent))
(logging-http-log-port)) (logging-http-log-port))
(force-output (logging-http-log-port)) (force-output (logging-http-log-port)))))))
(release-lock http-log-lock)))))
;; does the logfile rotation on signal USR1 ;; does the logfile rotation on signal USR1
@ -125,10 +124,10 @@
(on-interrupt (on-interrupt
interrupt/usr1 interrupt/usr1
(lambda () (lambda ()
(obtain-lock http-log-lock) (with-lock http-log-lock
(close-output-port (logging-http-log-port)) (lambda ()
(set-logging-http-log-port (open-logfile logfile)) (close-output-port (logging-http-log-port))
(release-lock http-log-lock))))) (set-logging-http-log-port (open-logfile logfile))))))))
(define (open-logfile logfile) (define (open-logfile logfile)
(with-errno-handler* (with-errno-handler*
@ -166,6 +165,9 @@
(if (logging-dns-lookup?) (if (logging-dns-lookup?)
(or (with-fatal-error-handler* (or (with-fatal-error-handler*
(lambda (condition decline) (lambda (condition decline)
(http-syslog (syslog-level debug)
"An error occured while resolving IP ~A: ~A"
remote-ip condition)
remote-ip) remote-ip)
(lambda () (lambda ()
(dns-lookup-ip remote-ip))) (dns-lookup-ip remote-ip)))