[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Communication between Symbolics & Sun using TCP

I am trying to write code that will send binary messages to and receive
binary messages from a Sun (running C++ under UNIX).  My code is written in
Lisp using an XL400 under Genera 8.0.  

My essential problem is this: I can establish a connection with the Sun and it
will attempt to send me a message.  I, however, don't know when the message
arrives because my server function (defined through neti:define-server) is
never invoked.  Shouldn't this functionality activate when a message is sent
to the port specified through tcp:add-tcp-port-for-protocol ?  Note that i did
not say that i don't receive the message sent.  If i peek at the contents of
the buffered input stream, the message is there, but it never gets pushed on
my message stack!

I am including a simplified version of my code. The primary code is about
2 pages.  The rest of the code is comprised of utility functions for parsing
the incoming binary data or formatting data for binary output.  Note that the
Sun uses Big-endian byte-ordering while the Symbolics uses Little-endian.  This
simple code does the following:

1) Connects to the Sun
2) Polls the contents of *SOCKET-MESSAGES*; if there is not message there,`
it checks the stream buffer; if there is a message there, it grabs it, prints
`it, and translates the header.  The program then quits.  

The program is invoked by (handle-messages <Sun host>), where <Sun Host> is
the string name of the sun that you are communicating with.

The sun should 
1) Wait for a connection
2) Receive a string process ID ("MPC" in this case) followed by a NULL (character 0).
3) Send a binary message with 7 or more 4-byte integers.  The first integer
must be the length of the message in bytes of the entire message (including the
4 bytes for the length itself).

-- The Lisp program will announce when a socket has been established on the
Sun host and it will print the message found in *SOCKET-MESSAGES* or in the
stream buffer.

I would greatly appreciate ANY input.  I know i am missing something fundamental, but i just cannot figure out what it is! HELP!


;;; -*- Mode: LISP; Syntax: Common-lisp; Package: USER; Base: 10 -*-

(defvar *QUIT-APP* nil)
(defvar *SOCKET-MESSAGES* nil)
(defvar *MESSAGE-STREAM* nil)
(defvar *WORD-SIZE* 4)

;; use TCP socket port # 2001 for all communication
(tcp::add-tcp-port-for-protocol :binary-tcp 2001)	;for use over TCP

;; define the server end
(neti:define-server :binary-tcp (:medium :byte-stream
				 :simple-p t
				 :host host ;; the user host requesting service
				 :stream binary-stream)
   (tcp-server-function binary-stream host))

