From 3be94a89e4bd6d7ae57c410c4b84d7dbe46f8ccd Mon Sep 17 00:00:00 2001
From: sperber <sperber>
Date: Thu, 16 Jan 2003 10:34:39 +0000
Subject: [PATCH] Split out FTP-LIBRARY from FTPD; it contains data-shuffling
 procedures which are useful for the client as well.

---
 scheme/ftpd/ftpd.scm       | 39 -------------------------------
 scheme/lib/ftp-library.scm | 47 ++++++++++++++++++++++++++++++++++++++
 scheme/packages.scm        | 11 +++++++++
 3 files changed, 58 insertions(+), 39 deletions(-)
 create mode 100644 scheme/lib/ftp-library.scm

diff --git a/scheme/ftpd/ftpd.scm b/scheme/ftpd/ftpd.scm
index 07c4fcd..d8d314f 100644
--- a/scheme/ftpd/ftpd.scm
+++ b/scheme/ftpd/ftpd.scm
@@ -1208,8 +1208,6 @@
 		thunk
 		maybe-close-data-connection))
   
-(define *window-size* 51200)
-
 (define (ensure-data-connection)
   (if (and (not (the-session-data-socket)) 
 	   (not (the-session-passive-socket)))
@@ -1353,40 +1351,3 @@
 	(cons message (the-session-reverse-replies)))
   (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))
diff --git a/scheme/lib/ftp-library.scm b/scheme/lib/ftp-library.scm
new file mode 100644
index 0000000..cdafe3c
--- /dev/null
+++ b/scheme/lib/ftp-library.scm
@@ -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))
\ No newline at end of file
diff --git a/scheme/packages.scm b/scheme/packages.scm
index 091477d..22e3e85 100644
--- a/scheme/packages.scm
+++ b/scheme/packages.scm
@@ -83,6 +83,11 @@
 	  parse-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
   (export ftp-connect
           ftp-login
@@ -401,6 +406,11 @@
 	httpd-error)
   (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
   (open scheme-with-scsh
 	netrc
@@ -524,6 +534,7 @@
 	(subset srfi-1 (any partition))
 	crlf-io
 	ls
+	ftp-library
 	dns
 	sunet-version
 	sunet-utilities