128 lines
4.1 KiB
Racket
128 lines
4.1 KiB
Racket
#lang racket/base
|
|
(require ffi/unsafe
|
|
ffi/unsafe/define
|
|
ffi/file
|
|
unstable/error)
|
|
(provide unix-socket-connect
|
|
unix-socket-available?)
|
|
|
|
;; 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] ;; includes x86_64
|
|
[else #f])))
|
|
|
|
#|
|
|
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 1)
|
|
|
|
(define _socklen_t
|
|
(case platform
|
|
((linux86) _uint) ;; in practice, _uint32
|
|
((macosx) _uint32)))
|
|
|
|
(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 (make-array-type _byte 104)]))
|
|
|
|
(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)
|
|
(_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))
|
|
|
|
;; make-sockaddr : bytes -> (U _linux_sockaddr_un _macosx_sockaddr_un)
|
|
(define (make-sockaddr path)
|
|
(case platform
|
|
((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)))
|