Added sending wrapper

cl-sipc.asd

@@ -9,4 +9,5 @@
   :depends-on (  :cffi  )
   :components  ((:file "package")
 		(:file "ffi")
+		(:file "pointer")
 		(:file "cl-sipc")))

cl-sipc.lisp

@@ -41,12 +41,23 @@
   (si-close sd)
   t)
 
+(defun connect (file)
+  "connect to socket `file'"
+  (let ((rc (si-connect file)))
+    (if (< rc 0) ;error
+      nil
+      rc)))
+
 (defmacro with-bound-socket (desc &body body)
-  "bind socket, run `body', then close the socket
+  "bind socket, run `body', then close the socket.
+   if :connect is in desc, connect instead of binding.
    example: (with-bound-socket (socket \"file.socket\") (hook socket ...))
+   example: (with-bound-socket (socket \"file.socket\" :connect) (send socket ...))
    returns the last value from body on success, returns NIL without running body if the socket failed to bind
   "
-  `(let* ((,(first desc) (bind ,(second desc)))
+  `(let* ((,(first desc) (if (member :connect ',(cddr desc))
+			   (connect ,(second desc))
+			   (bind ,(second desc))))
 	  (return-value 
 	    (if (null ,(first desc)) ;;bind failed
 	      nil
@@ -55,4 +66,42 @@
        (release ,(first desc)))
      return-value))
 
-(mapc #'export '(bind hook release with-bound-socket))
+(defun %siqs-binary (sd value)
+  (cond ((pointer-p value) (siqs-binary sd (pointer-memory value) (pointer-size value)))
+	(t (with-pointer (ptr) value (%siqs-binary sd ptr)))))
+
+(defun send (sd value &optional (type :string))
+  "send to sever on socket sd.
+   example: (with-bound-socket (socket \"file.socket\") (hook socket ...))
+   returns (values t nil) on success. (values nil <error>) on failure.
+   error can be:
+   	:partial - Could not write whole message
+	:error - send() error
+	:failure - send failed
+	:unknown - unknown error code
+	:unknown-type - key argument :type is unknown
+  :type can be:
+  	:string (default) - assumes `value' is string, send that as string type
+	:binary - assumes `value' is either string or vector of bytes, send that as binary type
+	:close - ignore value, send close signal
+  "
+  (let ((rc (cond ((eql type :string) (siqs-string sd value))
+		  ((eql type :binary) (%siqs-binary sd value))
+		  ((eql type :close) (siqs-close sd))
+		  (t :unknown-type))))
+    (if (numberp rc)
+      (if (= rc #.+si-send-okay+)
+	(values t nil)
+	(values nil
+		(cond ((= rc #.+si-send-partial+) :partial)
+		      ((= rc #.+si-send-error+) :error)
+		      ((= rc #.+si-send-failure+) :failure)
+		      (t :unknown))))
+      rc)))
+
+(defun send-quick (sock value &optional (type :string))
+  "Quickly send value to socket file `sock'"
+  (with-bound-socket (sd sock :connect)
+    (send sd value type)))
+
+(mapc #'export '(connect send send-quick bind hook release with-bound-socket))

ffi.lisp

@@ -74,3 +74,20 @@
 
 (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))

libsipc/src/sipc.c

@@ -72,22 +72,25 @@ int si_listen(int sd, si_error_callback on_error, si_callback on_message)
 		int read=0;
 		int rd=0;
 		rc=0;
+		int rc2=0;
 		while( (read += (rd = recv(csd, buffer, sizeof(si_message), 0))) < sizeof(si_message))
 		{
 			if(rd<0)
 			{
 				rc = on_error(SIE_READ);
+				rc2=1;
 				break;
 			} else if(rd==0)
 			{
 				rc = on_error(SIE_PCONCLS);
+				rc2=1;
 				break;
 			}
 		}
 		if(rc<0) {
 			close(csd);
 			break;
-		} else {
+		} else if (!rc2) {
 			//message header has been read.
 			si_message *full;
 			if(_si_valid_header(message))
@@ -96,10 +99,6 @@ int si_listen(int sd, si_error_callback on_error, si_callback on_message)
 				memset(full,0,sizeof(si_message)+message->data_len+1); //always have null-term
 				memcpy(full, message, sizeof(si_message));
 				rc = _si_read_rest(csd, full);
-			}
-			else {
-				rc = on_error(SIE_INVALID);
-			}
 				if(rc!=0) {
 					if(rc==-1)
 						rc = on_error(SIE_READ);
@@ -109,12 +108,17 @@ int si_listen(int sd, si_error_callback on_error, si_callback on_message)
 						close(csd);
 						break;
 					}
-			} else {
+				}
+			  	else {
 					//Message has been read.
 					rc = on_message(full);
 					free(full);	
 				}
 			}
+			else {
+				rc = on_error(SIE_INVALID);
+			}
+		}
 		close(csd);
 		if(rc!=0) break;
 	}

pointer.lisp

@@ -0,0 +1,71 @@
+;; pointer
+
+(in-package :cl-sipc)
+
+(defstruct pointer
+  memory
+  size)
+
+
+(defun pointer-from-string (str)
+  "String to pointer"
+  (let ((ptr (foreign-string-alloc str)))
+    (make-pointer :memory ptr :size (foreign-funcall "strlen" :pointer ptr :int))))
+
+(defun pointer-from-seq (vec &optional (type :unsigned-char))
+  "Vector or list to pointer"
+  (let ((ptr (foreign-alloc type :initial-contents vec)))
+    (make-pointer :memory ptr :size (* (foreign-type-size type) (length vec)))))
+
+(defun pointer-from (value &optional (type :unsigned-char))
+  "Value to new allocated pointer"
+  (pointer-from-sequence (list value) type))
+
+(defmacro with-pointer (desc from &body body)
+  "with pointer allocated
+   desc can have name, type allocated, C type.
+   example: 
+   	(with-pointer (string-ptr) lisp-string
+		      body...)
+	(with-pointer (string-ptr-explicit :string) lisp-string
+		      body...)
+	(with-pointer (vector :sequence :int) vector-of-ints
+		      body...)
+	(with-pointer (vector :infer :char) vector-of-chars
+		      body...)
+  "
+  (let ((name (car desc))
+	(type0 (or (cadr desc) :infer))
+	(type (or (caddr desc) :unsigned-char))
+	(pointer-from-type-infer (gensym)))
+    (let ((makeptr
+	    (cond ((eql type0 :string) `(pointer-from-string ,from))
+	  	  ((eql type0 :sequence) `(pointer-from-seq ,from ,type))
+	 	  ((eql type0 :single) `(pointer-from ,from ,type))
+		  (t `(,pointer-from-type-infer ,from ,type)))))
+      `(flet ((,pointer-from-type-infer (fr ty)
+					(cond ((stringp fr) (pointer-from-string fr))
+					      ((or (vectorp fr)
+						   (listp fr)) (pointer-from-seq fr ty))
+					      (t (pointer-from fr ty)))))
+	 (let* ((,name ,makeptr)
+		(result
+		  (progn ,@body)))
+	   (pointer-free ,name)
+	   result)))))
+
+(defun pointer-free (ptr)
+  "Free pointer"
+  (foreign-free (pointer-memory ptr)))
+
+(mapc #'export '( make-pointer
+		  pointer
+		  pointer-memory
+		  pointer-p
+		  pointer-size
+
+		  pointer-from-string
+		  pointer-from-seq
+		  pointer-from
+		  with-pointer
+		  pointer-free))

test-client

@@ -0,0 +1,8 @@
+#!/bin/bash
+
+if [[ ! -f "`readlink -f libsipc.so`" ]]; then
+	echo "[w] have to build first..."
+	make ffi
+fi
+
+sbcl --noinform --load test-client.lisp

test-client.lisp

@@ -0,0 +1,37 @@
+
+
+(let ((*standard-output* (make-broadcast-stream)))
+  (ql:quickload :cl-sipc))
+
+(defparameter *socket-file* "sipc.socket")
+
+(defun help (&optional (st t))
+  (format t "Available commands:~% (send hello-world)~% (send-binary hello-world)~% (close)~% (rebind \"socket-file.socket\")~% help~% quit~%")
+  (when st
+    (format t "(bound to \"~a\")~%" *socket-file*))
+  'unknown-command)
+
+(format t "Working with socket \"~a\"~%" *socket-file*)
+(help nil)
+
+(loop while t do
+  (let ((rd (progn
+	      (format t "> ")
+	      (force-output)
+	      (read))))
+    (and (atom rd)
+	 (eql rd 'quit)
+	 (quit))
+    (print (and (not (atom rd))
+	 (cond ((eql (car rd) 'send) (sipc:send-quick *socket-file* (if (stringp (cadr rd))
+								      (cadr rd)
+								      (write-to-string (cadr rd))) :string))
+	       ((eql (car rd) 'send-binary) (sipc:send-quick *socket-file* (if (stringp (cadr rd))
+									    (cadr rd)
+									    (write-to-string (cadr rd))) :binary))
+	       ((eql (car rd) 'close) (sipc:send-quick *socket-file* nil :close))
+	       ((eql (car rd) 'rebind) (setf *socket-file* (cadr rd)))
+	       (t (help)))))
+    (format t "~%")
+    (and (atom rd)
+	 (help))))