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.
108 lines
3.3 KiB
108 lines
3.3 KiB
;; 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)
|
|
|
|
(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.
|
|
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) (if (member :connect ',(cddr desc))
|
|
(connect ,(second desc))
|
|
(bind ,(second desc))))
|
|
(return-value
|
|
(if (null ,(first desc)) ;;bind failed
|
|
nil
|
|
(progn ,@body))))
|
|
(when (not (null ,(first desc)))
|
|
(release ,(first desc)))
|
|
return-value))
|
|
|
|
(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))
|