cl-sipc/ffi.lisp

;; Foreign functions

(in-package :cl-sipc)


(defctype si-type :int)
(defconstant +si-string+ 0)
(defconstant +si-binary+ 1)
(defconstant +si-close+ 2)

(defctype si-error :int)
(defconstant +sie-accept+ 0)
(defconstant +sie-read+ 1)
(defconstant +sie-pconcls+ 2)
(defconstant +sie-invalid+ 3)

(defctype si-send-rc :int)
(defconstant +si-send-okay+ 0)
(defconstant +si-send-partial+ 1)
(defconstant +si-send-error+ -1)
(defconstant +si-send-failure+ -2)

;; library definition

(define-foreign-library libsipc
  (:unix (:or "libsipc.so" "libsipc-ffi.so" "./libsipc.so"))
  (t (:default "libsipc")))

(use-foreign-library libsipc)

;; FFI helper functions

(defcfun "sif_type" si-type (message :pointer))
(defcfun "sif_size" :unsigned-int (message :pointer))
(defcfun "sif_data" :pointer (message :pointer))

(defcfun "si_error_string" :pointer (err si-error))

;; Callbacks

(defun marshal-ec (err)
  (cond ((= err #.+sie-accept+) :accept)
	((= err #.+sie-read+) :read)
	((= err #.+sie-pconcls+) :closed)
	((= err #.+sie-invalid+) :message)
	(t :unknown)))

(defcallback si-error-callback :int ((err si-error))
  (when (symbol-value '*on-error*)
    (if (funcall (symbol-value '*on-error*) (marshal-ec err))
      0
      1)))
 
(defcallback si-callback :int ((message :pointer))
  (let* ((type (sif-type message))
	(size (sif-size message))
	(data (sif-data message))
	(rval (cond ((= type #.+si-string+) (funcall (symbol-value '*on-message*) :string (foreign-string-to-lisp data)))
		    ((= type #.+si-close+) (funcall (symbol-value '*on-message*) :close nil))
		    ((= type #.+si-binary+) (funcall (symbol-value '*on-message*) :binary (make-pointer :memory data :size size))))))
    (if rval
      0
      1)))

;; libsipc functions

(defcfun "si_bind" :int
  (file :string))

(defcfun "si_listen" :int
  (server :int)
  (on-error :pointer)
  (on-message :pointer))

(defcfun "si_close" :void
  (server :int))

(defcfun "si_connect" :int
  (file :string))

;; send functions

(defcfun "siqs_string" :int
  (sd :int)
  (string :string))

(defcfun "siqs_close" :int
  (sd :int))

(defcfun "siqs_binary" :int
  (sd :int)
  (buffer :pointer)
  (size :int))