move global variables in httpd-logging to preserved-thread-fluids
This commit is contained in:
parent
f9060d992a
commit
becf14ce30
|
@ -35,62 +35,67 @@
|
||||||
((httpd-options-simultaneous-requests options)
|
((httpd-options-simultaneous-requests options)
|
||||||
=> make-rate-limiter)
|
=> make-rate-limiter)
|
||||||
(else #f))))
|
(else #f))))
|
||||||
(init-http-log! options)
|
(let-thread-fluid
|
||||||
(with-syslog-destination
|
logging
|
||||||
"httpd" #f #f #f
|
(make-logging)
|
||||||
(lambda ()
|
(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
|
(init-http-log! options)
|
||||||
(lambda (c decline)
|
(with-syslog-destination
|
||||||
(http-syslog (syslog-level notice) "error during connection negotiation~%")
|
"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
|
(if rate-limiter
|
||||||
(rate-limit-close rate-limiter)))
|
(begin
|
||||||
(call-with-values
|
(rate-limit-block rate-limiter)
|
||||||
(lambda ()
|
(rate-limit-open rate-limiter)))
|
||||||
(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)))
|
|
||||||
|
|
||||||
(set-port-buffering (socket:outport sock) bufpol/none) ; No buffering
|
(with-fatal-error-handler
|
||||||
(fork-thread
|
(lambda (c decline)
|
||||||
|
(http-syslog (syslog-level notice) "error during connection negotiation~%")
|
||||||
|
(if rate-limiter
|
||||||
|
(rate-limit-close rate-limiter)))
|
||||||
|
(call-with-values
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(set-port-buffering (current-input-port) bufpol/none)
|
(socket-address->internet-address (socket-remote-address sock)))
|
||||||
(process-toplevel-request sock host-address options)
|
(lambda (host-address service-port)
|
||||||
(if (http-syslog?)
|
(if (and rate-limiter (http-syslog?))
|
||||||
(http-syslog (syslog-level debug) "<~a>~a [closing]~%"
|
(http-syslog (syslog-level info) "<~a>~a: concurrent request #~a~%"
|
||||||
(pid)
|
(pid)
|
||||||
(format-internet-host-address host-address)))
|
(format-internet-host-address host-address)
|
||||||
(with-fatal-error-handler
|
(rate-limiter-current-requests rate-limiter)))
|
||||||
(lambda (c decline)
|
|
||||||
|
(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?)
|
(if (http-syslog?)
|
||||||
(http-syslog (syslog-level notice) "<~a>~a [error closing (~a)]~%"
|
(http-syslog (syslog-level debug) "<~a>~a [closing]~%"
|
||||||
(pid)
|
(pid)
|
||||||
(format-internet-host-address host-address)
|
(format-internet-host-address host-address)))
|
||||||
c)))
|
(with-fatal-error-handler
|
||||||
(close-socket sock))
|
(lambda (c decline)
|
||||||
(if rate-limiter
|
(if (http-syslog?)
|
||||||
(rate-limit-close rate-limiter))
|
(http-syslog (syslog-level notice) "<~a>~a [error closing (~a)]~%"
|
||||||
(if (http-syslog?)
|
(pid)
|
||||||
(http-syslog (syslog-level info) "<~a>~a [closed]~%"
|
(format-internet-host-address host-address)
|
||||||
(pid)
|
c)))
|
||||||
(format-internet-host-address host-address)))))))))
|
(close-socket sock))
|
||||||
port))))))
|
(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
|
;;; Top-level http request processor
|
||||||
|
|
|
@ -16,14 +16,14 @@
|
||||||
(http-syslog-proc do-nothing-proc) ;proc to run for syslog (level fmt . args)
|
(http-syslog-proc do-nothing-proc) ;proc to run for syslog (level fmt . args)
|
||||||
(dns-lookup? #f)) ;perform dns-lookups?
|
(dns-lookup? #f)) ;perform dns-lookups?
|
||||||
|
|
||||||
(define logging (make-fluid #f))
|
(define logging (make-preserved-thread-fluid #f))
|
||||||
|
|
||||||
(define (make-fluid-selector selector)
|
(define (make-fluid-selector selector)
|
||||||
(lambda () (selector (fluid logging))))
|
(lambda () (selector (thread-fluid logging))))
|
||||||
|
|
||||||
(define (make-fluid-setter setter)
|
(define (make-fluid-setter setter)
|
||||||
(lambda (value)
|
(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-log-proc (make-fluid-selector logging:http-log-proc))
|
||||||
(define logging-http-syslog-proc (make-fluid-selector logging:http-syslog-proc))
|
(define logging-http-syslog-proc (make-fluid-selector logging:http-syslog-proc))
|
||||||
|
@ -51,7 +51,6 @@
|
||||||
(define (init-http-log! options)
|
(define (init-http-log! options)
|
||||||
;; syslog has to be initialized before CLF-logging
|
;; syslog has to be initialized before CLF-logging
|
||||||
;; because the latter may generate syslog-messages
|
;; because the latter may generate syslog-messages
|
||||||
(set! logging (make-fluid (make-logging)))
|
|
||||||
(init-http-syslog! (httpd-options-syslog? options))
|
(init-http-syslog! (httpd-options-syslog? options))
|
||||||
(init-http-port-log! (httpd-options-logfile options))
|
(init-http-port-log! (httpd-options-logfile options))
|
||||||
(if (httpd-options-resolve-ips? options)
|
(if (httpd-options-resolve-ips? options)
|
||||||
|
|
|
@ -697,6 +697,7 @@
|
||||||
enumerated ; enum
|
enumerated ; enum
|
||||||
architecture ; exception, os-error
|
architecture ; exception, os-error
|
||||||
|
|
||||||
|
|
||||||
handle-fatal-error
|
handle-fatal-error
|
||||||
httpd-read-options
|
httpd-read-options
|
||||||
httpd-error
|
httpd-error
|
||||||
|
@ -745,7 +746,8 @@
|
||||||
threads ; spawn
|
threads ; spawn
|
||||||
dns ; dns-lookup-ip
|
dns ; dns-lookup-ip
|
||||||
defrec-package ; define-record
|
defrec-package ; define-record
|
||||||
fluids ; make-fluid et al.
|
thread-fluids ; make-preserved-fluid et al.
|
||||||
|
|
||||||
scsh
|
scsh
|
||||||
scheme)
|
scheme)
|
||||||
(files (httpd logging)))
|
(files (httpd logging)))
|
||||||
|
|
Loading…
Reference in New Issue