;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.237
;;; Reason:
;;;  A Network Interface can now provide a :time-to-transmit operation which
;;;  returns the time in seconds to transmit a packet of specified size over
;;;  this network interface.  Primarily useful for serial lines...
;;;  (ip:mss) uses this and returns it as one of its values.
;;;  (tcp:set-interface-mss) uses this to choose a default user
;;;  timeout for the socket.
;;; Written 20-Apr-88 13:52:20 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 1
;;; with Experimental System 123.236, Experimental Local-File 73.4, Experimental FILE-Server 22.2, Experimental Unix-Interface 11.0, Experimental KERMIT 34.3, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, Experimental Tape 22.1, Experimental VERIFY 6.0, Experimental RPG-BENCHMARKS 6.0, Experimental Site Data Editor 9.0, microcode 1755, SDU Boot Tape 3.14, SDU ROM 8.



; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; IP.LISP#289 at 20-Apr-88 13:52:30
#10R INTERNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "INTERNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; IP  "

(defun mss (address)
  "Given an internet address, find the network interface packets will be sent on and return its MSS"
  (declare (values mss local-p transmission-time))
  (multiple-value-bind (ignore interface local-p)
      (route address)
    (if interface
	(let ((mss (net:ni-maximum-data-length interface)))
	  (values mss
		  local-p
		  (send interface :send-if-handles :time-to-transmit mss)))
      (values 0 nil 0))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#289 at 20-Apr-88 13:53:09
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP  "

(defvar *transmission-time-multiple* 30.
  "Default TCP user timeout = this number times seconds to transmit one max packet over the network-interface")
(defvar *minimum-user-timeout* 30. "Minimum number of seconds for a TCP socket user timeout.")

(defun set-interface-mss (socket remote-address header)
  (multiple-value-bind (mss local-p transmission-time)
      (mss remote-address)
    (setf (tcp-user-interface-mss socket) (- mss (length header) 20))
    (setf (tcp-user-local-host-p socket) local-p)
    (unless (integerp (tcp-user-send-timeout socket))
      ;;Unless the user has specified a user timeout in 60'ths of seconds, choose one based on time
      ;;to transmit a maximum packet over the interface.  (mss) returns this time in seconds;
      ;;minimum user timeout is 30 times that, minimum of *minimum-user-timeout* seconds.
      (setf (tcp-user-send-timeout socket)
	    (max *minimum-user-timeout*
		 (ceiling (* (or transmission-time 1.)
			     60.
			     *transmission-time-multiple*)))))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#289 at 20-Apr-88 13:53:16
#10R TCP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP  "

(defop (tcp-socket :open) (&key active local-port remote-port remote-address auto-push (optimistic t)
				open-timeout send-timeout ip-header-options
				(initial-gauges nil ig-p) gauge-name
				&aux header parsed-remote-address)
  (unless (tcp-user-enabled self)
    (when (tcp-enabled *tcp-stream*)
      (assert (or (setq parsed-remote-address nil)	;This branch always fails, but reinitializes local
		  (cond ((null remote-port)
			 ;;If no remote-port, must be inactive and have no remote-address
			 (and (not active) (null remote-address)))
			((setq parsed-remote-address (parse-internet-address remote-address))
			 ;;If have a remote-port, remote-address must be valid AND remote-port must be valid
			 (typep remote-port '(unsigned-byte 16)))
			(t
			 ;;If remote-port and remote-address invalid, error
			 nil)))
	      (remote-port remote-address)
	      "~[Active connection must specify both REMOTE-PORT and REMOTE-ADDRESS~;REMOTE-PORT ~D out of range~;REMOTE-ADDRESS ~S unknown~;REMOTE-PORT and REMOTE-ADDRESS must be both nil or both non-nil~]"
	      (cond ((null remote-port) (if active 0 3))
		    (parsed-remote-address 1)
		    (t 2))
	      (if parsed-remote-address remote-port remote-address))
      (if local-port
	  (assert (and (typep local-port '(unsigned-byte 16))
		       (unused-local-port local-port remote-port remote-address))
		  (local-port)
		  "LOCAL-PORT ~D is ~:[out of range~;already in use~]"
		  (typep local-port '(unsigned-byte 16))
		  local-port)
	(setq local-port (assign-local-port remote-port remote-address)))
      (setf (SND.UNA self) 0)
      (setf (SND.NXT self) 0)
      (setf (SND.WND self) 0)
      (setf (SND.UP self) nil)
      (setf (SND.WL1 self) 0)
      (setf (SND.WL2 self) 0)
      (setf (ISS self) 0)
      (setf (RCV.NXT self) 0)
      (setf (RCV.WND self) 0)
      (setf (RCV.UP self) nil)
      (setf (IRS self) 0)
      (setf (tcp-user-active self) active)
      (setf (tcp-user-fully-specified self) (not (null remote-port)))
      (setf (tcp-user-local-port self) local-port)
      (setf (tcp-user-remote-port self) remote-port)
      (setf (tcp-user-remote-address self) parsed-remote-address)
      (setf (tcp-user-packet-list self) (make-fifo))
      (setf (tcp-user-saved-packets self) (make-fifo))
      (let ((buffer (get-tcp-buffer)))
	(push-fifo (make-rcv-data :buffer buffer :holes (ncons (cons 0 (1- (array-length buffer)))))
		   (tcp-user-saved-packets self)))
      (setf (tcp-user-smoothed-round-trip-time self) nil)
      (setf (tcp-user-retransmission-timeout self) *rto-lbound*)
      (setf (tcp-user-send-data self) (make-fifo))
      (setf (tcp-user-send-data-length self) 0)
      (setf (tcp-user-send-data-offset self) 0)
      (setf (tcp-user-receive-data self) (make-fifo))
      (setf (tcp-user-receive-data-length self) 0)
      (setf (tcp-user-receive-data-offset self) 0)
      (setf (tcp-user-auto-push self) auto-push)
      (setf (tcp-user-push-sequence-number self) NIL)
      (setf (SND.LAST self) 0)
      (setf (RCV.LAST self) 0)
      (setf (tcp-user-gauge-name self) (or gauge-name (format nil "TCP ~D" (tcp-user-local-port self))))
      (array-initialize (tcp-user-statistics-block self) 0)
      (array-initialize (tcp-user-stats self) 0 1)
      (dolist (g (tcp-user-inactive-gauges self))
	(send (cdr g) :set-margin-name (tcp-user-gauge-name self)))
      (when ig-p
	;;If initial-gauges specified, NIL means no gauges, T means default, anything else specifies gauges
	;;The reason to add no gauges is to have the statistics block looked at by the clock function
	(if (eq initial-gauges t)
	    (setq initial-gauges '(:apr :aps :abr :abs)))
	(set-gauges (tcp-user-statistics-block self)
		    (locf (tcp-user-active-gauges self))
		    (locf (tcp-user-inactive-gauges self))
		    (tcp-user-gauge-name self)
		    initial-gauges)
	(add-network-statistics-block (tcp-user-statistics-block self)))
      (setf (tcp-user-remote-mss self) 536)	;The default MSS
      (setq header (apply 'make-ip-header (append ip-header-options
						  (if parsed-remote-address `(:destination ,parsed-remote-address))
						  '(:ttl 60)	;drop segments after 60 seconds
						  `(:protocol ,tcp-protocol))))
      (setf (tcp-user-ip-header self) header)
      (multiple-value-bind (precedence security compartment handling tcc)
	  (find-security-and-precedence header)
	(setf (tcp-user-precedence self) precedence)
	(setf (tcp-user-security-options self) (list security compartment handling tcc)))
      (setf (tcp-user-open-timeout self) open-timeout)
      (setf (tcp-user-send-timeout self) send-timeout)
      (setf (tcp-user-cumulative-timeout self) 0)
      (setf (tcp-user-last-time self) nil)
      (setf (tcp-user-timeout-alist self) nil)
      (setf (tcp-user-rtt-sequence-time-alist self) nil)
      (setf (tcp-user-closed-p self) nil)
      (setf (tcp-user-local-fin-sequence-number self) nil)
      (setf (tcp-user-remote-fin-sequence-number self) nil)
      (setf (tcp-user-lock self) nil)
      (setf (tcp-user-discard-p self) nil)
      (setf (tcp-user-optimistic-window-p self) optimistic)
      (setf (tcp-user-ack-needed-p self) nil)
      (setf (tcp-user-ack-delay self) *ack-delay*)
      (setf (tcp-user-fin-needed-p self) nil)
      (push (cons local-port self) (tcp-user-socket-alist *tcp-stream*))
      (tcp-log :open self)
      (cond (active
	     (tcp-stat-incf nil out-connection-requests)
	     (set-interface-mss self parsed-remote-address header)
	     (setf (RCV.WND self) (if optimistic	;Initial window includes one max packet
				      (tcp-user-interface-mss self)
				    0))
	     (change-state self :SYN-SENT)
	     (setf (ISS self) (choose-iss))
	     (setf (SND.UNA self) (ISS self))
	     (setf (SND.NXT self) (ISS self))
	     (setf (SND.LAST self) (ISS self))
	     (send-tcp-packets self))
	    (t
	     (tcp-stat-incf nil in-connection-requests)
	     (change-state self :LISTEN)
	     (when open-timeout
	       (start-timeout open-timeout 'listen-timeout self))))
      local-port)))

))