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