;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*- ;;; Patch file for System version 123.105 ;;; Reason: ;;; TCP-STREAM and UDP-STREAM no longer call (ip:parse-internet-address), as TCP and UDP ;;; respectively already do that very nicely and use (assert) to let you correct unknown ;;; addresses. TCP and UDP :open and :bind methods now include in their error messages ;;; the bad port or address. ;;; Written 9-Nov-87 13:45:38 by pld at site LMI Cambridge ;;; while running on Djinn from band 2 ;;; with Experimental System 123.104, 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 ROM 8. ; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#282 at 9-Nov-87 13:45:56 #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 ~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))) )) ; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP-STREAM.LISP#46 at 9-Nov-87 13:46:11 #10R TCP#: (COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP-STREAM  " (defmethod (tcp-stream-mixin :open) (&optional keyword &rest args) (setq args (copy-list args)) (let* ((host-list (member :remote-address args :test #'eq)) (host (second host-list)) (user-timeout (member :send-timeout args :test #'eq)) (current-timeout (* 30 60)) (open-socket (null args))) (setq args (append args `(:auto-push ,auto-push))) (if user-timeout (setq current-timeout (second user-timeout)) (setq args (append args `(:send-timeout ,current-timeout)))) (when (null socket) (setq socket (make-tcp-socket :keyword keyword))) (setq closing nil) (cond (open-socket ;Is socket already open? (setq open t) (send self :build-buffers) self) (t ;If user specified open keywords, open socket (loop (setq open (apply socket :open args)) (if (tcp:tcp-user-active socket) (ecase (send self :handle-replies) (:open ;All is well! (return self)) (:unreachable (cerror "Try again." "Remote Host ~S is unreachable" host)) (:reset (cerror "Try again." "Connection refused by ~S" host)) (:timeout (setq open nil) (send socket :abort) (incf current-timeout current-timeout) (cerror (format nil "Try again with timeout of ~D ticks." current-timeout) "Connection timed out") (let ((user-timeout (member :send-timeout args :test #'eq))) (setf (second user-timeout) current-timeout)))) (return self))))))) )) ; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; UDP.LISP#110 at 9-Nov-87 13:46:21 #10R UDP#: (COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "UDP"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; UDP  " (defop (udp-socket :open) (&key local-port remote-port remote-address (initial-gauges nil ig-p) &aux parsed-remote-address) (unless (udp-user-enabled self) (when (udp-enabled *udp-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 no remote-address (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 have a remote-port and remote-address invalid, error nil))) (remote-port 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) 2) (parsed-remote-address 0) (t 1)) (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)) (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))) (setf (udp-user-local-port self) local-port) (setf (udp-user-remote-port self) remote-port) (setf (udp-user-remote-address self) parsed-remote-address) (setf (udp-user-packet-list self) (make-fifo)) (array-initialize (udp-user-statistics-block self) 0) (setf (udp-user-gauge-name self) (format nil "UDP ~D" (udp-user-local-port self))) (dolist (g (udp-user-inactive-gauges self)) (send (cdr g) :set-margin-name (udp-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 (udp-user-statistics-block self) (locf (udp-user-active-gauges self)) (locf (udp-user-inactive-gauges self)) (udp-user-gauge-name self) initial-gauges) (add-network-statistics-block (udp-user-statistics-block self))) (do ((blip (pop-fifo (udp-user-packet-list self)) (pop-fifo (udp-user-packet-list self)))) ((null blip)) (unless (eq (first blip) :close) (free-ip-header (second blip))) (if (eq (first blip) :data) (free-udp-buffer (original-array (third blip))))) (push (cons local-port self) (udp-user-socket-alist *udp-stream*)) local-port))) )) ; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; UDP.LISP#110 at 9-Nov-87 13:46:23 #10R UDP#: (COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "UDP"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; UDP  " (defop (udp-socket :bind) (&optional remote-port remote-address &aux parsed-remote-address) (when (and (udp-enabled *udp-stream*) (udp-user-enabled self)) (assert (or (setq parsed-remote-address nil) ;This branch always fails, but reinitializes local (cond ((null remote-port) ;;If no remote-port, must be no remote-address (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 have a remote-port and remote-address invalid, error nil))) (remote-port 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) 2) (parsed-remote-address 0) (t 1)) (if parsed-remote-address remote-port remote-address)) (when (and (null remote-port) (null remote-address)) (unless (fifo-empty-p (udp-user-packet-list self)) (let ((blip (first (fifo-as-list (udp-user-packet-list self))))) ;;Look at packet at head of packet-list to find remote address and remote port (when (eq (first blip) :data) (setq remote-port (fourth blip)) (setq remote-address (ip:ih-source-address (second blip))))))) (setf (udp-user-remote-port self) remote-port) (setf (udp-user-remote-address self) remote-address) t)) )) ; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; UDP-STREAM.LISP#18 at 9-Nov-87 13:46:40 #10R UDP#: (COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "UDP"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; UDP-STREAM  " (defmethod (udp-stream :open) (&optional keyword &rest args) (setq args (copy-list args)) (let ((open-socket (null args)) host) (setq ip-header (make-ip-header)) (when (null socket) (setq socket (make-udp-socket :keyword keyword))) (setq open (or open-socket (apply socket :open args))) (when (setq host (send socket :remote-address)) (set-destination-address ip-header host)) (dotimes (i receives-out) (send socket :receive))) self) ))