;;; -*- 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))))) ))