From 782aa78d56391c87280aafc2e0e29ac748b845be Mon Sep 17 00:00:00 2001 From: Avril Date: Sun, 12 May 2019 21:46:34 +0100 Subject: [PATCH] added lisp part --- cl-sipc.asd | 12 ++++++++ cl-sipc.lisp | 42 ++++++++++++++++++++++++++ ffi.lisp | 76 +++++++++++++++++++++++++++++++++++++++++++++++ libsipc/Makefile | 4 +++ libsipc/src/ffi.c | 18 +++++++++++ package.lisp | 5 ++++ test.lisp | 19 ++++++++++++ 7 files changed, 176 insertions(+) create mode 100644 cl-sipc.asd create mode 100644 cl-sipc.lisp create mode 100644 ffi.lisp create mode 100644 libsipc/src/ffi.c create mode 100644 package.lisp create mode 100644 test.lisp diff --git a/cl-sipc.asd b/cl-sipc.asd new file mode 100644 index 0000000..3d7b37a --- /dev/null +++ b/cl-sipc.asd @@ -0,0 +1,12 @@ + + +(asdf:defsystem #:cl-sipc + :description "AF_UNIX IPC for CL" + :author "Avril " + :license "None" + :version "0.0.1" + :serial t + :depends-on ( :cffi ) + :components ((:file "package") + (:file "ffi") + (:file "cl-sipc"))) diff --git a/cl-sipc.lisp b/cl-sipc.lisp new file mode 100644 index 0000000..c504f8e --- /dev/null +++ b/cl-sipc.lisp @@ -0,0 +1,42 @@ +;; cl-sipc + +(in-package :cl-sipc) + +(defparameter *on-error* #'(lambda (err) nil)) +(defparameter *on-message* #'(lambda (msg) + (not (eql :close (car msg))))) + +;; wrappers + +(defun bind (file) + "bind to the AF_UNIX socket `file'" + "returns the sd on success, nil on failure" + "(remember it has to be deleted first!)" + (let ((rc (si-bind file))) + (if (< rc 0) ;error + nil + rc))) + +(defun hook (sd on-err on-msg) + "listen on socket `sd'" + "on error call the callback `on-err' with args (error)" + "on message call the callback `on-msg' with args (type message)" + "type can be: + :string - a string + :binary - (TODO) a foreign pointer + :close - a close request" + "returns rc on success (1), and nil on failure" + "(note: this function blocks until the connection closes)" + (let ((*on-message* on-msg) + (*on-err* on-err)) + (let ((rc (si-listen sd (callback si-error-callback) (callback si-callback)))) + (if (< rc 0) + nil + rc)))) + +(defun release (sd) + "close a socket `sd'" + (si-close sd) + t) + +(mapc #'export '(bind hook release)) diff --git a/ffi.lisp b/ffi.lisp new file mode 100644 index 0000000..125a248 --- /dev/null +++ b/ffi.lisp @@ -0,0 +1,76 @@ +;; 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)) diff --git a/libsipc/Makefile b/libsipc/Makefile index d773ede..705b7b6 100644 --- a/libsipc/Makefile +++ b/libsipc/Makefile @@ -14,6 +14,10 @@ libsipc: gcc $(CFLAGS) $(TRANS) gcc -shared -o $@.so *.o +libsipc-ffi: + gcc $(CFLAGS) $(TRANS) src/ffi.c + gcc -shared -o $@.so *.o + sipcli: libsipc gcc -Wall -pedantic -I$(INCLUDE) -Wl,-rpath=./ src/test.c -o $@ -L./ -lsipc ./$@ diff --git a/libsipc/src/ffi.c b/libsipc/src/ffi.c new file mode 100644 index 0000000..dbe3b2c --- /dev/null +++ b/libsipc/src/ffi.c @@ -0,0 +1,18 @@ +#include + +//Some FFI helpers + +si_type sif_type(const si_message* msg) +{ + return msg->type; +} + +unsigned int sif_size(const si_message* msg) +{ + return msg->data_len; +} + +const unsigned char* sif_data(const si_message* msg) +{ + return msg->data; +} diff --git a/package.lisp b/package.lisp new file mode 100644 index 0000000..e9381ee --- /dev/null +++ b/package.lisp @@ -0,0 +1,5 @@ + + +(defpackage #:cl-sipc + (:use #:cl + #:cffi)) diff --git a/test.lisp b/test.lisp new file mode 100644 index 0000000..cb94c9c --- /dev/null +++ b/test.lisp @@ -0,0 +1,19 @@ + + +(ql:quickload :cl-sipc) + +(defparameter *socket-file* "sipc.socket") +(defparameter *socket* (cl-sipc:bind *socket-file*)) + +(when (not *socket*) + (format t "Error binding ~a~%" *socket-file*) (quit)) + +(let ((rc (cl-sipc:hook *socket* + #'(lambda (err) + (format t "Error: ~a~%" err) + nil) + #'(lambda (type message) + (format t "<- (~a) ~a~%" type message) + (not (eql :close type)))))) + (format t "Listen rc ~a~%" rc) + (cl-sipc:release *socket*))