;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.169
;;; Reason:
;;;  Three problems found when trying TCP band transfer:
;;;    - If a TCP Server is closed from peek, the socket in the stream is set to NIL.
;;;      You then get an error in the scheduler when purge-servers tries to check if
;;;      the stream is open.
;;;    - TCP was improperly resetting hole offsets when the push-offset came exactly
;;;      at the end of a buffer and more buffers were queued.
;;;    - The TCP Disk Unit should close the stream with :abort t when asked to
;;;      :dispose of the unit -- All data transfer is synchronized such that
;;;      nothing is lost in the normal case -- and if you abort the transfer,
;;;      the Server isn't obligated to send the reset of the band to be
;;;      discarded by the user as it is with a normal graceful close.    
;;; Written 22-Dec-87 16:17:33 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.168, 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.KERNEL; TCP-STREAM.LISP#51 at 22-Dec-87 16:18:06
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  "

(defmethod (tcp-stream-mixin :close) (&optional mode)
  (when open
    (send self :force-output)
    (setq open nil)
    (apply socket :close (ncons mode))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#284 at 22-Dec-87 17:36:46
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP  "

(defun process-data (socket packet)
  "Copies data into appropriate spots of receive buffers"
  (let* ((packet-offset (tcp-first-data-byte packet))	;offset in packet of first new data byte
	 (packet-seq (32-bit-plus (SEG.SEQ packet) (tcp-syn-bit packet)))	;seq num of 1st new data byte
	 (packet-bytes (- (length packet) packet-offset))	;number of new data bytes in packet
	 (packet-edge (32-bit-plus packet-seq packet-bytes))	;1+ last seq in packet
	 (push-offset (if (or (tcp-psh-bit-p packet) (tcp-fin-bit-p packet)) packet-bytes))
	 (old-RCV.NXT (RCV.NXT socket))		;Remember current version of RCV.NXT
	 new-buffer-seq)
    
    (when (32-bit-> (RCV.NXT socket) packet-seq)
      (let ((dup (32-bit-minus (RCV.NXT socket) packet-seq)))	;bytes of duplicate data
	(incf packet-offset dup)
	(setq packet-seq (32-bit-plus packet-seq dup))
	(decf packet-bytes dup)
	(cond ((null push-offset))
	      ((>= dup push-offset)
	       (setq push-offset nil))
	      (t
	       (decf push-offset dup)))))
    
    (when (32-bit-> packet-edge (RCV.LAST socket))
      (setf (RCV.LAST socket) packet-edge))
    
    ;;If the FIN bit is set, remember its sequence number.
    (when (tcp-fin-bit-p packet)
      (setf (tcp-user-remote-fin-sequence-number socket) packet-edge)
      (setf (RCV.LAST socket) (32-bit-plus packet-edge 1)))


    (when (plusp packet-bytes)
      ;;Copy as much data as possible to user receive buffers
      (multiple-value-setq (packet-bytes packet-offset packet-seq push-offset new-buffer-seq)
	(copy-packet-data-to-receive-data socket
					  (32-bit-minus (RCV.NXT socket) (tcp-user-receive-data-offset socket))
					  packet
					  packet-bytes
					  packet-offset
					  packet-seq
					  push-offset
					  :data))
      
      ;;Reply to filled receive buffers
      (reply-to-completed-receives socket)
      
      (when (plusp packet-bytes)
	(if (and (tcp-user-closed-p socket)
		 (tcp-user-discard-p socket)
		 (fifo-empty-p (tcp-user-receive-data socket)))
	    ;;User has closed, said we should discard excess data, and no buffers remain
	    (setf (RCV.NXT socket) packet-edge)
	  ;;Save as much as possible in existing saved-packet list
	  (progn
	    (multiple-value-bind (new-packet-bytes new-packet-offset)
		(copy-packet-data-to-saved-data socket
						new-buffer-seq
						packet
						packet-bytes
						packet-offset
						packet-seq
						push-offset)
	      (when (plusp new-packet-bytes)
		;;Some data still remains uncopied.  Drop it.
		(tcp-log :drop socket new-packet-bytes new-packet-offset)
		(tcp-stat-incf socket dropped-bytes new-packet-bytes)))))))

    ;;If all data up to FIN has been processed, signal user
    (check-if-fin-processed socket)
  
    ;;Finally, send an ACK if any in-sequence data has arrived
    (unless (= old-RCV.NXT (RCV.NXT socket))
      (when (assoc 'ack-delay-timeout (tcp-user-timeout-alist socket) :test #'eq)
	(tcp-stat-incf socket packets-while-ack-delayed))
      (setf (tcp-user-ack-needed-p socket) t))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#284 at 22-Dec-87 17:49:28
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP  "

(defun copy-packet-data-to-receive-data (socket buffer-seq packet packet-bytes packet-offset packet-seq
					 push-offset keyword)
  "Copy data from a received packet into user receive buffers.  Return amount of uncopied data"
  (declare (values bytes-not-copied new-offset new-sequence new-push-offset new-buffer-seq))
  (do ((list (fifo-as-list (tcp-user-receive-data socket)) (cdr list))
       (packet-edge (32-bit-plus packet-seq packet-bytes)))	;sequence number of end of packet
      ((null list))				;Quit when we've run out of buffers
    (let* ((elt (car list))
	   (length (array-length (rcv-buffer elt)))
	   (buffer-edge (32-bit-plus buffer-seq length))
	   (buffer-offset 0)
	   (copy-bytes 0))
      ;;Sequence numbers of buffer: [buffer-seq,buffer-edge)
      (cond ((32-bit-< buffer-seq packet-seq)
	     ;;Packet starts after left edge of buffer
	     (unless (32-bit-<= buffer-edge packet-seq)
	       ;;Packet's left edge is in this buffer
	       (setq buffer-offset (32-bit-minus packet-seq buffer-seq))
	       (setq copy-bytes (min (- length buffer-offset) packet-bytes))))
	    ((32-bit->= packet-edge buffer-seq)
	     ;;Packet's right edge is in this buffer
	     (setq buffer-offset 0)
	     (setq copy-bytes (min length packet-bytes))))
      (when (plusp copy-bytes)
	(copy-tcp-data packet packet-offset elt buffer-offset copy-bytes socket keyword)
	(incf packet-offset copy-bytes)
	(setq packet-seq (32-bit-plus packet-seq copy-bytes))
	(decf packet-bytes copy-bytes)
	(when push-offset
	  (decf push-offset copy-bytes))
	(cond ((plusp packet-bytes)		;Entire packet doesn't fit in this buffer
	       (when push-offset
		 (setf (rcv-push-offset elt) (array-length (rcv-buffer elt)))))
	      ((zerop packet-bytes)
	       (unless (32-bit-<= buffer-edge packet-seq)
		 (adjust-push-offset elt (and push-offset (+ buffer-offset push-offset copy-bytes)))
		 (reset-holes socket)
		 (return)))
	      (t
	       (error "packet-bytes < 0"))))
      (setq buffer-seq buffer-edge)))
  (values packet-bytes packet-offset packet-seq push-offset buffer-seq))

))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; DISK.LISP#20 at 22-Dec-87 17:59:32
#10R TCP-APPLICATION#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP-APPLICATION")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; DISK  "

(defmethod (serial-stream-disk-unit :dispose) ()
  (close stream :abort t))

))