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
type
data-socket
passive-socket)
passive-socket
maybe-log-port)
session?
(control-input-port session-control-input-port
set-session-control-input-port!)
@ -118,9 +119,11 @@
(data-socket session-data-socket
set-session-data-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
(make-lock)
#f ; logged-in?
@ -134,6 +137,7 @@
'ascii ; type
#f ; data-socket
#f ; passive-socket
maybe-log-port
))
(define session (make-fluid #f))
@ -165,6 +169,7 @@
(define the-session-type (make-session-selector session-type))
(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-maybe-log-port (make-session-selector session-maybe-log-port))
(define set-the-session-control-input-port!
(make-session-modifier set-session-control-input-port!))
@ -192,6 +197,8 @@
(make-session-modifier set-session-data-socket!))
(define set-the-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)
(lambda ()
@ -260,10 +267,10 @@
ip))
ip)))
(lambda (start-transfer-seconds info full-path direction)
(if (the-ftpd-options-logfile)
(if (the-session-maybe-log-port)
(begin
(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 *~%"
(format-date "~a ~b ~d ~H:~M:~S ~Y" (date)) ; current date and time
(- (current-seconds) start-transfer-seconds) ; transfer time in secs
@ -285,18 +292,18 @@
; authentication mode
; authenticated user id'
)
(force-output (the-ftpd-options-logfile))
(force-output (the-session-maybe-log-port))
(release-lock (the-session-logfile-lock)))))))
(define (open-logfile logfile)
(define (maybe-open-logfile maybe-logfile)
(with-errno-handler
((errno packet)
(else
(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)~%")
(current-error-port)))
(and logfile
(open-output-file logfile
(and maybe-logfile
(open-output-file maybe-logfile
(bitwise-ior open/create open/append)))))
;;; CONVERTERS ------------------------------------------------
@ -335,7 +342,7 @@
(expand-file-name (ftpd-options-anonymous-home ftpd-options)
(cwd))
(ftpd-options-logfile ftpd-options))
(let ((maybe-log-port (maybe-open-logfile (ftpd-options-logfile ftpd-options))))
(bind-listen-accept-loop
protocol-family/internet
(lambda (socket address)
@ -346,10 +353,11 @@
(handle-connection-encapsulated ftpd-options
socket
address
remote-address)))))
(ftpd-options-port ftpd-options)))))
remote-address
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
(lambda (exit)
(with-errno-handler*
@ -372,7 +380,8 @@
(lambda ()
(handle-connection ftpd-options
(socket:inport socket)
(socket:outport socket)))
(socket:outport socket)
maybe-log-port))
(lambda ()
(log (syslog-level debug)
"shutting down socket ~S"
@ -406,7 +415,8 @@
(cwd)))
(handle-connection ftpd-options
(current-input-port)
(current-output-port)))))
(current-output-port)
(maybe-open-logfile (ftpd-options-logfile ftpd-options))))))
(define (set-ftp-socket-options! socket)
;; 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))
(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)
"handling connection with input port ~A, output port ~A"
input-port
@ -436,7 +446,7 @@
(escape 'fick-dich-ins-knie))
(lambda ()
(let-fluids
session (make-session input-port output-port)
session (make-session input-port output-port maybe-log-port)
options ftpd-options
(lambda ()
(display-banner)