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

22
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
(lambda ()
(syslog level (syslog level
(apply format #f fmt args)) (apply format #f fmt args)))))))
(release-lock http-syslog-lock))))
(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,8 +98,8 @@
(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
@ -114,8 +114,7 @@
(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
(lambda ()
(close-output-port (logging-http-log-port)) (close-output-port (logging-http-log-port))
(set-logging-http-log-port (open-logfile logfile)) (set-logging-http-log-port (open-logfile logfile))))))))
(release-lock http-log-lock)))))
(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)))