From a2c39de2b98de53ee4eecafd1c0c4a95d869714e Mon Sep 17 00:00:00 2001
From: interp <interp>
Date: Thu, 22 Aug 2002 17:12:08 +0000
Subject: [PATCH] adding dns-lookup to ftpd logging

---
 scheme/ftpd/ftpd.scm | 20 ++++++++++++++++----
 scheme/packages.scm  |  1 +
 2 files changed, 17 insertions(+), 4 deletions(-)

diff --git a/scheme/ftpd/ftpd.scm b/scheme/ftpd/ftpd.scm
index 1bcad4f..be6e6cd 100644
--- a/scheme/ftpd/ftpd.scm
+++ b/scheme/ftpd/ftpd.scm
@@ -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*)))
diff --git a/scheme/packages.scm b/scheme/packages.scm
index 15d75f3..a7712e7 100644
--- a/scheme/packages.scm
+++ b/scheme/packages.scm
@@ -622,6 +622,7 @@
 	defrec-package
 	crlf-io
 	ls
+	dns
 	let-opt
 	receiving                   ; RECEIVE
 	format-net)                 ; pretty print of internet-addresses