2003-01-28 08:44:57 -05:00
|
|
|
;;; This file is part of the Scheme Untergrund Library.
|
|
|
|
|
|
|
|
;;; Copyright (c) 2002-2003 by Martin Gasbichler.
|
|
|
|
;;; For copyright information, see the file COPYING which comes with
|
|
|
|
;;; the distribution.
|
|
|
|
|
2003-02-26 10:31:33 -05:00
|
|
|
(define (socket<->stdports host port)
|
2003-01-28 08:44:57 -05:00
|
|
|
(let ((s (socket-connect protocol-family/internet socket-type/stream host port)))
|
|
|
|
(set-port-buffering (socket:outport s) bufpol/none)
|
|
|
|
(set-port-buffering (socket:inport s) bufpol/none)
|
|
|
|
(spawn (lambda () (dynamic-wind
|
|
|
|
(lambda () #f)
|
|
|
|
(lambda ()
|
|
|
|
(dup-port (socket:inport s) (current-output-port)))
|
|
|
|
(lambda ()
|
|
|
|
(close (socket:inport s))))))
|
|
|
|
|
|
|
|
(dynamic-wind
|
|
|
|
(lambda () #f)
|
|
|
|
(lambda ()
|
|
|
|
(dup-port (current-input-port) (socket:outport s)))
|
|
|
|
(lambda ()
|
2003-02-26 10:31:33 -05:00
|
|
|
(close-socket s)))))
|
2003-01-28 08:44:57 -05:00
|
|
|
|
|
|
|
|
|
|
|
(define (dup-port from to)
|
|
|
|
(let ((c (read-char from)))
|
|
|
|
(if (not (eof-object? c))
|
|
|
|
(begin
|
|
|
|
(display c to)
|
|
|
|
(dup-port from to)))))
|
|
|
|
|
|
|
|
|