;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.180
;;; Reason:
;;;  Patch 123.169 doesn't quite do the job -- it can cause TCP not to hand up
;;;  PUSHED data immediately and to acknowledge data that hasn't been received.
;;;  Also create (tcp:print-tcp-receive-log) and make that function and
;;;  (tcp:print-tcp-log) go to *standard-output* instead of *terminal-io*.
;;; Written 8-Jan-88 14:30:22 by pld at site Gigamos Cambridge
;;; while running on James Brown from band 1
;;; with Experimental System 123.179, 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.13, SDU ROM 102.



; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#285 at 8-Jan-88 14:42:17
#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)
	       ;;Unless this buffer precedes the packet....
	       (when (32-bit-> packet-seq buffer-seq)
		 ;;If part of packet went into this buffer...
		 (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.KERNEL; TCP.LISP#285 at 8-Jan-88 14:42:36
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP  "


(defun send-immediate-ack (tp)
  "Builds and sends a ACK packet for a specific TCP connection"
  (with-lock ((tcp-user-lock tp))
    (unless (eq (tcp-user-state tp) :closed)
      (tcp-stat-incf tp ack-packets-sent)
      (tcp-log :send-ack tp (RCV.NXT tp))
      (setf (tcp-user-ack-needed-p tp) nil)
      (cancel-timeout tp 'ack-delay-timeout)
      (multiple-value-bind (header ip-header)
	  (build-ack-packet tp)
	(send-control-packet header ip-header tp)))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#285 at 8-Jan-88 14:42:40
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP  "


(defun tcp-receive-logging (enable)
  "Turns on TCP logging for data reception"
  (setq *tcp-logging* nil)
  (setq *tcp-log-keywords* nil)
  (initialize-tcp-log)
  (when enable
    (setq *tcp-log-keywords* '(:open :close :read :receive :copy :save :retrieve :drop :read-reply :send-ack))
    (setq *tcp-logging* t)))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#285 at 8-Jan-88 14:42:43
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP  "


(defun print-tcp-log (&optional (stream *standard-output*))
  (unless (fifo-empty-p *tcp-log*)
    (format stream "~&S/R sport dport      SEQ      ACK  flags   WND    UP  data")
    (dolist (elt (fifo-as-list *tcp-log*))
      (let ((keyword (case (car elt)
		       (:copy :CPY)
		       (:save :SAV)
		       (:retrieve :RET)
		       (:drop :DRP)
		       (:delay :DLY)
		       (:wait :WAI)
		       (:skip :SKP)
		       (:send-ack :ACK)
		       (:timeout :TMO)
		       (:user-timeout :UTM)
		       (:cancel :CAN)
		       (:open :OP)
		       (:open-reply :OPR)
		       (:close :CL)
		       (:close-reply :CLR)
		       (:abort :ABO)
		       (:read :RD)
		       (:read-reply :RDR)
		       (:write :WR)
		       (:write-reply :WRR)
		       (:reset-received :RSR)
		       (:reset-packet :RSP)
		       (:reset-sent :RSS)
		       (:receive :RCV)
		       (:send :SND)
		       (:failed-send :FAI)
		       (:failed-send-timeout :FST)
		       (:block :BLK)
		       (:unblock :UBL)
		       (:initial-rtt :IRT)
		       (:rtt :RTT)))
	    (args (cdr elt)))
	(case (car elt)
	  ((:copy :save :retrieve :drop)
	   (format stream "~&~A ~5D ~5D ~5D bytes from ~D -> ~D"
		   keyword
		   (first args)
		   (second args)
		   (third args)
		   (fourth args)
		   (fifth args)))
	  (:user-timeout
	   (format stream "~&~3A ~5D ~5D cum = ~D tmo = ~D"
		   keyword
		   (first args)
		   (second args)
		   (third args)
		   (fourth args)))
	  (:initial-rtt
	   (format stream "~&~3A ~5D ~5D ~,4F"
		   keyword
		   (first args)
		   (second args)
		   (third args)))
	  (:rtt
	   (format stream "~&~3A ~5D ~5D ~,4F -> ~,4F"
		   keyword
		   (first args)
		   (second args)
		   (third args)
		   (fourth args)))
	  (:send-ack
	   (format stream "~&~3A ~5D ~5D ~16,8,'0R"
		   keyword
		   (first args)
		   (second args)
		   (third args)))
	  ((:delay :wait :skip :timeout :cancel :open :open-reply :close :close-reply :abort
		   :failed-send :failed-send-timeout :block :unblock)
	   (format stream "~&~3A ~5D ~5D"
		   keyword
		   (first args)
		   (second args)))
	  (:read-reply
	   (format stream "~&~3A ~5D ~5D ~5D bytes~@[ ~D~]~@[ URG = ~D~]"
		   keyword
		   (first args)
		   (second args)
		   (third args)
		   (fourth args)
		   (fifth args)))
	  ((:read :write :write-reply)
	   (format stream "~&~3A ~5D ~5D ~5D bytes"
		   keyword
		   (first args)
		   (second args)
		   (third args)))
	  (:state
	   (format stream "~&STC ~5D ~5D ~A -> ~A"
		   (first args)
		   (second args)
		   (third args)
		   (fourth args)))
	  (:reset-received
	   (format stream "~&~3A ~5D ~5D ~S"
		   keyword
		   (first args)
		   (second args)
		   (third args)))
	  (:reset-sent
	   (format stream "~&~3A ~5D ~5D ~S"
		   keyword
		   (first args)
		   (second args)
		   (fourth args)))
	  (:reset-packet
	   (let* ((pkt (first args))
		  (source (tcp-source-port pkt))
		  (dest (tcp-destination-port pkt)))
	     (format stream "~&~3A (~D[~A]->~D) ~S"
		     keyword
		     source
		     (canonical-ip (third args))
		     dest
		     (second args))))
	  ((:send :receive)
	   (let ((pkt (first args))
		 (data-bytes (second args))
		 (source (third args))
		 (destination (fourth args)))
	     (format stream
		     "~&~3A ~5D ~5D ~16,8,'0R ~16,8,'0R ~:[ ~;U~]~:[ ~;A~]~:[ ~;P~]~:[ ~;R~]~:[ ~;S~]~:[ ~;F~] ~5D ~5D ~5D ~A -> ~A"
		     keyword
		     (tcp-source-port pkt)
		     (tcp-destination-port pkt)
		     (tcp-sequence-number pkt)
		     (tcp-ack-number pkt)
		     (tcp-urg-bit-p pkt)
		     (tcp-ack-bit-p pkt)
		     (tcp-psh-bit-p pkt)
		     (tcp-rst-bit-p pkt)
		     (tcp-syn-bit-p pkt)
		     (tcp-fin-bit-p pkt)
		     (tcp-window pkt)
		     (tcp-urgent-pointer pkt)
		     data-bytes
		     (canonical-ip source)
		     (canonical-ip destination))
	     (when (fifth args)
	       (format stream "~&~S" (fifth args))))))))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#285 at 8-Jan-88 14:42:44
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP  "


(defun print-tcp-receive-log (&optional (stream *standard-output*))
  (unless (fifo-empty-p *tcp-log*)
    (format stream "~&S/R sport dport      SEQ      flags   WND    UP  data")
    (dolist (elt (fifo-as-list *tcp-log*))
      (let ((keyword (case (car elt)
		       (:copy :CPY)
		       (:save :SAV)
		       (:retrieve :RET)
		       (:drop :DRP)
		       (:send-ack :ACK)
		       (:open :OP)
		       (:close :CL)
		       (:read :RD)
		       (:read-reply :RDR)
		       (:receive :RCV)))
	    (args (cdr elt)))
	(case (car elt)
	  ((:copy :save :retrieve :drop)
	   (format stream "~&~A ~5D ~5D ~5D bytes from ~D -> ~D"
		   keyword
		   (first args)
		   (second args)
		   (third args)
		   (fourth args)
		   (fifth args)))
	  (:send-ack
	   (format stream "~&~3A ~5D ~5D ~D"
		   keyword
		   (first args)
		   (second args)
		   (third args)))
	  ((:open :close)
	   (format stream "~&~3A ~5D ~5D"
		   keyword
		   (first args)
		   (second args)))
	  (:read
	   (format stream "~&~3A ~5D ~5D ~5D bytes"
		   keyword
		   (first args)
		   (second args)
		   (third args)))
	  (:read-reply
	   (format stream "~&~3A ~5D ~5D ~5D bytes~@[ ~D~]~@[ URG = ~D~]"
		   keyword
		   (first args)
		   (second args)
		   (third args)
		   (fourth args)
		   (fifth args)))
	  ((:read :write :write-reply)
	   (format stream "~&~3A ~5D ~5D ~5D bytes"
		   keyword
		   (first args)
		   (second args)
		   (third args)))
	  (:receive
	   (let ((pkt (first args))
		 (data-bytes (second args)))
	     (format stream
		     "~&~3A ~5D ~5D ~D ~:[ ~;U~]~:[ ~;A~]~:[ ~;P~]~:[ ~;R~]~:[ ~;S~]~:[ ~;F~] ~5D ~5D ~5D"
		     keyword
		     (tcp-source-port pkt)
		     (tcp-destination-port pkt)
		     (tcp-sequence-number pkt)
		     (tcp-urg-bit-p pkt)
		     (tcp-ack-bit-p pkt)
		     (tcp-psh-bit-p pkt)
		     (tcp-rst-bit-p pkt)
		     (tcp-syn-bit-p pkt)
		     (tcp-fin-bit-p pkt)
		     (tcp-window pkt)
		     (tcp-urgent-pointer pkt)
		     data-bytes)
	     (when (fifth args)
	       (format stream "~&~S" (fifth args))))))))))

))