added lisp part

cl-sipc.asd

@@ -0,0 +1,12 @@
+
+
+(asdf:defsystem #:cl-sipc
+  :description "AF_UNIX IPC for CL"
+  :author "Avril <flanchan@cumallover.me>"
+  :license "None"
+  :version "0.0.1"
+  :serial t
+  :depends-on (  :cffi  )
+  :components  ((:file "package")
+		(:file "ffi")
+		(:file "cl-sipc")))

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))

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))

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
 	./$@

libsipc/src/ffi.c

@@ -0,0 +1,18 @@
+#include <sipc.h>
+
+//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;
+}

package.lisp

@@ -0,0 +1,5 @@
+
+
+(defpackage #:cl-sipc
+  (:use #:cl
+	#:cffi))

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*))