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

Be more careful about catching errors. 

Add a few log statements.
This commit is contained in:
sperber 2002-02-21 16:21:05 +00:00
parent 24214819dc
commit 001f9a511b
1 changed files with 35 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
ftpd.scm
View File

@ -154,16 +154,10 @@
(lambda (exit) (lambda (exit)
(with-errno-handler* (with-errno-handler*
(lambda (errno packet) (lambda (errno packet)
(cond
;; I dunno why SHUTDOWN-SOCKET can die this way, but it
;; can and does
((or (= errno errno/notconn)
;; this one can come out of SOCKET->STRING
(= errno errno/inval))
(log (syslog-level notice) (log (syslog-level notice)
"socket to ~A not connected any more - exiting thread" "error with connection to ~A (~A)"
remote-address) remote-address (car packet))
(exit 'fick-dich-ins-knie)))) (exit 'fick-dich-ins-knie))
(lambda () (lambda ()
(let ((socket-string (socket->string socket))) (let ((socket-string (socket->string socket)))
@ -173,20 +167,31 @@
(log (syslog-level debug) "socket: ~S" socket-string) (log (syslog-level debug) "socket: ~S" socket-string)
(dynamic-wind
(lambda () 'fick-dich-ins-knie)
(lambda ()
(handle-connection (socket:inport socket) (handle-connection (socket:inport socket)
(socket:outport socket) (socket:outport socket)
(file-name-as-directory anonymous-home)) (file-name-as-directory anonymous-home)))
(lambda ()
(log (syslog-level debug) (log (syslog-level debug)
"shutting down socket ~S" "shutting down socket ~S"
socket-string) socket-string)
(shutdown-socket socket shutdown/sends+receives) (call-with-current-continuation
(lambda (exit)
(with-errno-handler*
(lambda (errno packet)
(log (syslog-level notice)
"error shutting down socket to ~A (~A)"
remote-address (car packet))
(exit 'fick-dich-ins-knie))
(lambda ()
(shutdown-socket socket shutdown/sends+receives)))))
(log (syslog-level notice) (log (syslog-level notice)
"closing connection to ~A and finishing thread" remote-address) "closing connection to ~A and finishing thread" remote-address)
(log (syslog-level debug) (log (syslog-level debug)
"closing socket ~S" socket-string) "closing socket ~S" socket-string)
(close-socket socket)))))))) (close-socket socket))))))))))
(define (ftpd-inetd anonymous-home) (define (ftpd-inetd anonymous-home)
(with-syslog-destination (with-syslog-destination
@ -218,7 +223,7 @@
(define (handle-connection input-port output-port anonymous-home) (define (handle-connection input-port output-port anonymous-home)
(log (syslog-level debug) (log (syslog-level debug)
"handling connection with input-port ~A, outputport ~A and home ~A" "handling connection with input port ~A, output port ~A and home ~A"
input-port input-port
output-port output-port
anonymous-home) anonymous-home)
@ -226,8 +231,8 @@
(lambda (escape) (lambda (escape)
(with-handler (with-handler
(lambda (condition more) (lambda (condition more)
(log (syslog-level debug) (log (syslog-level notice)
"hit error condition ~A (maybe reason (maybe Netscape?): ~S) -- exiting" "hit error condition ~A (~S) -- exiting"
(condition-type condition) (condition-type condition)
(condition-stuff condition)) (condition-stuff condition))
(escape 'fick-dich-ins-knie)) (escape 'fick-dich-ins-knie))
@ -1109,12 +1114,12 @@
(define (write-final-reply line) (define (write-final-reply line)
(format (session-control-output-port) "~D ~A" (session-reply-code) line) (format (session-control-output-port) "~D ~A" (session-reply-code) line)
;; (format #t "Reply: ~D ~A~%" (session-reply-code) line) (log (syslog-level debug) "Reply: ~D ~A~%" (session-reply-code) line)
(write-crlf (session-control-output-port))) (write-crlf (session-control-output-port)))
(define (write-nonfinal-reply line) (define (write-nonfinal-reply line)
(format (session-control-output-port) "~D-~A" (session-reply-code) line) (format (session-control-output-port) "~D-~A" (session-reply-code) line)
;; (format #t "Reply: ~D-~A~%" (session-reply-code) line) (log (syslog-level debug) "Reply: ~D-~A~%" (session-reply-code) line)
(write-crlf (session-control-output-port))) (write-crlf (session-control-output-port)))
(define (signal-error! code message) (define (signal-error! code message)
@ -1128,7 +1133,7 @@
; Version ; Version
(define *ftpd-version* "$Revision: 1.31 $") (define *ftpd-version* "$Revision: 1.32 $")
(define (copy-port->port-binary input-port output-port) (define (copy-port->port-binary input-port output-port)
(let ((buffer (make-string *window-size*))) (let ((buffer (make-string *window-size*)))