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

Added logfile rotation on SIGUSR1.

This commit is contained in:
mainzelm 2002-05-08 12:04:41 +00:00
parent 5c72a6dad2
commit 18c056e01e
1 changed files with 57 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
httpd-core.scm
View File

@ -45,6 +45,11 @@
(define http-syslog (lambda a #f)) ; makes syslog (define http-syslog (lambda a #f)) ; makes syslog
(define *http-syslog?* #f) ; trigger used to avoid (define *http-syslog?* #f) ; trigger used to avoid
; unnecessary computations ; unnecessary computations
(define *http-log-port*)
(define (http-log-port)
*http-log-port*)
(define (set-http-log-port! port)
(set! *http-log-port* port))
(define (init-http-log! options) (define (init-http-log! options)
(init-http-port-log! (httpd-options-logfile options)) (init-http-port-log! (httpd-options-logfile options))
@ -54,19 +59,7 @@
(let ((logport (let ((logport
(cond (cond
((string? logfile) ; try to open logfile for appending (output) ((string? logfile) ; try to open logfile for appending (output)
(call-with-current-continuation (open-logfile logfile))
(lambda (exit)
(with-errno-handler*
(lambda (errno packet)
(format (current-error-port)
"[httpd] Warning: An error occured while opening ~S for writing (~A).
Logging now to stderr.~%"
logfile
(car packet))
(exit (current-error-port)))
(lambda ()
(open-output-file logfile
(bitwise-ior open/create open/append)))))))
((output-port? logfile) ; we were given an output port, so let's use it ((output-port? logfile) ; we were given an output port, so let's use it
logfile) logfile)
((eq? logfile #f) ; no logging demanded ((eq? logfile #f) ; no logging demanded
@ -80,7 +73,11 @@
(current-error-port))))) (current-error-port)))))
(if logfile ; if logging was specified, set up the logger (if logfile ; if logging was specified, set up the logger
(set! http-log (make-http-log-proc logport))))) (let ((http-log-lock (make-lock)))
(set-http-log-port! logport)
(if (string? logfile)
(spawn (make-logfile-rotator logfile http-log-lock)))
(set! http-log (make-http-log-proc http-log-lock))))))
; alternative-clause: default values of *http-syslog?* and http-log ; alternative-clause: default values of *http-syslog?* and http-log
(define (init-http-syslog! syslog?) (define (init-http-syslog! syslog?)
@ -94,30 +91,53 @@
(apply format #f fmt args)) (apply format #f fmt args))
(release-lock http-syslog-lock)))))) (release-lock http-syslog-lock))))))
(define (make-http-log-proc http-log-port) (define (make-http-log-proc http-log-lock)
(let ((http-log-lock (make-lock)))
; (display "--- MARK (server started) ---\n" http-log-port) ; (display "--- MARK (server started) ---\n" http-log-port)
(lambda (req reply-code) (lambda (req reply-code)
(if req (if req
(begin (begin
(obtain-lock http-log-lock) (obtain-lock http-log-lock)
(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
reply-code reply-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))
http-log-port) (http-log-port))
(force-output http-log-port) (force-output (http-log-port))
(release-lock http-log-lock)))))) (release-lock http-log-lock)))))
(define (make-logfile-rotator logfile http-log-lock)
(set-interrupt-handler interrupt/usr1 #f)
(lambda ()
(on-interrupt
interrupt/usr1
(lambda ()
(obtain-lock http-log-lock)
(close-output-port (http-log-port))
(set-http-log-port! (open-logfile logfile))
(release-lock http-log-lock)))))
(define (open-logfile logfile)
(with-errno-handler*
(lambda (errno packet)
(format (current-error-port)
"[httpd] Warning: An error occured while opening ~S for writing (~A).
Logging now to stderr.~%"
logfile
(car packet))
((current-error-port)))
(lambda ()
(open-output-file logfile
(bitwise-ior open/create open/append)))))
; returns a string for a CLF entry (Common Log Format) ; returns a string for a CLF entry (Common Log Format)
; note: till now, we do not log the user's time zone code ; note: till now, we do not log the user's time zone code
(define (make-CLF remote-ip request-type requested-file protocol http-code filesize referer user-agent) (define (make-CLF remote-ip request-type requested-file protocol http-code filesize referer user-agent)