(FILECREATED "21-Jun-85 19:31:00" {ERIS}<LISPCORE>LIBRARY>TCPLLICMP.;8 12577
previous date: " 7-Jun-85 13:55:54" {ERIS}<LISPCORE>LIBRARY>TCPLLICMP.;7)
(* Copyright (c) 1985 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 (QUOTE 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.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 (QUOTE 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: " 3-Jun-85 07:15")
(* * 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.ECHO.TEST
(LAMBDA (IPADDRESS ECHOSTREAM) (* ejs: " 3-Jan-85 17:09")
(* * An ICMP echo tester)
(RESETVAR \ICMP.ECHOING T (PROG (ICMP (IPSOCKET (\IP.FIND.PROTOCOL \ICMP.PROTOCOL)))
(for SEQUENCE from 0 do ((SETQ ICMP (\ALLOCATE.ETHERPACKET))
(\IP.SETUPIP ICMP 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)
(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 (QUOTE 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: " 3-Jun-85 03:08")
(* * Called when a gateway tells us a better route to the destination)
(LET* ((ICMPCODE (fetch (ICMP ICMPCODE) of ICMP))
(IP (fetch (ICMPREDIRECT ICMPIPHEADER) of ICMP))
(NDB (fetch EPNETWORK of ICMP))
(DESTNET (fetch (IP IPDESTINATIONNET) of IP))
(GATEWAY (fetch (ICMPREDIRECT ICMPGATEWAY) of ICMP)))
(COND
((EQ ICMPCODE \ICMP.REDIRECT.NET)
(* * Store the new route in the routing table)
(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 (QUOTE ICMPGET)
IPTRACEFILE "[dropping packet--bad ICMP checksum]"))))))
(\ICMP.REPLY.TO.ECHO
(LAMBDA (ICMP) (* ejs: "27-Dec-84 19:44")
(* * 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 (QUOTE 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-Jun-85 07:15")
(* * 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)
(\RELEASE.ETHERPACKET PACKET))))
(\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))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5357 12451 (PRINTICMP 5367 . 5590) (\ICMP.DEST.UNREACHABLE 5592 . 6514) (
\ICMP.ECHO.TEST 6516 . 7964) (\ICMP.HANDLE.ECHO.REPLY 7966 . 8259) (\ICMP.HANDLE.REDIRECT 8261 . 9293)
(\ICMP.INPUT 9295 . 10413) (\ICMP.REPLY.TO.ECHO 10415 . 10862) (\ICMP.SETUPICMP 10864 . 11168) (
\ICMP.TIME.EXCEEDED 11170 . 12086) (\ICMP.TRANSMIT 12088 . 12449)))))
STOP