;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.30
;;; Reason:
;;;  (tcp-socket :close) takes an optional "mode" argument which defaults to :discard.
;;;  If explicitly called with NIL, it should also default to :discard -- the callers
;;;  who call it that way are simply trying to use mode :abort.  Thus: NIL or :discard
;;;  means discard further received data, T or :abort means abort the connection, and
;;;  :normal means close the connection but allow :receive operations to get further data
;;; Written 6-Oct-87 17:33:38 by pld at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.28, 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.IP-TCP.KERNEL; TCP.LISP#274 at 6-Oct-87 17:33:41
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP  "


(defop (tcp-socket :close) (&optional (mode :discard))
  ;;mode = nil or :discard -- throw away incoming data until FIN
  ;;mode = :normal -- allow further :receive's
  ;;mode = :abort or t -- abort connection
  (ecase mode
    ((:discard nil) (setq mode :discard))
    ((:abort t) (setq mode :abort))
    (:normal))
  (cond ((null (tcp-user-state self)))
	((eq (tcp-user-state self) :closed))
	((eq mode :abort)
	 (send self :abort))
	(t
	 ;;Normal graceful close
	 (with-lock ((tcp-user-lock self))
	   (tcp-log :close self)
	   (cond ((setf (tcp-user-discard-p self) (eq mode :discard))
		  ;;Max out the window.  Some (broken) implementations treat the window as a SIGNED number...
		  (setf (RCV.WND self) (floor 65535 2))
		  (let ((saved-data (saved-but-unacknowledged-data self)))
		    (when (plusp saved-data)
		      ;;We have data saved but not given to user.  Acknowledge it all.
		      (setf (RCV.NXT self) (32-bit-plus (RCV.NXT self) saved-data))))
		  (do ((elt (pop-fifo (tcp-user-saved-packets self))
			    (pop-fifo (tcp-user-saved-packets self))))
		      ((null elt))
		    (free-tcp-buffer (rcv-buffer elt)))
		  (let ((receives (fifo-as-list (tcp-user-receive-data self))))
		    (setf (tcp-user-receive-data self) nil)
		    (setf (tcp-user-receive-data-length self) 0)
		    (setf (tcp-user-receive-data-offset self) 0)
		    (push-fifo `(:close ,(mapcar #'rcv-buffer receives)) (tcp-user-packet-list self))))
		 (t
		  (push-fifo '(:close) (tcp-user-packet-list self))))
	   (ecase (tcp-user-state self)
	     (:CLOSED
	      ;;(error "connection does not exist")
	      nil)
	     ((:LISTEN :SYN-SENT)
	      (tcp-stat-incf self (if (eq (tcp-user-state self) :listen)
				      in-connection-aborts
				    out-connection-aborts))
	      (flush-tcp-socket self)
	      t)
	     (:SYN-RECEIVED
	      (setf (tcp-user-closed-p self) t)
	      (setf (tcp-user-fin-needed-p self) t)
	      (when (fifo-empty-p (tcp-user-send-data self))
		(change-state self :FIN-WAIT-1)
		(send-tcp-packets self))
	      t)
	     (:ESTABLISHED
	      (setf (tcp-user-closed-p self) t)
	      (setf (tcp-user-fin-needed-p self) t)
	      (change-state self :FIN-WAIT-1)
	      (send-tcp-packets self)
	      t)
	     (:CLOSE-WAIT
	      (setf (tcp-user-closed-p self) t)
	      (setf (tcp-user-fin-needed-p self) t)
	      (change-state self :CLOSING)
	      (send-tcp-packets self)
	      t)
	     ((:FIN-WAIT-1 :FIN-WAIT-2 :CLOSING :LAST-ACK :TIME-WAIT)
	      ;;(error "connection closing")
	      nil))))))

))