Re: Symbolics and SUN's

[Mabry Tyson <TYSON@SRI-STRIPE.ARPA>]

Here is the patch (for Rel 6).  The fault really is the suns.  They are in effect
sending a message to all the machines on a network to give them a particular
file.  Sounds pretty silly to me.  (Not to mention what having TFTP does to
their security...)  And they only do it if the machine that has that file
doesn't talk to them when they boot.  Oh yes... They do it repeatedly...

;;; -*- Syntax: Zetalisp; Package: TCP; Base: 10; Mode: LISP -*-


;;; These patches disallow broadcast requests for tftp connections.

(defmethod (ip-protocol :transmit-packet) (pkt length protocol
					       route source destination free-flag)
  (unless route (setq route (send self :route-to-address destination)))
  
   ;; Make sure the source address is valid.
  (setf source (ip-validate-transmit-source-address source))

  
  (let ((identification (incf pkts-out))
	(total-length (+ ip-header-size length))
	(ip (neti:get-sub-packet pkt 'art-8b (- ip-header-size)
				 neti:sub-packet-size 'ip-header)))
    (copy-array-portion ip 0 0 ip 0 ip-header-size)
    (alter-ip-header ip
		     version internet-header-version-number
		     ihl (// ip-header-size 4)
		     type-of-service 0
		     dont-fragment 0
		     more-fragments 0
		     fragment-offset-high 0
		     fragment-offset-low 0
		     time-to-live 64
		     protocol protocol)
    (setf (ip-header-length ip) total-length)
    (setf (ip-header-identification ip) identification)
    (set-ip-header-source ip source) (set-ip-header-destination ip destination)
    (ip-retransmit-packet ip ip-header-size total-length source destination
			  route nil free-flag)))


(defun-method ip-validate-transmit-source-address ip-protocol (source)
  (block have-source
    (dolist (interface interface-list)
      (when (compare-internet-address source (ip-interface-local-address interface))
	(return-from have-source source)))
    (let* ((back-route (send self :route-to-address source))
	   (route-gateway (ip-route-gateway-address back-route)))
      (when (and route-gateway
		 (compare-internet-address *ip-broadcast-address* route-gateway))
	(let ((interface (ip-route-interface back-route)))
	  (cond ((instancep interface)
		 (return-from have-source
		   (ip-interface-local-address interface)))
		((and (eq interface :broadcast)
		      (= (length interface-list) 1))
		 (return-from have-source
		   (ip-interface-local-address (first interface-list))))))))
    (ferror "Invalid source address.")))