added unstable/socket
This commit is contained in:
parent
7a0b100ce0
commit
b3afbdd485
|
@ -4,7 +4,7 @@
|
||||||
openssl
|
openssl
|
||||||
"../generic/interfaces.rkt"
|
"../generic/interfaces.rkt"
|
||||||
"../generic/common.rkt"
|
"../generic/common.rkt"
|
||||||
"../generic/socket.rkt"
|
unstable/socket
|
||||||
"connection.rkt")
|
"connection.rkt")
|
||||||
(provide mysql-connect
|
(provide mysql-connect
|
||||||
mysql-guess-socket-path
|
mysql-guess-socket-path
|
||||||
|
|
|
@ -4,7 +4,7 @@
|
||||||
openssl
|
openssl
|
||||||
"../generic/interfaces.rkt"
|
"../generic/interfaces.rkt"
|
||||||
"../generic/common.rkt"
|
"../generic/common.rkt"
|
||||||
"../generic/socket.rkt"
|
unstable/socket
|
||||||
"connection.rkt")
|
"connection.rkt")
|
||||||
(provide postgresql-connect
|
(provide postgresql-connect
|
||||||
postgresql-guess-socket-path
|
postgresql-guess-socket-path
|
||||||
|
|
61
collects/tests/unstable/socket.rkt
Normal file
61
collects/tests/unstable/socket.rkt
Normal file
|
@ -0,0 +1,61 @@
|
||||||
|
#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 (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"))])
|
27
collects/unstable/scribblings/socket.scrbl
Normal file
27
collects/unstable/scribblings/socket.scrbl
Normal file
|
@ -0,0 +1,27 @@
|
||||||
|
#lang scribble/manual
|
||||||
|
@(require "utils.rkt"
|
||||||
|
(for-label racket/base
|
||||||
|
racket/contract
|
||||||
|
unstable/socket))
|
||||||
|
|
||||||
|
@title[#:tag "unix-socket"]{Unix Domain Sockets}
|
||||||
|
@unstable-header[]
|
||||||
|
|
||||||
|
@defmodule[unstable/socket]
|
||||||
|
|
||||||
|
@defthing[unix-socket-available?
|
||||||
|
boolean?]{
|
||||||
|
|
||||||
|
A boolean value that indicates whether unix domain sockets are
|
||||||
|
available and supported on the current platform. The supported
|
||||||
|
platforms are Linux and Mac OS X; unix domain sockets are not
|
||||||
|
supported on Windows and other Unix variants.
|
||||||
|
}
|
||||||
|
|
||||||
|
@defproc[(unix-socket-connect [socket-path path-string?])
|
||||||
|
(values input-port? output-port?)]{
|
||||||
|
|
||||||
|
Connects to the unix domain socket associated with
|
||||||
|
@racket[socket-path] and returns an input port and output port for
|
||||||
|
communicating with the socket.
|
||||||
|
}
|
|
@ -105,6 +105,7 @@ Keep documentation and tests up to date.
|
||||||
@include-section["custom-write.scrbl"] ;; Struct Printing
|
@include-section["custom-write.scrbl"] ;; Struct Printing
|
||||||
@include-section["syntax.scrbl"]
|
@include-section["syntax.scrbl"]
|
||||||
@include-section["../temp-c/scribblings/temp-c.scrbl"]
|
@include-section["../temp-c/scribblings/temp-c.scrbl"]
|
||||||
|
@include-section["socket.scrbl"] ;; Unix Domain Sockets
|
||||||
@include-section["2d.scrbl"]
|
@include-section["2d.scrbl"]
|
||||||
|
|
||||||
@;{--------}
|
@;{--------}
|
||||||
|
|
|
@ -1,9 +1,8 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
(require ffi/unsafe
|
(require ffi/unsafe
|
||||||
ffi/file)
|
ffi/file)
|
||||||
(provide unix-socket-connect)
|
(provide unix-socket-connect
|
||||||
|
unix-socket-available?)
|
||||||
;; The solaris code is untested (and thus disabled).
|
|
||||||
|
|
||||||
;; unix-socket-connect : pathlike -> input-port output-port
|
;; unix-socket-connect : pathlike -> input-port output-port
|
||||||
;; Connects to the unix domain socket associated with the given path.
|
;; Connects to the unix domain socket associated with the given path.
|
||||||
|
@ -36,11 +35,12 @@
|
||||||
[machine (system-type 'machine)])
|
[machine (system-type 'machine)])
|
||||||
(cond [(eq? os 'macosx) 'macosx]
|
(cond [(eq? os 'macosx) 'macosx]
|
||||||
[(regexp-match #rx"Linux.*86" machine) 'linux86]
|
[(regexp-match #rx"Linux.*86" machine) 'linux86]
|
||||||
[(regexp-match #rx"SunOS" machine) #f #;'solaris]
|
[(regexp-match #rx"SunOS" machine) #f #|'solaris |#]
|
||||||
[else #f])))
|
[else #f])))
|
||||||
|
|
||||||
|
(define unix-socket-available? (and platform #t))
|
||||||
|
|
||||||
(define _socklen_t _uint)
|
(define _socklen_t _uint)
|
||||||
(define _size_t _int)
|
|
||||||
|
|
||||||
(define AF_UNIX 1)
|
(define AF_UNIX 1)
|
||||||
(define SOCK_STREAM
|
(define SOCK_STREAM
|
Loading…
Reference in New Issue
Block a user