Cleaned up a bunch of log messages.
This commit is contained in:
sperber
parent
d7a148a2a5
commit
27ff0f4326
|
|
@ -277,14 +277,9 @@
|
|||
#f
|
||||
(lambda ()
|
||||
(log (syslog-level notice)
|
||||
"new connection on current input- and output-port with ~S as anonymous home"
|
||||
"starting ftpd from inetd"
|
||||
(expand-file-name anonymous-home (cwd)))
|
||||
|
||||
(log (syslog-level debug)
|
||||
"inport: ~A, outport: ~A"
|
||||
(current-input-port)
|
||||
(current-output-port))
|
||||
|
||||
(handle-connection (current-input-port)
|
||||
(current-output-port)
|
||||
(file-name-as-directory anonymous-home)))))
|
||||
|
|
@ -303,10 +298,9 @@
|
|||
|
||||
(define (handle-connection input-port output-port anonymous-home)
|
||||
(log (syslog-level debug)
|
||||
"handling connection with input port ~A, output port ~A and home ~A"
|
||||
"handling connection with input port ~A, output port ~A"
|
||||
input-port
|
||||
output-port
|
||||
anonymous-home)
|
||||
output-port)
|
||||
(call-with-current-continuation
|
||||
(lambda (escape)
|
||||
(with-handler
|
||||
|
|
@ -481,10 +475,10 @@
|
|||
(log-command (syslog-level info) "PASS" password)
|
||||
(cond
|
||||
((not (session-logged-in?))
|
||||
(log (syslog-level info) "Rejecting password as user has not logged in yet. (530)")
|
||||
(log (syslog-level info) "Rejecting password; user has not logged in yet. (530)")
|
||||
(register-reply! 530 "You have not logged in yet."))
|
||||
((session-anonymous?)
|
||||
(log (syslog-level info) "Accepting password as user is logged in (200)")
|
||||
(log (syslog-level info) "Accepting password; user is logged in (200)")
|
||||
(register-reply! 200 "Thank you."))
|
||||
(else
|
||||
(log (syslog-level notice) "Reached unreachable case-branch while handling password (502)")
|
||||
|
|
@ -521,7 +515,7 @@
|
|||
(file-name-as-directory
|
||||
(string-append (session-root-directory) current-directory))
|
||||
(lambda () ; I hate gratuitous syntax
|
||||
(log (syslog-level info)
|
||||
(log (syslog-level debug)
|
||||
"changing current directory to \"/~A\" (250)"
|
||||
current-directory)
|
||||
(set-session-current-directory current-directory)
|
||||
|
|
@ -572,7 +566,7 @@
|
|||
(lambda (path full-path)
|
||||
(log-command (syslog-level info) "DELE" path)
|
||||
(delete-file full-path)
|
||||
(log (syslog-level info) "deleted ~S (250)" full-path)
|
||||
(log (syslog-level debug) "deleted ~S (250)" full-path)
|
||||
(log (syslog-level debug) "reporting about ~S" path)
|
||||
(register-reply! 250 (format #f "Deleted \"~A\"." path)))))
|
||||
|
||||
|
|
@ -584,7 +578,7 @@
|
|||
(let* ((info (file-info full-path))
|
||||
(the-date (date (file-info:mtime info) 0))
|
||||
(formatted-date (format-date "~Y~m~d~H~M~S" the-date)))
|
||||
(log (syslog-level info) "reporting modification time of ~S: ~A (213)"
|
||||
(log (syslog-level debug) "reporting modification time of ~S: ~A (213)"
|
||||
full-path
|
||||
formatted-date)
|
||||
(register-reply! 213
|
||||
|
|
@ -596,7 +590,7 @@
|
|||
(lambda (path full-path)
|
||||
(log-command (syslog-level info) "MKD" path)
|
||||
(create-directory full-path #o755)
|
||||
(log (syslog-level info) "created directory ~S (257)" full-path)
|
||||
(log (syslog-level debug) "created directory ~S (257)" full-path)
|
||||
(log (syslog-level debug) "reporting about ~S" path)
|
||||
(register-reply! 257
|
||||
(format #f "Created directory \"~A\"." path)))))
|
||||
|
|
@ -607,7 +601,7 @@
|
|||
(lambda (path full-path)
|
||||
(log-command (syslog-level info) "RMD" path)
|
||||
(delete-directory full-path)
|
||||
(log (syslog-level info) "deleted directory ~S (250)" full-path)
|
||||
(log (syslog-level debug) "deleted directory ~S (250)" full-path)
|
||||
(log (syslog-level debug) "reporting about ~S" path)
|
||||
(register-reply! 250
|
||||
(format #f "Deleted directory \"~A\"." path)))))
|
||||
|
|
@ -619,7 +613,7 @@
|
|||
(lambda (path full-path)
|
||||
(log-command (syslog-level info) "RNFR" path)
|
||||
(file-info full-path)
|
||||
(log (syslog-level info)
|
||||
(log (syslog-level debug)
|
||||
"RNFR-command accepted, waiting for RNTO-command (350)")
|
||||
(register-reply! 350 "RNFR accepted. Gimme a RNTO next.")
|
||||
(set-session-to-be-renamed full-path))))
|
||||
|
|
@ -661,7 +655,7 @@
|
|||
(lambda ()
|
||||
(let ((old-name (session-to-be-renamed)))
|
||||
(rename-file old-name full-path)
|
||||
(log (syslog-level info)
|
||||
(log (syslog-level debug)
|
||||
"~S renamed to ~S - no more waiting for RNTO-command (250)"
|
||||
old-name full-path)
|
||||
(register-reply! 250 "File renamed.")
|
||||
|
|
@ -683,7 +677,7 @@
|
|||
(format #f "\"~A\" is not a regular file."
|
||||
path))))
|
||||
(let ((file-size (file-info:size info)))
|
||||
(log (syslog-level info)
|
||||
(log (syslog-level debug)
|
||||
"reporting ~D as size of ~S (213)"
|
||||
file-size full-path)
|
||||
(register-reply! 213 (number->string file-size)))))))
|
||||
|
|
@ -693,13 +687,13 @@
|
|||
(log-command (syslog-level info) "TYPE" arg)
|
||||
(cond
|
||||
((string-ci=? "A" arg)
|
||||
(log (syslog-level info) "changed type to ascii (200)")
|
||||
(log (syslog-level debug) "changed type to ascii (200)")
|
||||
(set-session-type 'ascii))
|
||||
((string-ci=? "I" arg)
|
||||
(log (syslog-level info) "changed type to image (8-bit binary) (200)")
|
||||
(log (syslog-level debug) "changed type to image (8-bit binary) (200)")
|
||||
(set-session-type 'image))
|
||||
((string-ci=? "L8" arg)
|
||||
(log (syslog-level info) "changed type to image (8-bit binary) (200)")
|
||||
(log (syslog-level debug) "changed type to image (8-bit binary) (200)")
|
||||
(set-session-type 'image))
|
||||
(else
|
||||
(log (syslog-level info)
|
||||
|
|
@ -739,7 +733,7 @@
|
|||
(register-reply! 500
|
||||
"No arguments. Not to worry---I'd ignore them anyway."))
|
||||
((string-ci=? "F" arg)
|
||||
(log (syslog-level info) "(still) using file structure to transfer files (200)")
|
||||
(log (syslog-level debug) "(still) using file structure to transfer files (200)")
|
||||
(register-reply! 200 "Using file structure to transfer files."))
|
||||
(else
|
||||
(log (syslog-level info) "file structure ~S is not supported (504)" arg)
|
||||
|
|
@ -813,7 +807,7 @@
|
|||
|
||||
(let ((formatted-internet-host-address
|
||||
(format-internet-host-address address)))
|
||||
(log (syslog-level info)
|
||||
(log (syslog-level debug)
|
||||
"connected to ~A, port ~A (200)"
|
||||
formatted-internet-host-address port)
|
||||
|
||||
|
|
@ -849,7 +843,7 @@
|
|||
(let ((formatted-this-host-address
|
||||
(format-internet-host-address (this-host-address) ","))
|
||||
(formatted-port (format-port port)))
|
||||
(log (syslog-level info) "accepting passive mode (on ~A,~A) (227)"
|
||||
(log (syslog-level debug) "accepting passive mode (on ~A,~A) (227)"
|
||||
formatted-this-host-address formatted-port)
|
||||
(register-reply! 227
|
||||
(format #f "Passive mode OK (~A,~A)"
|
||||
|
|
@ -903,7 +897,7 @@
|
|||
(log (syslog-level info) "got invalid flags (501)")
|
||||
(signal-error! 501 "Invalid flag(s).")))
|
||||
(let ((all-flags (append preset-flags flags)))
|
||||
(log (syslog-level info)
|
||||
(log (syslog-level debug)
|
||||
"sending file-listing for path ~S with flags ~A"
|
||||
path all-flags)
|
||||
|
||||
|
|
@ -945,7 +939,7 @@
|
|||
(define (handle-abor foo)
|
||||
(log-command (syslog-level info) "ABOR")
|
||||
(maybe-close-data-connection)
|
||||
(log (syslog-level info) "closing data connection (226)")
|
||||
(log (syslog-level debug) "closing data connection (226)")
|
||||
(register-reply! 226 "Closing data connection."))
|
||||
|
||||
(define (handle-retr path)
|
||||
|
|
@ -979,7 +973,7 @@
|
|||
(lambda ()
|
||||
(case (session-type)
|
||||
((image)
|
||||
(log (syslog-level info)
|
||||
(log (syslog-level debug)
|
||||
"sending file ~S (binary mode)"
|
||||
full-path)
|
||||
(log (syslog-level debug) "sending is from port ~S" file-port)
|
||||
|
|
@ -987,7 +981,7 @@
|
|||
file-port
|
||||
(socket:outport (session-data-socket))))
|
||||
((ascii)
|
||||
(log (syslog-level info) "sending file ~S (ascii mode)"
|
||||
(log (syslog-level debug) "sending file ~S (ascii mode)"
|
||||
full-path)
|
||||
(log (syslog-level debug) "sending is from port ~S" file-port)
|
||||
(copy-port->port-ascii
|
||||
|
|
@ -1223,7 +1217,7 @@
|
|||
|
||||
; Version
|
||||
|
||||
(define *ftpd-version* "$Revision: 1.2 $")
|
||||
(define *ftpd-version* "$Revision: 1.3 $")
|
||||
|
||||
(define (copy-port->port-binary input-port output-port)
|
||||
(let ((buffer (make-string *window-size*)))
|
||||
|
|
|
|||
Loading…
Reference in New Issue