;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 123.272
;;; Reason:
;;;  Fix (chaos:disallow-connection?) to not reject the connection if keyword
;;;  is :notify.  Generalize sufficiently to allow both (telnet-server-function)
;;;  and (eval-server-function) to use it.
;;; Written 11-May-88 16:08:16 by pld (Peter L. DeWolf) at site Gigamos Cambridge
;;; while running on Azathoth from band 3
;;; with Experimental System 123.270, Experimental Local-File 73.5, Experimental FILE-Server 22.5, Experimental Unix-Interface 11.0, Experimental KERMIT 34.3, Experimental ZMail 71.2, Experimental Lambda-Diag 15.0, Experimental Tape 22.4, microcode 1756, SDU Boot Tape 3.14, SDU ROM 8, the old ones.



; From modified file DJ: L.NETWORK.CHAOS; CHSAUX.LISP#398 at 11-May-88 16:20:10
#8R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSAUX  "

(DEFUN DISALLOW-CONNECTION? (WHAT CONN FASCISM-LEVEL)
  "Return a string explaining why someone can't use the server, or NIL if its allowed."
  (COND ((MEMQ NIL FASCISM-LEVEL)		        ;Server always unavailable
	 (FORMAT NIL "Fascism at this site prevents the usage of the ~A server." WHAT))
	((AND (MEMQ :REJECT-UNWANTED FASCISM-LEVEL)	;Special check available....
	      (UNWANTED-CONNECTION-P CONN))
	 (UNWANTED-CONNECTION-REJECTION-STRING WHAT CONN))
	((MEMQ :NOT-LOGGED-IN FASCISM-LEVEL)	        ;Server available if not logged in...
	 (UNLESS (SYS:MEMBER-EQUAL USER-ID '(NIL ""))
	   (FORMAT NIL "This machine is in use by ~A, try again later." USER-ID)))
	((MEMQ :NOTIFY FASCISM-LEVEL)		        ;Server available after Notification
	 (PROCESS-RUN-FUNCTION "Notify" 'TV:NOTIFY
			       NIL "Attempt to use ~A server by the user at ~A"
			       WHAT (HOST-SHORT-NAME (FOREIGN-ADDRESS CONN)))
	 (PROCESS-ALLOW-SCHEDULE)
	 NIL)
	((MEMQ T FASCISM-LEVEL)			        ;Server always available
	 NIL)
	(T
	 (FORMAT NIL "Unknown rejection: ~A" (set-difference fascism-level '(:reject-unwanted :not-logged-in))))))

))

; From modified file DJ: L.NETWORK.CHAOS; CHSAUX.LISP#398 at 11-May-88 16:20:44
#8R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSAUX  "

(DEFUNP EVAL-SERVER-FUNCTION (&AUX CONN)
  (SETQ CONN (LISTEN "EVAL"))
  (LET ((LOSE (DISALLOW-CONNECTION? "EVAL" CONN (LIST EVAL-SERVER-ON :NOT-LOGGED-IN :REJECT-UNWANTED))))
    (WHEN LOSE
      (REJECT CONN LOSE)
      (RETURN-FROM EVAL-SERVER-FUNCTION NIL)))
  (ACCEPT CONN)
  (PUSH CONN EVAL-SERVER-CONNECTIONS)
  (SEND TV:WHO-LINE-FILE-STATE-SHEET :ADD-SERVER CONN "EVAL")
  (CATCH-ERROR
    (WITH-OPEN-STREAM (STREAM (MAKE-STREAM CONN :ASCII-TRANSLATION T))
      ;; Flush any number of telnet negotiations.  (We only understand the simplest kind).
      (DO-FOREVER
	(LET ((CH (TYI STREAM)))
	  (IF (= CH #o377)
	      (PROGN (TYI STREAM) (TYI STREAM))
	    (RETURN (SEND STREAM :UNTYI CH)))))
      (DO ((*TERMINAL-IO* STREAM)
	   (INPUT))
	  (NIL)
	(AND (EQ (SETQ INPUT (READ STREAM 'QUIT)) 'QUIT)
	     (RETURN NIL))
	(CATCH-ERROR (PRIN1 (MULTIPLE-VALUE-LIST (EVAL INPUT))) T)
	(WRITE-CHAR #/NEWLINE STREAM)
	(SEND STREAM :FORCE-OUTPUT)))
    NIL))

))

; From modified file DJ: L.NETWORK.CHAOS; CHSAUX.LISP#398 at 11-May-88 16:20:52
#8R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSAUX  "

(DEFUN TELNET-SERVER-FUNCTION (&AUX CONN)
  (SETQ CONN (LISTEN "TELNET"))
  (LET ((LOSE (DISALLOW-CONNECTION? "TELNET" CONN
				    (LIST TELNET-SERVER-ON :REJECT-UNWANTED))))
    (WHEN LOSE
      (REJECT CONN LOSE)
      (RETURN-FROM TELNET-SERVER-FUNCTION NIL)))
  (ACCEPT CONN)
  (PUSH CONN EVAL-SERVER-CONNECTIONS)
  (SEND TV:WHO-LINE-FILE-STATE-SHEET :ADD-SERVER CONN "TELNET")
  (CATCH-ERROR
    (WITH-OPEN-STREAM (REMOTE (MAKE-STREAM CONN :ASCII-TRANSLATION T))
      (PRINT-HERALD REMOTE)
      (FORMAT REMOTE "~&Telnet server here, hit <RETURN> to begin~%")
      (SEND REMOTE :FORCE-OUTPUT)
      (TELNET-SERVER-NEGOTIATIONS REMOTE)
      (SI:LISP-TOP-LEVEL1 (MAKE-TELNET-ECHOING-STREAM REMOTE)))
    NIL))

))