;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 123.141
;;; Reason:
;;;  Add Verbose mode to Telnet, which displays telnet commands and option negotiations
;;;  sent and received.
;;; Written 4-Dec-87 14:04:41 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.140, Experimental Local-File 73.3, 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; SUPDUP.LISP#301 at 4-Dec-87 14:04:53
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "

(DEFFLAVOR BASIC-TELNET
	    ((MORE-FLAG NIL)
	     (ECHO-FLAG NIL)
	     (SIMULATE-IMLAC-FLAG NIL)
	     (BINARY-OUTPUT-FLAG NIL)
	     (SUPDUP-OUTPUT-FLAG NIL)
	     (verbose-flag nil))
	    (BASIC-NVT TV:FULL-SCREEN-HACK-MIXIN TV:LIST-MOUSE-BUTTONS-MIXIN)
  (:DEFAULT-INIT-PLIST :PROGRAM-NAME "Telnet")
  (:DOCUMENTATION "A TELNET NVT")
  (:SETTABLE-INSTANCE-VARIABLES SIMULATE-IMLAC-FLAG verbose-flag))

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#301 at 4-Dec-87 14:05:07
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "


(defmethod (basic-telnet :connect) (&optional path (net-window 3) &aux conn)
  (multiple-value-bind (host protocol contact contact-p)
      (parse-path path "TELNET" 23. :internet)
    (setq conn (send self :new-connection host protocol contact contact-p net-window)))
  (unless (errorp conn)
    (telnet-echo t)
    (telnet-send-option nvt-do nvt-suppress-go-ahead)
    (setq overprint nil))
  conn)

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#301 at 4-Dec-87 14:05:27
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "

(defun telnet-echo (on-p)
  (declare (:self-flavor basic-telnet))
  (unless (eq echo-flag on-p) ;If not the right way already
    (telnet-send-option (if on-p nvt-do nvt-dont) nvt-echo)
    (setq echo-flag on-p)
    (when verbose-flag
      (format self "~&Setting ~:[local~;remote~] echo~%" on-p))))

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#301 at 4-Dec-87 14:05:29
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "


(defun telnet-send-command (command)
  (declare (:self-flavor basic-telnet))
  (when verbose-flag
    (format self
	    "~&Sending IAC~@[ ~A~]~%"
	    (cadr (assq command telnet:*telsyms*))))
  (lock-output
    (send stream :tyo nvt-iac)
    (send stream :tyo command)
    (send stream :force-output)))

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#301 at 4-Dec-87 14:05:32
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "


(defmethod (basic-telnet :toggle-verbose-mode) ()
  (setq verbose-flag (not verbose-flag)))

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#301 at 4-Dec-87 14:05:37
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "


(defmethod (basic-telnet :send-ip) ()
  ;; Send a New Telnet "Interrupt Process".
  (lock-output
    (send stream :force-output))
  (send stream :set-urgent-output t)
  (telnet-send-command nvt-ip)
  (telnet-send-command nvt-dm)
  (send stream :set-urgent-output nil))

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#302 at 4-Dec-87 14:16:06
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "

