clean up socket code

collects/unstable/socket.rkt

@@ -1,105 +1,127 @@
 #lang racket/base
 (require ffi/unsafe
-         ffi/file)
+         ffi/unsafe/define
+         ffi/file
+         unstable/error)
 (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.
-(define (unix-socket-connect path0)
-  (unless (path-string? path0)
-    (raise-argument-error 'unix-socket-connect "path-string?" path0))
-  (security-guard-check-file 'unix-socket-connect path0 '(read write))
-  (let* ([path* (cleanse-path (path->complete-path path0))]
-         [path-b (path->bytes path*)])
-    (unless (< (bytes-length path-b) 100)
-      (error 'unix-socket-connect
-             "expected path of less than 100 bytes, got ~e" path*))
-    (define s (make-socket))
-    (unless (positive? s)
-      (error 'unix-socket-connect "failed to create socket"))
-    (define addr (make-unix-sockaddr path-b))
-    (define addrlen (+ (ctype-sizeof _short) (bytes-length path-b)))
-    (define ce (_connect s addr addrlen))
-    (unless (zero? ce)
-      (_close s)
-      (error 'unix-socket-connect "failed to connect socket to path: ~s" path0))
-    (with-handlers ([(lambda (e) #t)
-                     (lambda (e)
-                       (_close s)
-                       (raise e))])
-      (_make_fd_output_port s 'socket #f #f #t))))
+;; Unix domain sockets (connect only)
 
 (define platform
   (let ([os (system-type 'os)]
         [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"Linux.*86" machine) 'linux86] ;; includes x86_64
           [else #f])))
 
-(define unix-socket-available? (and platform #t))
-
-(define _socklen_t _uint)
+#|
+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
+|#
 
 (define AF_UNIX 1)
-(define SOCK_STREAM
+(define SOCK_STREAM 1)
+
+(define _socklen_t
   (case platform
-    ((linux86 macosx) 1)
-    ((solaris) 2)
-    (else #f)))
+    ((linux86) _uint)    ;; in practice, _uint32
+    ((macosx) _uint32)))
 
-(define (make-socket)
-  (unless (and AF_UNIX SOCK_STREAM)
-    (error 'unix-socket-connect "unix-domain sockets not supported on this platform"))
-  (_socket AF_UNIX SOCK_STREAM 0))
-
-(define _sockaddr_un_path_part
-  (case platform
-    ((linux86 solaris)
-     (make-cstruct-type (build-list 108 (lambda (i) _byte))))
-    ((macosx)
-     (make-cstruct-type (build-list 104 (lambda (i) _byte))))
-    (else
-     ;; kluge: so that later definitions go through.
-     _int)))
-
-(define-cstruct _sockaddr_un
-  ([sun_family _short]
-   [sun_path   _sockaddr_un_path_part]))
+(define-cstruct _linux_sockaddr_un
+  ([sun_family _ushort]
+   [sun_path   (make-array-type _byte 108)]))
 
 (define-cstruct _macosx_sockaddr_un
   ([sun_len    _ubyte]
    [sun_family _ubyte]
-   [sun_path   _sockaddr_un_path_part]))
+   [sun_path   (make-array-type _byte 104)]))
 
-(define (ffi name type)
+(define-ffi-definer define-libc (ffi-lib #f)
+  #:default-make-fail make-not-available)
+
+(define-libc socket
+  (_fun #:save-errno 'posix
+        _int _int _int -> _int))
+(define-libc connect
   (case platform
-    ((linux86 solaris macosx)
-     (get-ffi-obj name #f type (lambda () #f)))
-    (else
-     (lambda _ (error name "not supported")))))
+    ((linux86)
+     (_fun #:save-errno 'posix
+           _int _linux_sockaddr_un-pointer _int -> _int))
+    ((macosx)
+     (_fun #:save-errno 'posix
+           _int _macosx_sockaddr_un-pointer _int -> _int))))
+(define-libc close
+  (_fun #:save-errno 'posix
+        _int -> _int))
+(define-libc scheme_make_fd_output_port
+  (_fun _int _racket _bool _bool _bool -> _scheme))
 
-(define _socket
-  (ffi "socket" (_fun _int _int _int -> _int)))
-(define _connect
-  (ffi "connect"
-       (case platform
-         ((linux86 solaris)
-          (_fun _int _sockaddr_un-pointer _int -> _int))
-         ((macosx)
-          (_fun _int _macosx_sockaddr_un-pointer _int -> _int)))))
-(define _setsockopt
-  (ffi "setsockopt" (_fun _int _int _int _pointer _socklen_t -> _int)))
-(define _close
-  (ffi "close" (_fun _int -> _int)))
-(define _make_fd_output_port
-  (ffi "scheme_make_fd_output_port"
-       (_fun _int _scheme _bool _bool _bool -> _scheme)))
-
-(define (make-unix-sockaddr path)
+;; make-sockaddr : bytes -> (U _linux_sockaddr_un _macosx_sockaddr_un)
+(define (make-sockaddr path)
   (case platform
-    ((linux86 solaris)
-     (make-sockaddr_un AF_UNIX path))
+    ((linux86)
+     (make-linux_sockaddr_un AF_UNIX path))
     ((macosx)
      (make-macosx_sockaddr_un (bytes-length path) AF_UNIX path))))
+
+(define strerror_r
+  (get-ffi-obj (case platform
+                 ((linux86) "__xpg_strerror_r")
+                 (else "strerror_r"))
+               #f
+               (_fun (errno) ::
+                     (errno : _int)
+                     (buf : _bytes = (make-bytes 1000))
+                     (buf-len : _uintptr #| size_t |# = (bytes-length buf))
+                     -> _void
+                     -> (cast buf _bytes _string))
+               (lambda () (lambda (errno) #f))))
+
+;; ============================================================
+
+(define unix-socket-available? (and platform #t))
+
+;; unix-socket-connect : path-string -> input-port output-port
+;; Connects to the unix domain socket associated with the given path.
+(define (unix-socket-connect path0)
+  (unless (path-string? path0)
+    (raise-argument-error 'unix-socket-connect "path-string?" path0))
+  (unless platform
+    (error 'unix-socket-connect "unix domain sockets are not supported on this platform"))
+  (security-guard-check-file 'unix-socket-connect path0 '(read write))
+  (define clean-path (cleanse-path (path->complete-path path0)))
+  (define path-b (path->bytes clean-path))
+  (unless (< (bytes-length path-b) 100)
+    (raise-misc-error 'unix-socket-connect
+                      "complete path must be less than 100 bytes"
+                      '("path" value) path0
+                      '("complete path" value) clean-path))
+  (define s (socket AF_UNIX SOCK_STREAM 0))
+  (unless (positive? s)
+    (let ([errno (saved-errno)])
+      (raise-misc-error 'unix-socket-connect
+                        "failed to create socket"
+                        "errno" errno
+                        '("error" maybe) (strerror_r errno))))
+  (define addr (make-sockaddr path-b))
+  (define addrlen (+ (ctype-sizeof _ushort) (bytes-length path-b)))
+  (define ce (connect s addr addrlen))
+  (unless (zero? ce)
+    (close s)
+    (let ([errno (saved-errno)])
+      (raise-misc-error 'unix-socket-connect
+                        "failed to connect socket"
+                        '("path" value) path0
+                        "errno" errno
+                        '("error" maybe) (strerror_r errno))))
+  (with-handlers ([(lambda (e) #t)
+                   (lambda (e)
+                     (close s)
+                     (raise e))])
+    (scheme_make_fd_output_port s 'socket #f #f #t)))