;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.168
;;; Reason:
;;;  Chaos SUPDUP Server.
;;; Written 22-Dec-87 13:24:14 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.166, Experimental Local-File 73.3, Experimental FILE-Server 22.1, Experimental Unix-Interface 11.0, Experimental Tape 18.0, Experimental KERMIT 34.3, 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#109 at 22-Dec-87 13:24:27
#10R TELNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TELNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; TELNET  "

(defun chaos-supdup-server ()
  (let* ((conn (chaos:listen "SUPDUP"))
	 (process-name (format nil "SUPDUP serving ~A" (chaos:host-short-name (chaos:foreign-address conn))))
	 (tcpa:*server* (tcpa:make-network-server :service (tcpa:make-network-service :name "SUPDUP")
						  :process global:current-process
						  :process-name process-name))
	 (stream nil))
    (global:condition-case-if (not tcpa:*tcp-generic-server-toplevel-debug*) ()
	(unwind-protect
	    (progn
	      (chaos:accept conn)
	      (setq stream (chaos:make-stream conn))
	      (send tv:who-line-file-state-sheet :add-server conn "SUPDUP")
	      (supdup-server-function stream))
	  (and stream (send stream :force-output))
	  (chaos:close-conn conn)
	  (dolist (proc (tcpa:network-server-subprocesses *server*))
	    (send proc :kill))
	  (send tv:who-line-file-state-sheet :delete-server conn))
      (error nil))))

))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; TELNET.LISP#109 at 22-Dec-87 13:24:33
#10R TELNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TELNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; TELNET  "

(add-initialization "SUPDUP"
                    '(process-run-function "SUPDUP Server" 'chaos-supdup-server)
                    NIL
                    'chaos:server-alist)

))