;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.114
;;; Reason:
;;;  Simplify Telnet Server process.
;;; Written 18-Nov-87 13:41:29 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.113, 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, microcode 1754, SDU Boot Tape 3.12, SDU ROM 8.



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

(defvar *telnet-user-process-bindings*
	'((*package* (find-package "TELNET-USER"))
	  (*print-base* 10.)
	  (base 10.)
	  (*read-base* 10.)
	  (ibase 10.)
	  (*error-output* (make-synonym-stream '*terminal-io*)))
  "These are used in addition to *BREAK-BINDINGS*")

))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; TELNET.LISP#87 at 18-Nov-87 13:41:42
#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)
      (subprocess :closure-variables cvars
		  (loop
		    (send terminal :force-output)
		    (sys:process-sleep *telnet-asynchronous-force-output-period*)))
      (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#84 at 17-Nov-87 17:13:45
#10R TELNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TELNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; TELNET  "

(fmakunbound 'stream-copy-and-force-output)
(fmakunbound 'telnet-server-local)
(makunbound '*telnet-server-debug*)
(fmakunbound 'telnet-lisp-top-level)
(fmakunbound 'telnet-announce-and-prompt)

))