84 lines
2.4 KiB
Racket
84 lines
2.4 KiB
Racket
#lang racket/base
|
|
(require racket/tcp
|
|
racket/list
|
|
racket/match
|
|
racket/port
|
|
racket/contract)
|
|
|
|
(define to-client #"0")
|
|
(define to-server #"1")
|
|
(define (tcp-localhost-available?)
|
|
(with-handlers
|
|
([exn? (λ (x) #f)])
|
|
(define the-listener
|
|
(tcp-listen 0 4 #t #f))
|
|
(define-values (local-host port end-host end-port)
|
|
(tcp-addresses the-listener #t))
|
|
(let loop ([listener the-listener]
|
|
[sip #f] [sop #f]
|
|
[connected? #f]
|
|
[cip #f] [cop #f])
|
|
(if (and (not listener)
|
|
(not sip)
|
|
(not sop)
|
|
connected?
|
|
(not cip)
|
|
(not cop))
|
|
#t
|
|
(sync
|
|
(if listener
|
|
(handle-evt
|
|
(tcp-accept-evt listener)
|
|
(match-lambda
|
|
[(list sip sop)
|
|
(tcp-close listener)
|
|
(loop #f sip sop connected? cip cop)]))
|
|
never-evt)
|
|
(if sop
|
|
(handle-evt
|
|
(write-bytes-avail-evt to-client sop)
|
|
(λ (written-bs-n)
|
|
(tcp-abandon-port sop)
|
|
(loop #f sip #f connected? cip cop)))
|
|
never-evt)
|
|
(if sip
|
|
(handle-evt
|
|
(read-bytes-evt 1 sip)
|
|
(λ (read-bs)
|
|
(unless (bytes=? to-server read-bs)
|
|
(error 'wrong))
|
|
(tcp-abandon-port sip)
|
|
(loop #f #f sop connected? cip cop)))
|
|
never-evt)
|
|
(if connected?
|
|
never-evt
|
|
(handle-evt
|
|
always-evt
|
|
(λ (_)
|
|
(define-values (cip cop)
|
|
(tcp-connect "localhost" port))
|
|
(loop listener sip sop #t cip cop))))
|
|
(if cop
|
|
(handle-evt
|
|
(write-bytes-avail-evt to-server cop)
|
|
(λ (written-bs-n)
|
|
(tcp-abandon-port cop)
|
|
(loop listener sip sop connected? cip #f)))
|
|
never-evt)
|
|
(if cip
|
|
(handle-evt
|
|
(read-bytes-evt 1 cip)
|
|
(λ (read-bs)
|
|
(unless (bytes=? to-client read-bs)
|
|
(error 'wrong))
|
|
(tcp-abandon-port cip)
|
|
(loop listener sip sop connected? #f cop)))
|
|
never-evt))))))
|
|
|
|
(provide
|
|
(contract-out
|
|
[tcp-localhost-available? (-> boolean?)]))
|
|
|
|
(module+ main
|
|
(tcp-localhost-available?))
|