(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")

(FILECREATED " 8-Jan-87 16:44:25" {ERIS}<LISPCORE>TCP>TCPLLICMP.;2
 NIL  

      previous date%: "12-May-86 18:23:14" {ERIS}<LISPCORE>TCP>TCPLLICMP.;1)


(* "
Copyright (c) 1985, 1986, 1987 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT TCPLLICMPCOMS)

(RPAQQ TCPLLICMPCOMS
 [(COMS (* * ICMP functions)
                            (DECLARE%: DONTCOPY (EXPORT (RECORDS ICMP ICMPECHO ICMPDESTUN 
                                                               ICMPREDIRECT)
                                                       (CONSTANTS * ICMPTYPES)
                                                       (CONSTANTS * ICMPUNREACHABLES)
                                                       (CONSTANTS * ICMPREDIRECTS)
                                                       (CONSTANTS * ICMPTIMEXS)
                                                       (CONSTANTS \ICMPOVLEN)
                                                       (MACROS ICMPLENGTH)))
                            (INITVARS (\ICMP.ECHO.REPLY.QUEUE (NCREATE 'SYSQUEUE))
                                   (\ICMP.ECHO.REPLY.EVENT (CREATE.EVENT "ICMP Echo reply"))
                                   (\ICMP.ECHOING))
                            (GLOBALVARS \ICMP.ECHO.REPLY.QUEUE \ICMP.ECHO.REPLY.EVENT \ICMP.ECHOING)
                            (FNS PRINTICMP \ICMP.DEST.UNREACHABLE \ICMP.REDIRECT \ICMP.ECHO.TEST 
                                 \ICMP.HANDLE.ECHO.REPLY \ICMP.HANDLE.REDIRECT \ICMP.INPUT 
                                 \ICMP.REPLY.TO.ECHO \ICMP.SETUPICMP \ICMP.TIME.EXCEEDED 
                                 \ICMP.TRANSMIT)
                            (ADDVARS (IPPRINTMACROS (1 . PRINTICMP])
(* * ICMP functions)


(DECLARE%: DONTCOPY 
(* "FOLLOWING DEFINITIONS EXPORTED")

(DECLARE%: EVAL@COMPILE

(ACCESSFNS ICMP
 ((ICMPBASE (\IPDATABASE DATUM)))
                (BLOCKRECORD ICMPBASE ((ICMPTYPE BYTE)
                                       (ICMPCODE BYTE)
                                       (ICMPCHECKSUM WORD)
                                       (ICMPDATASTART WORD)))
                [ACCESSFNS ICMP ((ICMPCONTENTS (LOCF (fetch
 (ICMP ICMPDATASTART) of
 DATUM])

(ACCESSFNS ICMPECHO
 ((ICMPECHOBASE (fetch
 (ICMP ICMPCONTENTS) of
 DATUM)))
                    (BLOCKRECORD ICMPECHOBASE ((ICMPECHOID WORD)
                                               (ICMPECHOSEQNO WORD)
                                               (ICMPECHODATA BYTE))))

(ACCESSFNS ICMPDESTUN
 ((ICMPECHOBASE (fetch
 (ICMP ICMPCONTENTS) of
 DATUM)))
                      (BLOCKRECORD ICMPECHOBASE ((NIL FIXP)
                                                 (ICMPIPSTART WORD)))
                      [ACCESSFNS ICMPDESTUN ((ICMPIPHEADER (LOCF (fetch
 (ICMPDESTUN ICMPIPSTART)
                                                                    of
 DATUM])

(ACCESSFNS ICMPREDIRECT
 ((ICMPREDIRECTBASE (fetch
 (ICMP ICMPCONTENTS) of
 DATUM)))
                        (BLOCKRECORD ICMPREDIRECTBASE ((ICMPGATEWAY FIXP)
                                                       (ICMPIPSTART WORD)))
                        [ACCESSFNS ICMPREDIRECT ((ICMPIPHEADER (LOCF (fetch
 (ICMPREDIRECT ICMPIPSTART
                                                                                   ) of
 DATUM])
)

(RPAQQ ICMPTYPES
 ((\ICMP.ECHO.REPLY 0)
                  (\ICMP.DEST.UNREACHABLE 3)
                  (\ICMP.SOURCE.QUENCH 4)
                  (\ICMP.REDIRECT 5)
                  (\ICMP.ECHO 8)
                  (\ICMP.TIME.EXCEEDED 11)
                  (\ICMP.PARAMETER.PROBLEM 12)
                  (\ICMP.TIMESTAMP 13)
                  (\ICMP.TIMESTAMP.REPLY 14)
                  (\ICMP.INFO.REQUEST 15)
                  (\ICMP.INFO.REPLY 16)))
(DECLARE%: EVAL@COMPILE 

(RPAQQ \ICMP.ECHO.REPLY
 0)

(RPAQQ \ICMP.DEST.UNREACHABLE
 3)

(RPAQQ \ICMP.SOURCE.QUENCH
 4)

(RPAQQ \ICMP.REDIRECT
 5)

(RPAQQ \ICMP.ECHO
 8)

(RPAQQ \ICMP.TIME.EXCEEDED
 11)

(RPAQQ \ICMP.PARAMETER.PROBLEM
 12)

(RPAQQ \ICMP.TIMESTAMP
 13)

(RPAQQ \ICMP.TIMESTAMP.REPLY
 14)

(RPAQQ \ICMP.INFO.REQUEST
 15)

(RPAQQ \ICMP.INFO.REPLY
 16)

(CONSTANTS (\ICMP.ECHO.REPLY 0)
       (\ICMP.DEST.UNREACHABLE 3)
       (\ICMP.SOURCE.QUENCH 4)
       (\ICMP.REDIRECT 5)
       (\ICMP.ECHO 8)
       (\ICMP.TIME.EXCEEDED 11)
       (\ICMP.PARAMETER.PROBLEM 12)
       (\ICMP.TIMESTAMP 13)
       (\ICMP.TIMESTAMP.REPLY 14)
       (\ICMP.INFO.REQUEST 15)
       (\ICMP.INFO.REPLY 16))
)

(RPAQQ ICMPUNREACHABLES
 ((\ICMP.NET.UNREACHABLE 0)
                         (\ICMP.HOST.UNREACHABLE 1)
                         (\ICMP.PROTOCOL.UNREACHABLE 2)
                         (\ICMP.PORT.UNREACHABLE 3)
                         (\ICMP.CANT.FRAGMENT 4)
                         (\ICMP.SOURCE.ROUTE 5)))
(DECLARE%: EVAL@COMPILE 

(RPAQQ \ICMP.NET.UNREACHABLE
 0)

(RPAQQ \ICMP.HOST.UNREACHABLE
 1)

(RPAQQ \ICMP.PROTOCOL.UNREACHABLE
 2)

(RPAQQ \ICMP.PORT.UNREACHABLE
 3)

(RPAQQ \ICMP.CANT.FRAGMENT
 4)

(RPAQQ \ICMP.SOURCE.ROUTE
 5)

(CONSTANTS (\ICMP.NET.UNREACHABLE 0)
       (\ICMP.HOST.UNREACHABLE 1)
       (\ICMP.PROTOCOL.UNREACHABLE 2)
       (\ICMP.PORT.UNREACHABLE 3)
       (\ICMP.CANT.FRAGMENT 4)
       (\ICMP.SOURCE.ROUTE 5))
)

(RPAQQ ICMPREDIRECTS
 ((\ICMP.REDIRECT.NET 0)
                      (\ICMP.REDIRECT.HOST 1)
                      (\ICMP.REDIRECT.SVC.AND.NET 2)
                      (\ICMP.REDIRECT.SVC.AND.HOST 3)))
(DECLARE%: EVAL@COMPILE 

(RPAQQ \ICMP.REDIRECT.NET
 0)

(RPAQQ \ICMP.REDIRECT.HOST
 1)

(RPAQQ \ICMP.REDIRECT.SVC.AND.NET
 2)

(RPAQQ \ICMP.REDIRECT.SVC.AND.HOST
 3)

(CONSTANTS (\ICMP.REDIRECT.NET 0)
       (\ICMP.REDIRECT.HOST 1)
       (\ICMP.REDIRECT.SVC.AND.NET 2)
       (\ICMP.REDIRECT.SVC.AND.HOST 3))
)

(RPAQQ ICMPTIMEXS
 ((\ICMP.TRANSIT.TIME.EXCEEDED 0)
                   (\ICMP.FRAGMENT.TIME.EXCEEDED 1)))
(DECLARE%: EVAL@COMPILE 

(RPAQQ \ICMP.TRANSIT.TIME.EXCEEDED
 0)

(RPAQQ \ICMP.FRAGMENT.TIME.EXCEEDED
 1)

(CONSTANTS (\ICMP.TRANSIT.TIME.EXCEEDED 0)
       (\ICMP.FRAGMENT.TIME.EXCEEDED 1))
)
(DECLARE%: EVAL@COMPILE 

(RPAQQ \ICMPOVLEN
 4)

(CONSTANTS \ICMPOVLEN)
)
(DECLARE%: EVAL@COMPILE 
[PUTPROPS ICMPLENGTH MACRO (LAMBDA (ICMP)
                                  (IDIFFERENCE (fetch (IP IPTOTALLENGTH)
                                                      of ICMP)
                                         (LLSH (fetch (IP IPHEADERLENGTH)
                                                      of ICMP)
                                               2]
)

(* "END EXPORTED DEFINITIONS")

)

(RPAQ? \ICMP.ECHO.REPLY.QUEUE
 (NCREATE 'SYSQUEUE))

(RPAQ? \ICMP.ECHO.REPLY.EVENT
 (CREATE.EVENT "ICMP Echo reply"))

(RPAQ? \ICMP.ECHOING
 )
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \ICMP.ECHO.REPLY.QUEUE \ICMP.ECHO.REPLY.EVENT \ICMP.ECHOING)
)
(DEFINEQ

(PRINTICMP

  [LAMBDA (ICMP FILE)
                                        (* ejs%: "28-Dec-84 09:56")

    (PRINTCONSTANT (fetch
 (ICMP ICMPTYPE) of
 ICMP)
           ICMPTYPES FILE "ICMP: ")
    (TERPRI FILE])

(\ICMP.DEST.UNREACHABLE

  [LAMBDA (PACKET CODE)
                                      (* ejs%: " 2-Feb-86 11:35")

          
          (* * Returns an ICMP unreachable packet of proper code to sender)


    (PROG ((ICMP (\ALLOCATE.ETHERPACKET))
           NWORDS)
          (\IP.SETUPIP ICMP (fetch
 (IP IPSOURCEADDRESS) of
 PACKET)
                 0
                 (\IP.FIND.PROTOCOL \ICMP.PROTOCOL))
          (\ICMP.SETUPICMP
 ICMP \ICMP.DEST.UNREACHABLE CODE)
          (SETQ NWORDS (IPLUS (FOLDHI 64 BITSPERWORD)
                              (UNFOLD (fetch
 (IP IPHEADERLENGTH) of
 PACKET)
                                     WORDSPERCELL)))
          (\BLT (fetch
 (ICMPDESTUN ICMPIPHEADER) of
 ICMP)
                (fetch
 (IP IPBASE) of
 PACKET)
                NWORDS)
          (add
 (fetch
 (IP IPTOTALLENGTH) of
 ICMP)
               (UNFOLD NWORDS BYTESPERWORD))
          (\ICMP.TRANSMIT
 ICMP)
          (\RELEASE.ETHERPACKET PACKET])

(\ICMP.REDIRECT

  [LAMBDA (PACKET CODE)
                                      (* ejs%: " 2-Feb-86 12:13")

          
          (* * Returns an ICMP unreachable packet of proper code to sender)


    (PROG ((ICMP (\ALLOCATE.ETHERPACKET))
           NWORDS)
          (\IP.SETUPIP ICMP (fetch
 (IP IPSOURCEADDRESS) of
 PACKET)
                 0
                 (\IP.FIND.PROTOCOL \ICMP.PROTOCOL))
          (\ICMP.SETUPICMP
 ICMP \ICMP.REDIRECT CODE)
          (SETQ NWORDS (IPLUS (FOLDHI 64 BITSPERWORD)
                              (UNFOLD (fetch
 (IP IPHEADERLENGTH) of
 PACKET)
                                     WORDSPERCELL)
                              WORDSPERCELL))
          (replace
 (ICMPREDIRECT ICMPGATEWAY) of
 ICMP with
 (OR \IP.DEFAULT.GATEWAY 0))
          (\BLT (fetch
 (ICMPREDIRECT ICMPIPHEADER) of
 ICMP)
                (fetch
 (IP IPBASE) of
 PACKET)
                NWORDS)
          (add
 (fetch
 (IP IPTOTALLENGTH) of
 ICMP)
               (UNFOLD NWORDS BYTESPERWORD))
          (\ICMP.TRANSMIT
 ICMP)
          (\RELEASE.ETHERPACKET PACKET])

(\ICMP.ECHO.TEST

  [LAMBDA (IPADDRESS ECHOSTREAM DATALENGTH)
                  (* ejs%: "12-May-86 18:01")

          
          (* * An ICMP echo tester)


    (while
 (\QUEUEHEAD \ICMP.ECHO.REPLY.QUEUE) do
 (\RELEASE.ETHERPACKET (\DEQUEUE 
                                                                               \ICMP.ECHO.REPLY.QUEUE
                                                                               )))
    (RESETVAR \ICMP.ECHOING T (PROG (ICMP (IPSOCKET (\IP.FIND.PROTOCOL \ICMP.PROTOCOL)))
                                    (for
 SEQUENCE from
 0
                                       do
 ((SETQ ICMP (\ALLOCATE.ETHERPACKET))
                                           (\IP.SETUPIP ICMP (DODIP.HOSTP IPADDRESS)
                                                  0 IPSOCKET)
                                           (\ICMP.SETUPICMP
 ICMP \ICMP.ECHO 0)
                                           (replace
 (ICMPECHO ICMPECHOID) of
 ICMP with
 0)
                                           (replace
 (ICMPECHO ICMPECHOSEQNO) of
 ICMP with
 SEQUENCE)
                                           (add
 (fetch
 (IP IPTOTALLENGTH) of
 ICMP)
                                                4)
                                           (AND (NUMBERP DATALENGTH)
                                                (add
 (fetch
 (IP IPTOTALLENGTH) of
 ICMP)
                                                     DATALENGTH))
                                           (printout ECHOSTREAM "!")
                                           (\ICMP.TRANSMIT
 ICMP)
                                           (AWAIT.EVENT \ICMP.ECHO.REPLY.EVENT \ETHERTIMEOUT)
                                           (COND
                                              [(SETQ ICMP (\DEQUEUE \ICMP.ECHO.REPLY.QUEUE))
                                               (COND
                                                  ((IGREATERP (fetch
 (ICMPECHO ICMPECHOSEQNO)
                                                                 of
 ICMP)
                                                          SEQUENCE)
                                                   (printout T "ICMP echo out of sequence" T)
                                                   (PRINTPACKET ICMP 'GET ECHOSTREAM)
                                                   (RETURN ICMP))
                                                  (T (printout ECHOSTREAM "+")
                                                     (\RELEASE.ETHERPACKET ICMP]
                                              (T (printout ECHOSTREAM "."])

(\ICMP.HANDLE.ECHO.REPLY

  [LAMBDA (ICMP)
                                             (* ejs%: "28-Dec-84 09:02")

    (COND
       (\ICMP.ECHOING (\ENQUEUE \ICMP.ECHO.REPLY.QUEUE ICMP)
              (NOTIFY.EVENT \ICMP.ECHO.REPLY.EVENT))
       (T (\RELEASE.ETHERPACKET ICMP])

(\ICMP.HANDLE.REDIRECT

  [LAMBDA (ICMP)
                                             (* ejs%: " 2-Feb-86 12:34")

          
          (* * Called when a gateway tells us a better route to the destination)


    (LET* ((ICMPCODE (fetch
 (ICMP ICMPCODE) of
 ICMP))
           [IP (\ADDBASE (fetch
 (ICMPREDIRECT ICMPIPHEADER) of
 ICMP)
                      (IMINUS (INDEXF (fetch
 EPBODY of
 T]
           (NDB (fetch
 EPNETWORK of
 ICMP))
           (SOURCEADDRESS (fetch
 (NDB NDBIPHOST#) of
 NDB))
           (SUBNETMASK (CDR (SASSOC SOURCEADDRESS \IP.SUBNET.MASKS)))
           (DESTADDRESS (fetch
 (IP IPDESTINATIONADDRESS) of
 IP))
           (DESTNET (\IPNETADDRESS DESTADDRESS))
           (GATEWAY (fetch
 (ICMPREDIRECT ICMPGATEWAY) of
 ICMP)))
          (COND
             ((EQ ICMPCODE \ICMP.REDIRECT.NET)
          
          (* * Store the new route in the routing table)


              (COND
                 [(EQP DESTNET (fetch
 (NDB NDBIPNET#) of
 NDB))
          
          (* The dest net is a local net. Either we fouled up in our routing, or the dest 

          net is really a subnet)


                  (COND
                     ((NOT (EQP (LOGAND DESTADDRESS SUBNETMASK)
                                (LOGAND SOURCEADDRESS SUBNETMASK)))
          
          (* Yes, this is a redirect for a subnet, if such is possible)


                      (SPUTASSOC (LOGAND DESTADDRESS SUBNETMASK)
                             GATEWAY \IP.ROUTING.TABLE]
                 (T (SPUTASSOC DESTNET GATEWAY \IP.ROUTING.TABLE)))
          
          (* * If it's a 10MB network, see if we have the 10MB address of this gateway, 

          and if not, request the address)


              (SELECTQ (fetch
 (NDB NETTYPE) of
 NDB)
                  (10 (COND
                         ((NOT (\AR.TRANSLATE.TO.10MB GATEWAY T))
                          (\AR.TRANSLATE.TO.10MB GATEWAY))))
                  NIL)))
          (\RELEASE.ETHERPACKET ICMP])

(\ICMP.INPUT

  [LAMBDA (ICMP)
                                             (* ejs%: " 7-Jun-85 12:26")

          
          (* * ICMP packet received)


    (COND
       ((\IP.CHECKSUM.OK (\IPCHECKSUM ICMP (fetch
 (ICMP ICMPBASE) of
 ICMP)
                                (\IPDATALENGTH ICMP)))
        (SELECTC (fetch
 (ICMP ICMPTYPE) of
 ICMP)
            (\ICMP.ECHO.REPLY 
                 (\ICMP.HANDLE.ECHO.REPLY
 ICMP))
            (\ICMP.ECHO (\ICMP.REPLY.TO.ECHO
 ICMP))
            (\ICMP.DEST.UNREACHABLE 
                 [LET* [(SEGMENT (\ADDBASE ICMP (FOLDHI (IPLUS \ICMPOVLEN (UNFOLD (fetch
 (IP 
                                                                                       IPHEADERLENGTH
                                                                                             )
                                                                                     of
 ICMP)
                                                                                 BYTESPERCELL)
                                                               4)
                                                       BYTESPERWORD)))
                        (PROTOCOL (\IP.FIND.PROTOCOL (fetch
 (IP IPPROTOCOL) of
 SEGMENT]
                       (COND
                          (PROTOCOL (APPLY* (fetch
 (IPSOCKET IPSICMPFN) of
 PROTOCOL)
                                           ICMP SEGMENT])
            (\ICMP.REDIRECT 
                 (\ICMP.HANDLE.REDIRECT
 ICMP))
            (\RELEASE.ETHERPACKET ICMP)))
       (T (AND IPTRACEFLG (PRINTPACKET ICMP 'ICMPGET IPTRACEFILE 
                                 "[dropping packet--bad ICMP checksum]"])

(\ICMP.REPLY.TO.ECHO

  [LAMBDA (ICMP)
                                             (* ejs%: "12-May-86 17:34")

          
          (* * Reply to an echo request)


    (swap
 (fetch
 (IP IPSOURCEADDRESS) of
 ICMP)
          (fetch
 (IP IPDESTINATIONADDRESS) of
 ICMP))
    (replace
 (ICMP ICMPTYPE) of
 ICMP with
 \ICMP.ECHO.REPLY)
    (replace
 EPREQUEUE of
 ICMP with
 'FREE)
    (\ICMP.TRANSMIT
 ICMP])

(\ICMP.SETUPICMP

  [LAMBDA (ICMP TYPE CODE)
                                   (* ejs%: "27-Dec-84 19:00")

    (replace
 (ICMP ICMPTYPE) of
 ICMP with
 TYPE)
    (replace
 (ICMP ICMPCODE) of
 ICMP with
 CODE)
    (add
 (fetch
 (IP IPTOTALLENGTH) of
 ICMP)
         \ICMPOVLEN])

(\ICMP.TIME.EXCEEDED

  [LAMBDA (PACKET CODE)
                                      (* ejs%: " 3-Feb-86 11:00")

          
          (* * Returns an ICMP unreachable packet of proper code to sender)


    (PROG ((ICMP (\ALLOCATE.ETHERPACKET))
           NWORDS)
          (\IP.SETUPIP ICMP (fetch
 (IP IPSOURCEADDRESS) of
 PACKET)
                 0
                 (\IP.FIND.PROTOCOL \ICMP.PROTOCOL))
          (\ICMP.SETUPICMP
 ICMP \ICMP.TIME.EXCEEDED CODE)
          (SETQ NWORDS (IPLUS (FOLDHI 64 BITSPERWORD)
                              (UNFOLD (fetch
 (IP IPHEADERLENGTH) of
 PACKET)
                                     WORDSPERCELL)))
          (\BLT (fetch
 (ICMPDESTUN ICMPIPHEADER) of
 ICMP)
                (fetch
 (IP IPBASE) of
 PACKET)
                NWORDS)
          (add
 (fetch
 (IP IPTOTALLENGTH) of
 ICMP)
               (UNFOLD NWORDS BYTESPERWORD))
          (\ICMP.TRANSMIT
 ICMP])

(\ICMP.TRANSMIT

  [LAMBDA (ICMP)
                                             (* ejs%: "31-Dec-84 14:27")

          
          (* * Checksum and transmit an ICMP packet)


    (\IP.SET.CHECKSUM ICMP (fetch
 (ICMP ICMPBASE) of
 ICMP)
           (\IPDATALENGTH ICMP)
           (LOCF (fetch
 (ICMP ICMPCHECKSUM) of
 ICMP)))
    (\IP.TRANSMIT ICMP])
)

(ADDTOVAR IPPRINTMACROS
 (1 . PRINTICMP))
(PUTPROPS TCPLLICMP COPYRIGHT ("Xerox Corporation" 1985 1986 1987))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (6991 18202 (PRINTICMP 7001 . 7226) (\ICMP.DEST.UNREACHABLE 7228 . 8236) (\ICMP.REDIRECT
 8238 . 9374) (\ICMP.ECHO.TEST 9376 . 12037) (\ICMP.HANDLE.ECHO.REPLY 12039 . 12327) (
\ICMP.HANDLE.REDIRECT 12329 . 14373) (\ICMP.INPUT 14375 . 16086) (\ICMP.REPLY.TO.ECHO 16088 . 16545) (
\ICMP.SETUPICMP 16547 . 16862) (\ICMP.TIME.EXCEEDED 16864 . 17826) (\ICMP.TRANSMIT 17828 . 18200)))))
STOP