diff --git a/cl-sipc.asd b/cl-sipc.asd index 3d7b37a..980aa9f 100644 --- a/cl-sipc.asd +++ b/cl-sipc.asd @@ -9,4 +9,5 @@ :depends-on ( :cffi ) :components ((:file "package") (:file "ffi") + (:file "pointer") (:file "cl-sipc"))) diff --git a/cl-sipc.lisp b/cl-sipc.lisp index e45b647..a9a645e 100644 --- a/cl-sipc.lisp +++ b/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 ) 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)) diff --git a/ffi.lisp b/ffi.lisp index 125a248..9576681 100644 --- a/ffi.lisp +++ b/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)) diff --git a/libsipc/src/sipc.c b/libsipc/src/sipc.c index a17e436..37f0ca0 100644 --- a/libsipc/src/sipc.c +++ b/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,24 +99,25 @@ 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); + if(rc!=0) { + if(rc==-1) + rc = on_error(SIE_READ); + else + rc = on_error(SIE_PCONCLS); + if(rc<0) { + close(csd); + break; + } + } + else { + //Message has been read. + rc = on_message(full); + free(full); + } } else { rc = on_error(SIE_INVALID); } - if(rc!=0) { - if(rc==-1) - rc = on_error(SIE_READ); - else - rc = on_error(SIE_PCONCLS); - if(rc<0) { - close(csd); - break; - } - } else { - //Message has been read. - rc = on_message(full); - free(full); - } } close(csd); if(rc!=0) break; diff --git a/pointer.lisp b/pointer.lisp new file mode 100644 index 0000000..8a74987 --- /dev/null +++ b/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)) diff --git a/test-client b/test-client new file mode 100755 index 0000000..7c1016a --- /dev/null +++ b/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 diff --git a/test-client.lisp b/test-client.lisp new file mode 100644 index 0000000..0dbece1 --- /dev/null +++ b/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))))