62 lines
1.9 KiB
Racket
62 lines
1.9 KiB
Racket
#lang racket
|
|
(require racket/port
|
|
rackunit
|
|
unstable/socket)
|
|
|
|
(define (call-in-custodian proc)
|
|
(parameterize ((current-subprocess-custodian-mode 'kill))
|
|
(parameterize ((current-custodian (make-custodian)))
|
|
(call-with-continuation-barrier
|
|
(lambda ()
|
|
(dynamic-wind void
|
|
proc
|
|
(lambda ()
|
|
(custodian-shutdown-all (current-custodian)))))))))
|
|
|
|
(define netcat
|
|
(for/first ([netcat '("/bin/nc" "/usr/bin/nc")]
|
|
#:when (and (file-exists? netcat)
|
|
(memq 'execute (file-or-directory-permissions netcat))))
|
|
netcat))
|
|
|
|
(cond
|
|
[(and unix-socket-available? netcat)
|
|
(test-case "unix socket"
|
|
;; Uses netcat to create a simple unix domain socket server
|
|
(define tmp ((values make-temporary-file)))
|
|
(delete-file tmp)
|
|
(call-in-custodian
|
|
(lambda ()
|
|
(define-values (ncprocess ncout ncin ncerr)
|
|
(subprocess #f #f #f netcat "-Ul" (path->string tmp)))
|
|
(sleep 0.5)
|
|
(define-values (from-sock to-sock)
|
|
(unix-socket-connect tmp))
|
|
|
|
(define-check (check-comm msg out in)
|
|
(write-bytes msg out)
|
|
(flush-output out)
|
|
(check-equal? (sync/timeout 1 (read-bytes-evt (bytes-length msg) in))
|
|
msg))
|
|
|
|
(check-comm #"hello" to-sock ncout)
|
|
(check-comm #"charmed" ncin from-sock)
|
|
(check-comm #"well\ngoodbye, then" to-sock ncout)
|
|
|
|
(close-output-port to-sock)
|
|
(close-input-port from-sock)
|
|
|
|
(close-output-port ncin)
|
|
(close-input-port ncout)
|
|
(close-input-port ncerr)
|
|
(or (sync/timeout 1 ncprocess)
|
|
(subprocess-kill ncprocess))
|
|
))
|
|
(when (file-exists? tmp) (delete-file tmp)))]
|
|
[else
|
|
(eprintf "cannot test unix sockets\n")
|
|
(unless unix-socket-available?
|
|
(eprintf "unix sockets not supported\n"))
|
|
(unless netcat
|
|
(eprintf "netcat not available\n"))])
|