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

* added file logging like wu-ftpd does

This commit is contained in:
interp 2002-04-19 15:50:06 +00:00
parent 48a0a95a4a
commit fb0833078b
3 changed files with 181 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
doc/latex/ftpd.tex
View File

@ -9,19 +9,44 @@
\subsubsection*{Entry points} \subsubsection*{Entry points}
\defun {ftpd} {anonymous-home \ovar{port}} {\noreturn} \defun {ftpd} {anonymous-home \ovar{port \ovar{logfile}}} {\noreturn}
\begin{defundescx}{ftp-inetd} {anonymous-home} {\noreturn} \begin{defundescx}{ftp-inetd} {anonymous-home} {\noreturn}
\ex{ftpd} starts the server, using \semvar{anonymous-home} as the \ex{ftpd} starts the server, using \semvar{anonymous-home} as the
root directory of the server. Usage of relative paths is not root directory of the server. Usage of relative paths is not
encouraged. \semvar{port} specifies the port the server is encouraged. \semvar{port} specifies the port the server is
listening for connections. It defaults to 21. listening for connections. It defaults to 21. \ex{ftpd} makes a log
entry for each file sent or retrieved. These logs are written to
\semvar{logfile}, if given.
The log format of \ex{ftpd} is the same as the one of
\ex{wuftpd}. The fields are seperated by spaces and contain
following informations:
\codex{Fri Apr 19 17:08:14 2002 4 134.2.2.171 56881 /files.lst b \_ i a nop@ssword ftp 0 *}
\begin{enumerate}
\item Current date and time. This field contains
spaces and is 24 characters long.
\item Transfer time in seconds.
\item Remote host IP (wuftpd puts the name here).
\item File size in bytes
\item Name of file
\item Transfer type: \underline{a}scii or \underline{b}inary (image type).
\item Special action flags. As \ex{ftpd} does not support any special
action, we are always `\ex{\_}' here.
\item File was sent to user (\underline{o}utgoing) or received from user
(\underline{i}ncoming)
\item \underline{A}nonymous access
\item Anonymous ftp password. We do not use anyone.
\item Service name - always \ex{ftp}.
\item Authentication mode (always none = `\ex{0}').
\item Authenticated user ID (always not available = `\ex{*}')
\end{enumerate}
As the procedure does not return, you have to do a \ex{fork} in As the procedure does not return, you have to do a \ex{fork} in
order to have a ``real'' daemon: order to have a ``real'' daemon: \codex{(fork (lambda () (ftpd
\codex{(fork (lambda () (ftpd "/data/ftp" 8080)))} "/data/ftp" 8080)))} \ex{ftpd-inetd} is the version to be used with
\ex{ftpd-inetd} is the version to be used with a daemon like a daemon like \ex{inetd}. If the server is started this way, it
\ex{inetd}. If the server is started this way, it handles the handles the connection through the current standard output and input
connection through the current standard output and input ports. ports.
\end{defundescx} \end{defundescx}
\subsubsection*{Examples} \subsubsection*{Examples}

204
ftpd.scm
View File

@ -13,11 +13,12 @@
; following things should be improved: ; following things should be improved:
; ;
; - GET-command: ftpd reports "Can't open FILENAME for reading" if ; - GET/RETR-command: ftpd reports "Can't open FILENAME for reading" if
; file actually doesn't exist. This is confusing. Reporting ; file actually doesn't exist. This is confusing. Reporting
; "FILENAME does not exist" is much better. ; "FILENAME does not exist" is much better.
(define *logfile* #f) ; file-port to log to like wu-ftpd (analyzable with webalizer)
(define-record session (define-record session
control-input-port control-input-port
@ -93,7 +94,62 @@
(log level "handling ~A-command with argument ~S" ; does this ever happen? (log level "handling ~A-command with argument ~S" ; does this ever happen?
command-name (car argument))))) command-name (car argument)))))
;; Extended logging like wu.ftpd:
;; Each file up/download is protocolled
; Mon Dec 3 18:52:41 1990 1 wuarchive.wustl.edu 568881 /files.lst.Z a _ o a chris@wugate.wustl.edu ftp 0 *
;
; %.24s %d %s %d %s %c %s %c %c %s %s %d %s
; 1 2 3 4 5 6 7 8 9 10 11 12 13
;
; 1 current time in the form DDD MMM dd hh:mm:ss YYYY
; 2 transfer time in seconds
; 3 remote host name
; 4 file size in bytes
; 5 name of file
; 6 transfer type (a>scii, b>inary)
; 7 special action flags (concatenated as needed):
; C file was compressed
; U file was uncompressed
; T file was tar'ed
; _ no action taken
; 8 file was sent to user (o>utgoing) or received from
; user (i>ncoming)
; 9 accessed anonymously (r>eal, a>nonymous, g>uest) -- mostly for FTP
; 10 local username or, if guest, ID string given
; (anonymous FTP password)
; 11 service name ('ftp', other)
; 12 authentication method (bitmask)
; 0 none
; 1 RFC931 Authentication
; 13 authenticated user id (if available, '*' otherwise)
;
(define file-log
(let ((file-log-lock (make-lock)))
(lambda (start-transfer-seconds info full-path direction)
(if *logfile*
(begin
(obtain-lock file-log-lock)
(format *logfile* "~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
(socket-address->string (socket-remote-address (session-data-socket)) #f) ; remote host name
(file-info:size info) ; file size in bytes
full-path ; name of file
(case (session-type)
((ascii) "a")
((image) "b")
(else "?")) ; transfer type
direction ; incoming / outgoing file
; anonymous access
; password (no password given)
; service name
; authentication mode
; authenticated user id'
)
(force-output *logfile*)
(release-lock file-log-lock))))))
;;; CONVERTERS ------------------------------------------------ ;;; CONVERTERS ------------------------------------------------
(define (protocol-family->string protocol-family) (define (protocol-family->string protocol-family)
(cond ((= protocol-family protocol-family/unspecified) (cond ((= protocol-family protocol-family/unspecified)
@ -113,40 +169,49 @@
(socket:outport socket))) (socket:outport socket)))
(define (socket-address->string socket-address) (define (socket-address->string socket-address . with-port?)
(call-with-values (let ((with-port? (optional with-port? #t)))
(lambda () (socket-address->internet-address socket-address)) (receive (host-address service-port)
(lambda (host-address service-port) (socket-address->internet-address socket-address)
(format #f "~A:~A" (if with-port?
(format-internet-host-address host-address) (format #f "~A:~A"
(format-port service-port))))) (format-internet-host-address host-address)
(format-port service-port))
(format #f "~A"
(format-internet-host-address host-address))))))
;;; ftpd ------------------------------------------------------- ;;; ftpd -------------------------------------------------------
(define (ftpd anonymous-home . maybe-port) (define (ftpd anonymous-home . maybe-args)
(let ((port (optional maybe-port 21))) (let-optionals
(with-syslog-destination maybe-args
"ftpd" ((port 21)
#f (logfile #f))
#f (display "ping!\n")
#f (if logfile
(lambda () (set! *logfile* (open-output-file logfile (bitwise-ior open/create open/append))))
(log (syslog-level notice) (with-syslog-destination
"starting daemon on port ~D with ~S as anonymous home" "ftpd"
port (expand-file-name anonymous-home (cwd))) #f
#f
#f
(lambda ()
(log (syslog-level notice)
"starting daemon on port ~D with ~S as anonymous home and logfile ~S"
port (expand-file-name anonymous-home (cwd)) logfile)
(bind-listen-accept-loop (bind-listen-accept-loop
protocol-family/internet protocol-family/internet
(lambda (socket address) (lambda (socket address)
(let ((remote-address (socket-address->string address))) (let ((remote-address (socket-address->string address)))
(set-ftp-socket-options! socket) (set-ftp-socket-options! socket)
(fork-thread (fork-thread
(spawn-to-handle-connection socket (spawn-to-handle-connection socket
address address
anonymous-home anonymous-home
port port
remote-address)))) remote-address))))
port))))) port)))))
(define (spawn-to-handle-connection socket address anonymous-home port remote-address) (define (spawn-to-handle-connection socket address anonymous-home port remote-address)
(lambda () (lambda ()
@ -193,7 +258,16 @@
"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 . maybe-logfile)
(let ((logfile (optional 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)~%")
(set! *logfile* (current-error-port))))
(if logfile
(set! *logfile* (open-output-file logfile (bitwise-ior open/create open/append))))))
(with-syslog-destination (with-syslog-destination
"ftpd" "ftpd"
#f #f
@ -883,7 +957,8 @@
(format #f "Can't open \"~A\" for reading." (format #f "Can't open \"~A\" for reading."
path)))) path))))
(lambda () (lambda ()
(let ((info (file-info full-path))) (let ((info (file-info full-path))
(start-transfer-seconds (current-seconds)))
(if (not (eq? 'regular (file-info:type info))) (if (not (eq? 'regular (file-info:type info)))
(begin (begin
(log (syslog-level info) "rejecting RETR-command as ~S is not a regular file (450)" (log (syslog-level info) "rejecting RETR-command as ~S is not a regular file (450)"
@ -911,7 +986,11 @@
(log (syslog-level debug) "sending is from port ~S" file-port) (log (syslog-level debug) "sending is from port ~S" file-port)
(copy-port->port-ascii (copy-port->port-ascii
file-port file-port
(socket:outport (session-data-socket)))))))))))))) (socket:outport (session-data-socket)))))
(file-log start-transfer-seconds info full-path "o"))))))))))
(define (current-seconds)
(receive (time ticks) (time+ticks) time))
(define (handle-stor path) (define (handle-stor path)
(log-command (syslog-level info) "STOR" path) (log-command (syslog-level info) "STOR" path)
@ -926,32 +1005,35 @@
(log (syslog-level debug) "replying error for file ~S (maybe reason: ~S)" path reason) (log (syslog-level debug) "replying error for file ~S (maybe reason: ~S)" path reason)
(signal-error! 550 (format #f "Can't open \"~A\" for writing." path)))) (signal-error! 550 (format #f "Can't open \"~A\" for writing." path))))
(lambda () (lambda ()
(call-with-output-file full-path (let ((start-transfer-seconds (current-seconds)))
(lambda (file-port) (call-with-output-file full-path
(with-data-connection (lambda (file-port)
(lambda () (with-data-connection
(let ((inport (socket:inport (session-data-socket)))) (lambda ()
(case (session-type) (let ((inport (socket:inport (session-data-socket))))
((image) (case (session-type)
(log (syslog-level notice) ((image)
"storing data to ~S (binary mode)" (log (syslog-level notice)
full-path) "storing data to ~S (binary mode)"
(log (syslog-level debug) full-path)
"storing comes from socket-inport ~S (binary-mode)" (log (syslog-level debug)
inport) "storing comes from socket-inport ~S (binary-mode)"
(copy-port->port-binary inport)
(socket:inport (session-data-socket)) (copy-port->port-binary
file-port)) (socket:inport (session-data-socket))
((ascii) file-port))
(log (syslog-level notice) ((ascii)
"storing data to ~S (ascii-mode)" (log (syslog-level notice)
full-path) "storing data to ~S (ascii-mode)"
(log (syslog-level debug) full-path)
"storing comes from socket-inport ~S (ascii-mode)" (log (syslog-level debug)
inport) "storing comes from socket-inport ~S (ascii-mode)"
(copy-ascii-port->port inport)
(socket:inport (session-data-socket)) (copy-ascii-port->port
file-port)))))))))))) (socket:inport (session-data-socket))
file-port)))
(file-log start-transfer-seconds (file-info full-path) full-path "i")
))))))))))
(define (assemble-path current-directory path) (define (assemble-path current-directory path)
(log (syslog-level debug) "assembling path ~S" (log (syslog-level debug) "assembling path ~S"
@ -1133,7 +1215,7 @@
; Version ; Version
(define *ftpd-version* "$Revision: 1.32 $") (define *ftpd-version* "$Revision: 1.33 $")
(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*)))

7
modules.scm
View File

@ -537,18 +537,21 @@
ftpd-inetd)) ftpd-inetd))
(define-structure ftpd ftpd-interface (define-structure ftpd ftpd-interface
(open scheme (open scsh
conditions handle signals conditions handle signals
structure-refs structure-refs
handle-fatal-error handle-fatal-error
scsh scheme
threads threads-internal ; last one to get CURRENT-THREAD threads threads-internal ; last one to get CURRENT-THREAD
locks
thread-fluids ; fork-thread thread-fluids ; fork-thread
fluids fluids
string-lib string-lib
big-util big-util
defrec-package defrec-package
crlf-io strings ls crlf-io strings ls
let-opt
receiving ; RECEIVE
format-net) ; pretty print of internet-addresses format-net) ; pretty print of internet-addresses
(access big-scheme) (access big-scheme)
(files ftpd)) (files ftpd))