;;; -*- Mode:Common-Lisp; Package:NET; Base:10; Fonts:(COURIER TR12I TR12BI TR12 MEDFNTB) -*-

;1 File name: TALK.LISP*
;1 Defines the TALK protocol for the TIs.*
;1 Started 8-10-1989 by Eric Karlson, UC-Berkeley under Robert Wilensky*
;1 Phone: (415) 642-9076, E-mail Address: karlson@ucbarpa.berkeley.edu*

;1 This files defines the TALK protocol as implemented for the UNIX systems. Only a TCP*
;1 version of this protocol has been implemented here since the TIs already have a CONVERSE*
;1 program.*

;1 Service List entry is (:TALK :UDP :UNIX-TALK)*

;1-------------------------------*
;1 Some Structures for ease of use*
;1-------------------------------*

(defstruct 4socket*
  (family 0 :type FIXNUM)		   ;1 The address family type.*	12 bytes*
  (addr "" :type STRING))		   ;1 The address itself.*  1     14 bytes.*

(defstruct 4control-msg*
  (version 1 :type FIXNUM)		   ;1 The protocol version.*	11 byte.*
  (req 4 :type FIXNUM)			   ;1 The request type*	11 byte.*
  (answer 0 :type FIXNUM)		   ;1 An unused answer field.*	11 byte*
  (pad 0 :type FIXNUM)			   ;1 The PAD field.*		11 byte*
  (pkt-id 0 :type FIXNUM)		   ;1 The packet ID number.*	16 bytes*
  (address nil :type (or NULL SOCKET))	   ;1 The address field.*  1      16 bytes*
  (ctl-addr nil :type (or NULL SOCKET))	   ;1 The Control Address.*  1   16 bytes*
  (pid 0 :type FIXNUM)			   ;1 The Process ID number.*	16 bytes*
  (caller "" :type STRING)		   ;1 The TALK requester.*  1   12 bytes*
  (target "" :type STRING)		   ;1 The person to talk to.*  1  12 bytes*
  (tty "" :type STRING))		   ;1 The caller's TTY.*  1 *  1   16 bytes*

;1-----------------------*
;1 Some global parameters*
;1-----------------------*

(defvar 4*TALK-TIMEOUT** 600 "2Time to wait before timing out on connection in 60ths of a second.*")

;1------------------------------------------------*
;1 A number of general functions for the the servers*
;1------------------------------------------------*

;1-----------------*
;1 Public Functions*
;1-----------------*

;1 The client side of the TALK service*

(defun 4talk* ()
"2Responds to or initiates a TALK session with a remote user on some system.*"
  (declare (function talk () T))
  )

;1------------------------*
;1 Define the EXEC service*
;1------------------------*

(define-service 4:TALK* (&rest args) (medium self args) "3Start a TALK session.*")

(defflavor 4unix-talk*
 ((name :unix-talk)
  (desirability .75))
 (service-implementation-mixin)
 :gettable-instance-variables
 :settable-instance-variables
 :initable-instance-variables
 (:documentation "3This is the implemention of the :TALK service for UDP connections.*"))

(define-service-implementation 4'unix-talk)*
(define-logical-contact-name 4"3unix-talk*"* '((:udp 518)))
(define-logical-contact-name 4"3unix-old-talk*"* '((:udp 517)))

(defmethod 4(unix-talk :connect*) (medium host &optional (version :NEW))
"2Opens and returns a connection to the appropriate TALK daemon on the remote HOST.
VERSION indicates which version of the TALK protocol to use.*"
  (declare (function (:METHOD unix-talk :connect) (MEDIUM HOST &optional KEYWORD) ip:UDP-PORT)
	   (values TALK-CONNECTION))

  ;1 Make sure we are using some sort of UDP connection*
  (unless (superior-medium-p medium :UDP)
    (ferror 'gni-service-error "3Service ~A cannot connect using ~A medium*" self medium))
  (open-connection-on-medium host medium
			     (if (eq version :NEW)
				 "3unix-talk*"
				 "3unix-old-talk*")
			     :connect-string ""
			     :timeout *TALK-TIMEOUT*
			     :timeout-after-open nil
			     :error nil))

(compile-flavor-methods unix-talk)

;1-----------------------------------*
;1 The server side of the EXEC service*
;1-----------------------------------*

(add-server-for-medium :UDP "3unix-talk*"
		       '(process-run-function "3UNIX TALK Server*" #'unix-talk-server :NEW))
(add-server-for-medium :UDO "3unix-old-talk*"
		       '(process-run-function "3UNIX TALK Server*" #'unix-talk-server :OLD))

(defun 4unix-talk-server* (version)
"2This is the server for the :TALK service over a TCP connection. The version is
either :NEW or :OLD indicating what type of TALK this is.*"
  (declare (function unix-talk-server (KEYWORD) SYMBOL)
	   (values T-OR-NIL))
  (condition-case ()
      (let ((server-conn (listen-for-connection-on-medium
			   :UDP
			   (if (eq version :NEW)
			       "3unix-talk*"
			       "3unix-old-talk*"))))
	(declare (type ip:UDP-PORT server-conn))
	(send w:WHO-LINE-FILE-STATE-SHEET :add-server server-conn "3TALK*" si:current-process)
	(do ((pkt)
	     (str))
	    (nil)
	  (multiple-value-setq (pkt str) (send server-conn :get-next-pkt))
	  (when str
	    (setq istr (copy str)
		  ctl-msg (make-control-msg
			    :version (char-int (char str 0))
			    :req (char-int (char str 1))
			    :answer (char-int (char str 2))
			    :pad (char-int (char str 3))
			    :pkt-id (do ((val 0)
					 (i 4 (1+ i)))
					((= i 10) val)
				      (declare (FIXNUM val i))
				      (incf val (char-int (char str i))))
			    :address (make-socket :family (do ((val 0)
							       (i 10 (1+ i)))
							      ((= i 12) val)
							    (declare (FIXNUM val i))
							    (incf val (char-int (char str i))))
						  :addr (get-byte-string
							  (do ((val 0)
							       (i 12 (1+ i)))
							      ((= i 24) val)
							    (declare (FIXNUM val i))
							    (incf val (char-int (char str i))))))
			    :ctl-addr (make-socket :family (do ((val 0)
							       (i 24 (1+ i)))
							      ((= i 26) val)
							    (declare (FIXNUM val i))
							    (incf val (char-int (char str i))))
						   :addr (get-byte-string
							   (do ((val 0)
								(i 26 (1+ i)))
							       ((= i 38) val)
							     (declare (FIXNUM val i))
							     (incf val (char-int (char str i))))))
			    :pid (do ((val 0)
				      (i 38 (1+ i)))
				     ((= i 44) val)
				   (declare (FIXNUM val i))
				   (incf val (char-int (char str i))))
			    :caller (subseq str 44 56)
			    :target (subseq str 56 68)
			    :tty (do ((val 0)
				      (i 68 (1+ i)))
				     ((= i 84) val)
				   (declare (FIXNUM val i))
				   (incf val (char-int (char str i))))))
	    (send lisp-window :string-out str)))
	)
    (sys:NETWORK-ERROR nil)))