tests, doc edits, and minor changes for unix sockets

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
+Returns @racket[#t] if @racket[v] is a valid unix domain socket path
-system.  This is equivalent to @racket[path-string?] on Mac OS X,
+for the current system, according to the following cases:
-but also includes an arbitrary string with @racket[\u0000] prefix
+
-on Linux (to accomodate for it's abstract namespace feature).
+@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].
 }

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-ports to-sock from-sock)
-       (close-output-port to-sock)
+       (close-ports ncin ncout ncerr)
-       (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")
+  (printf "cannot test unix sockets: ~a\n"
-  (unless unix-socket-available?
+          (if netcat
-    (eprintf "unix sockets not supported\n"))
+              "unix sockets not supported"
-  (unless netcat
+              "netcat not found"))])
-    (eprintf "netcat not available\n"))])
+
+;; 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")])

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)
+         ffi/file
-
+         unstable/error)
-(require "error.rkt")
 
 (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)
+    (with-handlers ([(lambda (e) #t)
-                              (close socket-fd)
+                     (lambda (exn)
-                              (raise exn))])
+                       (close socket-fd)
+                       (raise exn))])
       (scheme_make_fd_output_port socket-fd 'unix-socket #f #f #t))))