;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.117
;;; Reason:
;;;  Server Telnet doesn't need a third process to do a :force-output every second.
;;; Written 20-Nov-87 11:18:22 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.116, Experimental Local-File 73.2, Experimental FILE-Server 22.1, Experimental Unix-Interface 11.0, Experimental Tape 18.0, Experimental KERMIT 34.0, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, Experimental Site Data Editor 8.4, microcode 1754, SDU Boot Tape 3.12, SDU ROM 8.



; From modified file DJ: L.NETWORK.IP-TCP.SERVER; TELNET.LISP#88 at 20-Nov-87 11:18:36
#10R TELNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TELNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; TELNET  "

(defun telnet-server-function (remote-stream)
  (let* ((safe-input-stream (make-eof-throwing-stream remote-stream))
	 (terminal (make-stream-terminal nil remote-stream safe-input-stream))
	 (si:user-id nil)
	 (telnet-user:*term* nil)
	 (cvars '(telnet-user:*term* si:user-id)))
    (catch 'eof
      (send terminal :send-if-handles :send-initial-telnet-frobs)
      (format terminal "~%Welcome to ~A Server Telnet." (send si:local-host :name))
      (send terminal :force-output)
      (telnet-user-login terminal)
      (global:print-herald terminal)
      (terpri terminal)
      (send terminal :force-output)
      (multiple-value-bind (buffer-stream buffer)
	  (make-simple-io-buffer-stream)
	(send terminal :set-input-stream buffer-stream)
	(send terminal :set-more-p t)
	(send sys:current-process :set-priority 1)
	(catch 'telnet-server-logout
	  (do ((c)(int)
	       (user-process (subprocess
			       :closure-variables cvars
			       (global:progw (append *telnet-user-process-bindings*
						     si:*break-bindings*)
				 (catch 'telnet-server-logout
				   (si:lisp-top-level1 terminal))
				 (send (network-server-process *server*)
				       :interrupt #'telnet-user:logout)))))
	      ((null (setq c (send remote-stream :tyi))))
	    (cond ((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)))))
		  ((simple-io-buffer-full-p buffer)
		   ;; 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
		   (simple-io-buffer-put buffer c)))))))))

))


; From modified file DJ: L.NETWORK.IP-TCP.SERVER; TELNET.LISP#88 at 20-Nov-87 11:18:36
#10R TELNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TELNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; TELNET  "

(makunbound '*telnet-asynchronous-force-output-period*)

))