scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

adding dns-lookup to ftpd logging

This commit is contained in:
interp 2002-08-22 17:12:08 +00:00
parent be5e206eb1
commit a2c39de2b9
2 changed files with 17 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
scheme/ftpd/ftpd.scm
View File

@ -19,6 +19,7 @@
; - default value for ftpd should be looked up as in ftp.scm ; - 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 *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 (define-record session
control-input-port control-input-port
@ -125,7 +126,12 @@
; 13 authenticated user id (if available, '*' otherwise) ; 13 authenticated user id (if available, '*' otherwise)
; ;
(define file-log (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) (lambda (start-transfer-seconds info full-path direction)
(if *logfile* (if *logfile*
(begin (begin
@ -133,7 +139,9 @@
(format *logfile* "~A ~A ~A ~A ~A ~A _ ~A a nop@ssword ftp 0 *~%" (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 (format-date "~a ~b ~d ~H:~M:~S ~Y" (date)) ; current date and time
(- (current-seconds) start-transfer-seconds) ; transfer time in secs (- (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 (file-info:size info) ; file size in bytes
(string-map (lambda (c) (string-map (lambda (c)
(if (eq? c #\space) #\_ c)) (if (eq? c #\space) #\_ c))
@ -188,10 +196,14 @@
(let-optionals (let-optionals
maybe-args maybe-args
((port 21) ((port 21)
(logfile #f)) (logfile #f)
(dns-lookup? #f))
(if logfile (if logfile
(set! *logfile* (open-output-file logfile (bitwise-ior open/create open/append)))) (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 (with-syslog-destination
"ftpd" "ftpd"
#f #f
@ -1217,7 +1229,7 @@
; Version ; Version
(define *ftpd-version* "$Revision: 1.3 $") (define *ftpd-version* "$Revision: 1.4 $")
(define (copy-port->port-binary input-port output-port) (define (copy-port->port-binary input-port output-port)
(let ((buffer (make-string *window-size*))) (let ((buffer (make-string *window-size*)))

1
scheme/packages.scm
View File

@ -622,6 +622,7 @@
defrec-package defrec-package
crlf-io crlf-io
ls ls
dns
let-opt let-opt
receiving ; RECEIVE receiving ; RECEIVE
format-net) ; pretty print of internet-addresses format-net) ; pretty print of internet-addresses