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)
(with-errno-handler*
(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)
"socket to ~A not connected any more - exiting thread"
remote-address)
(exit 'fick-dich-ins-knie))))
"error with connection to ~A (~A)"
remote-address (car packet))
(exit 'fick-dich-ins-knie))
(lambda ()
(let ((socket-string (socket->string socket)))
@ -173,20 +167,31 @@
(log (syslog-level debug) "socket: ~S" socket-string)
(dynamic-wind
(lambda () 'fick-dich-ins-knie)
(lambda ()
(handle-connection (socket:inport socket)
(socket:outport socket)
(file-name-as-directory anonymous-home))
(file-name-as-directory anonymous-home)))
(lambda ()
(log (syslog-level debug)
"shutting down socket ~S"
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)
"closing connection to ~A and finishing thread" remote-address)
(log (syslog-level debug)
"closing socket ~S" socket-string)
(close-socket socket))))))))
(close-socket socket))))))))))
(define (ftpd-inetd anonymous-home)
(with-syslog-destination
@ -218,7 +223,7 @@
(define (handle-connection input-port output-port anonymous-home)
(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
output-port
anonymous-home)
@ -226,8 +231,8 @@
(lambda (escape)
(with-handler
(lambda (condition more)
(log (syslog-level debug)
"hit error condition ~A (maybe reason (maybe Netscape?): ~S) -- exiting"
(log (syslog-level notice)
"hit error condition ~A (~S) -- exiting"
(condition-type condition)
(condition-stuff condition))
(escape 'fick-dich-ins-knie))
@ -1109,12 +1114,12 @@
(define (write-final-reply 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)))
(define (write-nonfinal-reply 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)))
(define (signal-error! code message)
@ -1128,7 +1133,7 @@
; Version
(define *ftpd-version* "$Revision: 1.31 $")
(define *ftpd-version* "$Revision: 1.32 $")
(define (copy-port->port-binary input-port output-port)
(let ((buffer (make-string *window-size*)))