Fix condition handling in HANDLE-COMMAND.
This commit is contained in:
parent
4c2a10f0ff
commit
001c86f6d2
|
@ -515,7 +515,9 @@
|
||||||
;; (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 (exit)
|
||||||
|
(with-handler
|
||||||
(lambda (condition more)
|
(lambda (condition more)
|
||||||
(cond
|
(cond
|
||||||
((error? condition)
|
((error? condition)
|
||||||
|
@ -524,12 +526,14 @@
|
||||||
"internal error occured: ~S (maybe reason: ~S) -- replying and escaping (451)"
|
"internal error occured: ~S (maybe reason: ~S) -- replying and escaping (451)"
|
||||||
condition reason)
|
condition reason)
|
||||||
(replace-reply! 451
|
(replace-reply! 451
|
||||||
(format #f "Internal error: ~S" reason))))
|
(format #f "Internal error: ~S" reason))
|
||||||
|
(exit)))
|
||||||
((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 occured (maybe reason: ~S)-- escaping" (condition-stuff condition)))
|
"ftpd error occured (maybe reason: ~S)-- escaping" (condition-stuff condition))
|
||||||
|
(exit))
|
||||||
(else
|
(else
|
||||||
(more))))
|
(more))))
|
||||||
(lambda ()
|
(lambda ()
|
||||||
|
@ -542,7 +546,7 @@
|
||||||
(replace-reply! 451
|
(replace-reply! 451
|
||||||
(format #f "Unix error: ~A." unix-error))))
|
(format #f "Unix error: ~A." unix-error))))
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(dispatch-command command arg))))))
|
(dispatch-command command arg))))))))
|
||||||
|
|
||||||
(define (dispatch-command command arg)
|
(define (dispatch-command command arg)
|
||||||
; (log (syslog-level debug)
|
; (log (syslog-level debug)
|
||||||
|
|
Loading…
Reference in New Issue