;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.27
;;; Reason:
;;;  When you close IP or TCP, the Generic Server's listens get returned.  When it tries to
;;;  issue new ones, it gets errors.  It doesn't REALLY need to have a cerror, and it shouldn't
;;;  try to close a socket that is already closed -- but TCP shouldn't get an error trying to
;;;  close a never opened socket, either.  Fixes to both TCP and the Generic Server.
;;; Written 5-Oct-87 16:30:32 by pld at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.25, 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#273 at 5-Oct-87 16:30:33
#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))
  (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))))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; GENERIC-SERVER.LISP#22 at 5-Oct-87 16:33:51
#10R TCP-APPLICATION#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP-APPLICATION")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; GENERIC-SERVER  "

(defun listen-on-network-service-port (service)
  (with-network-service-lock (service)
    (unless (network-service-listening-server service)
      (let ((server (allocate-network-server service))
	    (socket (funcall (ecase (network-service-transport-protocol service)
			       (:tcp 'tcp:make-tcp-socket)
			       (:udp 'udp:make-udp-socket))
			     :keyword
			     (string-append (string (network-service-name service))
					    " Server"))))
	(setf (network-server-socket server) socket)
	(setf (network-server-process-name server) "listening")
	(cond ((send socket :open :local-port (network-service-listen-port service))
	       (setf (network-service-listening-server service) server)
	       (when (eq :udp (network-service-transport-protocol service))
		 (send socket :receive)))
	      (t
	       ;;(cerror "continue" "Can't open socket for service: ~A" service)
	       (setf (network-server-socket server) nil)	;socket not open
	       (deallocate-network-server server)))))))

))