adding dns-lookup to ftpd logging
This commit is contained in:
parent
be5e206eb1
commit
a2c39de2b9
|
@ -19,6 +19,7 @@
|
|||
; - default value for ftpd should be looked up as in ftp.scm
|
||||
|
||||
(define *logfile* #f) ; file-port to log to like wu-ftpd (analyzable with webalizer)
|
||||
(define *dns-lookup?* #f) ; perform dns-lookup for ips in logfile?
|
||||
|
||||
(define-record session
|
||||
control-input-port
|
||||
|
@ -125,7 +126,12 @@
|
|||
; 13 authenticated user id (if available, '*' otherwise)
|
||||
;
|
||||
(define file-log
|
||||
(let ((file-log-lock (make-lock)))
|
||||
(let ((file-log-lock (make-lock))
|
||||
(maybe-dns-lookup (lambda (ip)
|
||||
(if *dns-lookup?*
|
||||
(or (dns-lookup-ip ip)
|
||||
ip)
|
||||
ip))))
|
||||
(lambda (start-transfer-seconds info full-path direction)
|
||||
(if *logfile*
|
||||
(begin
|
||||
|
@ -133,7 +139,9 @@
|
|||
(format *logfile* "~A ~A ~A ~A ~A ~A _ ~A a nop@ssword ftp 0 *~%"
|
||||
(format-date "~a ~b ~d ~H:~M:~S ~Y" (date)) ; current date and time
|
||||
(- (current-seconds) start-transfer-seconds) ; transfer time in secs
|
||||
(socket-address->string (socket-remote-address (session-data-socket)) #f) ; remote host name
|
||||
(maybe-dns-lookup
|
||||
(socket-address->string
|
||||
(socket-remote-address (session-data-socket)) #f)) ; remote host ip
|
||||
(file-info:size info) ; file size in bytes
|
||||
(string-map (lambda (c)
|
||||
(if (eq? c #\space) #\_ c))
|
||||
|
@ -188,10 +196,14 @@
|
|||
(let-optionals
|
||||
maybe-args
|
||||
((port 21)
|
||||
(logfile #f))
|
||||
(logfile #f)
|
||||
(dns-lookup? #f))
|
||||
|
||||
(if logfile
|
||||
(set! *logfile* (open-output-file logfile (bitwise-ior open/create open/append))))
|
||||
(if dns-lookup?
|
||||
(set! *dns-lookup?* #t)
|
||||
(set! *dns-lookup?* #f))
|
||||
(with-syslog-destination
|
||||
"ftpd"
|
||||
#f
|
||||
|
@ -1217,7 +1229,7 @@
|
|||
|
||||
; Version
|
||||
|
||||
(define *ftpd-version* "$Revision: 1.3 $")
|
||||
(define *ftpd-version* "$Revision: 1.4 $")
|
||||
|
||||
(define (copy-port->port-binary input-port output-port)
|
||||
(let ((buffer (make-string *window-size*)))
|
||||
|
|
|
@ -622,6 +622,7 @@
|
|||
defrec-package
|
||||
crlf-io
|
||||
ls
|
||||
dns
|
||||
let-opt
|
||||
receiving ; RECEIVE
|
||||
format-net) ; pretty print of internet-addresses
|
||||
|
|
Loading…
Reference in New Issue