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

Put port for logging into session.

This commit is contained in:
mainzelm 2002-12-19 17:11:38 +00:00
parent 63ca4e7c09
commit 6156c77161
1 changed files with 37 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
scheme/ftpd/ftpd.scm
View File

@ -90,7 +90,8 @@
reply-code reply-code
type type
data-socket data-socket
passive-socket) passive-socket
maybe-log-port)
session? session?
(control-input-port session-control-input-port (control-input-port session-control-input-port
set-session-control-input-port!) set-session-control-input-port!)
@ -118,9 +119,11 @@
(data-socket session-data-socket (data-socket session-data-socket
set-session-data-socket!) set-session-data-socket!)
(passive-socket session-passive-socket (passive-socket session-passive-socket
set-session-passive-socket!)) set-session-passive-socket!)
(maybe-log-port session-maybe-log-port
set-session-maybe-log-port!))
(define (make-session input-port output-port) (define (make-session input-port output-port maybe-log-port)
(really-make-session input-port output-port (really-make-session input-port output-port
(make-lock) (make-lock)
#f ; logged-in? #f ; logged-in?
@ -134,6 +137,7 @@
'ascii ; type 'ascii ; type
#f ; data-socket #f ; data-socket
#f ; passive-socket #f ; passive-socket
maybe-log-port
)) ))
(define session (make-fluid #f)) (define session (make-fluid #f))
@ -165,6 +169,7 @@
(define the-session-type (make-session-selector session-type)) (define the-session-type (make-session-selector session-type))
(define the-session-data-socket (make-session-selector session-data-socket)) (define the-session-data-socket (make-session-selector session-data-socket))
(define the-session-passive-socket (make-session-selector session-passive-socket)) (define the-session-passive-socket (make-session-selector session-passive-socket))
(define the-session-maybe-log-port (make-session-selector session-maybe-log-port))
(define set-the-session-control-input-port! (define set-the-session-control-input-port!
(make-session-modifier set-session-control-input-port!)) (make-session-modifier set-session-control-input-port!))
@ -192,6 +197,8 @@
(make-session-modifier set-session-data-socket!)) (make-session-modifier set-session-data-socket!))
(define set-the-session-passive-socket! (define set-the-session-passive-socket!
(make-session-modifier set-session-passive-socket!)) (make-session-modifier set-session-passive-socket!))
(define set-the-session-maybe-log-port!
(make-session-modifier set-session-maybe-log-port!))
(define (make-ftpd-options-selector selector) (define (make-ftpd-options-selector selector)
(lambda () (lambda ()
@ -260,10 +267,10 @@
ip)) ip))
ip))) ip)))
(lambda (start-transfer-seconds info full-path direction) (lambda (start-transfer-seconds info full-path direction)
(if (the-ftpd-options-logfile) (if (the-session-maybe-log-port)
(begin (begin
(obtain-lock (the-session-logfile-lock)) (obtain-lock (the-session-logfile-lock))
(format (the-ftpd-options-logfile) (format (the-session-maybe-log-port)
"~A ~A ~A ~A ~A ~A _ ~A a nop@ssword ftp 0 *~%" "~A ~A ~A ~A ~A ~A _ ~A a nop@ssword ftp 0 *~%"
(format-date "~a ~b ~d ~H:~M:~S ~Y" (date)) ; current date and time (format-date "~a ~b ~d ~H:~M:~S ~Y" (date)) ; current date and time
(- (current-seconds) start-transfer-seconds) ; transfer time in secs (- (current-seconds) start-transfer-seconds) ; transfer time in secs
@ -285,18 +292,18 @@
; authentication mode ; authentication mode
; authenticated user id' ; authenticated user id'
) )
(force-output (the-ftpd-options-logfile)) (force-output (the-session-maybe-log-port))
(release-lock (the-session-logfile-lock))))))) (release-lock (the-session-logfile-lock)))))))
(define (open-logfile logfile) (define (maybe-open-logfile maybe-logfile)
(with-errno-handler (with-errno-handler
((errno packet) ((errno packet)
(else (else
(format (current-error-port) (format (current-error-port)
"[ftpd] Warning: Unable to write logs to ~S. Logging is now made to (current-error-port).~%[ftpd] (To disable logging at all, either leave the logfile argument or give #f as logfile)~%") "[ftpd] Warning: Unable to write logs to ~S. Logging is now made to (current-error-port).~%[ftpd] (To disable logging at all, either leave the logfile argument or give #f as logfile)~%")
(current-error-port))) (current-error-port)))
(and logfile (and maybe-logfile
(open-output-file logfile (open-output-file maybe-logfile
(bitwise-ior open/create open/append))))) (bitwise-ior open/create open/append)))))
;;; CONVERTERS ------------------------------------------------ ;;; CONVERTERS ------------------------------------------------
@ -335,7 +342,7 @@
(expand-file-name (ftpd-options-anonymous-home ftpd-options) (expand-file-name (ftpd-options-anonymous-home ftpd-options)
(cwd)) (cwd))
(ftpd-options-logfile ftpd-options)) (ftpd-options-logfile ftpd-options))
(let ((maybe-log-port (maybe-open-logfile (ftpd-options-logfile ftpd-options))))
(bind-listen-accept-loop (bind-listen-accept-loop
protocol-family/internet protocol-family/internet
(lambda (socket address) (lambda (socket address)
@ -346,10 +353,11 @@
(handle-connection-encapsulated ftpd-options (handle-connection-encapsulated ftpd-options
socket socket
address address
remote-address))))) remote-address
(ftpd-options-port ftpd-options))))) maybe-log-port)))))
(ftpd-options-port ftpd-options))))))
(define (handle-connection-encapsulated ftpd-options socket address remote-address) (define (handle-connection-encapsulated ftpd-options socket address remote-address maybe-log-port)
(call-with-current-continuation (call-with-current-continuation
(lambda (exit) (lambda (exit)
(with-errno-handler* (with-errno-handler*
@ -372,7 +380,8 @@
(lambda () (lambda ()
(handle-connection ftpd-options (handle-connection ftpd-options
(socket:inport socket) (socket:inport socket)
(socket:outport socket))) (socket:outport socket)
maybe-log-port))
(lambda () (lambda ()
(log (syslog-level debug) (log (syslog-level debug)
"shutting down socket ~S" "shutting down socket ~S"
@ -406,7 +415,8 @@
(cwd))) (cwd)))
(handle-connection ftpd-options (handle-connection ftpd-options
(current-input-port) (current-input-port)
(current-output-port))))) (current-output-port)
(maybe-open-logfile (ftpd-options-logfile ftpd-options))))))
(define (set-ftp-socket-options! socket) (define (set-ftp-socket-options! socket)
;; If the client closes the connection, we won't lose when we try to ;; If the client closes the connection, we won't lose when we try to
@ -420,7 +430,7 @@
(set-socket-option socket level/socket socket/oob-inline #t)) (set-socket-option socket level/socket socket/oob-inline #t))
(define (handle-connection ftpd-options input-port output-port) (define (handle-connection ftpd-options input-port output-port maybe-log-port)
(log (syslog-level debug) (log (syslog-level debug)
"handling connection with input port ~A, output port ~A" "handling connection with input port ~A, output port ~A"
input-port input-port
@ -436,7 +446,7 @@
(escape 'fick-dich-ins-knie)) (escape 'fick-dich-ins-knie))
(lambda () (lambda ()
(let-fluids (let-fluids
session (make-session input-port output-port) session (make-session input-port output-port maybe-log-port)
options ftpd-options options ftpd-options
(lambda () (lambda ()
(display-banner) (display-banner)