(DEFMETHOD (BASIC-NVT :HANDLE-ESCAPE) (&AUX CH XPOS YPOS command)
  (UNWIND-PROTECT
    (PROGN
      (MULTIPLE-VALUE (XPOS YPOS) (TV:SHEET-READ-CURSORPOS SELF))
      (PUT-DOWN-STRING SELF "CMND-->")
      (SETQ CH (CHAR-UPCASE (SEND SELF :TYI)))
      (SELECTQ CH
	((#/CALL #/P)
	 (TV:DESELECT-AND-MAYBE-BURY-WINDOW SELF))
	(#/A
	 (unless (NULL CONNECTION)
	   (setq command '(SEND SELF :SEND-IF-HANDLES :SEND-IP))))
	((#/B #/BREAK)
	 (SEND SELF :SET-SUPER-IMAGE-MODE NIL)
	 (BREAK "BREAK")
	 (SEND SELF :SET-SUPER-IMAGE-MODE T))
	(#/C			      ;C = Change escape character.
	 (PUT-DOWN-STRING SELF "Change escape character to -->")
	 (SEND SELF :SET-SUPER-IMAGE-MODE NIL)
	 (SETQ ESCAPE-CHAR (CHAR-UPCASE (SEND SELF :TYI)))
	 (SEND SELF :SET-SUPER-IMAGE-MODE T))
	(#/D                         ;D = Disconnect, ask for new host to connect to.
	 (IF (NULL CONNECTION)
	     (THROW 'NVT-DONE "(Already disconnected.)")
	   (SEND SELF :DISCONNECT)
	   (THROW 'NVT-DONE "Disconnected")))
	(#/E
	 (unless (null connection)
	   (setq command '(send self :send-if-handles :toggle-remote-echo))))
	(#/N
	 (SEND SELF :SET-SUPER-IMAGE-MODE NIL))
	(#/L			      ;L = Logout.
	 (IF (NULL CONNECTION)
	     (QUIT)
	   (setq command '(progn
			    (SEND SELF :LOGOUT)
			    (QUIT "Logout")))))
	(#/Q			      ;Q = Quit.
	 (QUIT))
	(#/M			      ;M = More.
	 (IF (NOT (NULL CONNECTION))
	     (SEND SELF :SEND-IF-HANDLES :USER-SET-MORE-P (NOT (SEND SELF :MORE-P)))))
	(#/I			      ;I = Imlac.
	 (IF (NOT (NULL CONNECTION))
	     (SEND SELF :SEND-IF-HANDLES :TOGGLE-IMLAC-SIMULATION)))
	(#/O
	 (SEND SELF :SEND-IF-HANDLES :TOGGLE-OVERPRINTING))
	(#/V
	 (send self :send-if-handles :toggle-verbose-mode))
	(#/Y
	 (let* ((node (zwei:history-latest-element zwei:*kill-history*))
		(string (if (arrayp node) node (zwei:string-interval node nil nil t))))
	   (dotimes (i (array-length string))
	     (send self :force-kbd-input (aref string i)))))

	((#/HELP #/?)		      ;<HELP> or ? = Help
	 (SI:WITH-HELP-STREAM (WINDOW :LABEL "Help for Network commands")
	   (SEND WINDOW :CLEAR-WINDOW)
	   (FORMAT WINDOW "After typing the Escape character, which is ~:C,
you can type these commands:~%" ESCAPE-CHAR)
	   (FORMAT WINDOW "
CALL -- Do a local CALL (return to top window).
BREAK-- Enter a breakpoint.
~:[~;A    -- Send an ATTN (in Telnet, a New Telnet /"Interrupt Process/").
~]~
C    -- Change the SUPDUP escape character.
D    -- Disconnect and connect to new host.
~:[~;E    -- Toggle remote echo
~]~
~:[~;I    -- Toggle imlac simulation.
~]~
L    -- Log out of remote host, and break the connection.
~:[~;M    -- Toggle more processing.
~]~
~:[~;O    -- Toggle overprinting (for servers that expect non-overprinting terminals).
~]~
P    -- Return to top window, but don't break connection.
Q    -- Disconnect and return to top window.
~:[~;V    -- Toggle verbose mode
~]~
Y    -- Send the most recently killed string through the connection.

Help -- Type this cruft.
"
		   (GET-HANDLER-FOR SELF :SEND-IP)
		   (GET-HANDLER-FOR SELF :TOGGLE-REMOTE-ECHO)
		   (GET-HANDLER-FOR SELF :TOGGLE-IMLAC-SIMULATION)
		   (GET-HANDLER-FOR SELF :USER-SET-MORE-P)
		   (GET-HANDLER-FOR SELF :TOGGLE-OVERPRINTING)
		   (get-handler-for self :toggle-verbose-mode))
	   (FORMAT WINDOW "~4A -- Send ~:C through~%"
		   (FORMAT NIL "~:C" ESCAPE-CHAR)
		   ESCAPE-CHAR)))
	(#/RUBOUT)				;<RUBOUT> = Do nothing.
	(OTHERWISE
	  (COND ((= CH ESCAPE-CHAR)
		 (SEND SELF :NET-OUTPUT-TRANSLATED CH)
		 (LOCK-OUTPUT
		   (SEND STREAM :FORCE-OUTPUT)))
		(T (TV:BEEP))))))
    (TV:SHEET-FORCE-ACCESS (SELF T)
      (PUT-DOWN-STRING SELF "")      ;Clear the bottom line.
      (TV:SHEET-SET-CURSORPOS SELF XPOS YPOS))
    (when command
      (eval command))))

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#302 at 4-Dec-87 14:18:45
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "

(defun telnet-send-option (command option)
  (declare (:self-flavor basic-telnet))
  (when verbose-flag
    (format self
	    "~&Sending IAC~@[ ~A~]~@[ ~A~]~%"
	    (cadr (assq command telnet:*telsyms*))
	    (let ((name (cadr (assq option telnet:*telopts*))))
	      (and name (substring (symbol-name name) 7)))))
  (lock-output
    (send stream :tyo nvt-iac)
    (send stream :tyo command)
    (send stream :tyo option)
    (send stream :force-output)))

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#302 at 4-Dec-87 14:19:52
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "

(DEFMETHOD (BASIC-TELNET :HANDLE-IAC) (&AUX COMMAND OPTION)
  (SETQ COMMAND (NVT-NETI))
  (AND ( COMMAND NVT-WILL) ( COMMAND NVT-DONT)
       (SETQ OPTION (NVT-NETI)))
  (when verbose-flag
    (format self
	    "~&Received IAC~@[ ~A~]~@[ ~A~]~%"
	    (cadr (assq command telnet:*telsyms*))
	    (and option 
		 (let ((name (cadr (assq option telnet:*telopts*))))
		   (and name (substring (symbol-name name) 7))))))
  (SELECT COMMAND
    (NVT-WILL
     (SELECT OPTION
       (NVT-SUPPRESS-GO-AHEAD)		;ignore things we requested
       (NVT-ECHO
	(telnet-echo t))
       (NVT-TRANSMIT-BINARY
	(SETQ BINARY-OUTPUT-FLAG T)
	(TELNET-SEND-OPTION NVT-DO OPTION))
       (NVT-SUPDUP-OUTPUT
	(TELNET-START-SUPDUP-OUTPUT))
       (nvt-logout
	(telnet-send-option nvt-do option))
       (OTHERWISE
	(TELNET-SEND-OPTION NVT-DONT OPTION))))
    (NVT-DO
     (select option
       ((NVT-SUPPRESS-GO-AHEAD NVT-TIMING-MARK NVT-TRANSMIT-BINARY)
	(TELNET-SEND-OPTION NVT-WILL OPTION))
       (T (TELNET-SEND-OPTION NVT-WONT OPTION))))
    (NVT-DONT
     (TELNET-SEND-OPTION NVT-WONT OPTION))
    (NVT-WONT
     (select option
       (NVT-ECHO
	(telnet-echo nil))
       (NVT-TRANSMIT-BINARY
	(SETQ BINARY-OUTPUT-FLAG NIL)
	(TELNET-SEND-OPTION NVT-DONT OPTION))))
    (NVT-SUBNEGOTIATION-BEGIN
     (TELNET-HANDLE-SUBNEGOTIATION))))

))