Starting to insert syslog-calls in ftpd.

This commit is contained in:
interp 2001-06-22 14:01:38 +00:00
parent 2278144662
commit 1e164e08b2
1 changed files with 67 additions and 2 deletions

View File

@ -69,12 +69,57 @@
(define set-session-data-socket (make-fluid-setter set-session:data-socket)) (define set-session-data-socket (make-fluid-setter set-session:data-socket))
(define set-session-passive-socket (make-fluid-setter set-session:passive-socket)) (define set-session-passive-socket (make-fluid-setter set-session:passive-socket))
(define log
(lambda (level format-message . args)
(syslog level
(apply format #f format-message args)
(format "ftpd[~D]" (thread-uid (current-thread)))
#f
(syslog-facility daemon))))
(define (protocol-family->string protocol-family)
(cond ((= protocol-family protocol-family/unspecified)
"unspecified")
((= protocol-family protocol-family/internet)
"internet")
((= protocol-family protocol-family/unix)
"unix")
(else "unknown")))
(define (socket->string socket)
(format #f "family: ~A, local address: ~A, remote address: ~A, input-port ~A, output-port ~A"
(protocol-family->string (socket:family socket))
(socket-address->string (socket-local-address socket))
(socket-address->string (socket-remote-address socket))
(socket:inport socket)
(socket:outport socket)))
(define (socket-address->string socket-address)
(call-with-values
(lambda () (socket-address->internet-address socket-address))
(lambda (host-address service-port)
(format #f "~A:~A"
(format-internet-host-address host-address)
(format-port service-port)))))
(define (ftpd anonymous-home . maybe-port) (define (ftpd anonymous-home . maybe-port)
(let ((port (optional maybe-port 21))) (let ((port (optional maybe-port 21)))
(log (syslog-level notice)
"starting on port ~D with ~S as anonymous home"
port (expand-file-name anonymous-home (cwd)))
(bind-listen-accept-loop (bind-listen-accept-loop
protocol-family/internet protocol-family/internet
(lambda (socket address) (lambda (socket address)
(log (syslog-level info)
"new connection with ~S"
(socket-address->string address)
(log (syslog-level debug)
"got connection with socket ~S and address ~S"
(socket->string socket)
(socket-address->string address))
(set-ftp-socket-options! socket) (set-ftp-socket-options! socket)
(spawn (spawn
@ -90,14 +135,34 @@
;; I dunno why SHUTDOWN-SOCKET can die this way, but it ;; I dunno why SHUTDOWN-SOCKET can die this way, but it
;; can and does ;; can and does
((= errno errno/notconn) ((= errno errno/notconn)
(log (syslog-level warning)
"socket not connected any more - exiting thread")
(log (syslog-level debug) "socket ~S not connected any more"
(socket->string socket))
(exit 'fick-dich-ins-knie)))) (exit 'fick-dich-ins-knie))))
(lambda () (lambda ()
(log (syslog-level debug)
"shutting down socket ~S"
(socket->string socket))
(shutdown-socket socket shutdown/sends+receives))))) (shutdown-socket socket shutdown/sends+receives)))))
(close-socket socket)))) (log (syslog-level info)
"closing socket")
(close-socket socket))
(socket-address->string address)))) ; use remote address as thread-name
port))) port)))
(define (ftpd-inetd anonymous-home) (define (ftpd-inetd anonymous-home)
(log (syslog-level info)
"new connection on current input- and output-port with ~S as anonymous home"
(expand-file-name anonymous-home (cwd)))
(log (syslog-level debug)
"new connection on current input-port ~A and current output-port ~A with ~S as anonymous home"
(current-input-port)
(current-output-port)
(expand-file-name anonymous-home (cwd)))
(handle-connection (current-input-port) (handle-connection (current-input-port)
(current-output-port) (current-output-port)
(file-name-as-directory anonymous-home))) (file-name-as-directory anonymous-home)))
@ -811,7 +876,7 @@
; Version ; Version
(define *ftpd-version* "$Revision: 1.16 $") (define *ftpd-version* "$Revision: 1.17 $")
(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*)))