# Pastebin 1LMtfchQ

(format t "About to load quicklisp:setup.lisp~%")
#-clasp(load "~/quicklisp/setup.lisp")
#+clasp(load "quicklisp:setup.lisp")
(format t "About to quickload pzmq~%")
(ql:quickload :pzmq)

(defmacro logg (idx fmt &rest args)
  `(format t ,fmt ,@args))

(defparameter +WIRE-IDS-MSG-DELIMITER+ "<IDS|MSG>")

(defun wire-serialize (msg &key (identities nil))
  (append identities
          (list +WIRE-IDS-MSG-DELIMITER+)
          msg))

(defun message-send (socket msg &key (identities nil))
  (flet ((send-part (part sndmore)
           ;; Clasp supports binary buffers using clasp-ffi:foreign-data
           (cond
             #+clasp((typep part 'clasp-ffi:foreign-data)
                     (pzmq:send socket part :len (clasp-ffi:foreign-data-size part) :sndmore sndmore))
             ((stringp part)
              (logg 2 "message-send string: ~s~%" part)
              (pzmq:send socket (format nil part) :sndmore sndmore))
             ((typep part '(array (unsigned-byte 8)))
              (let (buf)
                (unwind-protect
                     (progn
                       (setf buf (cffi:foreign-alloc :uint8 :initial-contents part :count (length part)))
                       (logg 2 "message-send (array (unsigned-byte 8)): ~s~%" (loop for x from 0 below (length part) collect (cffi:mem-aref buf :uint8 x)))
                       (pzmq:send socket buf :len (length part)))
                  (cffi:foreign-free buf))))
             (t (error "Cannot send part ~s of type ~s" part (type-of part))))))
    (let ((wire-parts (wire-serialize msg :identities identities)))
      (logg 2 "  in message-send (length wire-parts) -> ~s~%" (length wire-parts))
      (logg 2 "    send  wire-parts-> ~s~%" wire-parts)
      (logg 2 "    send (pzmq:getsockopt socket :type) -> ~s~%" (pzmq:getsockopt socket :type))
      (logg 2 "    send (pzmq:getsockopt socket :identity) -> ~s~%" (pzmq:getsockopt socket :identity))
      ;; Ensure that the last part send has sndmore = NIL
      (do* ((cur wire-parts (cdr cur))
            (part (car cur) (car cur))
            (sndmore (cdr cur) (cdr cur)))
           ((null cur))
        (Send-part part sndmore)))))

(defun recv-string-or-array-bytes (socket &key dontwait (encoding cffi:*default-foreign-encoding*))
  "Receive a message part from a socket as a string."
  (pzmq:with-message msg
    (pzmq:msg-recv msg socket :dontwait dontwait)
    (values
     (let* ((data (pzmq:msg-data msg))
            (len (pzmq:msg-size msg))
            (all-graphic-p (loop for index from 0 below len
                                 always (graphic-char-p (code-char (cffi:mem-aref data :uint8 index))))))
       (if all-graphic-p
           (cffi:foreign-string-to-lisp data :count len :encoding encoding)
           (let ((array-bytes (make-array len :element-type '(unsigned-byte 8))))
             (loop for index from 0 below len
                   do (setf (aref array-bytes index) (cffi:mem-aref data :uint8 index)))
             array-bytes)))
     (pzmq:getsockopt socket :rcvmore))))

(defun zmq-recv-list (socket &optional (parts nil) (part-num 1))
  (multiple-value-bind (part more)
      (recv-string-or-array-bytes socket)
    ;;(format t "[Shell]: received message part #~A: ~W (more? ~A)~%" part-num part more)
    (if more
        (zmq-recv-list socket (cons part parts) (+ part-num 1))
        (reverse (cons part parts)))))


(defun wire-deserialize (parts)
  (logg 2 "  (length parts) -> ~d~%" (length parts))
  (logg 2 "     parts -> ~s~%" parts)
  (let ((delim-index (position +WIRE-IDS-MSG-DELIMITER+ parts :test  #'equal)))
    (when (not delim-index)
      (error "no <IDS|MSG> delimiter found in message parts"))
    (logg 2 "     delim-index -> ~d~%" delim-index)
    (logg 2 "     parts -> ~s~%" parts)
    (let ((identities (subseq parts 0 delim-index))
          (msg (nthcdr (1+ delim-index) parts)))
      (logg 2 "    identities: ~s~%" identities)
      (logg 2 "    msg: ~s~%" msg)
      (values identities msg))))

(defun message-recv (socket)
  (let ((parts (zmq-recv-list socket)))
    (logg 2 "=============== message-recv ==============~%")
    (logg 2 "    recv (pzmq:getsockopt socket :type) -> ~s~%" (pzmq:getsockopt socket :type))
    (logg 2 "    recv (pzmq:getsockopt socket :identity) -> ~s~%" (pzmq:getsockopt socket :identity))
    ;;DEBUG>>
    ;;(format t "[Recv]: parts: ~A~%" (mapcar (lambda (part) (format nil "~W" part)) parts))
    (wire-deserialize parts)))


(defun test-connection ()
  (let* ((ctx (pzmq:ctx-new))
         (worker (pzmq:socket ctx :router))
         (address (format nil "~A://~A:~A" "tcp" "127.0.0.1" 9734)))
    (unwind-protect
         (progn
           (format t "address -> ~s~%" address)
           (format t "type-of address -> ~s~%" (type-of address))
;;;    (pzmq:bind worker "ipc://routing.ipc")
           (pzmq:bind worker address)
;;;           (pzmq:setsockopt worker :identity (format nil "deadbeef"))
           (format t "(pzmq:getsockopt worker :identity) -> ~s~%" (pzmq:getsockopt worker :identity))
           (format t "About to wait for message-recv~%")
           (multiple-value-bind (idents msg)
               (message-recv worker)
             (let ((response-msg (list* "reSSSSSSSSSSsponse" msg)))
               (format t "Sending response-msg: ~s~%" response-msg)
               (message-send worker response-msg :identities idents))))
      (pzmq:close worker))))

(test-connection)