;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.123
;;; Reason:
;;;  By analogy with IP, add some maintenance functions to Chaos:
;;;  (list-route-table), (add-gateway), (remove-gateway)
;;;  Parameterize chaos:default-routing-cost
;;; Written 23-Nov-87 17:00:21 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.122, Experimental Local-File 73.2, Experimental FILE-Server 22.1, 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 8.



; From modified file DJ: L.NETWORK.CHAOS; CHSNCP.LISP#403 at 23-Nov-87 17:00:30
#10R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSNCP  "

(defvar default-routing-cost 10. "The default routing cost")

))

; From modified file DJ: L.NETWORK.CHAOS; CHSNCP.LISP#403 at 23-Nov-87 17:00:35
#10R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSNCP  "


(defun list-route-table ()
  (format t "~&Subnet~16TGateway~32TCost~48TType")
  (dotimes (i routing-table-size)
    (unless (zerop (aref routing-table i))
      (format t "~&~A~16T~O~32T~S~48T~S"
		(if (zerop i) "DEFAULT" i)
		(aref routing-table i)
		(aref routing-table-cost i)
		(aref routing-table-type i))))
  )

))

; From modified file DJ: L.NETWORK.CHAOS; CHSNCP.LISP#403 at 23-Nov-87 17:09:38
#10R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSNCP  "


(defun add-gateway (subnet gateway &optional (cost default-routing-cost) (type :ethernet) &aux parsed-gateway)
  (check-type subnet (integer 0 (#.routing-table-size)))
  (assert (setq parsed-gateway (address-parse gateway))
	  (gateway)
	  "Bad Chaos address specified for GATEWAY:~A"
	  gateway)
  (setf (aref routing-table subnet) parsed-gateway)
  (setf (aref routing-table-cost subnet) cost)
  (setf (aref routing-table-type subnet) type)
  t)

))

; From modified file DJ: L.NETWORK.CHAOS; CHSNCP.LISP#403 at 23-Nov-87 17:09:39
#10R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSNCP  "


(defun remove-gateway (subnet)
  (check-type subnet (integer 0 (#.routing-table-size)))
  (setf (aref routing-table subnet) 0)
  (setf (aref routing-table-cost subnet) maximum-routing-cost)
  (setf (aref routing-table-type subnet) nil))

))

; From modified file DJ: L.NETWORK.CHAOS; CHSNCP.LISP#403 at 23-Nov-87 17:09:41
#10R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHSNCP  "


(DEFUN RESET-ROUTING-TABLE ()
  "Flush out old routing data."
  (SETQ MY-OTHER-SUBNETS NIL)
  (DOTIMES (I (ARRAY-LENGTH ROUTING-TABLE))	;Clear out the routing table
    (SETF (AREF ROUTING-TABLE I) 0)
    (SETF (AREF ROUTING-TABLE-COST I) MAXIMUM-ROUTING-COST)
    (SETF (AREF ROUTING-TABLE-TYPE I) NIL))
  (SETF (AREF ROUTING-TABLE MY-SUBNET) MY-ADDRESS)
  (SETF (AREF ROUTING-TABLE-COST MY-SUBNET) default-routing-cost)
  ;; RPK please check this
  ;; LMI-specific numeric host numbers garbage flushed from this function by RMS, 8/28/84
  ;; Regretfully reinstated by KHS, 9/17/84
  ;; at least modularized and made site independant due to a function by MWT, 2/05/85 10:09:21
  (cond ((null (get-site-option :lmi-bridge-kludge))
	 (SELECT-PROCESSOR
	   (:CADR
	     (SETF (AREF ROUTING-TABLE-TYPE MY-SUBNET) :CHAOS))
	   (:LAMBDA
	     (SETF (AREF ROUTING-TABLE-TYPE MY-SUBNET) :ETHERNET))
	   (:explorer
	     (setf (aref routing-table-type my-subnet) :ethernet))
	   ))
	(t
	 ;; any site which has bridges which do not send routing packets will need to run
	 ;; this code. One example is a site which has given different sets of machines
	 ;; on the same physical ether different subnet addresses. A "feature" is that
	 ;; these machines won't see each other unless :LMI-BRIDGE-KLUDGE is on.
	 ;; One use of this has been to isolate "EDUCATION" and "DEVELOPEMENT" use machines.
	 ;; Ah, sometimes turning a kludge into a feature is a hackers only reward.
	 (set-routing-table-from-host-table))))


))