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

* insert missing *http-log?* variable 

* minor format changing to CLF-log entries
This commit is contained in:
interp 2002-04-02 11:34:53 +00:00
parent ea3615a633
commit 75970e8842
1 changed files with 13 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
httpd-core.scm
View File

@ -39,11 +39,11 @@
(define server/version "Scheme-Underground/1.0")
(define server/protocol "HTTP/1.0")
;;; Configurable Variables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define http-log (lambda a #f))
(define http-syslog (lambda a #f))
; default: no logging
(define http-log (lambda a #f)) ; makes logging in CLF
(define http-syslog (lambda a #f)) ; makes syslog
(define *http-syslog?* #f) ; trigger used to avoid
; unnecessary computations
(define (init-http-log! options)
(init-http-port-log! (httpd-options-logfile options))
@ -80,7 +80,7 @@
(if logfile ; if logging was specified, set up the logger
(set! http-log (make-http-log-proc logport)))))
; alternative-clause: default values of *http-log?* and http-log
; alternative-clause: default values of *http-syslog?* and http-log
(define (init-http-syslog! syslog?)
(if syslog?
@ -121,12 +121,11 @@
(define (make-CLF remote-ip request-type requested-file protocol http-code filesize referer user-agent)
(format #f "~A - - ~A ~S ~A ~A ~S ~S~%"
(or remote-ip "-")
(format-date "[~d/~b/~Y:~H:~M:~S]" (date))
(string-join (list request-type requested-file protocol))
(format-date "[~d/~b/~Y:~H:~M:~S +0000]" (date)) ; +0000 as we don't know
(string-join (list "/" request-type requested-file protocol))
; Unfortunately, we first split the request line into
; method/request-type etc. and put it together here.
; Files conform to CLF are expected to print the original line.
; We loose here, as the initial `/' is missing in our log.
(or http-code "-")
(or filesize "-")
(or referer "")
@ -171,7 +170,7 @@
(lambda ()
(socket-address->internet-address (socket-remote-address sock)))
(lambda (host-address service-port)
(if (and rate-limiter *http-log?*)
(if (and rate-limiter *http-syslog?*)
(http-syslog (syslog-level info) "<~a>~a: concurrent request #~a~%"
(pid)
(format-internet-host-address host-address)
@ -186,13 +185,13 @@
(socket:outport sock)
(set-port-buffering (current-input-port) bufpol/none)
(process-toplevel-request sock host-address options)))
(if *http-log?*
(if *http-syslog?*
(http-syslog (syslog-level debug) "<~a>~a [closing]~%"
(pid)
(format-internet-host-address host-address)))
(with-fatal-error-handler
(lambda (c decline)
(if *http-log?*
(if *http-syslog?*
(http-syslog (syslog-level notice) "<~a>~a [error closing (~a)]~%"
(pid)
(format-internet-host-address host-address)
@ -200,7 +199,7 @@
(close-socket sock))
(if rate-limiter
(rate-limit-close rate-limiter))
(if *http-log?*
(if *http-syslog?*
(http-syslog (syslog-level info) "<~a>~a [closed]~%"
(pid)
(format-internet-host-address host-address)))))))))
@ -318,7 +317,7 @@
(let ((line (read-crlf-line)))
; (display line (current-error-port)) (newline (current-error-port))
;; Blat out some logging info.
(if *http-log?*
(if *http-syslog?*
(call-with-values
(lambda ()
(socket-address->internet-address (socket-remote-address sock)))