You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
77 lines
1.8 KiB
77 lines
1.8 KiB
6 years ago
|
;; 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 data)))))
|
||
|
|
(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))
|