From 6156c77161dca1b87a8d2d7ecb182767dfebba18 Mon Sep 17 00:00:00 2001
From: mainzelm <mainzelm>
Date: Thu, 19 Dec 2002 17:11:38 +0000
Subject: [PATCH] Put port for logging into session.

---
 scheme/ftpd/ftpd.scm | 64 +++++++++++++++++++++++++-------------------
 1 file changed, 37 insertions(+), 27 deletions(-)

diff --git a/scheme/ftpd/ftpd.scm b/scheme/ftpd/ftpd.scm
index c82318e..7f48a45 100644
--- a/scheme/ftpd/ftpd.scm
+++ b/scheme/ftpd/ftpd.scm
@@ -90,7 +90,8 @@
 		       reply-code
 		       type
 		       data-socket
-		       passive-socket)
+		       passive-socket
+		       maybe-log-port)
   session?
   (control-input-port session-control-input-port
 		      set-session-control-input-port!)
@@ -118,9 +119,11 @@
   (data-socket session-data-socket
 	       set-session-data-socket!)
   (passive-socket session-passive-socket
-		  set-session-passive-socket!))
+		  set-session-passive-socket!)
+  (maybe-log-port session-maybe-log-port
+		  set-session-maybe-log-port!))
 
-(define (make-session input-port output-port)
+(define (make-session input-port output-port maybe-log-port)
   (really-make-session input-port output-port
 		       (make-lock)
 		       #f		; logged-in?
@@ -134,6 +137,7 @@
 		       'ascii		; type
 		       #f		; data-socket
 		       #f		; passive-socket
+		       maybe-log-port
 		       ))
 
 (define session (make-fluid #f))
@@ -165,6 +169,7 @@
 (define the-session-type (make-session-selector session-type))
 (define the-session-data-socket (make-session-selector session-data-socket)) 
 (define the-session-passive-socket (make-session-selector session-passive-socket))
+(define the-session-maybe-log-port (make-session-selector session-maybe-log-port))
 
 (define set-the-session-control-input-port! 
   (make-session-modifier set-session-control-input-port!))
@@ -192,6 +197,8 @@
   (make-session-modifier set-session-data-socket!)) 
 (define set-the-session-passive-socket!
   (make-session-modifier set-session-passive-socket!))
+(define set-the-session-maybe-log-port!
+  (make-session-modifier set-session-maybe-log-port!))
 
 (define (make-ftpd-options-selector selector)
   (lambda ()
@@ -260,10 +267,10 @@
 				    ip))
 			    ip)))
     (lambda (start-transfer-seconds info full-path direction)
-      (if (the-ftpd-options-logfile)
+      (if (the-session-maybe-log-port)
 	  (begin
 	    (obtain-lock (the-session-logfile-lock))
-	    (format (the-ftpd-options-logfile)
+	    (format (the-session-maybe-log-port)
 		    "~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
@@ -285,18 +292,18 @@
 					; authentication mode
 					; authenticated user id'
 		    )
-	    (force-output (the-ftpd-options-logfile))
+	    (force-output (the-session-maybe-log-port))
 	    (release-lock (the-session-logfile-lock)))))))
 
-(define (open-logfile logfile)
+(define (maybe-open-logfile maybe-logfile)
   (with-errno-handler
    ((errno packet)
     (else
      (format (current-error-port) 
 	     "[ftpd] Warning: Unable to write logs to ~S. Logging is now made to (current-error-port).~%[ftpd]          (To disable logging at all, either leave the logfile argument or give #f as logfile)~%")
 	   (current-error-port)))
-   (and logfile  
-	(open-output-file logfile 
+   (and maybe-logfile
+	(open-output-file maybe-logfile 
 			  (bitwise-ior open/create open/append)))))
     
 ;;; CONVERTERS ------------------------------------------------	    
@@ -335,21 +342,22 @@
 	  (expand-file-name (ftpd-options-anonymous-home ftpd-options)
 			    (cwd))
 	  (ftpd-options-logfile ftpd-options))
+     (let ((maybe-log-port (maybe-open-logfile (ftpd-options-logfile ftpd-options))))
+       (bind-listen-accept-loop
+	protocol-family/internet
+	(lambda (socket address)
+	  (let ((remote-address (socket-address->string address)))
+	    (set-ftp-socket-options! socket)
+	    (fork-thread
+	     (lambda ()
+	       (handle-connection-encapsulated ftpd-options
+					       socket
+					       address
+					       remote-address
+					       maybe-log-port)))))
+	(ftpd-options-port ftpd-options))))))
 
-     (bind-listen-accept-loop
-      protocol-family/internet
-      (lambda (socket address)
-	(let ((remote-address (socket-address->string address)))
-	  (set-ftp-socket-options! socket)
-	  (fork-thread
-	   (lambda ()
-	     (handle-connection-encapsulated ftpd-options
-					     socket
-					     address
-					     remote-address)))))
-      (ftpd-options-port ftpd-options)))))
-
-(define (handle-connection-encapsulated ftpd-options socket address remote-address)
+(define (handle-connection-encapsulated ftpd-options socket address remote-address maybe-log-port)
   (call-with-current-continuation
    (lambda (exit)
      (with-errno-handler*
@@ -372,7 +380,8 @@
 	   (lambda ()
 	     (handle-connection ftpd-options
 				(socket:inport socket) 
-				(socket:outport socket)))
+				(socket:outport socket)
+				maybe-log-port))
 	   (lambda ()
 	     (log (syslog-level debug)
 		  "shutting down socket ~S"
@@ -406,7 +415,8 @@
 			    (cwd)))
      (handle-connection ftpd-options
 			(current-input-port)
-			(current-output-port)))))
+			(current-output-port)
+			(maybe-open-logfile (ftpd-options-logfile ftpd-options))))))
 
 (define (set-ftp-socket-options! socket)
   ;; If the client closes the connection, we won't lose when we try to
@@ -420,7 +430,7 @@
   (set-socket-option socket level/socket socket/oob-inline #t))
 
 
-(define (handle-connection ftpd-options input-port output-port)
+(define (handle-connection ftpd-options input-port output-port maybe-log-port)
   (log (syslog-level debug)
        "handling connection with input port ~A, output port ~A"
        input-port
@@ -436,7 +446,7 @@
 	(escape 'fick-dich-ins-knie))
       (lambda ()
 	(let-fluids
-	 session (make-session input-port output-port)
+	 session (make-session input-port output-port maybe-log-port)
 	 options ftpd-options
 	 (lambda ()
 	   (display-banner)