;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.1
;;; Reason:
;;;  IP assumes it is the gateway for another processor on its backplane if it
;;;    receives a packet to forward from that processor.  If the packet has
;;;    source routing options in it, IP shouldn't make that assumption.
;;;  Also, when IP sends an ICMP Redirect over the Share interface, it should
;;;    send redirect-host, not redirect-network.
;;; Written 27-Aug-87 11:59:22 by pld (Peter L. DeWolf) at site LMI Cambridge
;;; while running on Azathoth from band 2
;;; with Experimental System 123.0, 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 102.



; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; IP.LISP#266 at 27-Aug-87 11:59:24
#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*))
	 (free-packet int-pkt))))

))