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)
;; "handling command ~S with argument ~S"
;; command arg)
(with-fatal-error-handler*
(lambda (condition more)
(cond
((error? condition)
(let ((reason (condition-stuff condition)))
(log (syslog-level notice)
"internal error occured: ~S (maybe reason: ~S) -- replying and escaping (451)"
condition reason)
(replace-reply! 451
(format #f "Internal error: ~S" reason))))
((ftpd-error? condition)
;; debug level because nearly every unsuccessful command ends
;; here (no args, can't change dir, etc.)
(log (syslog-level debug)
"ftpd error occured (maybe reason: ~S)-- escaping" (condition-stuff condition)))
(else
(more))))
(lambda ()
(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))))
(call-with-current-continuation
(lambda (exit)
(with-handler
(lambda (condition more)
(cond
((error? condition)
(let ((reason (condition-stuff condition)))
(log (syslog-level notice)
"internal error occured: ~S (maybe reason: ~S) -- replying and escaping (451)"
condition reason)
(replace-reply! 451
(format #f "Internal error: ~S" reason))
(exit)))
((ftpd-error? condition)
;; debug level because nearly every unsuccessful command ends
;; here (no args, can't change dir, etc.)
(log (syslog-level debug)
"ftpd error occured (maybe reason: ~S)-- escaping" (condition-stuff condition))
(exit))
(else
(more))))
(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)
; (log (syslog-level debug)