(FILECREATED " 9-Feb-85 16:13:09" {ERIS}<LISPCORE>LIBRARY>LLICMP.;1
 8725   

      changes to:  (VARS LLICMPCOMS)

      previous date: "27-Jan-85 17:15:10" {ERIS}<SCHOEN>LLICMP.;6)


(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT LLICMPCOMS)

(RPAQQ LLICMPCOMS
 ((COMS (* * ICMP functions)
			 (DECLARE: DONTCOPY (EXPORT (RECORDS ICMP ICMPECHO ICMPDESTUN)
						    (CONSTANTS * ICMPTYPES)
						    (CONSTANTS * ICMPUNREACHABLES)
						    (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.INPUT \ICMP.REPLY.TO.ECHO \ICMP.SETUPICMP 
			      \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)
				    (ICMPIPHEADER WORD))))
]

(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))
)
(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: "27-Jan-85 15:48")


          (* * 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
 4 (
LLSH
 (fetch
 (IP IPHEADERLENGTH) of
 PACKET)
				      2)))
          (
\BLT
 (LOCF (fetch
 (ICMPDESTUN ICMPIPHEADER) of
 ICMP))
		(fetch
 (IP IPBASE) of
 PACKET)
		NWORDS)
          (add
 (fetch
 (IP IPTOTALLENGTH) of
 ICMP)
	       (
LLSH
 NWORDS 1))
          (\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.INPUT

  (LAMBDA (ICMP)                                             (* ejs: "31-Dec-84 13:58")


          (* * 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))
		 (\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.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 LLICMP COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (4024 8597 (PRINTICMP 4034 . 4256) (\ICMP.DEST.UNREACHABLE 4258 . 5138) (\ICMP.ECHO.TEST
 5140 . 6604) (\ICMP.HANDLE.ECHO.REPLY 6606 . 6896) (\ICMP.INPUT 6898 . 7487) (\ICMP.REPLY.TO.ECHO 
7489 . 7935) (\ICMP.SETUPICMP 7937 . 8240) (\ICMP.TRANSMIT 8242 . 8595)))))
STOP