diff --git a/pkgs/unstable-pkgs/unstable-doc/scribblings/socket.scrbl b/pkgs/unstable-pkgs/unstable-doc/scribblings/socket.scrbl index 190011a08a..4d159b47ce 100644 --- a/pkgs/unstable-pkgs/unstable-doc/scribblings/socket.scrbl +++ b/pkgs/unstable-pkgs/unstable-doc/scribblings/socket.scrbl @@ -28,8 +28,24 @@ communicating with the socket. @defproc[(unix-socket-path? [v any/c]) boolean?]{ -Predicate that identifies a valid unix domain socket path for this -system. This is equivalent to @racket[path-string?] on Mac OS X, -but also includes an arbitrary string with @racket[\u0000] prefix -on Linux (to accomodate for it's abstract namespace feature). +Returns @racket[#t] if @racket[v] is a valid unix domain socket path +for the current system, according to the following cases: + +@itemlist[ + +@item{If @racket[v] is a path (@racket[path-string?]), then the +current platform must be either Linux or Mac OS X, and the length of +@racket[v]'s corresponding absolute path must be less than or equal to +the platform-specific length (108 bytes on Linux, 104 bytes on Mac OS +X). Example: @racket["/tmp/mysocket"].} + +@item{If @racket[v] is a bytestring (@racket[bytes?]), then the +current platform must be Linux, @racket[v] must start with a +@racket[0] (NUL) byte, and its length must be less than or equal to +108 bytes. Such a value refers to a socket in the Linux abstract +socket namespace. Example: @racket[#"\0mysocket"].} + +] + +Otherwise, returns @racket[#f]. } diff --git a/pkgs/unstable-pkgs/unstable-test/tests/unstable/socket.rkt b/pkgs/unstable-pkgs/unstable-test/tests/unstable/socket.rkt index b3152d9767..d4fcb8ce2c 100644 --- a/pkgs/unstable-pkgs/unstable-test/tests/unstable/socket.rkt +++ b/pkgs/unstable-pkgs/unstable-test/tests/unstable/socket.rkt @@ -13,12 +13,36 @@ (lambda () (custodian-shutdown-all (current-custodian))))))))) +;; Commands for creating socket listeners +;; - netcat is commonly available, but cannot use Linux abstract namespace +;; - socat can use Linux abstract namespace, but is less common +;; So use netcat for path test and socat for abstract-name test. + (define netcat (for/first ([netcat '("/bin/nc" "/usr/bin/nc")] #:when (and (file-exists? netcat) (memq 'execute (file-or-directory-permissions netcat)))) netcat)) +(define socat + (for/first ([socat '("/usr/bin/socat")] + #:when (and (file-exists? socat) + (memq 'execute (file-or-directory-permissions socat)))) + socat)) + +(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)) + +(define (close-ports . ports) + (for ([port ports]) + (cond [(input-port? port) (close-input-port port)] + [(output-port? port) (close-output-port port)]))) + +;; Test path-based socket + (cond [(and unix-socket-available? netcat) (test-case "unix socket" @@ -32,30 +56,43 @@ (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) + (close-ports to-sock from-sock) + (close-ports ncin ncout 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"))]) + (printf "cannot test unix sockets: ~a\n" + (if netcat + "unix sockets not supported" + "netcat not found"))]) + +;; Test Linux abstract name socket + +(cond + [(and unix-socket-available? socat) + (test-case "unix socket w/ abstract name" + ;; Uses socat to create a simple unix domain socket server + (call-in-custodian + (lambda () + (define name #"TestRacketABC") + (define-values (ncprocess ncout ncin ncerr) + (subprocess #f #f #f socat (format "ABSTRACT-LISTEN:~a" name) "STDIO")) + (sleep 0.5) + (define-values (from-sock to-sock) + (unix-socket-connect (bytes-append #"\0" name))) + (check-comm #"hello" to-sock ncout) + (check-comm #"charmed" ncin from-sock) + (check-comm #"well\ngoodbye, then" to-sock ncout) + (close-ports to-sock from-sock) + (close-ports ncin ncout ncerr) + (or (sync/timeout 1 ncprocess) + (subprocess-kill ncprocess)) + (void) + )))] + [(not socat) + (printf "cannot test unix sockets w/ abstract namespace: socat not found\n")]) diff --git a/racket/collects/unstable/socket.rkt b/racket/collects/unstable/socket.rkt index 602353cf68..0b9b7ff380 100644 --- a/racket/collects/unstable/socket.rkt +++ b/racket/collects/unstable/socket.rkt @@ -1,23 +1,29 @@ #lang racket/base -; -; Support for connecting to UNIX domain sockets. -; + +;; Support for connecting to UNIX domain sockets. + +#| +References: +linux (64): + Linux Standard Base Core Specification 4.1 +macosx (64): + /usr/include/i386/_types.h: __darwin_socklen_t + /usr/include/sys/socket.h: AF_UNIX + /usr/include/sys/un.h: struct sockaddr_un +|# (require racket/contract (rename-in ffi/unsafe (-> -->)) ffi/unsafe/define - ffi/file) - -(require "error.rkt") + ffi/file + unstable/error) (provide (contract-out [unix-socket-available? boolean?] - [unix-socket-connect (-> unix-socket-path? (values input-port? output-port?))] - [unix-socket-path? (-> any/c boolean?)])) @@ -27,10 +33,8 @@ (cond [(eq? (system-type 'os) 'macosx) 'macosx] - [(regexp-match? #rx"^Linux" (system-type 'machine)) 'linux] - [else #f])) @@ -67,12 +71,6 @@ [(macosx) _macosx_sockaddr_un-pointer] [else _pointer])) -(define sockaddr_un? - (case platform - [(linux) linux_sockaddr_un?] - [(macosx) macosx_sockaddr_un?] - [else cpointer?])) - (define-ffi-definer define-libc (ffi-lib #f) #:default-make-fail make-not-available) @@ -135,7 +133,6 @@ (case platform [(linux) (make-linux_sockaddr_un AF-UNIX path-bytes)] - [(macosx) (make-macosx_sockaddr_un (bytes-length path-bytes) AF-UNIX path-bytes)])) @@ -168,7 +165,8 @@ "errno" errno '("error" maybe) (strerror_r errno)))) - (with-handlers ([values (lambda (exn) - (close socket-fd) - (raise exn))]) + (with-handlers ([(lambda (e) #t) + (lambda (exn) + (close socket-fd) + (raise exn))]) (scheme_make_fd_output_port socket-fd 'unix-socket #f #f #t))))