move global variables in httpd-logging to preserved-thread-fluids

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

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)

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)))