remote process communication

["J. Scott Penberthy" <JSP@ibm.com>]

Here's the core of some host-to-host communications that I use.  It
allows one to pass lists between machines.  The macro 1defnmsg0 interprets
these lists as argument lists to user-defined functions.

You must add the service NET-SPEAK TCP NET-SPEAK to each host.

I slightly changed a few things, but I think these functions will
still work.  Simply compile this buffer on both the user and server
machines, then use the "TM" function on the user machine.  You can also
debug this by using the local host as a server host.

Cheers,
Scott

;;;;
;;;; Network core
;;;;

(defsubst1 net-send0 (thing stream)
  (format stream "~S" thing)
  (force-output stream))

(defun1 net-speak-server0 (stream host)
  2;; The first token within a token list is the name of
0  2;; the command.  We dispatch from this command name to find the
0  2;; appropriate handler.  Each handler accepts three arguments:
0  2;;
0  2;; 1) Stream
0  2;; 2) Host
0  2;; 3) Command as read from STREAM (- the first token, of course)
0  2;;
0  (loop for next-command = (read stream)
	for next-command-function = (get (first next-command) 'net-speak-server)
	do
    (cond ((null next-command-function)
	   (net-send `(error ,(format nil "I don't support the ~A command" (first next-command)))
		  stream))
	  (t
	   (funcall next-command-function stream host (rest next-command))))))

(net:define-server 1:net-speak
0    (:medium :byte-stream :stream (stream :characters t) :host host)
   (condition-case (err)
	(net-speak-server stream host)
      ((sys:end-of-file sys:network-error)
       nil)))

(defmacro1 defnmsg0 (message-name message-arglist &body body)
  (declare (zwei:indentation 2 1))
  (let ((real-function-name (intern (format nil "~A-%%INTERNAL" message-name))))
    `(progn
       (defun (:property ,message-name net-speak-server) (stream host command)
	 (apply #'(:property ,real-function-name net-speak-server)
		(nconc command `(:net-host ,host :net-stream ,stream)))
	 t)
       (defun (:property ,real-function-name net-speak-server)
	      (,@message-arglist &allow-other-keys)
	 (declare (sys:function-parent ,message-name defmsg))
	 ,@body))))

(defprop1 defnmsg0 "Net Message" si:definition-type-name)

2;;;; ==================== Net Messages ====================
;;;;
;;;; PLEASE make sure that all responses are in LIST form.  Otherwise,
;;;; the processes will hang in the "TCP IN" state.
;;;;

0(defnmsg1 time0 (&key net-stream)
  (net-send `(answer ,(format nil "The time is ~A"
			       (with-output-to-string (s)
				 (time:print-universal-time
				   (time:get-universal-time) s))))
	 net-stream))

(defnmsg1 eval-please0 (sexp &key net-stream)
  (net-send (list (eval sexp)) net-stream))

(defnmsg1 echo0 (thing &key net-stream)
  (net-send `(echo ,@thing) net-stream))

(defnmsg1 show-me0 (object &key property net-stream)
  (net-send `(answer ,(get object property)) net-stream))

(net:define-protocol 1:net-speak0 (:net-speak :byte-stream)
  (:invoke-with-stream-and-close ((stream :characters t) &key command)
    (net-send command stream)
    (format t "~&Response: ~S~%" (read stream))))

(eval-when (load eval)
  (tcp:add-tcp-port-for-protocol :net-speak 456))

2;; this is a function to test messages

0(defun1  tm0 (a-message a-host)
  (let ((host (neti:parse-host a-host)))
    (neti:invoke-service-on-host :net-speak host :command a-message)))

;; Try these on the user host:
;;
;; (tm '(eval-please (* 2 4)) "server-host")
;; (tm '(echo (2.234324 fs:foo hello 0 :bar)) "server-host")
;; (tm '(show-me + :property sys:form) "server-host")