;; Copyright 2011 Ryan Culpepper
;; Released under the terms of the LGPL version 3 or later.
;; See the file COPYRIGHT for details.

;; The solaris code is untested (and thus disabled).

#lang racket/base
(require ffi/unsafe
         (rename-in racket/contract [-> c->])
         "check-access.rkt")
(provide/contract
 [unix-socket-connect
  (c-> path-string? (values input-port? output-port?))])

;; unix-socket-connect : pathlike -> input-port output-port
;; Connects to the unix domain socket associated with the given path.
(define (unix-socket-connect path0)
  (define path-b (check-pathlike 'unix-socket-connect path0))
  (scheme_security_check_file "unix-socket-connect" path0
                              (+ SCHEME_GUARD_FILE_READ SCHEME_GUARD_FILE_WRITE))
  (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)
    (raise-user-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))))

(define (check-pathlike function path0)
  (unless (or (string? path0) (path? path0) (bytes? path0))
    (raise-type-error function
                      "path, string, or bytes"
                      path0))
  (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))
    path-b))