;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 123.136
;;; Reason:
;;;  Allow Telnet user to specify "host/known-port-name" (such as FTP or SMTP) rather
;;;  than forcing a decimal port number.
;;; Written 2-Dec-87 18:04:25 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.134, 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#299 at 2-Dec-87 18:04:25
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "

(DEFMETHOD (BASIC-NVT :HELP-MESSAGE)
	   (&AUX (FORMAT-ARGS
		   (LIST "~
~&You are using the ~A remote-login program.
To connect to any Chaosnet or Internet host, just type the target host name.
If you want to connect to a specific port on an Internet host, follow
the name of the Internet host by a slash and either the port number
in decimal or a known port name (like FTP or SMTP). 
If you want to connect to a specific connect-name on a Chaosnet host,
follow the name of the Chaosnet host by a slash and the connect name.

Summary:
  host      (for either network)
  internet-host//port-number (decimal)
  internet-host//port-name
  chaos-host//connect-name

At any time you can type the [Network] key to give any of a number of useful
commands.  For descriptions of the available commands, type [Network] [Help].

Connect to host: "
			 PROGRAM-NAME)))
  (COND ((NULL CONNECTION)
	 (SEND *STANDARD-OUTPUT* :CLEAR-WINDOW)
	 (APPLY #'FORMAT T FORMAT-ARGS))
	(T
	 (SI:WITH-HELP-STREAM (HELP-STREAM :LABEL "Keyboard system commands")
	   (APPLY #'FORMAT HELP-STREAM FORMAT-ARGS)))))

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#299 at 2-Dec-87 18:13:39
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "

(defmethod (basic-nvt :new-connection) (host protocol contact contact-p window
					&aux label-spec conn)
  (multiple-value-setq (host contact label-spec)
    (expand-path tv:name host contact contact-p))
  (when host
    (ecase protocol
      (:chaos
       (setq conn (chaos:connect host contact window)))
      (:internet
       (setq conn (condition-case (error)
		      (open (format nil "TCP-HOST:~A.~A" host contact) :keyword tv:name :optimistic nil)
		    (error error)))))
    (unless (errorp conn)
      (send self :set-label label-spec)
      (send self :set-connection conn))
      conn))

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#299 at 2-Dec-87 18:16:27
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "

(defun parse-path (path contact-name tcp-port &optional (protocol :chaos))
  (declare (values host protocol contact contact-specified-p))
  (and path
       (symbolp path)
       (setq path (symbol-name path)))
  (condition-case (lossage)
      (let (host specified-contact slash-p number)
	(typecase path
	  (null
	   (setq host si:associated-machine))
	  (integer
	   (or (setq host (si:get-host-from-address path :chaos))
	       (setq host path)))
	  (string
	   (when (setq slash-p (string-search-char #// path))
	     (cond ((setq number (parse-number path (1+ slash-p) nil 10. t))
		    ;; Format is "internet-host-name/number".
		    (setq specified-contact number)
		    (setq protocol :internet))
		   (t
		    ;; Format is "host-name/contact-string".
		    (setq specified-contact (substring path (1+ slash-p)))
		    (unless (eq protocol :chaos)
		      (let* ((upper (string-upcase specified-contact))
			     (temp (intern-soft (string-append "IPPORT-" upper) "TCP-APPLICATION")))
			(if (tcpa:sym-boundp temp)
			    (setq specified-contact upper)	;If known TCP port, make it upper case
			  (setq protocol :chaos))))))	        ;If unknown TCP port name, force Chaos
	     (setq path (substring path 0 slash-p)))
	   (cond ((setq host (si:parse-host path t nil))	;Known host
		  (unless (send host :network-typep protocol)	;Unknown protocol for this host
		    (if specified-contact	                ;Can't switch protocols...
			(setq host nil)
		      (setq protocol (ecase protocol	        ;Otherwise, check other protocol
				       (:chaos :internet)
				       (:internet :chaos)))
		      (unless (send host :network-typep protocol)
			(setq host nil)))))
		 (specified-contact
		  ;;If contact name or number specified, must find particular format of address
		  (setq host (nth-value 1 (funcall (ecase protocol
						     (:chaos 'chaos:address-parse)
						     (:internet 'ip:parse-internet-address))
						   path))))
		 ((setq host (nth-value 1 (ip:parse-internet-address path)))
		  (setq protocol :internet))
		 ((setq host (nth-value 1 (chaos:address-parse path)))
		  (setq protocol :chaos))
		 (t
		  (setq host nil))))
	  (si:host
	   (setq host path))
	  (t
	   (error "Invalid host specification")))
	(values host
		protocol
		(or specified-contact
		    (ecase protocol
		      (:chaos contact-name)
		      (:internet tcp-port)))
		(not (null specified-contact))))
    (error
     (format *terminal-io* "~&Error: ~A~%" lossage)
     (signal eh:abort-object))
     nil))

))
