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

Fix condition handling in HANDLE-COMMAND.

This commit is contained in:
sperber 2003-02-14 15:58:17 +00:00
parent 4c2a10f0ff
commit 001c86f6d2
1 changed files with 31 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
scheme/ftpd/ftpd.scm
View File

@ -515,34 +515,38 @@
;; (log (syslog-level debug) ;; (log (syslog-level debug)
;; "handling command ~S with argument ~S" ;; "handling command ~S with argument ~S"
;; command arg) ;; command arg)
(with-fatal-error-handler* (call-with-current-continuation
(lambda (condition more) (lambda (exit)
(cond (with-handler
((error? condition) (lambda (condition more)
(let ((reason (condition-stuff condition))) (cond
(log (syslog-level notice) ((error? condition)
"internal error occured: ~S (maybe reason: ~S) -- replying and escaping (451)" (let ((reason (condition-stuff condition)))
condition reason) (log (syslog-level notice)
(replace-reply! 451 "internal error occured: ~S (maybe reason: ~S) -- replying and escaping (451)"
(format #f "Internal error: ~S" reason)))) condition reason)
((ftpd-error? condition) (replace-reply! 451
;; debug level because nearly every unsuccessful command ends (format #f "Internal error: ~S" reason))
;; here (no args, can't change dir, etc.) (exit)))
(log (syslog-level debug) ((ftpd-error? condition)
"ftpd error occured (maybe reason: ~S)-- escaping" (condition-stuff condition))) ;; debug level because nearly every unsuccessful command ends
(else ;; here (no args, can't change dir, etc.)
(more)))) (log (syslog-level debug)
(lambda () "ftpd error occured (maybe reason: ~S)-- escaping" (condition-stuff condition))
(with-errno-handler* (exit))
(lambda (errno packet) (else
(let ((unix-error (car packet))) (more))))
(log (syslog-level notice)
"unix error occured: ~S -- replying (451) and escaping"
unix-error)
(replace-reply! 451
(format #f "Unix error: ~A." unix-error))))
(lambda () (lambda ()
(dispatch-command command arg)))))) (with-errno-handler*
(lambda (errno packet)
(let ((unix-error (car packet)))
(log (syslog-level notice)
"unix error occured: ~S -- replying (451) and escaping"
unix-error)
(replace-reply! 451
(format #f "Unix error: ~A." unix-error))))
(lambda ()
(dispatch-command command arg))))))))
(define (dispatch-command command arg) (define (dispatch-command command arg)
; (log (syslog-level debug) ; (log (syslog-level debug)