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

UDP communication

I have written some software (with help from Cory at UCAR) to communicate`binary data through UDP.  It works great between Symbolics.  I am having a heck of
a time getting it work Symbolics <--> Sun SparcStation.  The problem is
essentially this:
messages are transmitted from the Symbolics using the following:
(neti:invoke-serevice-on-host :binary-udp (net:parse-host host) message)

The message gets to the Sun no problem.  The Sun sends an ACK. The Symbolics
never returns from this call; it is waiting for an ACK.  Meanwhile, my
receive routine stuffs the ACK sent by the Sun into a stack for processing.
Unfortunately, the ...invoke-service... doesn't look on the stack, it just
waits around and eventually tells me the Sun didn't respond to its request.

How do i (1) disable the ACK requirement associated with ...invoke-service...
so that i can disregard anything sent through this channel and just look
explicitly at messages received?  
-- why is an ACK required?  I thought UDP was supposed to be a non-ackd 

(2) Get the sun to send an ACK in a way that the symbolics will like it.  The
sun is just using the standard UDP send; is there any UNIX stuff that needs
to be done that will associate the ACK sent out with the receipt of the 

Has anyone out there had similar problems? Unfortunately, i don't know what
the real cause of the problem is, so i am having some trouble expressing
my needs.  Any input would be useful.

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

;;;    This file defines the BINARY-UDP service which implements message passing 
;;;    of binary data from a symbolics to a UNIX machine using UDP (User Datagram
;;;    Protocol).  Most of the code below specifies the generic medium DATAGRAM.
;;;    The code below was based on an example contributed by Cory Morse of UCAR
;;;    (morse@zephyr.rap.ucar.edu).  Her contribution is gratefully acknowledged.
;;;    Robin R. Kladke
;;;    robin@ciani.den.mmc.com
;;;    Martin Marietta, Denver, CO
;;;    (transmit-udp <host> <message>)
;;;    ACK is a binary message with 6 integer fields:
;;;       (1) Destination Process
;;;       (2) Source Process
;;;       (3) Message Length
;;;       (4) Message Type
;;;       (5) Transaction ID
;;;       (6) Retry Count
;;;    (receive-udp) 

; FUNCTION NAME: init-udp
; PURPOSE: Inititializes the stack of received messages to NIL and may change 
;   the port number being used.  This should be done at the beginning of a
;   system run only or messages may be lost!
; DATE CREATED: 7/9/92
;    Created by Robin Kladke on Thursday the ninth of July, 1992; 5:48:16 pm
;   [socket]   - a new port number 
;   *SOCKET-MESSAGES* - a stack of received messages
;   *QUIT-UDP* - when set to 'Quit-now, the message handler will exit
;   *TRANSACTION-TABLE* - tracks start and end times of all message
;      transactions (see transaction-tracker.lisp)

(defun init-UDP (&optional socket)
  ;; reset the message queue
  (setq *SOCKET-MESSAGES* nil)
  ;; init the applicaiton's quit flag
  (setq *QUIT-UDP* nil)
  ;; reset the transaction tracker
  (setq *transaction-table* (make-hash-table))
  (cond ((null *PARSER-FUNCTION*)
	 (format t "~%Enter the name of the parsing function: ")
	 (setq *PARSER-FUNCTION* (read))))
  ;; change socket number, is specified
  (cond (socket
	 (Format t "~%Changing the UDP port number to ~A..." socket)
	 (tcp:add-udp-port-for-protocol :udp-socket socket))))

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

;; add a socket-handler to the network
;; when this host receives a request for connection for the :binary-udp
;; service, the generic network system creates a process and the body is
;; in the process.

;; This defines the server end, which will always be a Symbolics.
(neti:define-server :binary-udp (:medium :datagram :simple-p t
					 ;; the user host requesting service
					 :host host
					 ;; an array containing arguments to the
					 ;; service (the msg in this case) and
					 ;; the starting and ending indices
					 ;; (exclusive) of this array
					 :request-array (array start limit))
;; the server itself -- the arguments are the variables bound to 
;; request-array
   (let* ;; create a binary string
	(si:make-array (- limit start) :type'si:art-string
		    :displaced-to array
		    :displaced-index-offset start))
	(move-vector-part request-string
			  (message-template (- limit start))
			  0 (- limit start)))
     (msg-ack (acknowledge-receipt msg-copy *BYTE-ORDER*))
     ;; set the destination for transmissions to the sender of this message
     (setq *CLIENT-HOST* host)

     ;; push a copy of the string into the message queue 
     (push (format nil request-string) *SOCKET-MESSAGES*)
     ;; return t for request acceptance and the appropriate
     ;; ACK for the message
     (values t

;; Defines the socket protocol BINARY-UDP which provides the generic network
;; service BINARY-UDP.  DATAGRAM is the minimum medium needed for the
;; protocol.

;; Use the function (net:invoke-service-on-host :udp-socket (net:parse-host "host-name"))
;; to get the USER end of the bidirectional stream on a LISP Machine.

;;; This defines the client (user) end. For most cases this will be a Unix machine,
;;; but it can be a Symbolics
(neti:define-protocol :binary-udp (:binary-udp :datagram)
  (:desirability .75)
       :rfc-data (first (neti:service-access-path-args neti:.service.)))
    (binary-udp-simple stream request)))

(defun binary-udp-simple (stream request)
  (ignore request)
  (multiple-value-bind (buffer start limit)
      (send stream :read-input-buffer)
      ((size (- limit start))
	 (si:make-array size
			:displaced-to buffer
			:displaced-index-offset start)))

      (format t "~%The acknowledgement received was : ~A"
	      (multiple-value-list (parse-binary-ints (copy-seq stack-string) 0 6)))

      (si:copy-if-necessary stack-string)

; FUNCTION NAME: transmit-udp
; PURPOSE: transmits a binary message (array) to the specified host
; DATE CREATED: 7/14/92
;    Created by Robin Kladke on Tuesday the fourteenth of July, 1992; 3:00:58 pm
;   host   - the string name of the host to send the message to
;   message  - an binary formatted message array
;   [hang]   - NIL, t, or a number:
;              If nil, don't retry
;              If t, retry until success
;    	       If a number, wait until the given time (in seconds) elapses or
; 		 a receiver is finally found.  Can be a real number (eg, 1.5 seconds).
; RETURN VALUES: the ACK message

(defun transmit-udp (message &key (hang nil) (host *CLIENT-HOST*))
  ;; if host is not a numeric id, get the numeric id
  ;; associate with the symbolic name
  (cond ((numberp hang)				; Change units from seconds to 60ths
	 (setq hang (round (* hang 60))))	; and make sure its a fixnum
	((eq hang t)
	 (setq hang (* 60 60 60 24))))		; a day - I certainly won't wait any longer
  (do ((initial-time (time:time))
       (retry-count 1 (1+ retry-count))
       (header (make-array 6			; if must resend, use this to increment
			   :element-type 'integer	; value of retry count (element 5)
			   :displaced-to message
			   :displaced-index-offset 0))
      ((or (setq result
		 ;; invoke-service-on-host will not return until
		 ;; an ack is received -- the ack must be returned here
		 ;; and NOT pushed onto *SOCKET-MESSAGES* like other
		 ;; received messages.
		   :binary-udp   ;; service name
		   (net:parse-host host) ;; process id
		   message))			; service args -- an array of the string
	   (null hang)				; Don't want to wait or retry
	   (time:time-elapsed-p hang initial-time))	; Waited long enough
    ;; increment the retry count in the message
    (setf (aref header 5) retry-count)
    ;; sleep until time to try again
    (sleep *time-between-retries* :Sleep-Reason "Waiting to Retry Transmit"))

; FUNCTION NAME: receive-udp
; PURPOSE: Grabs the next message from the message stack
; DATE CREATED: 7/14/92
;    Created by Robin Kladke on Tuesday the fourteenth of July, 1992; 3:01:04 pm
;   [no-hang]  - t, a number, or NIL:
;                If t, don't wait if no message is available.
;                If a number,
;  	           wait until the given time elapses (units is 60ths of a second)
;    		   or the message finally arrives.
;		 If nil, wait until a message finally arrives.
;   [parse]   - (Defaults to t) parse the binary message into an internal structure
;   [byte-order]   - (Defaults to *BYTE-ORDER*)
; GLOBALS: *SOCKET-MESSAGES* - a stack of binary messages
;          *PARSER-FUNCTION* - function name of the application-dependent
;          parser.  
; SIDE EFFECTS: *SOCKET-MESSAGES* is decremented by one message 

(defun receive-udp (&optional (no-hang nil) (parse t) (byte-order *BYTE-ORDER*))
  (when (numberp no-hang) (setq no-hang (round (* no-hang 60))))
  (let ((message
	  (cond ((eq no-hang t)
		 (process-wait-with-timeout "No Message" no-hang
		   #'(lambda ()  *socket-messages*))
		 (pop *SOCKET-MESSAGES*)))))
    (format t "~%The unparsed message received was: ~S." message)

    (if (and message parse)
	(funcall *PARSER-FUNCTION* message byte-order))


; FUNCTION NAME: acknowledge-receipt
; PURPOSE: format the acknowledgment.  The acknowledgment is assumed to have a
; header of form:
;       (1) Destination Process
;       (2) Source Process
;       (3) Message Length
;       (4) Message Type
;       (5) Transaction ID
;       (6) Retry Count
; All fields are integers.
; The ID of the received message is copied, the source and destination
; processes are swapped, the message type is changed to 0 (for ACK)
; Additional fields may be filled in as appropriate to the ACK type.
; DATE CREATED: 7/14/92
;    Created by Robin Kladke on Tuesday the fourteenth of July, 1992; 2:52:25 pm
;   message   - the request message (this is a copy & may be altered)
;   [byte-order] - (Defaults to *BYTE-ORDER*) byte ordering within words for integers
; RETURN VALUES: the ack, formatted into the original message array (which
;   was copied prior to this call)
; SIDE EFFECTS: The message array contents are altered
; ASSUMPTIONS: This is a BIG ONE! This function assumes that the message array
; is at least as long as the corresponding acknowledgement.
; If this is not the case, a new array must be created by calling 
; (message-template <length>), where <length> is the number of BYTES 
; (not integers) and the header information must be copied over from the  
; original message by calling (move-vector-part <source> <dest> 0 *header-length*),
; where <source> is the original message and
; <dest> is the newly created template.

(defun acknowledge-receipt (message &optional (byte-order *BYTE-ORDER*))
  (let ((start-byte 0)
	(end-byte *header-length*)
	(num-ints (/ *header-length* *word-size*))
	(curr-proc nil))
    ;; parse the header of the received message
    ;; if byte-order=big-endian, this reverses the first 24 bytes
    (multiple-value-bind (msg-dest msg-source msg-length msg-type msg-id msg-retry-count)
	(alp-clos::parse-header message byte-order)

      ;; based on the message type, create an appropriate acknowledgement 
      (case msg-type
	;; if the message is a heartbeat, create a heartbeat-ack,
	;; using the message as template (it was copied upon receipt)
	  (setq num-ints (+ num-ints 7))
	  (setq end-byte (+ end-byte (* 7 *word-size*)))
	  (setq curr-proc (alp-clos::get-current-procedure))

	  ;; message is Little-endian after formatting
	    message 0
	      msg-source msg-dest msg-length (cdr (assoc 'heartack type-alist))
	      msg-id msg-retry-count
	      (alp-clos::get-est-end-time curr-proc)))
	  ;; if not a heartbeat, send a regular ACK

	  ;; message is little-endian after formatting
	    message 0
	      msg-source msg-dest msg-length (cdr (assoc 'ack type-alist))
	      msg-id msg-retry-count))

;      (format t "~%The acknowledgement being sent is: ~A"
;	      (multiple-value-list (parse-binary-ints message 0 6 'little)))

      ;; if the byte-order is 'big-endian, reverse the message so it is
      ;; back in big-endian format
      (cond ((string-equal byte-order 'big-endian)
	     (user::reverse-bytes message *word-size* start-byte end-byte)))
      (subseq message start-byte end-byte))))