;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*- ;;; Patch file for System version 123.56 ;;; Reason: ;;; :open method of a tcp-socket should call set-interface-mss with the ;;; parsed-remote-address, not with the remote-address (which can be a ;;; string, for example) ;;; Written 16-Oct-87 14:52:50 by pld at site LMI Cambridge ;;; while running on Jack Flanders from band 2 ;;; with Experimental System 123.52, 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, Experimental Site Data Editor 6.1, microcode 1754, SDU Boot Tape 3.12, SDU ROM 8. ; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#278 at 16-Oct-87 14:52:51 #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 (* 30 60)) 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 out of range~;REMOTE-ADDRESS 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 local-port (assert (and (typep local-port '(unsigned-byte 16)) (unused-local-port local-port remote-port)) (local-port) "LOCAL-PORT is ~:[out of range~;already in use~]" (typep local-port '(unsigned-byte 16))) (setq local-port (assign-local-port))) (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))) ))