[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!
SOURCE CODE FOLLOWS:
_____________________
;;; -*- 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)
(let*
((buffer-size (- limit start))
(stack-string
(si:make-array buffer-size
:type'si:art-string
:displaced-to buffer
:displaced-index-offset start))
(binary-msg-size (reverse-bytes (subseq stack-string 0 4) 4))
(msg-size
(aref (make-array 1
:element-type 'integer
:displaced-to binary-msg-size
:displaced-index-offset 0)
0))
)
(values
(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*
(net:invoke-service-on-host
: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)
*MESSAGE-STREAM*
))
(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??
(t
(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."))
(t
(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
:type'si:art-string
))
(defun format-ints (message start-byte int-list)
(let* ((len (length int-list))
(i -1)
(*formatted-msg*
(make-array len
:element-type'integer
:displaced-to message
:displaced-index-offset start-byte)))
(map 'nil #'(lambda (elt)
(setf (aref *formatted-msg* (incf i)) elt))
int-list))
message)
(defun format-string (message start-byte string)
(let* ((i (1- start-byte)))
(map 'nil #'(lambda (elt)
(setf (aref message (incf i)) elt))
string))
message)
(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))
(t
(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))))
)))
________________________
END CODE
Robin R. Kladke
Martin Marietta
Denver, CO
robin@jarrett.den.mmc.com
(303) 977-9760