;; this function is never invoked! Why isn't this invoked when the Sun sends
;; a message to socket 2001??  The buffered input stream actually receives
;; the messsage (see HANDLE-MESSAGES below)
(defun tcp-server-function (stream host)
  (ignore host)
  ;; fetch a message from the buffered input stream
  (multiple-value-bind (request-string request-length)
      (fetch-binary-message stream)
    ;; push a copy of the message into the message queue for processing 
    (push (format nil request-string) *SOCKET-MESSAGES*)
    ;; return the contents of the message buffer and the length of the request
    (values request-string request-length)

(defun fetch-binary-message (stream)
  (multiple-value-bind (buffer start limit)
      (send stream :read-input-buffer)
      ((buffer-size (- limit start))
	 (si:make-array buffer-size
			:displaced-to buffer
			:displaced-index-offset start))
       (binary-msg-size (reverse-bytes (subseq stack-string 0 4) 4))
	 (aref (make-array 1
		     :element-type 'integer
		     :displaced-to binary-msg-size
		     :displaced-index-offset 0)
	(subseq (si:copy-if-necessary stack-string) 4 msg-size)
	(- msg-size 4)))))

;; define the client end
(neti:define-protocol :binary-tcp (:binary-tcp :byte-stream)
    (:invoke (service)
      (tcp-client-function service)))

;; this function is invoked once prior to making the connection
(defun tcp-client-function (service)
     (net:get-connection-for-service service :ascii-translation t))

(defun send-stream (message)
  (let ((stream *MESSAGE-STREAM*))
    (format stream "~A" message)
    (send stream :force-output)))    

(defun init-TCP (host)
  (let ((process-id
	  (format-string (message-template 4) 0 "MPC")))
    ;; reset the message queue
    (setq *SOCKET-MESSAGES* nil)
    ;; init the applicaiton's quit flag
    (setq *QUIT-APP* nil)
    ;; establish a connection on HOST
    (setq *MESSAGE-STREAM*
	    :binary-tcp   ;; service name
	    (net:parse-host host))) ;; process id
    ;; this is where the connection is made to the Sun
    (send-stream process-id) ;; identify process to server host
    (format t "~%Socket established on ~A." host)

(defun handle-messages (host &optional (byte-order 'big-endian))
  (init-tcp host) ;; initialize the message-handler system
  (do ()
      ;; if *QUIT-APP* global is set, leave the system
      ((string-equal *QUIT-APP* 'quit-now)
       (format t "~%Exiting TCP Message Handler..."))

    ;; if there are any messages on the queue, 
    (cond (*SOCKET-MESSAGES*
	   (format t "~%The message received was: ~S"
		   (pop *SOCKET-MESSAGES*)))

	  ;; If there is a message in the buffer, but no message was placed in
	  ;; the message queue, print the message and exit
	  ;; How can this happen?? why isn't TCP-SERVER-FUNCTION invoked??
	   (multiple-value-bind (message length)
	       (fetch-binary-message *MESSAGE-STREAM*)
	     (format t "~%The message in the buffer was: ~S~%Length = ~A" message length)
	     (format t "~%The translated header is: ~A"
		     (multiple-value-list (parse-binary-ints message 0 6 byte-order)))
	     (setq *QUIT-APP* 'quit-now)))

;; The following are necessary utility functions

(defun swap-elements (array index1 index2)
  (let ((temp))
	(setf temp (aref array index1))
	(setf (aref array index1) (aref array index2))
	(setf (aref array index2) temp)))

(defun reverse-bytes (bytes bytes-per-int
		      &optional (start-byte 0) (end-byte (array-total-size bytes)))
  (cond ((/= 0 (rem (- end-byte start-byte) bytes-per-int))
	 (format t "~%ERROR: Number of bytes must be divisible by bytes-per-integer."))
	 (let ((int-index (1- bytes-per-int)))
	   (do ((i start-byte (+ i bytes-per-int)))
	       ((>= i end-byte) bytes)
	     (do ((j i (1+ j))
		  (k (+ i int-index) (1- k))
		 ((< k j))
	       (swap-elements bytes j k)

(defun message-template (length)
  (si:make-array length

(defun format-ints (message start-byte int-list)
  (let* ((len (length int-list))
	 (i -1)
	   (make-array len
		       :displaced-to message
		       :displaced-index-offset start-byte)))
    (map 'nil #'(lambda (elt)
		  (setf (aref *formatted-msg* (incf i)) elt))


(defun format-string (message start-byte string)
  (let* ((i (1- start-byte)))
    (map 'nil #'(lambda (elt)
		  (setf (aref message (incf i)) elt))

(defun parse-binary-ints (message start-byte num-ints &optional (byte-order 'big-endian))
  ;(format t "~%Parsing integers....")
  (let ((end-byte (+ (* num-ints *word-size*) start-byte))
    (cond ((> end-byte (length message))
	   (format t "~%Message ~s is too short to parse." message))
	   (cond ((string-equal byte-order 'big-endian)
		  (reverse-bytes message *word-size* start-byte end-byte))
	   ;; return the integers
	   (values-list (map 'list #'identity
			     (make-array num-ints
					 :element-type 'integer
					 :displaced-to message
					 :displaced-index-offset start-byte))))


Robin R. Kladke
Martin Marietta
Denver, CO
(303) 977-9760