I had a crack at implementing RESTART support for ftpd. Honestly, I
found RFC 959 to be rather opaque, so I don't know how conformant my
changes are, or how much more there is to do. Regardless, the patch
is pasted below. STRING->NUMBER needs to be made available to the
ftpd module somehow.
A couple of related questions:
While making the changes, I found that if I aborted a long STORE
operation abruptly, scsh could sometimes "lock up" (stuck in a loop, I
suppose, as CPU usage jumps to ~100%). I'll see if I can come up with
something more reproducible.
Also, I'm getting really low transfer rates for STOREs (stabilises at
~80 kb/s on a local machine). RETRIEVE is much faster (10 MB/s or
thereabouts).
I'm using scsh 0.6.4, SUnet 2.0, Linux 2.4.20.
PS. Thanks to everyone involved with scsh.
--- ftpd.scm.orig Thu Mar 27 00:14:18 2003
+++ ftpd.scm Fri May 23 21:41:27 2003
@@ -95,6 +95,7 @@
root-directory
current-directory
to-be-renamed
+ restart-position
replies
reply-code
type
@@ -117,6 +118,8 @@
set-session-current-directory!)
(to-be-renamed session-to-be-renamed
set-session-to-be-renamed!)
+ (restart-position session-restart-position
+ set-session-restart-position!)
(replies session-replies
set-session-replies!)
(reply-code session-reply-code
@@ -136,6 +139,7 @@
#f ; root-directory
"" ; current-directory
#f ; to-be-renamed
+ #f ; restart-position
'() ; replies
#f ; reply-code
'ascii ; type
@@ -166,6 +170,7 @@
(define the-session-root-directory (make-session-selector
session-root-directory))
(define the-session-current-directory (make-session-selector
session-current-directory))
(define the-session-to-be-renamed (make-session-selector
session-to-be-renamed))
+(define the-session-restart-position (make-session-selector
session-restart-position))
(define the-session-replies (make-session-selector session-replies))
(define the-session-reply-code (make-session-selector session-reply-code))
(define the-session-type (make-session-selector session-type))
@@ -188,6 +193,8 @@
(make-session-modifier set-session-current-directory!))
(define set-the-session-to-be-renamed!
(make-session-modifier set-session-to-be-renamed!))
+(define set-the-session-restart-position!
+ (make-session-modifier set-session-restart-position!))
(define set-the-session-replies!
(make-session-modifier set-session-replies!))
(define set-the-session-reply-code!
@@ -1039,6 +1046,20 @@
(log (syslog-level debug) "closing data connection (226)")
(register-reply! 226 "Closing data connection."))
+(define (handle-rest restart-position)
+ (log-command (syslog-level info) "REST" restart-position)
+ (ensure-authenticated-login)
+ (cond ((string->number restart-position) =>
+ (lambda (restart-position)
+ (log-command (syslog-level debug)
+ "REST-command accepted, waiting for RETR or STOR (350)")
+ (register-reply!
+ 350
+ (format #f "Restarting at ~A. Gimme RETR or STOR next."
restart-position))
+ (set-the-session-restart-position! restart-position)))
+ (else
+ (register-reply! 501 "REST requires a value greater than or equal to
0."))))
+
(define (handle-retr path)
(log-command (syslog-level info) "RETR" path)
(ensure-authenticated-login)
@@ -1066,6 +1087,12 @@
path))))
(call-with-input-file full-path
(lambda (file-port)
+ (cond ((the-session-restart-position) =>
+ (lambda (restart-position)
+ (log (syslog-level debug) "clearing RESTART position")
+ (set-the-session-restart-position! #f)
+ (seek file-port restart-position)
+ (log (syslog-level debug) "seeking for RESTART
successful"))))
(with-data-connection
(lambda ()
(case (the-session-type)
@@ -1089,6 +1116,20 @@
(define (current-seconds)
(receive (time ticks) (time+ticks) time))
+; Adapted from CALL-WITH-MUMBLE-FILE in scsh/newports.scm
+; Is DYNAMIC-WIND really needed for this case?
+(define (call-with-output-file/flags string flags proc)
+ (let ((port #f))
+ (dynamic-wind (lambda ()
+ (if port
+ (warn "throwing back into a call-with-output-file/flags"
+ string)
+ (set! port (open-output-file string flags))))
+ (lambda () (proc port))
+ (lambda ()
+ (if port
+ (close port))))))
+
(define (handle-stor path)
(log-command (syslog-level info) "STOR" path)
(ensure-authenticated-login)
@@ -1103,8 +1144,17 @@
(signal-error! 550 (format #f "Can't open \"~A\" for writing." path))))
(lambda ()
(let ((start-transfer-seconds (current-seconds)))
- (call-with-output-file full-path
+ (call-with-output-file/flags full-path
+ (if (the-session-restart-position)
+ (bitwise-ior open/create)
+ (bitwise-ior open/create
open/truncate))
(lambda (file-port)
+ (cond ((the-session-restart-position) =>
+ (lambda (restart-position)
+ (log (syslog-level debug) "clearing RESTART position")
+ (set-the-session-restart-position! #f)
+ (seek file-port restart-position)
+ (log (syslog-level debug) "seeking for RESTART
successful"))))
(with-data-connection
(lambda ()
(let ((inport (socket:inport (the-session-data-socket))))
@@ -1233,6 +1283,7 @@
(cons "PASV" handle-pasv)
(cons "NLST" handle-nlst)
(cons "LIST" handle-list)
+ (cons "REST" handle-rest)
(cons "RETR" handle-retr)
(cons "STOR" handle-stor)
(cons "ABOR" handle-abor)))
|