; 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))