;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*- ;;; Patch file for System version 123.156 ;;; Reason: ;;; TCP/UDP servers now appear on Who Line and on Peek Server page. ;;; Written 8-Dec-87 14:22:39 by pld at site Gigamos Cambridge ;;; while running on Jack Flanders from band 2 ;;; with Experimental System 123.154, 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.IP-TCP.KERNEL; IP.LISP#278 at 8-Dec-87 14:22:46 #10R INTERNET#: (COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "INTERNET"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; IP  " (defun host-short-name (host) "Return a brief name for the specified host." (multiple-value-bind (number object) (parse-internet-address host) (cond (object (send object :short-name)) (number (canonical-ip number)) (t host)))) )) ; From modified file DJ: L.WINDOW; WHOLIN.LISP#107 at 8-Dec-87 14:42:18 #8R TV#: #!:ZL (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "TV"))) (COMPILER::PATCH-SOURCE-FILE "SYS: WINDOW; WHOLIN  " (DEFMETHOD (WHO-LINE-FILE-SHEET :ADD-SERVER) (CONNECTION CONTACT-NAME &OPTIONAL (PROCESS SI:CURRENT-PROCESS) FUNCTION &REST ARGS &AUX (INHIBIT-SCHEDULING-FLAG T)) (SEND SELF :DELETE-SERVER CONNECTION) (PUSH (MAKE-SERVER-DESC :CONNECTION CONNECTION :HOST-NAME (if (typep connection 'chaos:conn) (CHAOS:HOST-SHORT-NAME (CHAOS:FOREIGN-ADDRESS CONNECTION)) (ip:host-short-name (send connection :remote-address))) :CONTACT-NAME CONTACT-NAME :PROCESS PROCESS :FUNCTION FUNCTION :ARGS (COPY-LIST ARGS)) SERVERS-LIST)) ;;; This isn't usually called; Normally servers are deleted automatically when ;;; it is noticed that the connection has been closed. )) ; From modified file DJ: L.WINDOW; WHOLIN.LISP#107 at 8-Dec-87 14:42:22 #8R TV#: #!:ZL (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "TV"))) (COMPILER::PATCH-SOURCE-FILE "SYS: WINDOW; WHOLIN  " (DEFMETHOD (WHO-LINE-FILE-SHEET :CLOSE-ALL-SERVERS) (REASON) (LOOP FOR SERVER IN SERVERS-LIST FINALLY (SETQ SERVERS-LIST NIL) DO (let ((connection (server-desc-connection server))) (if (typep connection 'chaos:conn) (CHAOS:CLOSE-CONN (SERVER-DESC-CONNECTION SERVER) REASON) (send connection :close))))) ;;; Remove all servers which aren't current anymore. )) ; From modified file DJ: L.WINDOW; WHOLIN.LISP#107 at 8-Dec-87 14:42:22 #8R TV#: #!:ZL (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "TV"))) (COMPILER::PATCH-SOURCE-FILE "SYS: WINDOW; WHOLIN  " (DEFUN PURGE-SERVERS () (DECLARE (:SELF-FLAVOR WHO-LINE-FILE-SHEET)) (WITHOUT-INTERRUPTS (DO ((S SERVERS-LIST (CDR S))) ((NULL S) (SETQ SERVERS-LIST (DELQ NIL SERVERS-LIST))) (let ((connection (server-desc-connection (car s)))) (cond ((typep connection 'chaos:conn) (when (AND (NEQ (CHAOS:STATE (SERVER-DESC-CONNECTION (CAR S))) 'CHAOS:OPEN-STATE) (NEQ (CHAOS:STATE (SERVER-DESC-CONNECTION (CAR S))) 'CHAOS:RFC-RECEIVED-STATE)) ; (BACKGROUND-NOTIFY "Server ~A from ~A being purged; state is ~A" ; (SERVER-DESC-CONTACT-NAME (CAR S)) ; (SERVER-DESC-HOST-NAME (CAR S)) ; (CHAOS:STATE (SERVER-DESC-CONNECTION (CAR S)))) (SETF (CAR S) NIL))) ((null (send connection :remote-address)) (setf (car s) nil))))))) )) ; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; GENERIC-SERVER.LISP#23 at 8-Dec-87 15:08:03 #10R TCP-APPLICATION#: (COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP-APPLICATION"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; GENERIC-SERVER  " (defun start-network-server-toplevel-function (service server) (let ((*server* server) (flavor (or (network-service-stream-flavor service) (ecase (network-service-transport-protocol service) (:tcp 'tcp:tcp-buffered-stream) (:udp 'udp:udp-stream))))) (with-open-stream (stream (send (make-instance flavor :socket (network-server-socket server)) :open)) (with-network-server-lock (server) (setf (network-server-stream server) stream)) (global:condition-case-if (not *tcp-generic-server-toplevel-debug*) () (unwind-protect (progn (send tv:who-line-file-state-sheet :add-server stream (network-service-name service)) (with-network-service-lock (service) (push server (network-service-active-servers service))) (funcall (network-service-toplevel-function service) stream)) (with-network-service-lock (service) (setf (network-service-active-servers service) (remove server (network-service-active-servers service)))) (send stream :force-output) (send tv:who-line-file-state-sheet :delete-server stream) (deallocate-network-server server)) (error nil))))) )) ; From modified file DJ: L.WINDOW; PEEK.LISP#200 at 8-Dec-87 15:13:55 #8R TV#: #!:ZL (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "TV"))) (COMPILER::PATCH-SOURCE-FILE "SYS: WINDOW; PEEK  " (DEFUN PEEK-SERVERS (IGNORE) (LIST () (SCROLL-PARSE-ITEM "Active Servers") (SCROLL-PARSE-ITEM "Contact Name Host Process // State") (SCROLL-PARSE-ITEM " Connection") (SCROLL-PARSE-ITEM "") (SCROLL-MAINTAIN-LIST #'(LAMBDA () (SEND TV:WHO-LINE-FILE-STATE-SHEET :SERVERS)) #'(LAMBDA (SERVER-DESC) (LET* ((PROCESS (SERVER-DESC-PROCESS SERVER-DESC)) (CONN (SERVER-DESC-CONNECTION SERVER-DESC)) (contact (server-desc-contact-name server-desc)) (HOST (if (typep conn 'chaos:conn) (SI:GET-HOST-FROM-ADDRESS (CHAOS:FOREIGN-ADDRESS CONN) :CHAOS) (nth-value 1 (ip:parse-internet-address (send conn :remote-address)))))) (LIST '(:PRE-PROCESS-FUNCTION PEEK-SERVER-PREPROCESS) (SCROLL-PARSE-ITEM :LEADER '(NIL NIL NIL) `(:FUNCTION ,#'values (,contact) 20. ("~A")) `(:MOUSE-ITEM (NIL :EVAL (CHAOS:PEEK-CHAOS-HOST-MENU ',HOST 'TV:ITEM 0) :DOCUMENTATION "Menu of useful things to do to this host.") :FUNCTION ,#'VALUES (,HOST) 20. ("~A")) `(:MOUSE (NIL :EVAL (PEEK-PROCESS-MENU ',PROCESS) :DOCUMENTATION "Menu of useful things to do to this process.") :STRING ,(FORMAT NIL "~S" PROCESS)) " " `(:FUNCTION ,#'PEEK-WHOSTATE ,(NCONS PROCESS))) (SCROLL-PARSE-ITEM :LEADER '(NIL NIL NIL NIL NIL NIL) ;6 " " `(:MOUSE-ITEM (NIL :EVAL (PEEK-CONNECTION-MENU ',CONN 'ITEM ',host ',contact) :DOCUMENTATION "Menu of useful things to do this connection") :STRING ,(FORMAT NIL "~S" CONN))) NIL ;Connection stat NIL ;hostat (AND (SERVER-DESC-FUNCTION SERVER-DESC) (APPLY (SERVER-DESC-FUNCTION SERVER-DESC) (SERVER-DESC-ARGS SERVER-DESC))))))))) )) ; From modified file DJ: L.WINDOW; PEEK.LISP#200 at 8-Dec-87 15:14:32 #8R TV#: #!:ZL (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "TV"))) (COMPILER::PATCH-SOURCE-FILE "SYS: WINDOW; PEEK  " (DEFUN PEEK-CONNECTION-MENU (CONN ITEM host contact) (APPLY #'PROCESS-RUN-FUNCTION "Peek Server Connection Menu" SELF :PEEK-SERVER-CONNECTION-MENU (LIST CONN ITEM host contact))) )) ; From modified file DJ: L.WINDOW; PEEK.LISP#200 at 8-Dec-87 15:14:32 #8R TV#: #!:ZL (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "TV"))) (COMPILER::PATCH-SOURCE-FILE "SYS: WINDOW; PEEK  " (DEFMETHOD (BASIC-PEEK :PEEK-SERVER-CONNECTION-MENU) (CONN ITEM host contact) (LET ((*TERMINAL-IO* TYPEOUT-WINDOW)) (LET ((CHOICE (MENU-CHOOSE (append '(("Close" :VALUE :CLOSE :DOCUMENTATION "Close connection forcibly.")) (when (typep conn 'chaos:conn) '(("Insert Detail" :VALUE :DETAIL :DOCUMENTATION "Insert detailed info about chaos connection."))) (when (typep conn 'chaos:conn) '(("Remove Detail" :VALUE :UNDETAIL :DOCUMENTATION "Remove detailed info from Peek display."))) '(("Inspect" :VALUE :INSPECT :DOCUMENTATION "Inspect the connection"))) (STRING-APPEND host "//" contact)))) (CASE CHOICE (:CLOSE (if (typep conn 'chaos:conn) (CHAOS:CLOSE-CONN CONN "Manual Close from PEEK") (send conn :close))) (:INSPECT (INSPECT CONN)) (:DETAIL (SETF (ARRAY-LEADER ITEM (+ 4 TV:SCROLL-ITEM-LEADER-OFFSET)) CONN) (SETF (ARRAY-LEADER ITEM (+ 5 TV:SCROLL-ITEM-LEADER-OFFSET)) T)) (:UNDETAIL (SETF (ARRAY-LEADER ITEM (+ 4 TV:SCROLL-ITEM-LEADER-OFFSET)) NIL) (SETF (ARRAY-LEADER ITEM (+ 5 TV:SCROLL-ITEM-LEADER-OFFSET)) NIL)))))) ))