106 lines
3.3 KiB
Racket
106 lines
3.3 KiB
Racket
#lang racket/base
|
|
(require ffi/unsafe
|
|
ffi/file)
|
|
(provide unix-socket-connect)
|
|
|
|
;; The solaris code is untested (and thus disabled).
|
|
|
|
;; 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))))
|
|
|
|
(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]
|
|
[else #f])))
|
|
|
|
(define _socklen_t _uint)
|
|
(define _size_t _int)
|
|
|
|
(define AF_UNIX 1)
|
|
(define SOCK_STREAM
|
|
(case platform
|
|
((linux86 macosx) 1)
|
|
((solaris) 2)
|
|
(else #f)))
|
|
|
|
(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 _macosx_sockaddr_un
|
|
([sun_len _ubyte]
|
|
[sun_family _ubyte]
|
|
[sun_path _sockaddr_un_path_part]))
|
|
|
|
(define (ffi name type)
|
|
(case platform
|
|
((linux86 solaris macosx)
|
|
(get-ffi-obj name #f type (lambda () #f)))
|
|
(else
|
|
(lambda _ (error name "not supported")))))
|
|
|
|
(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)
|
|
(case platform
|
|
((linux86 solaris)
|
|
(make-sockaddr_un AF_UNIX path))
|
|
((macosx)
|
|
(make-macosx_sockaddr_un (bytes-length path) AF_UNIX path))))
|