diff --git a/collects/db/private/mysql/main.rkt b/collects/db/private/mysql/main.rkt index b70ba1ac8f..9f03e2f453 100644 --- a/collects/db/private/mysql/main.rkt +++ b/collects/db/private/mysql/main.rkt @@ -4,7 +4,7 @@ openssl "../generic/interfaces.rkt" "../generic/common.rkt" - "../generic/socket.rkt" + unstable/socket "connection.rkt") (provide mysql-connect mysql-guess-socket-path diff --git a/collects/db/private/postgresql/main.rkt b/collects/db/private/postgresql/main.rkt index 9a986f8686..637bd6417d 100644 --- a/collects/db/private/postgresql/main.rkt +++ b/collects/db/private/postgresql/main.rkt @@ -4,7 +4,7 @@ openssl "../generic/interfaces.rkt" "../generic/common.rkt" - "../generic/socket.rkt" + unstable/socket "connection.rkt") (provide postgresql-connect postgresql-guess-socket-path diff --git a/collects/tests/unstable/socket.rkt b/collects/tests/unstable/socket.rkt new file mode 100644 index 0000000000..49faef801a --- /dev/null +++ b/collects/tests/unstable/socket.rkt @@ -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"))]) diff --git a/collects/unstable/scribblings/socket.scrbl b/collects/unstable/scribblings/socket.scrbl new file mode 100644 index 0000000000..73c531520a --- /dev/null +++ b/collects/unstable/scribblings/socket.scrbl @@ -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. +} diff --git a/collects/unstable/scribblings/unstable.scrbl b/collects/unstable/scribblings/unstable.scrbl index afabdd71d2..d72baa988c 100644 --- a/collects/unstable/scribblings/unstable.scrbl +++ b/collects/unstable/scribblings/unstable.scrbl @@ -105,6 +105,7 @@ Keep documentation and tests up to date. @include-section["custom-write.scrbl"] ;; Struct Printing @include-section["syntax.scrbl"] @include-section["../temp-c/scribblings/temp-c.scrbl"] +@include-section["socket.scrbl"] ;; Unix Domain Sockets @include-section["2d.scrbl"] @;{--------} diff --git a/collects/db/private/generic/socket.rkt b/collects/unstable/socket.rkt similarity index 94% rename from collects/db/private/generic/socket.rkt rename to collects/unstable/socket.rkt index 7ac4988991..f98695ca34 100644 --- a/collects/db/private/generic/socket.rkt +++ b/collects/unstable/socket.rkt @@ -1,9 +1,8 @@ #lang racket/base (require ffi/unsafe ffi/file) -(provide unix-socket-connect) - -;; The solaris code is untested (and thus disabled). +(provide unix-socket-connect + unix-socket-available?) ;; unix-socket-connect : pathlike -> input-port output-port ;; Connects to the unix domain socket associated with the given path. @@ -36,11 +35,12 @@ [machine (system-type 'machine)]) (cond [(eq? os 'macosx) 'macosx] [(regexp-match #rx"Linux.*86" machine) 'linux86] - [(regexp-match #rx"SunOS" machine) #f #;'solaris] + [(regexp-match #rx"SunOS" machine) #f #|'solaris |#] [else #f]))) +(define unix-socket-available? (and platform #t)) + (define _socklen_t _uint) -(define _size_t _int) (define AF_UNIX 1) (define SOCK_STREAM