47 lines
1.4 KiB
Scheme
47 lines
1.4 KiB
Scheme
|
; 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))
|