suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

up

Browse Source 
svn: r4435
This commit is contained in:
Jay McCarthy 2006-09-26 05:08:04 +00:00
parent 33f93c0d2e
commit f22e9424e2
1 changed files with 31 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
collects/web-server/dispatchers/dispatch-log.ss
View File

@ -21,15 +21,15 @@
[(parenthesized-default)
(let ([log-message (gen-log-message log-format log-path)])
(lambda (conn req)
(let ([host (get-host (request-uri req) (request-headers/raw req))])
(log-message (request-host-ip req)
(request-client-ip req)
(request-method req)
(request-uri req)
host)
(next-dispatcher))))]
(log-message (request-host-ip req)
(request-client-ip req)
(request-method req)
(request-uri req)
(get-host (request-uri req) (request-headers/raw req)))
(next-dispatcher)))]
[else
(lambda (conn req) (next-dispatcher))])
(lambda (conn req)
(next-dispatcher))])
(lambda (conn req)
(next-dispatcher))))
@ -45,25 +45,29 @@
(thread/suspend-to-kill
(lambda ()
(let loop ([log-p #f])
(with-handlers ([exn? (lambda (e) (loop #f))])
(if (not (and log-p (file-exists? log-path)))
(begin
(unless (eq? log-p #f)
(close-output-port log-p))
(let ([new-log-p (open-output-file log-path 'append)])
(file-stream-buffer-mode new-log-p 'line)
(loop new-log-p)))
(sync
(handle-evt
log-ch
(match-lambda
[(list host-ip client-ip method uri host)
(display
(format "~s~n"
(list 'from client-ip 'to host-ip 'for (url->string uri) 'at
(date->string (seconds->date (current-seconds)) #t)))
log-p)
(loop log-p)])))))))))
(sync
(handle-evt
log-ch
(match-lambda
[(list host-ip client-ip method uri host)
(with-handlers ([exn? (lambda (e)
((error-display-handler) "dispatch-log.ss: Error writing log entry" e)
(loop #f))])
(define the-log-p
(if (not (and log-p (file-exists? log-path)))
(begin
(unless (eq? log-p #f)
(close-output-port log-p))
(let ([new-log-p (open-output-file log-path 'append)])
(file-stream-buffer-mode new-log-p 'line)
new-log-p))
log-p))
(display
(format "~s~n"
(list 'from client-ip 'to host-ip 'for (url->string uri) 'at
(date->string (seconds->date (current-seconds)) #t)))
the-log-p)
(loop the-log-p))])))))))
(lambda args
(thread-resume log-thread (current-custodian))
(async-channel-put log-ch args)