;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.102
;;; Reason:
;;;  ip:parse-internet-address no longer gives an error if you give it something
;;;  that is neither a recognizable host nor parseable as an integer.
;;;  ip:add-gateway and ip:remove-gateway now call ip:parse-internet-address on
;;;  their NETWORK and GATEWAY arguments, and allow you to default the
;;;  INTERFACE argument.
;;; Written 6-Nov-87 11:52:49 by pld at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.100, 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 8.



; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; IP.LISP#272 at 6-Nov-87 11:52:50
#10R INTERNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "INTERNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; IP  "

(defun parse-internet-address (address &aux name)
  (labels ((glom-address (string)
	     (let* ((first (string-search-char #\. string))
		    (second (and first (string-search-char #\. string (1+ first))))
		    (third (and second (string-search-char #\. string (1+ second)))))
	       (if first			;If at least one dot, must be three of them...
		   (when (and second third)
		     (let ((one (parse-integer string :start 0 :end first :junk-allowed t))
			   (two (parse-integer string :start (1+ first) :end second :junk-allowed t))
			   (three (parse-integer string :start (1+ second) :end third :junk-allowed t))
			   (four (parse-integer string :start (1+ third) :junk-allowed t)))
		       (when (and one (not (minusp one)) (< one 256)
				  two (not (minusp two)) (< two 256)
				  three (not (minusp three)) (< three 256)
				  four (not (minusp four)) (< four 256))
			 (dpb one (byte 8 24)
			      (dpb two (byte 8 16)
				   (dpb three (byte 8 8)
					four))))))
		 (parse-integer string :junk-allowed t)))))	;If no dots, address given as an integer
    (cond ((null address) nil)
	  ((numberp address) address)
	  ((or (and (symbolp address)
		    (setq name (symbol-name address)))
	       (and (stringp address)
		    (setq name address)))
	   (let ((host (si:parse-host name t nil)))
	     (if host
		 (send host :network-address :internet)
	       (glom-address name))))
	  ((typep address 'si:host)
	   (send address :network-address :internet))
	  (t nil))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; IP.LISP#272 at 6-Nov-87 11:53:27
#10R INTERNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "INTERNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; IP  "

(defun add-gateway (network gateway &optional interface tos expires &aux parsed-network	parsed-gateway)
  (and (null interface)
       (null (setq interface *default-interface*))
       (error "No interface specified in ADD-GATEWAY and no default interface is known."))
  (assert (setq parsed-network (parse-internet-address network))
	  (network)
	  "Bad internet address specified for NETWORK:~A"
	  network)
  (assert (setq parsed-gateway (parse-internet-address gateway))
	  (gateway)
	  "Bad internet address specified for GATEWAY: ~A"
	  gateway)
  (without-interrupts
    (remove-gateway parsed-network tos)
    (when (zerop parsed-network)
      (setq *default-gateway* parsed-gateway)
      (setq *default-interface* interface))
    (push (make-route-entry :network parsed-network
			    :gateway parsed-gateway
			    :interface interface
			    :tos tos
			    :age (and expires (time-increment (zl:time) expires)))
	  *route-table*)
    (when expires
      (reset-ip-background-wakeup-time))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; IP.LISP#272 at 6-Nov-87 11:53:37
#10R INTERNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "INTERNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; IP  "

(defun remove-gateway (network &optional tos &aux parsed-network)
  (assert (setq parsed-network (parse-internet-address network))
	  (network)
	  "Bad internet address specified for NETWORK: ~A"
	  network)
  (without-interrupts
    (when (and (zerop parsed-network) (null tos))
      (setq *default-gateway* nil)
      (setq *default-interface* nil))
    (do* ((list *route-table* (cdr list))
	  (item (car list) (car list)))
	 ((null list))
      (when (and (= parsed-network (re-network item))
		 (eql tos (re-tos item)))
	(setq *route-table* (delete item *route-table*))
	(when (re-age item)
	  (reset-ip-background-wakeup-time))
	(return)))))

))
