;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.224
;;; Reason:
;;;  When UDP broadcasts IP packets, it needs to be able to recompute the checksum for
;;;  each network after IP has chosen the broadcast address for it.
;;; Written 7-Apr-88 14:53:11 by pld at site LMI
;;; while running on Opus from band 2
;;; with Experimental System 123.221, Experimental Local-File 73.4, Experimental FILE-Server 22.2, Experimental Unix-Interface 11.0, Experimental KERMIT 34.3, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, Experimental Tiger 27.0, Experimental Site Data Editor 9.0, Experimental Tape 22.0, microcode 1755, SDU Boot Tape 3.14, SDU ROM 8, Beta II/site/patch.



; From modified file OPUS: L.NETWORK.IP-TCP.KERNEL; IP.LISP#288 at 7-Apr-88 14:53:11
#10R INTERNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "INTERNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; IP  "

(defun broadcast-ip-packet-on-interface (header buffers interface identifier length &optional function &aux (frags 0))
  (cond ((net:ni-broadcast-address interface)
	 (let ((remote-network (cadr (assoc :internet (net:ni-address-alist interface)))))
	   (when remote-network
	     (set-destination-address header (ip-broadcast-address-from-address remote-network))
	     (when function
	       (funcall function header buffers))
	     (send-ip-packet-on-interface header
					  buffers
					  interface
					  nil
					  identifier
					  length
					  (net:ni-broadcast-address interface)))))
	(t
	 (dolist (at (net:ni-address-translations interface))
	   (when (eq (net:at-protocol at) :internet)
	     (set-destination-address header (ip-broadcast-address-from-address (net:at-protocol-address at)))
	     (when function
	       (funcall function header buffers))
	     (incf frags (send-ip-packet-on-interface header
						      buffers
						      interface
						      nil
						      identifier
						      length
						      (net:at-hardware-address at)))))
	 frags)))

))

; From modified file OPUS: L.NETWORK.IP-TCP.KERNEL; IP.LISP#288 at 7-Apr-88 14:53:23
#10R INTERNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "INTERNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; IP  "

(defun broadcast-ip-packet (stream buffers header &optional remote-network function
			    &aux identifier gateway interface (length 0) (sent 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)))
  (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)
  (when (check-user-header header)
    (if remote-network
	(when (multiple-value-setq (gateway interface)
		(route (ip-broadcast-address-from-address remote-network)))
	  (setq sent (or (broadcast-ip-packet-on-interface header buffers interface identifier length function) 0)))
      (dolist (interface net:*network-interfaces*)
	(incf sent (or (broadcast-ip-packet-on-interface header buffers interface identifier length function) 0)))))
  (values sent identifier))

))

; From modified file OPUS: L.NETWORK.IP-TCP.KERNEL; UDP.LISP#112 at 7-Apr-88 14:53:28
#10R UDP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "UDP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; UDP  "

(defop (udp-socket :broadcast-packet) (buffers ip-header remote-port &optional remote-network (checksum t))
  (when (udp-user-remote-address self)
    (error "Can't broadcast from a fully specified socket"))
  (unless (consp buffers)
    (setq buffers (ncons buffers)))
  (dolist (b buffers)
    (check-type b (satisfies byte-array-or-string-p)))
  (check-type ip-header (satisfies ip-header-p))
  (check-type remote-port (unsigned-byte 16))
  (when remote-network
    (check-type remote-network (unsigned-byte 32)))
  (setf (ip:ih-protocol ip-header) udp-protocol)
  (let ((udp-header (get-udp-header)))
    (unwind-protect
	(let ((result nil)
	      (buffer-length (apply '+ (mapcar 'length buffers))))
	  (push udp-header buffers)
	  (setf (udp-source-port udp-header) (udp-user-local-port self))
	  (setf (udp-destination-port udp-header) remote-port)
	  (setf (udp-length udp-header) (+ 8 buffer-length))
	  (setq result
		(multiple-value-list
		  (send *udp-stream* :broadcast buffers ip-header remote-network
				     #'(lambda (header buffers)
					 (if checksum
					     (store-udp-checksum buffers header (local-host-p (ip:ih-dest-address header)))
					   (setf (udp-checksum udp-header) 0))))))
	  (cond ((or (null (car result)) (zerop (car result)))
		 (incf (udp-user-packets-sent-discarded self))
		 (incf (udp-user-bytes-sent-discarded self) buffer-length))
		(t
		 (incf (udp-user-packets-sent self))
		 (incf (udp-user-bytes-sent self) buffer-length)))
	  (values-list result))
      (free-udp-header udp-header))))

))