[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
protocol
(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
packet?
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 -*-
;;;--------------------------------------------------------------------------------
;;; UDP SOCKET HANDLER
;;;
;;; FILE DESCRIPTION:
;;; 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.
;;;
;;; ORIGINAL PROGRAMMER:
;;; Robin R. Kladke
;;; robin@ciani.den.mmc.com
;;; Martin Marietta, Denver, CO
;;;
;;; TO SEND MESSAGES:
;;; (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
;;;
;;;
;;; TO RECEIVE MESSAGES:
;;; (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
; MODIFICATION HISTORY:
; Created by Robin Kladke on Thursday the ninth of July, 1992; 5:48:16 pm
;-------------------------------------------------------------------------------
; CALLS:
; CALLED BY:
; PARAMETERS:
; [socket] - a new port number
; RETURN VALUES:
; GLOBALS:
; *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)
; SIDE EFFECTS:
; PSEUDOCODE:
;-------------------------------------------------------------------------------
(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
((request-string
(si:make-array (- limit start) :type'si:art-string
:displaced-to array
:displaced-index-offset start))
(msg-copy
(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
msg-ack
)))
;; 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)
(:invoke-with-stream-and-close
((stream
:rfc-data (first (neti:service-access-path-args neti:.service.)))
request)
(binary-udp-simple stream request)))
(defun binary-udp-simple (stream request)
(ignore request)
(multiple-value-bind (buffer start limit)
(send stream :read-input-buffer)
(let*
((size (- limit start))
(stack-string
(si:make-array size
:type'si:art-string
: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
; MODIFICATION HISTORY:
; Created by Robin Kladke on Tuesday the fourteenth of July, 1992; 3:00:58 pm
;-------------------------------------------------------------------------------
; CALLS:
; CALLED BY:
; PARAMETERS:
; 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
; GLOBALS:
; SIDE EFFECTS:
; PSEUDOCODE:
;-------------------------------------------------------------------------------
(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))
result)
((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.
(net:invoke-service-on-host
: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
result)
;; 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
; MODIFICATION HISTORY:
; Created by Robin Kladke on Tuesday the fourteenth of July, 1992; 3:01:04 pm
;-------------------------------------------------------------------------------
; CALLS:
; CALLED BY:
; PARAMETERS:
; [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*)
; RETURN VALUES:
; 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
; PSEUDOCODE:
;-------------------------------------------------------------------------------
(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)
(pop *SOCKET-MESSAGES*))
(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))
message))
;-------------------------------------------------------------------------------
; 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
; MODIFICATION HISTORY:
; Created by Robin Kladke on Tuesday the fourteenth of July, 1992; 2:52:25 pm
;-------------------------------------------------------------------------------
; CALLS: FORMAT-ACK-HEADER
; CALLED BY: BINARY-UDP-SERVICE-FUNCTION-INTERNAL
; PARAMETERS:
; 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)
; GLOBALS:
;
; 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.
;
; PSEUDOCODE:
;-------------------------------------------------------------------------------
(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)
(7
(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
(format-ints
message 0
(list
msg-source msg-dest msg-length (cdr (assoc 'heartack type-alist))
msg-id msg-retry-count
curr-proc
(alp-clos::get-est-end-time curr-proc)))
)
(otherwise
;; if not a heartbeat, send a regular ACK
;; message is little-endian after formatting
(format-ints
message 0
(list
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))))