* open-logfile returns null-output-port if logfile cannot be opened for writing
* No output to stderr anymore. Output now goes to syslog. If syslogging is disabled, bad luck.
This commit is contained in:
parent
2f0397483b
commit
ed0679bb85
|
@ -39,9 +39,17 @@
|
||||||
(define server/version "Scheme-Underground/1.0")
|
(define server/version "Scheme-Underground/1.0")
|
||||||
(define server/protocol "HTTP/1.0")
|
(define server/protocol "HTTP/1.0")
|
||||||
|
|
||||||
; default: no logging
|
;; default: no logging
|
||||||
; initialized by init-http-log!
|
;; initialized by init-http-log!
|
||||||
|
|
||||||
|
;; CLF-logging
|
||||||
|
;; if enabled, it will look like this:
|
||||||
|
;; (lambda req reply-code)
|
||||||
(define http-log (lambda a #f)) ; makes logging in CLF
|
(define http-log (lambda a #f)) ; makes logging in CLF
|
||||||
|
|
||||||
|
;; syslogging
|
||||||
|
;; if enabled, it will look like this:
|
||||||
|
;; (lambda (level fmt . args)
|
||||||
(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
|
||||||
|
@ -52,8 +60,10 @@
|
||||||
(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))
|
;; syslog has to be initialized befor CLF-logging
|
||||||
(init-http-syslog! (httpd-options-syslog? options)))
|
;; because it may generate syslog-messages
|
||||||
|
(init-http-syslog! (httpd-options-syslog? options))
|
||||||
|
(init-http-port-log! (httpd-options-logfile options)))
|
||||||
|
|
||||||
(define (init-http-port-log! logfile)
|
(define (init-http-port-log! logfile)
|
||||||
(let ((logport
|
(let ((logport
|
||||||
|
@ -64,13 +74,13 @@
|
||||||
logfile)
|
logfile)
|
||||||
((eq? logfile #f) ; no logging demanded
|
((eq? logfile #f) ; no logging demanded
|
||||||
#f)
|
#f)
|
||||||
; unexpected value of logfile; we'll use (current-error-port) instead
|
; unexpected value of logfile;
|
||||||
(else
|
(else
|
||||||
(format (current-error-port)
|
(http-syslog
|
||||||
"[httpd] Warning: Logfile was not specified correctly (given: ~S).~%
|
(syslog-level warning)
|
||||||
Logging now to stderr.\n"
|
"[httpd] Warning: Logfile was not specified correctly (given: ~S).~% No CLF logging."
|
||||||
logfile)
|
logfile)
|
||||||
(current-error-port)))))
|
(make-null-output-port)))))
|
||||||
|
|
||||||
(if logfile ; if logging was specified, set up the logger
|
(if logfile ; if logging was specified, set up the logger
|
||||||
(let ((http-log-lock (make-lock)))
|
(let ((http-log-lock (make-lock)))
|
||||||
|
@ -130,7 +140,7 @@
|
||||||
(define (open-logfile logfile)
|
(define (open-logfile logfile)
|
||||||
(with-errno-handler*
|
(with-errno-handler*
|
||||||
(lambda (errno packet)
|
(lambda (errno packet)
|
||||||
(format (current-error-port)
|
(http-syslog (syslog-level warning)
|
||||||
"[httpd] Warning: An error occured while opening ~S for writing (~A).~%Send signal USR1 when the problem is fixed.~%"
|
"[httpd] Warning: An error occured while opening ~S for writing (~A).~%Send signal USR1 when the problem is fixed.~%"
|
||||||
logfile
|
logfile
|
||||||
(car packet))
|
(car packet))
|
||||||
|
@ -608,7 +618,6 @@
|
||||||
(if message (format out "<P>~%~a~%" message)))))
|
(if message (format out "<P>~%~a~%" message)))))
|
||||||
|
|
||||||
((= reply-code http-reply/internal-error)
|
((= reply-code http-reply/internal-error)
|
||||||
(format (current-error-port) "ERROR: ~A~%" message)
|
|
||||||
(http-syslog (syslog-level error) "internal-error: ~A" message)
|
(http-syslog (syslog-level error) "internal-error: ~A" message)
|
||||||
(if html-ok?
|
(if html-ok?
|
||||||
(begin
|
(begin
|
||||||
|
|
Loading…
Reference in New Issue