From ee5aba4cf5873474ff1db52fb98fc9d68e604595 Mon Sep 17 00:00:00 2001
From: sperber <sperber>
Date: Thu, 27 Feb 2003 09:01:45 +0000
Subject: [PATCH] Fix reply generation for data transfer errors and aborts.

---
 scheme/ftpd/ftpd.scm | 18 ++++++++++--------
 1 file changed, 10 insertions(+), 8 deletions(-)

diff --git a/scheme/ftpd/ftpd.scm b/scheme/ftpd/ftpd.scm
index 1237ee6..bb21f4a 100644
--- a/scheme/ftpd/ftpd.scm
+++ b/scheme/ftpd/ftpd.scm
@@ -884,7 +884,6 @@
 (define (handle-port stuff)
   (log-command (syslog-level info) "PORT" stuff)
   (ensure-authenticated-login)
-  (maybe-close-data-connection)
   (call-with-values
    (lambda () (ftpd-parse-port-arg stuff))
    (lambda (address port)
@@ -915,7 +914,6 @@
 (define (handle-pasv stuff)
   (log-command (syslog-level info) "PASV")
   (ensure-authenticated-login)
-  (maybe-close-data-connection)
   (let ((socket (create-socket protocol-family/internet
 			       socket-type/stream)))
     
@@ -1165,9 +1163,15 @@
       (log (syslog-level debug) "authenticated login ensured")))
 
 (define (with-data-connection thunk)
-  (dynamic-wind ensure-data-connection
-		thunk
-		maybe-close-data-connection))
+  (ensure-data-connection)
+  (with-fatal-error-handler*
+   (lambda (condition more)
+     (maybe-close-data-connection))
+   (lambda ()
+     (thunk)
+     (maybe-close-data-connection)
+     (log (syslog-level debug) "closing data connection (226)")
+     (register-reply! 226 "Closing data connection."))))
 
 (define *window-size* 4096)
 
@@ -1202,8 +1206,6 @@
       (close-socket (the-session-data-socket)))
   (if (the-session-passive-socket)
       (close-socket (the-session-passive-socket)))
-  (log (syslog-level debug) "closing data connection (226)")
-  (register-reply! 226 "Closing data connection.")
   (set-the-session-data-socket! #f)
   (set-the-session-passive-socket! #f))
 
@@ -1307,7 +1309,7 @@
 
 (define (register-reply! code . messages)
   (if (the-session-reply-code)
-      (apply error "tried to register more than one reply" code messages)
+      (apply error "tried to register more than one reply" code messages (the-session-replies))
       (apply replace-reply! code messages)))
 
 (define (replace-reply! code . messages)