suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

.

Browse Source 
original commit: b751948c1d6b391cdfee4f8d48c5ef697930787d
This commit is contained in:
Robby Findler 2004-08-19 01:55:44 +00:00
parent 0a0ab9fcd8
commit 800aed2f82
1 changed files with 101 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/net/tcp-redirect.ss
View File

@ -21,7 +21,8 @@
; primitive for bad inputs. ; primitive for bad inputs.
; : (listof nat) -> (unit/sig () -> net:tcp^) ; : (listof nat) -> (unit/sig () -> net:tcp^)
(define (tcp-redirect redirected-ports) (define tcp-redirect
(opt-lambda (redirected-ports [redirected-address "127.0.0.1"])
(unit/sig net:tcp^ (unit/sig net:tcp^
(import) (import)
@ -52,7 +53,7 @@
(define (tcp-addresses tcp-port) (define (tcp-addresses tcp-port)
(if (tcp-port? tcp-port) (if (tcp-port? tcp-port)
(raw:tcp-addresses tcp-port) (raw:tcp-addresses tcp-port)
(values local-address local-address))) (values redirected-address redirected-address)))
; : port -> void ; : port -> void
(define (tcp-close tcp-listener) (define (tcp-close tcp-listener)
@ -65,7 +66,7 @@
; : (str nat -> iport oport) -> str nat -> iport oport ; : (str nat -> iport oport) -> str nat -> iport oport
(define (gen-tcp-connect raw) (define (gen-tcp-connect raw)
(lambda (hostname-string port) (lambda (hostname-string port)
(if (and (string=? local-address hostname-string) (if (and (string=? redirected-address hostname-string)
(redirect? port)) (redirect? port))
(let-values ([(to-in from-out) (make-pipe)] (let-values ([(to-in from-out) (make-pipe)]
[(from-in to-out) (make-pipe)]) [(from-in to-out) (make-pipe)])
@ -76,8 +77,9 @@
port port
(lambda () (lambda ()
(raise (make-exn:fail:network (raise (make-exn:fail:network
(string->immutable-string
(format "tcp-connect: connection to ~a, port ~a failed (nobody is listening)" (format "tcp-connect: connection to ~a, port ~a failed (nobody is listening)"
hostname-string port) hostname-string port))
(current-continuation-marks)))))) (current-continuation-marks))))))
(cons to-in to-out)) (cons to-in to-out))
(values from-in from-out)) (values from-in from-out))
@ -119,6 +121,4 @@
; : nat -> bool ; : nat -> bool
(define (redirect? port) (define (redirect? port)
(hash-table-get redirect-table port (lambda () #f))))) (hash-table-get redirect-table port (lambda () #f)))))))
(define local-address "127.0.0.1"))