;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.31
;;; Reason:
;;;  If you do (net:configure) and then (fs:reset-file-access), the file system tries
;;;  to shut down TCP connections that are not open -- but aren't marked as fully closed.
;;;  This is because when you do (net:configure), TCP requests a graceful close for all
;;;  connections -- one that sends FINs.  It should abort all connections.  Then, when
;;;  the FS closes the connection, it finds it already closed.  tcp-stream now silently
;;;  ignores trying to write on a closed connection.
;;; Written 6-Oct-87 18:06:46 by pld (Peter L. DeWolf) at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.30, Experimental Local-File 73.0, Experimental FILE-Server 22.0, 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.KERNEL; TRANSPORT-PROTOCOL.LISP#41 at 6-Oct-87 18:29:28
#10R NETWORK#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "NETWORK")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; KERNEL; TRANSPORT-PROTOCOL  "

(defop (transport-protocol :close) (&optional args)
  (when (tp-opened self)
    (when (tp-enabled self)
      (send self :disable))
    (when (tp-close-function self)
      (apply (tp-close-function self) self args))
    (send self :kill-gauges)
    (delete-network-statistics-block (tp-statistics-block self))
    (setf (tp-opened self) nil)
    (when (tp-network-protocol self)
      (without-interrupts
	(delete-from-alist (tp-type self) (np-protocols (tp-network-protocol self)))))
    t))

))

(net:create-included-methods 'ip:ip-transport-protocol)

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#275 at 6-Oct-87 18:07:57
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP  "

(defun tcp-close (stream &optional (abort t))
  (do ()
      ((null (tcp-receive-buffers stream)))
    (free-tcp-buffer (pop (tcp-receive-buffers stream))))
  (close-tcp-sockets stream abort))

))

(net:create-included-methods 'tcp:tcp-ip-transport-protocol)

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#37 at 6-Oct-87 18:12:36
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "

(defmethod (tcp-buffered-stream :send-output-buffer) (buffer count)
  (setf (fill-pointer buffer) count)
  (unless (funcall socket :write-data buffer :pushed (< count output-buffer-size))
    ;;(cerror "Ignore error" "Write failed; connection closed")
    (push buffer output-buffer-list)))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; UDP.LISP#109 at 6-Oct-87 18:32:20
#10R UDP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "UDP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; UDP  "

(defun udp-close (stream &optional (abort t))
  (do ()
      ((null (udp-receive-buffers stream)))
    (free-udp-buffer (pop (udp-receive-buffers stream))))
  (close-udp-sockets stream abort))

))

(net:create-included-methods 'udp:udp-ip-transport-protocol)

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; ICMP.LISP#90 at 6-Oct-87 18:33:37
#10R ICMP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "ICMP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; ICMP  "

(defun icmp-close (stream &optional abort)
  (declare (ignore abort))
  (do ()
      ((null (icmp-receive-buffers stream)))
    (free-icmp-message (pop (icmp-receive-buffers stream))))
  (close-icmp-sockets stream))

))

(net:create-included-methods 'icmp:icmp-ip-transport-protocol)

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#276 at 6-Oct-87 18:56:42
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP  "

(defun send-control-packet (header ip-header tp &optional int-pkt)
  (let* ((source (ip::ih-source-address ip-header))
	 (destination (if tp
			  (tcp-user-remote-address tp)
			(ip::ih-dest-address ip-header))))
    (unless int-pkt
      (store-tcp-checksum header ip-header (and tp (tcp-user-local-host-p tp)))
      (setq int-pkt (net:allocate-packet nil)))
    (cond (int-pkt
	   (let ((result (send *tcp-stream* :send header ip-header int-pkt)))
	     (cond ((null result))		;TCP is down.
		   ((plusp result)
		    ;;Send succeeded.  Increment statistics and do logging.
		    (when tp
		      (incf (tcp-user-packets-sent tp))
		      (incf (tcp-user-bytes-sent tp) (- (length header) 20)))
		    (tcp-log :send
			     nil
			     (copy-tcp-header header (get-tcp-header))
			     (- (fill-pointer header) 20)
			     source
			     destination)
		    (free-tcp-header header))
		   (tp
		    ;;Send failed when sending a RST or ACK packet for a socket.
		    (cond ((tcp-rst-bit-p header)
			   (start-failed-control-packet-send-timeout header ip-header tp))
			  (t
			   ;;This was an ACK packet.  Note that we need an ACK and start failed-send-timeout
			   (setf (tcp-user-ack-needed-p tp) t)
			   (start-failed-send-timeout tp)
			   (free-tcp-header header))))
		   (t
		    ;;Send failed when sending a RST in response to bogus packet.  Ignore problem.
		    (start-failed-control-packet-send-timeout header ip-header nil))))
	   )
	  (t
	   (push-fifo (list header ip-header tp) *send-blocked-control-packets*)
	   (tcp-stat-incf tp packet-allocation-delays)))))

))