;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.184
;;; Reason:
;;;  Our Telnet Server now does something meaningful with AYT (Are You There)
;;;  EC (Erase Character) and EL (Erase Line).  Still need to do AO (Abort
;;;  Output)...
;;; Written 13-Jan-87 17:04:23 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.182, Experimental Local-File 73.3, Experimental FILE-Server 22.1, Experimental Unix-Interface 11.0, Experimental Tape 18.0, Experimental KERMIT 34.3, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, microcode 1754, SDU Boot Tape 3.12, SDU ROM 8.



; From modified file DJ: L.NETWORK.IP-TCP.SERVER; TELNET.LISP#112 at 13-Jan-87 17:04:43
#10R TELNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TELNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; TELNET  "

(defun telnet-server-input (user-process buffer-stream remote-stream terminal)
  (do (c int quote extended)
      ((null (setq c (send remote-stream :tyi))))
    (setq extended (termcap.extended-keyboard (global:symeval-in-instance terminal 'termcap)))
    (cond ((= c (get 'iac 'telnet-sym))
	   (let* ((c1 (send remote-stream :tyi))
		  (action (cadr (assoc c1 *telsyms* :test #'eq))))
	     (cond ((eq action 'ip)
		    (send user-process :interrupt 'network-user:handle-abort-all))
		   ((eq action 'ao)
		    ;;Abort Output
		    )
		   ((eq action 'ayt)
		    (send user-process :interrupt 'network-user:status-interrupt (process-status-info user-process)))
		   (t
		    (send buffer-stream :tyo c)
		    (send buffer-stream :tyo c1)))))
	  ((and extended (= c #o34))
	   (let ((bits (send remote-stream :tyi)))
	     (cond ((= bits #o034)
		    (send buffer-stream :tyo c))
		   (t
		    (setq c (make-char (global:char-flipcase (send remote-stream :tyi))
				       (logand bits #o77)))
		    (case c
		      (#\Control-Abort
		       (send user-process :interrupt 'network-user:handle-abort))
		      (#\Control-Meta-Abort
		       (send user-process :interrupt 'network-user:handle-abort-all))
		      (#\Control-Break
		       (send user-process :interrupt 'network-user:handle-break))
		      (#\Control-Meta-Break
		       (send user-process :interrupt 'network-user:handle-error-break))
		      (otherwise
		       (send buffer-stream :tyo (char-int c))))))))
	  ((and (not quote) (= c *telnet-ascii-quote-character*))
	   (setq quote t))
	  ((and (not quote) (= c *telnet-ascii-stop-output-character*))
	   (unless (eq (global:symeval-in-instance terminal 'output-lock) global:current-process)
	     (global:process-lock (locf (global:symeval-in-instance terminal 'output-lock)))))
	  ((and (not quote) (= c *telnet-ascii-resume-output-character*))
	   (when (eq (global:symeval-in-instance terminal 'output-lock) global:current-process)
	     (global:process-unlock (locf (global:symeval-in-instance terminal 'output-lock)))))
	  ((and (not quote) (setq int (assoc c *telnet-interrupt-characters* :test #'eq)))
	   (cond ((third int)
		  (send user-process :interrupt 
			(second int)
			(funcall (third int) user-process)))
		 (t
		  (send user-process :interrupt (second int)))))
	  ((send buffer-stream :buffer-full-p)
	   ;; GOOD QUESTION. LETS JUST THROW AWAY CHARACTERS, OTHERWISE
	   ;; WE WILL MISS ANY #\CONTROL-G'S COMING DOWN.
	   (send remote-stream :tyo (glass-tty-ascii-code #\Control-g)))
	  (t
	   (when quote
	     (send buffer-stream :tyo *telnet-ascii-quote-character*)
	     (setq quote nil))
	   (send buffer-stream :tyo c)))))

))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; TERMCAP.LISP#92 at 13-Jan-87 17:06:58
#10R TELNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TELNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; TERMCAP  "

(defun receive-iac (&aux c action option)
  (declare (:self-flavor telnet-server))
  (setq flush-next-lf nil)
  (setq c (send input :tyi))
  (case (setq action (cadr (assoc c *telsyms* :test #'eq)))
    (iac
     (values t c))
    (ec
     (values t #\Rubout))
    (el
     (values t #\Clear-input))
    (do
     (setq c (send input :tyi))
     (setq option (cadr (assoc c *telopts* :test #'eq)))
     (case option
       ((telopt_echo telopt_sga telopt_supdup-output)
	(receive-option action option))
       (telopt_logout
	(receive-option action option)
	(return-from receive-iac (values t nil)))
       (t
	(send-option 'wont option)))
     nil)
    (dont
     (setq c (send input :tyi))
     (setq option (cadr (assoc c *telopts* :test #'eq)))
     (case option
       ((telopt_echo telopt_sga telopt_supdup-output)
	(receive-option action option)))
     nil)
    (will
     (setq c (send input :tyi))
     (setq option (cadr (assoc c *telopts* :test #'eq)))
     (case option
       (telopt_sga
	(receive-option action option))
       (t
	(send-option 'dont option)))
     nil)
    (wont
     (setq c (send input :tyi))
     (setq option (cadr (assoc c *telopts* :test #'eq)))
     (case option
       (telopt_sga
	(receive-option action option)))
     nil)
    (sb
     (handle-subnegotiation)
     nil)
    (t
     nil)))

))