;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*- ;;; Patch file for System version 123.57 ;;; Reason: ;;; tcp:unused-local-port depends not only on remote port, but on remote-address. ;;; tcp:assign-local-port depends on remote port and remote address. ;;; (:method tcp-socket :open) calls the (modified) functions. ;;; Written 16-Oct-87 19:23:13 by pld at site LMI Cambridge ;;; while running on Jack Flanders from band 2 ;;; with Experimental System 123.56, 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#279 at 16-Oct-87 19:23:20 #10R TCP#: (COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP  " (defun unused-local-port (local-port remote-port remote-address) (do ((list (tcp-user-socket-alist *tcp-stream*))) ((null list) t) (setq list (member local-port list :key #'car :test #'=)) (and list (eql remote-port (tcp-user-remote-port (cdar list))) (eql remote-address (tcp-user-remote-address (cdar list))) (return nil)) (setq list (cdr list)))) )) ; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#279 at 16-Oct-87 19:25:43 #10R TCP#: (COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP  " (defun assign-local-port (remote-port remote-address) (without-interrupts (do ((port (tcp-next-local-port *tcp-stream*) (1+ port))) ((unused-local-port port remote-port remote-address) (setf (tcp-next-local-port *tcp-stream*) (1+ port)) (if (= (tcp-next-local-port *tcp-stream*) 65536) (setf (tcp-next-local-port *tcp-stream*) 256)) port)))) )) ; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#279 at 16-Oct-87 19:26:08 #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 remote-address)) (local-port) "LOCAL-PORT is ~:[out of range~;already in use~]" (typep local-port '(unsigned-byte 16))) (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))) ))