;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*- ;;; Patch file for System version 123.190 ;;; Reason: ;;; IP now clears out ip:*default-gateway* and ip:*default-interface* within ;;; (ip:initialize-route-table) rather than keeping obsolete previous values. ;;; IP differentiates between bad IP header, route failure, and address ;;; translation failure when sending an IP packet, and TCP notes this ;;; and passes a :host-unreachable to the user if routing failed. ;;; Written 22-Jan-88 11:04:58 by pld (Peter L. DeWolf) at site Gigamos Cambridge ;;; while running on Jack Flanders from band 2 ;;; with Experimental System 123.189, Experimental Local-File 73.3, Experimental FILE-Server 22.1, Experimental Unix-Interface 11.0, Experimental Tape 18.0, Experimental KERMIT 34.3, 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; IP.LISP#280 at 22-Jan-88 11:05:00 #10R INTERNET#: (COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "INTERNET"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; IP  " (defun initialize-route-table (default-internet-address) (when default-internet-address (setq *default-gateway* nil) (setq *default-interface* nil) (when (consp default-internet-address) ;;If given a list of addresses, assume the first is the default (setq default-internet-address (first default-internet-address))) (let ((r (global:get-site-option :default-internet-routing)) (default-interface nil)) (setq *route-table* nil) ;;Add entries for directly connected networks (setq *default-network-numbers* nil) (dolist (ni *network-interfaces*) (let ((my-address (second (assoc :internet (net:ni-address-alist ni) :test #'eq)))) (when my-address (when (= my-address default-internet-address) (setq default-interface ni)) (let* ((ip-on-ni (assoc :internet (net:ni-network-alist ni) :test #'eq)) (my-network (second ip-on-ni)) (mask (third ip-on-ni))) (when my-network (let ((network-number (logand mask my-network))) (push (cons network-number mask) *default-network-numbers*) (add-gateway network-number my-address ni))))))) ;;Add entries for gateways listed in site files (cond ((null r)) ((atom r) (let ((parsed-address (parse-internet-address r))) (if parsed-address (add-gateway 0 parsed-address default-interface) (format t "~&Bad Internet Address in :default-internet-routing site option: ~S" r)))) ((listp r) (dolist (elem r) (let ((parsed-network (parse-internet-address (first elem))) (parsed-gateway (parse-internet-address (second elem)))) (if (and parsed-network parsed-gateway) (add-gateway parsed-network parsed-gateway default-interface) (format t "~&Bad entry in :default-internet-routing site option: ~S" elem))))) (t nil))) (let ((op-address nil)) (cond ((null si:*ethernet-hardware-controller*)) ;No network interface? Too bad... ((eq si:*ethernet-hardware-controller* si:*my-op*)) ;We talk directly to ethernet? Good... ((setq op-address (net:find-network-address-for-other-processor si:*ethernet-hardware-controller* :internet)) (add-gateway 0 op-address si:share-interface)) (t (format t "~&The si:*ethernet-hardware-controller* has no Internet Address")))))) )) ; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; IP.LISP#280 at 22-Jan-88 11:05:00 #10R INTERNET#: (COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "INTERNET"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; IP  " (defun forward-packet (int-pkt interface source &aux destination gateway dest-interface) "Forward a packet. Returns NIL if succeeded, the packet if failed. It is the caller's responsibility to free the packet in the latter case" (cond ((not (plusp (decf (ih-ttl int-pkt)))) ;;Time-To-Live expired -- send ICMP message and drop packet (icmp:icmp :time-exceeded int-pkt icmp:icmp-ttl-exceeded) (free-packet int-pkt)) ((and (multiple-value-setq (gateway dest-interface) (route (ih-dest-address int-pkt))) (setq destination (send *ip-stream* :translate-address gateway dest-interface (ih-source-address int-pkt)))) (cond ((and (not (ip-gateway *ip-stream*)) ;We are not IP gateway (not (eq interface si:share-interface)) ; and not FROM share interface (not (eq dest-interface si:share-interface))) ; and not TO share interface ;;Destination is a processor not on this backplane and we are not being a gateway (incf (ip-not-for-me *ip-stream*)) (icmp:icmp :destination-unreachable int-pkt icmp:icmp-host-unreachable) (free-packet int-pkt)) (t ;;Successful routing and address translation -- send to the gateway (unless (ip-route-option-present int-pkt) (when (eq interface si:share-interface) ;;If packet is FROM share-interface, conclude that we are that processor's gateway ;;and set *processor-forwarding-alist* to indicate that. (let ((elt (assoc source net:*processor-forwarding-alist*))) (when elt (setf (cdr elt) t)))) (when (eq interface dest-interface) (icmp:icmp :redirect int-pkt (if (eq interface si:share-interface) icmp:icmp-redirect-host icmp:icmp-redirect-network) gateway))) (let ((count (ih-length int-pkt))) (if (> count (net:ni-maximum-data-length dest-interface)) (queue-packet-for-forwarding int-pkt dest-interface (ncons destination)) (progn (incf (ip-packets-forwarded *ip-stream*)) (store-header-checksum int-pkt t) (send *ip-stream* :send int-pkt count dest-interface destination))))))) (t ;;Either couldn't route to a gateway, or couldn't find gateway's link-level address (incf (ip-no-forwarding-address *ip-stream*)) (when (null gateway) ;We couldn't route this (icmp:icmp :destination-unreachable int-pkt icmp:icmp-host-unreachable)) (free-packet int-pkt)))) )) ; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; IP.LISP#280 at 22-Jan-88 11:20:20 #10R INTERNET#: (COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "INTERNET"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; IP  " (defun send-ip-packet (stream buffers header &optional int-pkt identifier &aux gateway interface address (length 0)) "Send IP packet(s) on behalf of a transport protocol given an IP header and a list of buffers" (declare (values fragments-sent identifier)) (check-type stream ip-transport-protocol) (when (null buffers) (error "No buffers")) (unless (listp buffers) (setq buffers (ncons buffers))) (check-type header (satisfies ip-header-p)) (dolist (b buffers) (check-type b (satisfies byte-array-or-string-p)) (incf length (length b))) (cond (identifier (check-type identifier (unsigned-byte 16))) (t (setq identifier (tp-next-identification stream)) (setf (tp-next-identification stream) (mod (1+ identifier) #xffff)))) ;;first, set the fields the user has no control over (setf (ih-version header) ip-version-number) (setf (ih-length header) (ih-ihl-bytes header)) (setf (ih-flags header) (logand (ih-flags header) df-flag)) (setf (ih-fragment-offset header) 0) (setf (ih-protocol header) (tp-type stream)) (setf (ih-checksum header) 0) (unwind-protect (cond ((not (check-user-header header)) (values nil :header)) ((not (multiple-value-setq (gateway interface) (route (ih-dest-address header)))) (values nil :route)) ((not (multiple-value-setq (address interface) (send *ip-stream* :translate-address gateway interface))) (values nil :arp)) (t (send-ip-packet-on-interface header buffers interface (prog1 int-pkt (setq int-pkt nil)) identifier length address))) (when int-pkt (free-packet int-pkt)))) )) ; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; TCP.LISP#286 at 22-Jan-88 11:28:58 #10R TCP#: (COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; TCP  " (defun send-tcp-packets (tp &optional first-only int-pkt) (declare (values number-of-packets-sent)) (unwind-protect (with-lock ((tcp-user-lock tp)) (unless (member (tcp-user-state tp) '(:closed :listen)) ;;socket may have aborted while waiting for lock (do ((count 0 (1+ count)) (source (ip::ih-source-address (tcp-user-ip-header tp))) (destination (tcp-user-remote-address tp))) ((or (not (ok-to-send tp)) (and first-only (plusp count))) (remove-from-fifo tp *send-blocked-sockets*) (when (tcp-user-ack-needed-p tp) (send-ack-for-connection tp)) count) (if (or int-pkt (setq int-pkt (net:allocate-packet nil))) ;;If we have an int-pkt to give to IP, build and send a TCP packet (multiple-value-bind (buffer-list byte-count) (build-tcp-packet tp) (unwind-protect (multiple-value-bind (result reason) (send *tcp-stream* :send buffer-list (tcp-user-ip-header tp) (prog1 int-pkt (setq int-pkt nil))) (cond ((null result) ;Returned NIL -- couldn't route. (case reason (:header ;Bad IP header (error "Bad IP header")) (:route ;IP routing failed (push-fifo '(:host-unreachable) (tcp-user-packet-list tp))) (:arp ;Routing succeeded, no address translation yet (start-retransmission-timeout tp (first buffer-list)))) (return nil)) ((plusp result) ;;the send succeeded (update-tcp-variables tp (first buffer-list) byte-count) (incf (tcp-user-packets-sent tp)) (incf (tcp-user-bytes-sent tp) byte-count) (tcp-log :send nil (copy-tcp-header (first buffer-list) (get-tcp-header)) byte-count source destination (when (and (plusp *tcp-log-level*) (second buffer-list)) (string (second buffer-list)))) ) (t ;;The send failed. Try again later... (start-failed-send-timeout tp) (return count)))) (free-tcp-header (first buffer-list)))) (progn ;;Else, note that this connection needs a packet sent (tcp-log :block tp) (tcp-stat-incf tp packet-allocation-delays) (priority-insert-fifo tp #'tcp-user-precedence *send-blocked-sockets*) (return count)))))) (when int-pkt ;;Shouldn't get here, but just in case -- free the unused int-pkt (net:free-packet int-pkt)))) ))