From 14a380bd494655048c5f825fc5771b31de03b1aa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Joe=20Pant=C5=AF=C4=8Dek?= Date: Thu, 19 Nov 2020 23:10:58 +0100 Subject: [PATCH] net-lib/ftp upload and download enhancement Allow using ports with ftp-download-file and ftp-upload-file. --- pkgs/net-doc/net/scribblings/ftp.scrbl | 36 ++++++++++++++++++-------- pkgs/net-lib/net/ftp.rkt | 23 ++++++++++------ 2 files changed, 40 insertions(+), 19 deletions(-) diff --git a/pkgs/net-doc/net/scribblings/ftp.scrbl b/pkgs/net-doc/net/scribblings/ftp.scrbl index e7c317396c..b2c70e0449 100644 --- a/pkgs/net-doc/net/scribblings/ftp.scrbl +++ b/pkgs/net-doc/net/scribblings/ftp.scrbl @@ -77,7 +77,8 @@ this information can be unreliable.} @defproc[(ftp-download-file [ftp-conn ftp-connection?] - [local-dir path-string?] + [local-dir-or-port (or/c path-string? + output-port?)] [file string?] [#:progress progress-proc (or/c #f @@ -87,11 +88,18 @@ this information can be unreliable.} #f]) void?]{ -Downloads @racket[file] from the server's current directory and puts -it in @racket[local-dir] using the same name. If the file already -exists in the local directory, it is replaced, but only after the -transfer succeeds (i.e., the file is first downloaded to a temporary -file in @racket[local-dir], then moved into place on success). +If @racket[local-dir-or-port] is a @racket[path-string?], +@racket[ftp-download-file] downloads @racket[file] from the server's current +directory and puts it in @racket[local-dir-or-port] using the same name. If the +file already exists in the local directory, it is replaced, but only after the +transfer succeeds (i.e., the file is first downloaded to a temporary file in +@racket[local-dir-or-port], then moved into place on success). + +When @racket[local-dir-or-port] is an @racket[output-port?], it downloads +@racket[file] from the server's current directory and writes its content to +provided @racket[output-port?]. The data is written to the port as it is being +received from the server and if the download is interrupted, incomplete data is +written to the port. The port is closed after finishing the transfer. If @racket[progress-proc] is not @racket[#f], then it is called with a function @racket[_get-count] that returns two values: the number of bytes @@ -118,7 +126,8 @@ is intended to limit polling. ]} @defproc[(ftp-upload-file [ftp-conn ftp-connection?] - [file-path path-string?] + [file-path path-string?] + [port (or/c #f input-port?) #f] [#:progress progress-proc (or/c #f (-> (-> (values exact-nonnegative-integer? @@ -127,10 +136,15 @@ is intended to limit polling. #f]) void?]{ -Upload @racket[file-path] to the server's current directory using the same name. -If the file already exists in the local directory, it is replaced. -The @racket[progress-proc] argument is used in the same way as in @racket[ftp-download-file], -but to report uploaded bytes instead of downloaded bytes.} +When @racket[port] is @racket[#f], upload @racket[file-path] to the server's +current directory using the same name. If the file already exists in the remote +directory, it is replaced. The @racket[progress-proc] argument is used in the +same way as in @racket[ftp-download-file], but to report uploaded bytes instead +of downloaded bytes. + +If @racket[port] is an @racket[input-port?], the content of that port is +streamed as upload to the server and stored under given @racket[file-path] +name. The port is closed after finishing the transfer.} @defproc[(ftp-delete-file [ftp-conn ftp-connection?] [file-path path-string?]) void?]{ diff --git a/pkgs/net-lib/net/ftp.rkt b/pkgs/net-lib/net/ftp.rkt index 0c6db57cc8..50f6a04c33 100644 --- a/pkgs/net-lib/net/ftp.rkt +++ b/pkgs/net-lib/net/ftp.rkt @@ -197,22 +197,29 @@ (define r `(,(car m) ,@(cddr m))) (if size `(,@r ,size) r))) -(define (ftp-download-file ftp-ports folder filename +(define (ftp-download-file ftp-ports folder-or-port filename #:progress [progress-proc #f]) ;; Save the file under a temporary name, rename it once download is ;; complete this assures we don't over write any existing file without ;; having a good file down - (let* ([tmpfile (make-temporary-file "~a.download" #f folder)] - [new-file (open-output-file tmpfile #:exists 'truncate)] - [tcp-data (establish-data-connection ftp-ports 'in)]) + (if (output-port? folder-or-port) + (let ([tcp-data (establish-data-connection ftp-ports 'in)]) - (transfer-data ftp-ports 'download tcp-data new-file filename progress-proc) + (transfer-data ftp-ports 'download tcp-data folder-or-port filename progress-proc)) - (rename-file-or-directory tmpfile (build-path folder filename) #t))) + (let* ([tmpfile (make-temporary-file "~a.download" #f folder-or-port)] + [new-file (open-output-file tmpfile #:exists 'truncate)] + [tcp-data (establish-data-connection ftp-ports 'in)]) -(define (ftp-upload-file ftp-ports filepath + (transfer-data ftp-ports 'download tcp-data new-file filename progress-proc) + + (rename-file-or-directory tmpfile (build-path folder-or-port filename) #t)))) + +(define (ftp-upload-file ftp-ports filepath [port #f] #:progress [progress-proc #f]) - (let ([upload-file (open-input-file filepath)] + (let ([upload-file (if port + port + (open-input-file filepath))] [tcp-data (establish-data-connection ftp-ports 'out)]) (let ([system-type (system-path-convention-type)]