;;; logging.scm ;;; logging functionality for web server ;;; 2002, Andreas Bernauer, Martin Gasbichler ;; default: no logging ;; 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 ;; syslogging ;; if enabled, it will look like this: ;; (lambda (level fmt . args) (define http-syslog (lambda a #f)) ; makes syslog (define *http-syslog?* #f) ; trigger used to avoid ; 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) ;; syslog has to be initialized befor CLF-logging ;; 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) (let ((logport (cond ((string? logfile) ; try to open logfile for appending (output) (open-logfile logfile)) ((output-port? logfile) ; we were given an output port, so let's use it logfile) ((eq? logfile #f) ; no logging demanded #f) ; unexpected value of logfile; (else (http-syslog (syslog-level warning) "[httpd] Warning: Logfile was not specified correctly (given: ~S).~% No CLF logging." logfile) (make-null-output-port))))) (if logfile ; if logging was specified, set up the logger (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 (define (init-http-syslog! syslog?) (if syslog? (let ((http-syslog-lock (make-lock))) (set! *http-syslog?* #t) (set! http-syslog (lambda (level fmt . args) (obtain-lock http-syslog-lock) (syslog level (apply format #f fmt args)) (release-lock http-syslog-lock)))))) (define (make-http-log-proc http-log-lock) ; (display "--- MARK (server started) ---\n" http-log-port) (lambda (req reply-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 reply-code 23 ; filesize (unknown) (get-header (request:headers req) 'referer) (get-header (request:headers req) 'user-agent)) (http-log-port)) (force-output (http-log-port)) (release-lock http-log-lock))))) ;; does the logfile rotation on signal USR1 (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) (http-syslog (syslog-level warning) "[httpd] Warning: An error occured while opening ~S for writing (~A).~%Send signal USR1 when the problem is fixed.~%" logfile (car packet)) (make-null-output-port)) (lambda () (open-output-file logfile (bitwise-ior open/create open/append))))) ; returns a string for a CLF entry (Common Log Format) ; 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) (format #f "~A - - ~A ~S ~A ~A ~S ~S~%" (or remote-ip "-") (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. (or http-code "-") (or filesize "-") (if (string? referer) (string-trim referer) "") (if (string? user-agent) (string-trim user-agent char-set:whitespace) "")))