Split out FTP-LIBRARY from FTPD; it contains data-shuffling procedures

which are useful for the client as well.
This commit is contained in:
sperber 2003-01-16 10:34:39 +00:00
parent f0448cb34f
commit 3be94a89e4
3 changed files with 58 additions and 39 deletions

View File

@ -1208,8 +1208,6 @@
thunk thunk
maybe-close-data-connection)) maybe-close-data-connection))
(define *window-size* 51200)
(define (ensure-data-connection) (define (ensure-data-connection)
(if (and (not (the-session-data-socket)) (if (and (not (the-session-data-socket))
(not (the-session-passive-socket))) (not (the-session-passive-socket)))
@ -1353,40 +1351,3 @@
(cons message (the-session-reverse-replies))) (cons message (the-session-reverse-replies)))
(set-the-session-reply-code! code)) (set-the-session-reply-code! code))
(define (copy-port->port-binary input-port output-port)
(let ((buffer (make-string *window-size*)))
(let loop ()
(cond
((read-string! buffer input-port)
=> (lambda (length)
(write-string buffer output-port 0 length)
(loop))))))
(force-output output-port))
(define (copy-port->port-ascii input-port output-port)
(let loop ()
(let ((line (read-line input-port 'concat)))
(if (not (eof-object? line))
(let ((length (string-length line)))
(cond
((zero? length)
'fick-dich-ins-knie)
((char=? #\newline (string-ref line (- length 1)))
(write-string line output-port 0 (- length 1))
(write-crlf output-port))
(else
(write-string line output-port)))
(loop)))))
(force-output output-port))
(define (copy-ascii-port->port input-port output-port)
(let loop ()
(let* ((line (read-crlf-line input-port
#f))
(length (string-length line)))
(if (not (eof-object? line))
(begin
(write-string line output-port 0 length)
(newline output-port)
(loop)))))
(force-output output-port))

View File

@ -0,0 +1,47 @@
; Utility library for FTP clients and servers
;;; This file is part of the Scheme Untergrund Networking package.
;;; Copyright (c) 1998-2002 by Mike Sperber <sperber@informatik.uni-tuebingen.de>
;;; For copyright information, see the file COPYING which comes with
;;; the distribution.
(define *window-size* 4096)
(define (copy-port->port-binary input-port output-port)
(let ((buffer (make-string *window-size*)))
(let loop ()
(cond
((read-string! buffer input-port)
=> (lambda (length)
(write-string buffer output-port 0 length)
(loop))))))
(force-output output-port))
(define (copy-port->port-ascii input-port output-port)
(let loop ()
(let ((line (read-line input-port 'concat)))
(if (not (eof-object? line))
(let ((length (string-length line)))
(cond
((zero? length)
'fick-dich-ins-knie)
((char=? #\newline (string-ref line (- length 1)))
(write-string line output-port 0 (- length 1))
(write-crlf output-port))
(else
(write-string line output-port)))
(loop)))))
(force-output output-port))
(define (copy-ascii-port->port input-port output-port)
(let loop ()
(let* ((line (read-crlf-line input-port
#f))
(length (string-length line)))
(if (not (eof-object? line))
(begin
(write-string line output-port 0 length)
(newline output-port)
(loop)))))
(force-output output-port))

View File

@ -83,6 +83,11 @@
parse-http-url-string parse-http-url-string
http-url->string)) http-url->string))
(define-interface ftp-library-interface
(export copy-port->port-binary
copy-port->port-ascii
copy-ascii-port->port))
(define-interface ftp-interface (define-interface ftp-interface
(export ftp-connect (export ftp-connect
ftp-login ftp-login
@ -401,6 +406,11 @@
httpd-error) httpd-error)
(files (lib url))) (files (lib url)))
(define-structure ftp-library ftp-library-interface
(open scheme-with-scsh
crlf-io)
(files (lib ftp-library)))
(define-structure ftp ftp-interface (define-structure ftp ftp-interface
(open scheme-with-scsh (open scheme-with-scsh
netrc netrc
@ -524,6 +534,7 @@
(subset srfi-1 (any partition)) (subset srfi-1 (any partition))
crlf-io crlf-io
ls ls
ftp-library
dns dns
sunet-version sunet-version
sunet-utilities sunet-utilities