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

welsh

Browse Source 
svn: r5590
This commit is contained in:
Jay McCarthy 2007-02-12 14:43:53 +00:00
parent 26e5b8012a
commit e3394a5cf5
1 changed files with 34 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -47,37 +47,40 @@
log-ch
(match-lambda
[(list req)
(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"
(case log-format
[(parenthesized-default)
(list 'from (request-client-ip req)
'to (request-host-ip req)
'for (url->string (request-uri req)) 'at
(date->string (seconds->date (current-seconds)) #t))]
[(extended)
`((client-ip ,(request-client-ip req))
(host-ip ,(request-host-ip req))
(referer ,(let ([R (headers-assq* #"Referer" (request-headers/raw req))])
(if R
(header-value R)
#f)))
(uri ,(url->string (request-uri req)))
(time ,(current-seconds)))]))
the-log-p)
(loop the-log-p))])))))))
(loop
(with-handlers ([exn? (lambda (e)
((error-display-handler) "dispatch-log.ss: Error writing log entry" e)
(with-handlers ([exn? (lambda (e) #f)])
(close-output-port log-p))
#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"
(case log-format
[(parenthesized-default)
(list 'from (request-client-ip req)
'to (request-host-ip req)
'for (url->string (request-uri req)) 'at
(date->string (seconds->date (current-seconds)) #t))]
[(extended)
`((client-ip ,(request-client-ip req))
(host-ip ,(request-host-ip req))
(referer ,(let ([R (headers-assq* #"Referer" (request-headers/raw req))])
(if R
(header-value R)
#f)))
(uri ,(url->string (request-uri req)))
(time ,(current-seconds)))]))
the-log-p)
the-log-p))])))))))
(lambda args
(thread-resume log-thread (current-custodian))
(async-channel-put log-ch args)