From becf14ce306cebd901d2a6d2e2e1bc23ff6d0190 Mon Sep 17 00:00:00 2001 From: interp Date: Thu, 5 Sep 2002 10:55:30 +0000 Subject: [PATCH] move global variables in httpd-logging to preserved-thread-fluids --- scheme/httpd/core.scm | 103 ++++++++++++++++++++------------------- scheme/httpd/logging.scm | 7 ++- scheme/packages.scm | 4 +- 3 files changed, 60 insertions(+), 54 deletions(-) diff --git a/scheme/httpd/core.scm b/scheme/httpd/core.scm index 96ede84..50774ae 100644 --- a/scheme/httpd/core.scm +++ b/scheme/httpd/core.scm @@ -35,62 +35,67 @@ ((httpd-options-simultaneous-requests options) => make-rate-limiter) (else #f)))) - (init-http-log! options) - (with-syslog-destination - "httpd" #f #f #f + (let-thread-fluid + logging + (make-logging) (lambda () - (with-cwd - root-dir - (bind-listen-accept-loop - protocol-family/internet - ;; Why is the output socket unbuffered? So that if the client - ;; closes the connection, we won't lose when we try to close the - ;; socket by trying to flush the output buffer. - (lambda (sock addr) - (if rate-limiter - (begin - (rate-limit-block rate-limiter) - (rate-limit-open rate-limiter))) - (with-fatal-error-handler - (lambda (c decline) - (http-syslog (syslog-level notice) "error during connection negotiation~%") + (init-http-log! options) + (with-syslog-destination + "httpd" #f #f #f + (lambda () + (with-cwd + root-dir + (bind-listen-accept-loop + protocol-family/internet + ;; Why is the output socket unbuffered? So that if the client + ;; closes the connection, we won't lose when we try to close the + ;; socket by trying to flush the output buffer. + (lambda (sock addr) (if rate-limiter - (rate-limit-close rate-limiter))) - (call-with-values - (lambda () - (socket-address->internet-address (socket-remote-address sock))) - (lambda (host-address service-port) - (if (and rate-limiter (http-syslog?)) - (http-syslog (syslog-level info) "<~a>~a: concurrent request #~a~%" - (pid) - (format-internet-host-address host-address) - (rate-limiter-current-requests rate-limiter))) + (begin + (rate-limit-block rate-limiter) + (rate-limit-open rate-limiter))) - (set-port-buffering (socket:outport sock) bufpol/none) ; No buffering - (fork-thread - (lambda () - (set-port-buffering (current-input-port) bufpol/none) - (process-toplevel-request sock host-address options) - (if (http-syslog?) - (http-syslog (syslog-level debug) "<~a>~a [closing]~%" + (with-fatal-error-handler + (lambda (c decline) + (http-syslog (syslog-level notice) "error during connection negotiation~%") + (if rate-limiter + (rate-limit-close rate-limiter))) + (call-with-values + (lambda () + (socket-address->internet-address (socket-remote-address sock))) + (lambda (host-address service-port) + (if (and rate-limiter (http-syslog?)) + (http-syslog (syslog-level info) "<~a>~a: concurrent request #~a~%" (pid) - (format-internet-host-address host-address))) - (with-fatal-error-handler - (lambda (c decline) + (format-internet-host-address host-address) + (rate-limiter-current-requests rate-limiter))) + + (set-port-buffering (socket:outport sock) bufpol/none) ; No buffering + (fork-thread + (lambda () + (set-port-buffering (current-input-port) bufpol/none) + (process-toplevel-request sock host-address options) (if (http-syslog?) - (http-syslog (syslog-level notice) "<~a>~a [error closing (~a)]~%" + (http-syslog (syslog-level debug) "<~a>~a [closing]~%" (pid) - (format-internet-host-address host-address) - c))) - (close-socket sock)) - (if rate-limiter - (rate-limit-close rate-limiter)) - (if (http-syslog?) - (http-syslog (syslog-level info) "<~a>~a [closed]~%" - (pid) - (format-internet-host-address host-address))))))))) - port)))))) + (format-internet-host-address host-address))) + (with-fatal-error-handler + (lambda (c decline) + (if (http-syslog?) + (http-syslog (syslog-level notice) "<~a>~a [error closing (~a)]~%" + (pid) + (format-internet-host-address host-address) + c))) + (close-socket sock)) + (if rate-limiter + (rate-limit-close rate-limiter)) + (if (http-syslog?) + (http-syslog (syslog-level info) "<~a>~a [closed]~%" + (pid) + (format-internet-host-address host-address))))))))) + port)))))))) ;;; Top-level http request processor diff --git a/scheme/httpd/logging.scm b/scheme/httpd/logging.scm index 89ba193..9196a2e 100644 --- a/scheme/httpd/logging.scm +++ b/scheme/httpd/logging.scm @@ -16,14 +16,14 @@ (http-syslog-proc do-nothing-proc) ;proc to run for syslog (level fmt . args) (dns-lookup? #f)) ;perform dns-lookups? -(define logging (make-fluid #f)) +(define logging (make-preserved-thread-fluid #f)) (define (make-fluid-selector selector) - (lambda () (selector (fluid logging)))) + (lambda () (selector (thread-fluid logging)))) (define (make-fluid-setter setter) (lambda (value) - (setter (fluid logging) value))) + (setter (thread-fluid logging) value))) (define logging-http-log-proc (make-fluid-selector logging:http-log-proc)) (define logging-http-syslog-proc (make-fluid-selector logging:http-syslog-proc)) @@ -51,7 +51,6 @@ (define (init-http-log! options) ;; syslog has to be initialized before CLF-logging ;; because the latter may generate syslog-messages - (set! logging (make-fluid (make-logging))) (init-http-syslog! (httpd-options-syslog? options)) (init-http-port-log! (httpd-options-logfile options)) (if (httpd-options-resolve-ips? options) diff --git a/scheme/packages.scm b/scheme/packages.scm index 1d7ebfe..b9259ec 100644 --- a/scheme/packages.scm +++ b/scheme/packages.scm @@ -696,6 +696,7 @@ fluids ; let-fluid enumerated ; enum architecture ; exception, os-error + handle-fatal-error httpd-read-options @@ -745,7 +746,8 @@ threads ; spawn dns ; dns-lookup-ip defrec-package ; define-record - fluids ; make-fluid et al. + thread-fluids ; make-preserved-fluid et al. + scsh scheme) (files (httpd logging)))