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

+ Moved WITH-DATA-CONNECTION closer to call to LS to avoid stray connections in case of an error 

+ Call surrounding exception handler in WITH-DATA-CONNECTION

+ Add arguments to two calls of escape proecures
This commit is contained in:
mainzelm 2003-07-28 07:50:16 +00:00
parent d7fb759988
commit 0656c89fca
1 changed files with 44 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
scheme/ftpd/ftpd.scm
View File

@ -533,13 +533,13 @@
condition reason) condition reason)
(replace-reply! 451 (replace-reply! 451
(format #f "Internal error: ~S" reason)) (format #f "Internal error: ~S" reason))
(exit))) (exit 'fick-dich-ins-knie)))
((ftpd-error? condition) ((ftpd-error? condition)
;; debug level because nearly every unsuccessful command ends ;; debug level because nearly every unsuccessful command ends
;; here (no args, can't change dir, etc.) ;; here (no args, can't change dir, etc.)
(log (syslog-level debug) (log (syslog-level debug)
"ftpd error occurred (maybe reason: ~S)-- escaping" (condition-stuff condition)) "ftpd error occurred (maybe reason: ~S)-- escaping" (condition-stuff condition))
(exit)) (exit 'fick-dich-ins-knie))
(else (else
(more)))) (more))))
(lambda () (lambda ()
@ -972,8 +972,6 @@
(define (handle-listing arg preset-flags) (define (handle-listing arg preset-flags)
(ensure-authenticated-login) (ensure-authenticated-login)
(with-data-connection
(lambda ()
(let ((args (split-arguments arg))) (let ((args (split-arguments arg)))
(call-with-values (call-with-values
(lambda () (lambda ()
@ -1003,8 +1001,7 @@
(log (syslog-level debug) (log (syslog-level debug)
"sending file-listing for path ~S with flags ~A" "sending file-listing for path ~S with flags ~A"
path all-flags) path all-flags)
(generate-listing path all-flags)))))))
(generate-listing path all-flags)))))))))
; Note this doesn't call ENSURE-AUTHENTICATED-LOGIN or ; Note this doesn't call ENSURE-AUTHENTICATED-LOGIN or
; ENSURE-DATA-CONNECTION. ; ENSURE-DATA-CONNECTION.
@ -1026,6 +1023,8 @@
(lambda () (lambda ()
(with-cwd* (with-cwd*
(file-name-directory full-path) (file-name-directory full-path)
(lambda ()
(with-data-connection
(lambda () (lambda ()
(let ((nondir (file-name-nondirectory full-path))) (let ((nondir (file-name-nondirectory full-path)))
(let-fluid (let-fluid
@ -1037,7 +1036,7 @@
(if (string=? nondir "") (if (string=? nondir "")
"." "."
nondir)) nondir))
(socket:outport (the-session-data-socket)))))))))))) (socket:outport (the-session-data-socket))))))))))))))
(define (handle-abor foo) (define (handle-abor foo)
(log-command (syslog-level info) "ABOR") (log-command (syslog-level info) "ABOR")
@ -1215,7 +1214,8 @@
(ensure-data-connection) (ensure-data-connection)
(with-fatal-error-handler* (with-fatal-error-handler*
(lambda (condition more) (lambda (condition more)
(maybe-close-data-connection)) (maybe-close-data-connection)
(more))
(lambda () (lambda ()
(thunk) (thunk)
(maybe-close-data-connection) (maybe-close-data-connection)