added unstable/socket

This commit is contained in:
Ryan Culpepper 2013-02-14 13:35:35 -05:00
parent 7a0b100ce0
commit b3afbdd485
6 changed files with 96 additions and 7 deletions

View File

@ -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

View File

@ -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

View 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"))])

View 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.
}

View File

@ -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"]
@;{--------} @;{--------}

View File

@ -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