(FILECREATED " 3-Feb-86 11:02:31" {ERIS}<SCHOEN>TCP>TCPLLIP.;18 80207
changes to: (FNS \HANDLE.RAW.IP \IP.NEW.FRAGMENT.LST \IP.CHECK.REASSEMBLY.TIMEOUTS
\IP.DELETE.FRAGMENT)
previous date: " 2-Feb-86 12:36:31" {ERIS}<SCHOEN>TCP>TCPLLIP.;17)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TCPLLIPCOMS)
(RPAQQ TCPLLIPCOMS ((COMS (* IP definitions and addressing)
(DECLARE: DONTCOPY (EXPORT (RECORDS IP IPSOCKET IPADDRESS)
(CONSTANTS \IPOVLEN \MAX.IPDATALENGTH
\IP.PROTOCOLVERSION
\IP.MAX.EPKTS.ON.QUEUE
\IP.DEFAULT.TIME.TO.LIVE
\IP.WAKEUP.INTERVAL)
(CONSTANTS * IPPACKETTYPES)
(CONSTANTS * ICMPUNREACHABLES)
(MACROS \IPDATABASE \IPDATALENGTH)))
(INITVARS (IPONLYTYPES)
(IPIGNORETYPES)
(IPPRINTMACROS)
(IPTRACEFLG)
(IPTRACEFILE)
(\IP.INIT.FILE)
(\IP.DEFAULT.CONFIGURATION)
(\IP.HOSTNAMES (HASHARRAY 40 1.1))
(\IP.HOSTNUMBERS))
(INITRECORDS IP IPSOCKET IPADDRESS)
(GLOBALVARS IPTRACEFILE IPTRACEFLG IPIGNORETYPES IPONLYTYPES
IPPRINTMACROS \IP.HOSTNAMES \IP.INIT.FILE
\IP.DEFAULT.CONFIGURATION \IP.HOSTNUMBERS)
(FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
TCPHTE TCPLLICMP TCPLLAR)
(ADDVARS (\PACKET.PRINTERS (2048 . PRINTIP)))
(FNS DODIP.HOSTP IPHOSTADDRESS IPHOSTNAME IPTRACE IPTRACEWINDOW.BUTTONFN
PRINTIP PRINTIPDATA \IPADDRESSCLASS \IPHOSTADDRESS \IPNETADDRESS
\IP.ADDRESS.TO.STRING \IP.BROADCAST.ADDRESS \IP.LEGAL.ADDRESS
\IP.MAKE.BROADCAST.ADDRESS \IP.PRINT.ADDRESS \IP.READ.STRING.ADDRESS)
)
(COMS (* * Startup and shutdown)
(INITVARS (\IPFLG)
(\IP.READY)
(\IP.READY.EVENT (CREATE.EVENT "IP Ready"))
(\IP.WAKEUP.TIMER)
(IPTRACEFLG)
(\IP.WAKEUP.EVENT (CREATE.EVENT "IP Wakeup")))
(GLOBALVARS \IPFLG \IP.READY \IP.READY.EVENT \IP.WAKEUP.TIMER \IP.WAKEUP.EVENT)
(FNS STOPIP \IPINIT \IPLISTENER)
(ADDVARS (AROUNDEXITFNS \IPINIT)
(RESTARTETHERFNS \IPINIT)))
(COMS (* * Early IP reception functions)
(DECLARE: DONTCOPY (EXPORT (CONSTANTS * IPADDRESSTYPES)))
(INITVARS (\IP.LOCAL.ADDRESSES)
(\IP.SUBNET.MASKS)
(\IP.GATEWAY.FLG))
(GLOBALVARS \IP.LOCAL.ADDRESSES \IP.SUBNET.MASKS \IP.GATEWAY.FLG)
(MACROS \IP.FIX.DEST.HOST \IP.FIX.DEST.NET \IP.FIX.SOURCE.HOST \IP.FIX.SOURCE.NET
\IPDATABASE)
(FNS \HANDLE.RAW.IP \FORWARD.IP \IP.LOCAL.DESTINATION \IPCHECKSUM \IP.CHECKSUM.OK
\IP.SET.CHECKSUM))
(COMS (* * Protocol Distribution)
(DECLARE: DONTCOPY (EXPORT (CONSTANTS * IPPROTOCOLTYPES)))
(INITVARS (\IP.PROTOCOLS))
(GLOBALVARS \IP.PROTOCOLS)
(FNS \IP.HAND.TO.PROTOCOL \IP.DEFAULT.INPUTFN \IP.DEFAULT.NOSOCKETFN \IP.ADD.PROTOCOL
\IP.DELETE.PROTOCOL \IP.FIND.PROTOCOL \IP.FIND.PROTOCOL.SOCKET \IP.FIND.SOCKET
\IP.OPEN.SOCKET \IP.CLOSE.SOCKET))
(COMS (* * Fragmentation Handling)
(DECLARE: DONTCOPY (EXPORT (RECORDS AssemblyRecord FragmentRecord FragmentID)))
(INITVARS (\IP.FRAGMENT.LIST)
(\IP.FRAGMENT.LOCK (CREATE.MONITORLOCK "IP Fragment Processing Lock")))
(GLOBALVARS \IP.FRAGMENT.LIST \IP.FRAGMENT.LOCK)
(CONSTANTS (\IP.FRAGMENTATION.UNIT 8))
(FNS \HANDLE.RAW.IP.FRAGMENT \IP.NEW.FRAGMENT.LST
\IP.COPY.FRAGMENT.HEADER.TO.PACKET.HEADER \IP.ADD.FRAGMENT
\IP.FIND.MATCHING.FRAGMENTS \IP.FRAGMENTED.PACKET \IP.CHECK.REASSEMBLY.TIMEOUTS
\IP.DELETE.FRAGMENT \IP.PRINT.FRAGMENT))
(COMS (* * Option Processing)
(DECLARE: DONTCOPY (EXPORT (CONSTANTS * IPOPTIONTYPES)
(CONSTANTS (IP.OPTION.NUMBER.BYTESPEC (BYTE 5 0)))))
(FNS \IP.PROCESS.OPTIONS))
(COMS (* * Packet Transmission and routing)
(INITVARS (\IP.ROUTING.TABLE (CONS))
(\IP.DEFAULT.GATEWAY)
(\IP.LOCAL.NETWORKS)
(\IP.GATEWAY.FORWARDING.FUNCTIONS))
(GLOBALVARS \IP.ROUTING.TABLE \IP.DEFAULT.GATEWAY \IP.LOCAL.NETWORKS
\IP.GATEWAY.FORWARDING.FUNCTIONS)
(FNS \IP.SETUPIP \IP.TRANSMIT \IP.ROUTE.PACKET))
(COMS (* * Client functions for building packets)
(FNS \IP.APPEND.BYTE \IP.APPEND.CELL \IP.APPEND.STRING \IP.APPEND.WORD))
(ADVISE \CANONICAL.HOSTNAME)))
(* IP definitions and addressing)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
[DECLARE: EVAL@COMPILE
(ACCESSFNS IP ((IPBASE (LOCF (fetch (ETHERPACKET EPBODY) of DATUM))))
(BLOCKRECORD IPBASE ((IPVERSION BITS 4) (* Protocol version)
(IPHEADERLENGTH BITS 4) (* Head length, in cells)
(IPSERVICE BYTE) (* Service type)
(IPTOTALLENGTH WORD) (* Packet length, in bytes)
(IPID WORD) (* Packet id)
(NIL BITS 1)
(IPDONTFRAGMENT FLAG) (* Don't fragment me)
(IPMOREFRAGMENTS FLAG) (* Last fragment)
(IPFRAGMENTOFFSET BITS 13) (* Fragment position)
(IPTIMETOLIVE BYTE) (* Hop limiter)
(IPPROTOCOL BYTE) (* Client protocol)
(IPHEADERCHECKSUM WORD) (* Header-only checksum)
(IPSOURCEADDRESS FIXP)
(IPDESTINATIONADDRESS FIXP)
(IPOPTIONSSTART BYTE) (* Options or data start here)
)
(ACCESSFNS IPSERVICE ((IPSERVICEBASE (LOCF (fetch (IP IPSERVICE)
of DATUM))))
(BLOCKRECORD IPSERVICEBASE ((IPPRECEDENCE BITS 3)
(IPDELAY FLAG)
(IPTHROUGHPUT FLAG)
(IPRELIABILITY FLAG)
(NIL BITS 2))))
(ACCESSFNS IPDESTINATIONADDRESS ((IPDESTBASE (LOCF DATUM)))
(ACCESSFNS IPDESTBASE
((IPDESTINATIONNET
(COND
((EQ \IP.CLASS.A (fetch
(IPADDRESS CLASSA)
of DATUM))
(fetch (IPADDRESS CLASSANET)
of DATUM))
((EQ \IP.CLASS.B (fetch
(IPADDRESS CLASSB)
of DATUM))
(fetch (IPADDRESS CLASSBNET)
of DATUM))
((EQ \IP.CLASS.C (fetch
(IPADDRESS CLASSC)
of DATUM))
(fetch (IPADDRESS CLASSCNET)
of DATUM))
(T (ERROR "Illegal address class"
DATUM)))
(COND
((EQ \IP.CLASS.A (fetch
(IPADDRESS CLASSA)
of DATUM))
(replace (IPADDRESS CLASSANET)
of DATUM with NEWVALUE))
((EQ \IP.CLASS.B (fetch
(IPADDRESS CLASSB)
of DATUM))
(replace (IPADDRESS CLASSBNET)
of DATUM with NEWVALUE))
((EQ \IP.CLASS.C (fetch
(IPADDRESS CLASSC)
of DATUM))
(replace (IPADDRESS CLASSCNET)
of DATUM with NEWVALUE))
(T (ERROR "Illegal address class"
DATUM))))
(IPDESTINATIONHOST
(COND
((EQ \IP.CLASS.A (fetch
(IPADDRESS CLASSA)
of DATUM))
(fetch (IPADDRESS CLASSAHOST)
of DATUM))
((EQ \IP.CLASS.B (fetch
(IPADDRESS CLASSB)
of DATUM))
(fetch (IPADDRESS CLASSBHOST)
of DATUM))
((EQ \IP.CLASS.C (fetch
(IPADDRESS CLASSC)
of DATUM))
(fetch (IPADDRESS CLASSCHOST)
of DATUM))
(T (ERROR "Illegal address class"
DATUM)))
(COND
((EQ \IP.CLASS.A (fetch
(IPADDRESS CLASSA)
of DATUM))
(replace (IPADDRESS CLASSAHOST)
of DATUM with NEWVALUE))
((EQ \IP.CLASS.B (fetch
(IPADDRESS CLASSB)
of DATUM))
(replace (IPADDRESS CLASSBHOST)
of DATUM with NEWVALUE))
((EQ \IP.CLASS.C (fetch
(IPADDRESS CLASSC)
of DATUM))
(replace (IPADDRESS CLASSCHOST)
of DATUM with NEWVALUE))
(T (ERROR "Illegal address class"
DATUM)))))))
(ACCESSFNS IPSOURCEADDRESS ((IPSOURCEBASE (LOCF DATUM)))
(ACCESSFNS IPSOURCEBASE
((IPSOURCENET (COND
((EQ \IP.CLASS.A
(fetch
(IPADDRESS CLASSA)
of DATUM))
(fetch (IPADDRESS
CLASSANET)
of DATUM))
((EQ \IP.CLASS.B
(fetch
(IPADDRESS CLASSB)
of DATUM))
(fetch (IPADDRESS
CLASSBNET)
of DATUM))
((EQ \IP.CLASS.C
(fetch
(IPADDRESS CLASSC)
of DATUM))
(fetch (IPADDRESS
CLASSCNET)
of DATUM))
(T (ERROR
"Illegal address class"
DATUM)))
(COND
((EQ \IP.CLASS.A
(fetch
(IPADDRESS CLASSA)
of DATUM))
(replace (IPADDRESS
CLASSANET)
of DATUM
with NEWVALUE))
((EQ \IP.CLASS.B
(fetch
(IPADDRESS CLASSB)
of DATUM))
(replace (IPADDRESS
CLASSBNET)
of DATUM
with NEWVALUE))
((EQ \IP.CLASS.C
(fetch
(IPADDRESS CLASSC)
of DATUM))
(replace (IPADDRESS
CLASSCNET)
of DATUM
with NEWVALUE))
(T (ERROR
"Illegal address class"
DATUM))))
(IPSOURCEHOST
(COND
((EQ \IP.CLASS.A (fetch
(IPADDRESS CLASSA)
of DATUM))
(fetch (IPADDRESS CLASSAHOST)
of DATUM))
((EQ \IP.CLASS.B (fetch
(IPADDRESS CLASSB)
of DATUM))
(fetch (IPADDRESS CLASSBHOST)
of DATUM))
((EQ \IP.CLASS.C (fetch
(IPADDRESS CLASSC)
of DATUM))
(fetch (IPADDRESS CLASSCHOST)
of DATUM))
(T (ERROR "Illegal address class"
DATUM)))
(COND
((EQ \IP.CLASS.A (fetch
(IPADDRESS CLASSA)
of DATUM))
(replace (IPADDRESS CLASSAHOST)
of DATUM with NEWVALUE))
((EQ \IP.CLASS.B (fetch
(IPADDRESS CLASSB)
of DATUM))
(replace (IPADDRESS CLASSBHOST)
of DATUM with NEWVALUE))
((EQ \IP.CLASS.C (fetch
(IPADDRESS CLASSC)
of DATUM))
(replace (IPADDRESS CLASSCHOST)
of DATUM with NEWVALUE))
(T (ERROR "Illegal address class"
DATUM))))))))
(TYPE? (type? ETHERPACKET DATUM)))
(DATATYPE IPSOCKET ((PROTOCOL BYTE)
(IPSLINK POINTER) (* Other sockets of this protocol type)
(NIL BYTE)
(IPSQUEUE POINTER) (* Queue of packets for this protocol)
(IPSQUEUELENGTH WORD) (* Count of packets of input queue)
(IPSQUEUEALLOC WORD) (* Max count allowed)
(IPSDESTSOCKETCOMPAREFN POINTER) (* Call this to compare dest protocol socket to this
socket)
(IPSOCKET POINTER) (* This socket)
(IPSINPUTFN POINTER) (* Call to hand packet to protocol)
(IPSEVENT POINTER) (* Notify me when a packet arrives)
(IPSNOSOCKETFN POINTER) (* Call this when no socket found)
(IPSICMPFN POINTER) (* Call this when an ICMP packet is received on this
protocol)
)
IPSQUEUE ←(create SYSQUEUE)
IPSQUEUEALLOC ← \IP.MAX.EPKTS.ON.QUEUE IPSEVENT ←(CREATE.EVENT)
IPSINPUTFN ←(FUNCTION \IP.DEFAULT.INPUTFN)
IPSICMPFN ←(FUNCTION \RELEASE.ETHERPACKET))
(BLOCKRECORD IPADDRESS ((ADDRESS FIXP))
(BLOCKRECORD IPADDRESS ((CLASSA BITS 1)
(CLASSANET BITS 7)
(CLASSAHOSTHI BITS 8)
(CLASSAHOSTLO BITS 16)))
(ACCESSFNS IPADDRESS ((CLASSAHOST (\MAKENUMBER (FETCH CLASSAHOSTHI
OF DATUM)
(FETCH CLASSAHOSTLO
OF DATUM))
(PROGN (REPLACE CLASSAHOSTHI
OF DATUM
WITH (LRSH NEWVALUE 16))
(REPLACE CLASSAHOSTLO
OF DATUM
WITH (LOGAND NEWVALUE
65535))
DATUM))))
(BLOCKRECORD IPADDRESS ((CLASSB BITS 2)
(CLASSBNETLO BITS 14)
(CLASSBHOSTWORD BITS 16)))
(ACCESSFNS IPADDRESS ((CLASSBNET (\HINUM DATUM)
(replace CLASSBNETLO of DATUM
with NEWVALUE))))
(ACCESSFNS IPADDRESS ((CLASSBHOST (fetch CLASSBHOSTWORD of DATUM)
(replace CLASSBHOSTWORD of DATUM
with (LOGAND NEWVALUE 65535)))))
(BLOCKRECORD IPADDRESS ((CLASSC BITS 3)
(CLASSCNETHI BITS 13)
(CLASSCNETLO BITS 8)
(CLASSCHOSTBYTE BITS 8)))
(ACCESSFNS IPADDRESS ((CLASSCNET (LOGOR (LLSH (\HINUM DATUM)
8)
(FETCH CLASSCNETLO
OF DATUM))
(PROGN (REPLACE CLASSCNETHI
OF DATUM
WITH (LRSH NEWVALUE 8))
(REPLACE CLASSCNETLO
OF DATUM
WITH (LOGAND
NEWVALUE
(MASK.1'S 0 8)))
DATUM))))
(ACCESSFNS IPADDRESS ((CLASSCHOST (fetch CLASSCHOSTBYTE of DATUM)
(replace CLASSCHOSTBYTE of DATUM
with (LOGAND 255 NEWVALUE))))))
]
(/DECLAREDATATYPE (QUOTE IPSOCKET)
(QUOTE (BYTE POINTER BYTE POINTER WORD WORD POINTER POINTER POINTER POINTER POINTER
POINTER))
(QUOTE ((IPSOCKET 0 (BITS . 7))
(IPSOCKET 0 POINTER)
(IPSOCKET 2 (BITS . 7))
(IPSOCKET 2 POINTER)
(IPSOCKET 4 (BITS . 15))
(IPSOCKET 5 (BITS . 15))
(IPSOCKET 6 POINTER)
(IPSOCKET 8 POINTER)
(IPSOCKET 10 POINTER)
(IPSOCKET 12 POINTER)
(IPSOCKET 14 POINTER)
(IPSOCKET 16 POINTER)))
(QUOTE 18))
(DECLARE: EVAL@COMPILE
(RPAQQ \IPOVLEN 20)
(RPAQQ \MAX.IPDATALENGTH 556)
(RPAQQ \IP.PROTOCOLVERSION 4)
(RPAQQ \IP.MAX.EPKTS.ON.QUEUE 16)
(RPAQQ \IP.DEFAULT.TIME.TO.LIVE 120)
(RPAQQ \IP.WAKEUP.INTERVAL 15000)
(CONSTANTS \IPOVLEN \MAX.IPDATALENGTH \IP.PROTOCOLVERSION \IP.MAX.EPKTS.ON.QUEUE
\IP.DEFAULT.TIME.TO.LIVE \IP.WAKEUP.INTERVAL)
)
(RPAQQ IPPACKETTYPES ((\EPT.IP 2048)
(\EPT.AR 2054)
(\EET.IP 513)
(\EPT.CHAOS 2052)))
(DECLARE: EVAL@COMPILE
(RPAQQ \EPT.IP 2048)
(RPAQQ \EPT.AR 2054)
(RPAQQ \EET.IP 513)
(RPAQQ \EPT.CHAOS 2052)
(CONSTANTS (\EPT.IP 2048)
(\EPT.AR 2054)
(\EET.IP 513)
(\EPT.CHAOS 2052))
)
(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
(PUTPROPS \IPDATABASE MACRO (LAMBDA (IP)
(* ejs: "26-Dec-84 17:50")
(* Returns the LOCF of the start of the data in the packet)
(\ADDBASE (fetch (IP IPBASE)
of IP)
(UNFOLD (fetch (IP IPHEADERLENGTH)
of IP)
2))))
(PUTPROPS \IPDATALENGTH MACRO (LAMBDA (IP)
(IDIFFERENCE (fetch (IP IPTOTALLENGTH)
of IP)
(LLSH (fetch (IP IPHEADERLENGTH)
of IP)
2))))
)
(* END EXPORTED DEFINITIONS)
)
(RPAQ? IPONLYTYPES )
(RPAQ? IPIGNORETYPES )
(RPAQ? IPPRINTMACROS )
(RPAQ? IPTRACEFLG )
(RPAQ? IPTRACEFILE )
(RPAQ? \IP.INIT.FILE )
(RPAQ? \IP.DEFAULT.CONFIGURATION )
(RPAQ? \IP.HOSTNAMES (HASHARRAY 40 1.1))
(RPAQ? \IP.HOSTNUMBERS )
(/DECLAREDATATYPE (QUOTE IPSOCKET)
(QUOTE (BYTE POINTER BYTE POINTER WORD WORD POINTER POINTER POINTER POINTER POINTER
POINTER))
(QUOTE ((IPSOCKET 0 (BITS . 7))
(IPSOCKET 0 POINTER)
(IPSOCKET 2 (BITS . 7))
(IPSOCKET 2 POINTER)
(IPSOCKET 4 (BITS . 15))
(IPSOCKET 5 (BITS . 15))
(IPSOCKET 6 POINTER)
(IPSOCKET 8 POINTER)
(IPSOCKET 10 POINTER)
(IPSOCKET 12 POINTER)
(IPSOCKET 14 POINTER)
(IPSOCKET 16 POINTER)))
(QUOTE 18))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS IPTRACEFILE IPTRACEFLG IPIGNORETYPES IPONLYTYPES IPPRINTMACROS \IP.HOSTNAMES
\IP.INIT.FILE \IP.DEFAULT.CONFIGURATION \IP.HOSTNUMBERS)
)
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
TCPHTE TCPLLICMP TCPLLAR)
(ADDTOVAR \PACKET.PRINTERS (2048 . PRINTIP))
(DEFINEQ
(DODIP.HOSTP
(LAMBDA (NAME) (* ejs: " 9-Feb-85 13:44")
(OR (NUMBERP NAME)
(IPHOSTADDRESS NAME))))
(IPHOSTADDRESS
(LAMBDA (NAME) (* ejs: "27-Apr-85 18:57")
(LET ((ENTRY (GETHASH (U-CASE NAME)
\IP.HOSTNAMES)))
(COND
(ENTRY (LET ((ADDRESS (CAR (fetch (HOSTS.TXT.ENTRY HTE.ADDRESSES) of ENTRY))))
(COND
((NOT (SASSOC ADDRESS \IP.HOSTNUMBERS))
(push \IP.HOSTNUMBERS (CONS ADDRESS NAME))))
ADDRESS))
((\IP.READ.STRING.ADDRESS NAME))))))
(IPHOSTNAME
(LAMBDA (IPADDRESS) (* ejs: "22-Apr-85 13:54")
(OR (CDR (SASSOC IPADDRESS \IP.HOSTNUMBERS))
(MKATOM (\IP.ADDRESS.TO.STRING IPADDRESS)))))
(IPTRACE
(LAMBDA (MODE) (* ejs: " 1-Feb-86 16:04")
(COND
((WINDOWP IPTRACEFILE)
(OPENW IPTRACEFILE))
(T (SETQ IPTRACEFILE (CREATEW NIL "IP Trace File"))
(DSPSCROLL (QUOTE ON)
IPTRACEFILE)
(DSPFONT (QUOTE (GACHA 8))
IPTRACEFILE)
(WINDOWPROP IPTRACEFILE (QUOTE BUTTONEVENTFN)
(FUNCTION IPTRACEWINDOW.BUTTONFN))
(WINDOWPROP IPTRACEFILE (QUOTE CLOSEFN)
(FUNCTION (LAMBDA NIL
(SETQ IPTRACEFLG NIL)
(SETQ IPTRACEFILE))))))
(SETQ IPTRACEFLG MODE)))
(IPTRACEWINDOW.BUTTONFN
(LAMBDA (WINDOW) (* ejs: " 2-Jun-85 13:05")
(COND
((MOUSESTATE (NOT UP))
(SETQ IPTRACEFLG (SELECTQ IPTRACEFLG
(NIL T)
(T (QUOTE PEEK))
(PEEK NIL)
NIL))
(printout WINDOW T "[Tracing " (SELECTQ IPTRACEFLG
(T "on")
(PEEK "peek")
"off")
"]" T)))))
(PRINTIP
(LAMBDA (IP CALLER FILE PRE.NOTE DOFILTER) (* ejs: " 9-Feb-85 18:07")
(OR FILE (SETQ FILE IPTRACEFILE))
(PROG ((PROTOCOL (fetch (IP IPPROTOCOL) of IP))
MACRO LENGTH)
(COND
(DOFILTER (COND
((COND
(IPONLYTYPES (NOT (FMEMB PROTOCOL IPONLYPROTOCOLS)))
(IPIGNORETYPES (FMEMB PROTOCOL IPIGNORETYPES)))
(RETURN (PRIN1 (SELECTQ CALLER
((PUT RAWPUT)
(QUOTE !))
((GET RAWGET)
(QUOTE +))
(QUOTE ?))
FILE))))))
(AND PRE.NOTE (printout FILE T PRE.NOTE))
(printout FILE "From " (\IP.ADDRESS.TO.STRING (fetch (IP IPSOURCEADDRESS) of IP))
" to "
(\IP.ADDRESS.TO.STRING (fetch (IP IPDESTINATIONADDRESS) of IP))
T)
(COND
((SETQ MACRO (CDR (FASSOC PROTOCOL IPPRINTMACROS)))
(* Macro is a function to which to dispatch for the
printing.)
(AND (NLISTP MACRO)
(RETURN (RESETFORM (OUTPUT FILE)
(APPLY* MACRO IP FILE))))))
(printout FILE "Length = " .P2 (SETQ LENGTH (fetch (IP IPTOTALLENGTH) of IP))
" bytes" " (header + " .P2 (IDIFFERENCE LENGTH \IPOVLEN)
")" T "Protocol = ")
(PRINTCONSTANT PROTOCOL IPPROTOCOLTYPES FILE)
(TERPRI FILE)
(COND
((IGREATERP LENGTH \IPOVLEN) (* MACRO tells how to print data.)
(PRIN1 "Contents: " FILE)
(PRINTIPDATA IP (OR MACRO (QUOTE (BYTES 12 ...)))
NIL FILE)))
(TERPRI FILE)
(RETURN IP))))
(PRINTIPDATA
(LAMBDA (IP MACRO OFFSET FILE) (* ejs: "27-Dec-84 18:43")
(* * Prints DATA part of IP starting at OFFSET (Default zero) according to MACRO. MACRO contains elements describing
what format the data is in -
WORDS, BYTES, CHARS: print as words, bytes (numeric) or ascii characters -
<number>: subsequent commands apply starting at this byte offset -
...: print "..." and quit if you still have data at this point)
(PROG ((DATA (\IPDATABASE IP))
(LENGTH (\IPDATALENGTH IP)))
(PRINTPACKETDATA DATA OFFSET MACRO LENGTH FILE))))
(\IPADDRESSCLASS
(LAMBDA (IPADDRESS) (* ejs: " 4-Apr-85 15:19")
(COND
((EQ \IP.CLASS.A (fetch (IPADDRESS CLASSA) of IPADDRESS))
(QUOTE \IP.CLASS.A))
((EQ \IP.CLASS.B (fetch (IPADDRESS CLASSB) of IPADDRESS))
(QUOTE \IP.CLASS.B))
((EQ \IP.CLASS.C (fetch (IPADDRESS CLASSC) of IPADDRESS))
(QUOTE \IP.CLASS.C))
(T (ERROR "Illegal address class" IPADDRESS)))))
(\IPHOSTADDRESS
(LAMBDA (IPADDRESS) (* ejs: "27-Dec-84 15:04")
(COND
((EQ \IP.CLASS.A (LDB \IP.CLASS.A.BYTESPEC IPADDRESS))
(LDB \IP.CLASS.A.HOST.BYTESPEC IPADDRESS))
((EQ \IP.CLASS.B (LDB \IP.CLASS.B.BYTESPEC IPADDRESS))
(LDB \IP.CLASS.B.HOST.BYTESPEC IPADDRESS))
((EQ \IP.CLASS.C (LDB \IP.CLASS.C.BYTESPEC IPADDRESS))
(LDB \IP.CLASS.C.HOST.BYTESPEC IPADDRESS))
(T (ERROR "Illegal address class" IPADDRESS)))))
(\IPNETADDRESS
(LAMBDA (IPADDRESS) (* ejs: "22-Apr-85 17:38")
(COND
((EQ \IP.CLASS.A (LDB \IP.CLASS.A.BYTESPEC IPADDRESS))
(LDB \IP.CLASS.A.NET.BYTESPEC IPADDRESS))
((EQ \IP.CLASS.B (LDB \IP.CLASS.B.BYTESPEC IPADDRESS))
(LDB \IP.CLASS.B.NET.BYTESPEC IPADDRESS))
((EQ \IP.CLASS.C (LDB \IP.CLASS.C.BYTESPEC IPADDRESS))
(LDB \IP.CLASS.C.NET.BYTESPEC IPADDRESS))
(T (ERROR "Illegal address class" IPADDRESS)))))
(\IP.ADDRESS.TO.STRING
(LAMBDA (IPADDRESS) (* ejs: "28-Dec-84 08:43")
(RESETFORM (RADIX 10)
(CONCAT (LDB (BYTE 8 24)
IPADDRESS)
"."
(LDB (BYTE 8 16)
IPADDRESS)
"."
(LDB (BYTE 8 8)
IPADDRESS)
"."
(LDB (BYTE 8 0)
IPADDRESS)))))
(\IP.BROADCAST.ADDRESS
(LAMBDA (IPADDRESS) (* ejs: "27-Dec-84 16:01")
(PROG ((HOSTADDRESS (\IPHOSTADDRESS IPADDRESS)))
(RETURN (SELECTQ (\IPADDRESSCLASS IPADDRESS)
(\IP.CLASS.A (EQP (MASK.1'S 0 24)
HOSTADDRESS))
(\IP.CLASS.B (EQ (MASK.1'S 0 16)
HOSTADDRESS))
(\IP.CLASS.C (EQ (MASK.1'S 0 8)
HOSTADDRESS))
NIL)))))
(\IP.LEGAL.ADDRESS
(LAMBDA (ADDRESS) (* ejs: " 4-Jun-85 23:28")
(OR (EQ 0 (\IPNETADDRESS ADDRESS))
(AND (NOT (EQ ADDRESS 0))
(OR (EQ (fetch (IPADDRESS CLASSA) of ADDRESS)
\IP.CLASS.A)
(EQ (fetch (IPADDRESS CLASSB) of ADDRESS)
\IP.CLASS.B)
(EQ (fetch (IPADDRESS CLASSC) of ADDRESS)
\IP.CLASS.C))))))
(\IP.MAKE.BROADCAST.ADDRESS
(LAMBDA (IPADDRESS) (* ejs: " 3-Jun-85 01:02")
(SELECTQ (\IPADDRESSCLASS IPADDRESS)
(\IP.CLASS.A (LOGOR (MASK.1'S 0 24)
IPADDRESS))
(\IP.CLASS.B (LOGOR (MASK.1'S 0 16)
IPADDRESS))
(\IP.CLASS.C (LOGOR (MASK.1'S 0 8)
IPADDRESS))
(SHOULDNT))))
(\IP.PRINT.ADDRESS
(LAMBDA (IPADDRESS FILE) (* ejs: "28-Dec-84 08:42")
(RESETFORM (RADIX 10)
(PRIN1 (LDB (BYTE 8 24)
IPADDRESS)
FILE)
(PRIN1 "." FILE)
(PRIN1 (LDB (BYTE 8 16)
IPADDRESS)
FILE)
(PRIN1 "." FILE)
(PRIN1 (LDB (BYTE 8 8)
IPADDRESS)
FILE)
(PRIN1 "." FILE)
(PRIN1 (LDB (BYTE 8 0)
IPADDRESS)
FILE)
IPADDRESS)))
(\IP.READ.STRING.ADDRESS
(LAMBDA (STRING.OR.ATOM) (* ejs: "27-Dec-84 15:42")
(* * Convert a dotted notation -- 36.9.0.9 -- to an internal notation)
(bind (CELL ←(ARRAY 4 (QUOTE BYTE)
0 0))
(INDEX ← 0)
(TEMP ← 0) for CHAR instring (MKSTRING STRING.OR.ATOM)
while (AND (ILEQ INDEX 3)
(ILEQ TEMP (MASK.1'S 0 8)))
do (COND
((EQ CHAR (CHARCODE %.))
(\BYTESETA CELL INDEX TEMP)
(SETQ TEMP 0)
(add INDEX 1))
((AND (IGEQ CHAR (CHARCODE 0))
(ILEQ CHAR (CHARCODE 9)))
(SETQ TEMP (IPLUS (ITIMES TEMP 10)
(IDIFFERENCE CHAR (CHARCODE 0))))))
finally (COND
((ILEQ TEMP (MASK.1'S 0 8))
(\BYTESETA CELL INDEX TEMP)))
(RETURN (COND
((EQ INDEX 3)
(create FIXP
HINUM ←(create WORD
HIBYTE ←(\BYTELT CELL 0)
LOBYTE ←(\BYTELT CELL 1))
LONUM ←(create WORD
HIBYTE ←(\BYTELT CELL 2)
LOBYTE ←(\BYTELT CELL 3)))))))))
)
(* * Startup and shutdown)
(RPAQ? \IPFLG )
(RPAQ? \IP.READY )
(RPAQ? \IP.READY.EVENT (CREATE.EVENT "IP Ready"))
(RPAQ? \IP.WAKEUP.TIMER )
(RPAQ? IPTRACEFLG )
(RPAQ? \IP.WAKEUP.EVENT (CREATE.EVENT "IP Wakeup"))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \IPFLG \IP.READY \IP.READY.EVENT \IP.WAKEUP.TIMER \IP.WAKEUP.EVENT)
)
(DEFINEQ
(STOPIP
(LAMBDA NIL (* ejs: "28-Dec-84 08:10")
(\DEL.PACKET.FILTER (FUNCTION \HANDLE.RAW.IP))
(\DEL.PACKET.FILTER (FUNCTION \HANDLE.RAW.AR))
(DEL.PROCESS (QUOTE \IPLISTENER))
(SETQ \IPFLG (SETQ \IP.READY NIL))))
(\IPINIT
(LAMBDA (EVENT) (* ejs: " 8-Sep-85 02:50")
(* Initialize IP protocol)
(DECLARE (GLOBALVARS (\IP.HTE.FILE \IP.HOSTNAME \IP.LOCAL.NETWORKS \IP.DEFAULT.GATEWAY
\IP.INIT.FILE \IP.SUBNET.MASKS)))
(SELECTQ EVENT
((NIL RESTART AFTERSYSOUT AFTERMAKESYS AFTERLOGOUT AFTERSAVEVM)
(SETQ \IP.DEFAULT.CONFIGURATION NIL)
(SETQ \IP.INIT.FILE NIL)
(SETQ \IP.LOCAL.ADDRESSES NIL)
(SETQ \IP.DEFAULT.GATEWAY NIL)
(SETQ \IP.ROUTING.TABLE (CONS))
(SETQ \IP.LOCAL.NETWORKS NIL)
(SETQ \IP.SUBNET.MASKS NIL)
(SETQ \AR.IP.TO.10MB.ALIST NIL)
(PROG ((PROC (FIND.PROCESS (QUOTE \IPLISTENER)))
NDB ADDRESS.STRING)
(* * This is a kludge until we know more about IP routing and reverse address resolution)
(CLEARBUF T)
(COND
((NOT \IP.INIT.FILE)
(SETQ \IP.INIT.FILE (OR (INFILEP (QUOTE {DSK}IP.INIT))
(bind NAME thereis (SETQ NAME (INFILEP (PROMPTFORWORD
"Please enter the name of the IP initialization file for this host: ")))
finally (RETURN NAME))))))
(COND
((NULL \IP.DEFAULT.CONFIGURATION)
(COND
((NULL (SETQ \IP.DEFAULT.CONFIGURATION
(LET ((STREAM (OPENSTREAM \IP.INIT.FILE (QUOTE INPUT)
(QUOTE OLD))))
(COND
(STREAM (PROG1 (READ STREAM)
(CLOSEF STREAM)))))))
(ERROR "Problem with local IP init file")))))
(COND
((NOT (fetch (IPINIT HTE.FILE) of \IP.DEFAULT.CONFIGURATION))
(bind NAME until (replace (IPINIT HTE.FILE) of \IP.DEFAULT.CONFIGURATION
with (INFILEP (SETQ NAME (PROMPTFORWORD
"Please supply the name of a HOSTS.TXT file, or <CR> to ignore this: "))))
do (COND
((NULL NAME)
(GO $$OUT))))))
(COND
((fetch (IPINIT HTE.FILE) of \IP.DEFAULT.CONFIGURATION)
(\HTE.READ.FILE (fetch (IPINIT HTE.FILE) of \IP.DEFAULT.CONFIGURATION))))
(COND
((AND (NOT (fetch (IPINIT HOSTNAME) of \IP.DEFAULT.CONFIGURATION))
(NOT (replace (IPINIT HOSTNAME) of \IP.DEFAULT.CONFIGURATION
with (U-CASE (MKATOM (ETHERHOSTNAME))))))
(replace (IPINIT HOSTNAME) of \IP.DEFAULT.CONFIGURATION
with (U-CASE (MKATOM (PROMPTFORWORD
"Please give this machine a name (or <CR> for no name): ")))))
)
(COND
((fetch (IPINIT LOCAL.ADDRESSES) of \IP.DEFAULT.CONFIGURATION)
(SETQ \IP.LOCAL.ADDRESSES (for ADDR in (fetch (IPINIT LOCAL.ADDRESSES)
of \IP.DEFAULT.CONFIGURATION)
collect (\IP.READ.STRING.ADDRESS ADDR))))
((AND (fetch (IPINIT HOSTNAME) of \IP.DEFAULT.CONFIGURATION)
(DODIP.HOSTP (fetch (IPINIT HOSTNAME) of \IP.DEFAULT.CONFIGURATION)))
(SETQ \IP.LOCAL.ADDRESSES (LIST (DODIP.HOSTP (fetch (IPINIT HOSTNAME)
of \IP.DEFAULT.CONFIGURATION)
))))
(T (until (SETQ ADDRESS.STRING (PROMPTFORWORD
"Please enter this machine's IP host address (e.g. 39.9.0.9)")))
(SETQ \IP.LOCAL.ADDRESSES (LIST (\IP.READ.STRING.ADDRESS ADDRESS.STRING)))
(COND
((fetch (IPINIT HOSTNAME) of \IP.DEFAULT.CONFIGURATION)
(PUTHASH (fetch (IPINIT HOSTNAME) of \IP.DEFAULT.CONFIGURATION)
(create HOSTS.TXT.ENTRY
HTE.TYPE ←(QUOTE HOST)
HTE.ADDRESSES ← \IP.LOCAL.ADDRESSES
HTE.NAMES ←(LIST (fetch (IPINIT HOSTNAME)
of \IP.DEFAULT.CONFIGURATION))
HTE.MACHINE.TYPE ←(SELECTQ (MACHINETYPE)
(DOVE (QUOTE XEROX-1185))
(DANDELION (QUOTE
XEROX-1108))
(DOLPHIN (QUOTE XEROX-1100))
(DORADO (QUOTE XEROX-1132))
(QUOTE XEROX-11XX))
HTE.OS.TYPE ←(QUOTE INTERLISP)
HTE.PROTOCOLS ←(QUOTE ((TCP)
(IP))))
\IP.HOSTNAMES)))))
(COND
((fetch (IPINIT DEFAULT.GATEWAY) of \IP.DEFAULT.CONFIGURATION)
(SETQ \IP.DEFAULT.GATEWAY (\IP.READ.STRING.ADDRESS (fetch (IPINIT
DEFAULT.GATEWAY)
of
\IP.DEFAULT.CONFIGURATION)))))
(COND
((EQLENGTH (fetch (IPINIT LOCAL.NETWORKS) of \IP.DEFAULT.CONFIGURATION)
(LENGTH \IP.LOCAL.ADDRESSES))
(SETQ \IP.LOCAL.NETWORKS (bind NDB for NET.AND.TYPE
in (fetch (IPINIT LOCAL.NETWORKS) of
\IP.DEFAULT.CONFIGURATION)
as ADDRESS in \IP.LOCAL.ADDRESSES
collect
(LET* ((TYPE (CDR NET.AND.TYPE))
(NET (\IPNETADDRESS (
\IP.READ.STRING.ADDRESS (CAR NET.AND.TYPE))))
(NDB (SELECTQ TYPE
(3 \3MBLOCALNDB)
(10 \10MBLOCALNDB)
(SHOULDNT))))
(replace (NDB NDBIPNET#) of NDB
with NET)
(replace (NDB NDBIPHOST#) of NDB
with ADDRESS)
(CONS NET NDB)))))
(T (COND
((EQLENGTH \IP.LOCAL.ADDRESSES 1)
(SETQ \IP.LOCAL.NETWORKS (LIST (CONS (\IPNETADDRESS (CAR
\IP.LOCAL.ADDRESSES))
(SETQ NDB (OR \10MBLOCALNDB
\3MBLOCALNDB)))))
(replace (NDB NDBIPNET#) of NDB with (CAAR \IP.LOCAL.NETWORKS))
(replace (NDB NDBIPHOST#) of NDB with (CAR \IP.LOCAL.ADDRESSES)))
((NULL \IP.LOCAL.NETWORKS)
(SHOULDNT "Error in IP init file. \IP.LOCAL.NETWORKS is not specified")
)
(T (SHOULDNT
"Error in IP init file. \IP.LOCAL.NETWORKS and \IP.LOCAL.ADDRESSES do not correlate.")))))
(SETQ \IP.SUBNET.MASKS (for LOCALADDR in \IP.LOCAL.ADDRESSES as MASK
in (fetch (IPINIT SUBNETMASK) of
\IP.DEFAULT.CONFIGURATION)
as NETADDRESS in (fetch (IPINIT LOCAL.NETWORKS)
of \IP.DEFAULT.CONFIGURATION)
collect (CONS LOCALADDR (\IP.READ.STRING.ADDRESS
(OR MASK (CAR NETADDRESS))))))
(SETQ \IPFLG T)
(\ADD.PACKET.FILTER (FUNCTION \HANDLE.RAW.IP))
(\ADD.PACKET.FILTER (FUNCTION \HANDLE.RAW.AR))
(\IP.ADD.PROTOCOL \ICMP.PROTOCOL (FUNCTION TRUE)
(FUNCTION NILL)
(FUNCTION \ICMP.INPUT))
(COND
(PROC (RESTART.PROCESS PROC))
(T (ADD.PROCESS (QUOTE (\IPLISTENER))
(QUOTE RESTARTABLE)
(QUOTE SYSTEM)
(QUOTE AFTEREXIT)
\IP.READY.EVENT)))
(SETQ \IP.READY T)
(NOTIFY.EVENT \IP.READY.EVENT)))
NIL)))
(\IPLISTENER
(LAMBDA NIL (* ejs: "25-Jun-85 18:52")
(* * IP background process)
(SETQ \IP.WAKEUP.TIMER (SETUPTIMER \IP.WAKEUP.INTERVAL))
(bind (\AR.WAKEUP.TIMER ←(SETUPTIMER (CONSTANT (ITIMES 4 \IP.WAKEUP.INTERVAL)))) while T
do (AWAIT.EVENT \IP.WAKEUP.EVENT \IP.WAKEUP.INTERVAL)
(\IP.CHECK.REASSEMBLY.TIMEOUTS)
(COND
((TIMEREXPIRED? \AR.WAKEUP.TIMER)
(\AR.DAEMON)
(SETQ \AR.WAKEUP.TIMER (SETUPTIMER (CONSTANT (ITIMES 4 \IP.WAKEUP.INTERVAL))
\AR.WAKEUP.TIMER)))))))
)
(ADDTOVAR AROUNDEXITFNS \IPINIT)
(ADDTOVAR RESTARTETHERFNS \IPINIT)
(* * Early IP reception functions)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
(RPAQQ IPADDRESSTYPES ((\IP.CLASS.A 0)
(\IP.CLASS.A.BYTESPEC (BYTE 1 31))
(\IP.CLASS.A.NET.BYTESPEC (BYTE 8 24))
(\IP.CLASS.A.HOST.BYTESPEC (BYTE 24 0))
(\IP.CLASS.B 2)
(\IP.CLASS.B.BYTESPEC (BYTE 2 30))
(\IP.CLASS.B.NET.BYTESPEC (BYTE 16 16))
(\IP.CLASS.B.HOST.BYTESPEC (BYTE 16 0))
(\IP.CLASS.C 6)
(\IP.CLASS.C.BYTESPEC (BYTE 3 29))
(\IP.CLASS.C.NET.BYTESPEC (BYTE 24 8))
(\IP.CLASS.C.HOST.BYTESPEC (BYTE 8 0))))
(DECLARE: EVAL@COMPILE
(RPAQQ \IP.CLASS.A 0)
(RPAQ \IP.CLASS.A.BYTESPEC (BYTE 1 31))
(RPAQ \IP.CLASS.A.NET.BYTESPEC (BYTE 8 24))
(RPAQ \IP.CLASS.A.HOST.BYTESPEC (BYTE 24 0))
(RPAQQ \IP.CLASS.B 2)
(RPAQ \IP.CLASS.B.BYTESPEC (BYTE 2 30))
(RPAQ \IP.CLASS.B.NET.BYTESPEC (BYTE 16 16))
(RPAQ \IP.CLASS.B.HOST.BYTESPEC (BYTE 16 0))
(RPAQQ \IP.CLASS.C 6)
(RPAQ \IP.CLASS.C.BYTESPEC (BYTE 3 29))
(RPAQ \IP.CLASS.C.NET.BYTESPEC (BYTE 24 8))
(RPAQ \IP.CLASS.C.HOST.BYTESPEC (BYTE 8 0))
(CONSTANTS (\IP.CLASS.A 0)
(\IP.CLASS.A.BYTESPEC (BYTE 1 31))
(\IP.CLASS.A.NET.BYTESPEC (BYTE 8 24))
(\IP.CLASS.A.HOST.BYTESPEC (BYTE 24 0))
(\IP.CLASS.B 2)
(\IP.CLASS.B.BYTESPEC (BYTE 2 30))
(\IP.CLASS.B.NET.BYTESPEC (BYTE 16 16))
(\IP.CLASS.B.HOST.BYTESPEC (BYTE 16 0))
(\IP.CLASS.C 6)
(\IP.CLASS.C.BYTESPEC (BYTE 3 29))
(\IP.CLASS.C.NET.BYTESPEC (BYTE 24 8))
(\IP.CLASS.C.HOST.BYTESPEC (BYTE 8 0)))
)
(* END EXPORTED DEFINITIONS)
)
(RPAQ? \IP.LOCAL.ADDRESSES )
(RPAQ? \IP.SUBNET.MASKS )
(RPAQ? \IP.GATEWAY.FLG )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \IP.LOCAL.ADDRESSES \IP.SUBNET.MASKS \IP.GATEWAY.FLG)
)
(DECLARE: EVAL@COMPILE
(PUTPROPS \IP.FIX.DEST.HOST MACRO (LAMBDA (IP NDB)
(* ejs: "26-Dec-84 15:07")
(replace (IP IPDESTINATIONHOST)
of IP with (ffetch (NDB NDBIPHOST#)
of NDB))))
(PUTPROPS \IP.FIX.DEST.NET MACRO (LAMBDA (IP NDB)
(* ejs: "26-Dec-84 15:08")
(* * Put the IP net# corresponding to the given NDB into the
destination net field of the dest address of the IP
packet)
(replace (IP IPDESTINATIONADDRESS)
of IP with
(LOGOR (fetch (IP IPDESTINATIONADDRESS)
of IP)
(LLSH (fetch (NDB NDBIPNET#)
of NDB)
(SELECTQ (\IPADDRESSCLASS
(fetch (NDB NDBIPHOST#)
of NDB))
(\IP.CLASS.A 24)
(\IP.CLASS.B 16)
(\IP.CLASS.C 8)
(SHOULDNT)))))))
(PUTPROPS \IP.FIX.SOURCE.HOST MACRO (LAMBDA (IP NDB)
(* ejs: "26-Dec-84 15:07")
(replace (IP IPSOURCEHOST)
of IP with (ffetch (NDB NDBIPHOST#)
of NDB))))
(PUTPROPS \IP.FIX.SOURCE.NET MACRO (LAMBDA (IP NDB)
(* ejs: "26-Dec-84 15:08")
(* * Put the IP net# corresponding to the given NDB into
the destination net field of the dest address of the IP
packet)
(replace (IP IPSOURCENET)
of IP with (ffetch (NDB NDBIPNET#)
of NDB))))
(PUTPROPS \IPDATABASE MACRO (LAMBDA (IP)
(* ejs: "26-Dec-84 17:50")
(* Returns the LOCF of the start of the data in the packet)
(\ADDBASE (fetch (IP IPBASE)
of IP)
(UNFOLD (fetch (IP IPHEADERLENGTH)
of IP)
2))))
)
(DEFINEQ
(\HANDLE.RAW.IP
(LAMBDA (IP TYPE) (* ejs: " 3-Feb-86 11:01")
(PROG ((NDB (ffetch (ETHERPACKET EPNETWORK) of IP)))
(COND
((NOT (type? NDB NDB))
(ERROR "No NDB in ETHERPACKET!" IP)))
(SELECTQ (ffetch (NDB NETTYPE) of NDB)
(10 (COND
((NEQ TYPE \EPT.IP)
(RETURN))))
(3 (COND
((NEQ TYPE \EET.IP)
(RETURN))))
(ERROR "Unknown net type" (ffetch (NDB NETTYPE) of NDB)))
(COND
((NOT \IP.READY)
(\RELEASE.ETHERPACKET IP))
((NOT (\IP.CHECKSUM.OK (\IPCHECKSUM IP (ffetch (IP IPBASE) of IP)
(TIMES (ffetch (IP IPHEADERLENGTH)
of IP)
BYTESPERCELL))))
(AND IPTRACEFLG (PRINTPACKET IP (QUOTE GET)
IPTRACEFILE
"[Packet dropped--bad IP header checksum]"))
(\RELEASE.ETHERPACKET IP))
((ZEROP (ffetch (IP IPTIMETOLIVE) of IP))
(\ICMP.TIME.EXCEEDED IP \ICMP.TRANSIT.TIME.EXCEEDED)
(\RELEASE.ETHERPACKET IP))
((\IP.PROCESS.OPTIONS IP)
(COND
((NOT (\IP.LOCAL.DESTINATION IP))
(\FORWARD.IP IP))
((\IP.FRAGMENTED.PACKET IP)
(COND
((SETQ IP (\HANDLE.RAW.IP.FRAGMENT IP))
(COND
(IPTRACEFLG (COND
((EQ IPTRACEFLG T)
(PRINTIP IP (QUOTE GETFRAGMENT)
IPTRACEFILE NIL T))
(T (PRIN1 "+" IPTRACEFILE)))))
(\IP.HAND.TO.PROTOCOL IP))))
(T (COND
(IPTRACEFLG (COND
((EQ IPTRACEFLG T)
(PRINTIP IP (QUOTE GET)
IPTRACEFILE NIL T))
(T (PRIN1 "+" IPTRACEFILE)))))
(\IP.HAND.TO.PROTOCOL IP)))))
(RETURN T))))
(\FORWARD.IP
(LAMBDA (IP) (* ejs:
" 2-Feb-86 12:26")
(DECLARE (GLOBALVARS \IP.GATEWAY.FLG \IP.GATEWAY.FORWARDING.FUNCTIONS))
(COND
(\IP.GATEWAY.FLG (LET*((NETADDRESS (\IPNETADDRESS (ffetch (IP IPDESTINATIONADDRESS)
of IP)))
(NDB (CDR (SASSOC NETADDRESS \IP.LOCAL.NETWORKS)))
ROUTE FORWARDING.FUNCTION)
(COND
((NULL NDB)
(COND
((SETQ ROUTE (CDR (SASSOC NETADDRESS \IP.ROUTING.TABLE)))
(SETQ NDB (CDR (SASSOC (\IPNETADDRESS ROUTE)
\IP.LOCAL.NETWORKS)))))))
(COND
(NDB (replace EPREQUEUE of IP with (QUOTE FREE))
(add (ffetch (IP IPTIMETOLIVE) of IP)
-1)
(COND
((SETQ FORWARDING.FUNCTION (CDR (SASSOC NETADDRESS
\IP.GATEWAY.FORWARDING.FUNCTIONS
)))
(APPLY* FORWARDING.FUNCTION IP NDB NETADDRESS ROUTE))
(T (\RELEASE.ETHERPACKET IP))))
(T (\ICMP.REDIRECT IP \ICMP.REDIRECT.NET)))))
(T (\RELEASE.ETHERPACKET IP)))))
(\IP.LOCAL.DESTINATION
(LAMBDA (IP) (* ejs: "21-Jun-85 18:25")
(* * Return T if IP packet is destined for us)
(LET ((DESTADDRESS (fetch (IP IPDESTINATIONADDRESS) of IP))
(LOCALNETADDRESS (fetch NDBIPNET# of (fetch EPNETWORK of IP))))
(COND
((EQ 0 DESTADDRESS)
NIL)
((MEMBER DESTADDRESS \IP.LOCAL.ADDRESSES)
T)
((NOT (\IP.LEGAL.ADDRESS DESTADDRESS)) (* Bogus destination address)
NIL)
((EQ 0 (\IPNETADDRESS DESTADDRESS)) (* Source doesn't know its network?)
(SETQ DESTADDRESS (replace (IP IPDESTINATIONADDRESS) of IP
with (LOGOR (LLSH LOCALNETADDRESS (SELECTQ (INTEGERLENGTH
LOCALNETADDRESS)
(8 24)
(16 16)
(24 8)
0))
DESTADDRESS)))
(COND
((AND (\IP.BROADCAST.ADDRESS DESTADDRESS)
(EQ LOCALNETADDRESS (\IPNETADDRESS DESTADDRESS)))
T)
((MEMBER DESTADDRESS \IP.LOCAL.ADDRESSES)
T)))
((AND (\IP.BROADCAST.ADDRESS DESTADDRESS)
(EQ LOCALNETADDRESS (\IPNETADDRESS DESTADDRESS)))
T)))))
(\IPCHECKSUM
(LAMBDA (ETHERPACKET CHECKSUMBASE NBYTES IGNOREDWORD) (* ejs: "31-Dec-84 13:53")
(* * Compute a general checksum for a packet starting at CHECKSUMBASE and extending NBYTES. If NBYTES is odd, a 0
byte is padded on the end. The IGNOREDWORD field is the LOCF of the field which will contain the checksum, and is to
be considered 0 for the calculation.)
(PROG ((MAXINDEX (SUB1 (FOLDHI NBYTES BYTESPERWORD)))
(CHECKSUM 0)
(ODDFLG (ODDP NBYTES))
DIFF WORDCONTENTS)
(AND IGNOREDWORD (\PUTBASE IGNOREDWORD 0 0))
(for WORD from 0 to MAXINDEX do (SETQ CHECKSUM
(COND
((AND ODDFLG (EQ WORD MAXINDEX))
(COND
((ILEQ CHECKSUM (SETQ DIFF
(IDIFFERENCE MAX.SMALL.INTEGER
(SETQ WORDCONTENTS
(LOGAND (\GETBASE
CHECKSUMBASE
WORD)
(MASK.1'S 8 8))))))
(IPLUS CHECKSUM WORDCONTENTS))
(T (IDIFFERENCE CHECKSUM DIFF))))
(T (COND
((ILEQ CHECKSUM (SETQ DIFF
(IDIFFERENCE MAX.SMALL.INTEGER
(SETQ WORDCONTENTS
(\GETBASE CHECKSUMBASE
WORD)))))
(IPLUS CHECKSUM WORDCONTENTS))
(T (IDIFFERENCE CHECKSUM DIFF)))))))
(RETURN CHECKSUM))))
(\IP.CHECKSUM.OK
(LAMBDA (CHECKSUM) (* ejs: "28-Dec-84 19:40")
(OR (EQ CHECKSUM (MASK.1'S 0 16))
(EQ CHECKSUM 0))))
(\IP.SET.CHECKSUM
(LAMBDA (PACKET CHECKSUMBASE NBYTES CHECKSUMWORD) (* ejs: " 4-Jun-85 22:47")
(PROG ((CHECKSUM (\IPCHECKSUM PACKET CHECKSUMBASE NBYTES CHECKSUMWORD)))
(\PUTBASE CHECKSUMWORD 0 (COND
((EQ CHECKSUM (MASK.1'S 0 16))
CHECKSUM)
(T (LOGAND (LOGNOT CHECKSUM)
(MASK.1'S 0 16))))))))
)
(* * Protocol Distribution)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
(RPAQQ IPPROTOCOLTYPES ((\ICMP.PROTOCOL 1)
(\TCP.PROTOCOL 6)
(\UDP.PROTOCOL 17)))
(DECLARE: EVAL@COMPILE
(RPAQQ \ICMP.PROTOCOL 1)
(RPAQQ \TCP.PROTOCOL 6)
(RPAQQ \UDP.PROTOCOL 17)
(CONSTANTS (\ICMP.PROTOCOL 1)
(\TCP.PROTOCOL 6)
(\UDP.PROTOCOL 17))
)
(* END EXPORTED DEFINITIONS)
)
(RPAQ? \IP.PROTOCOLS )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \IP.PROTOCOLS)
)
(DEFINEQ
(\IP.HAND.TO.PROTOCOL
(LAMBDA (IP) (* ejs: " 2-Jan-85 20:23")
(PROG ((PROTOCOL (ffetch (IP IPPROTOCOL) of IP))
PROTOCOLCHAIN IPSOCKET)
(COND
((NOT (SETQ PROTOCOLCHAIN (\IP.FIND.PROTOCOL PROTOCOL \IP.PROTOCOLS)))
(\ICMP.DEST.UNREACHABLE IP \ICMP.PROTOCOL.UNREACHABLE))
((NOT (SETQ IPSOCKET (\IP.FIND.PROTOCOL.SOCKET IP PROTOCOLCHAIN)))
(APPLY* (ffetch (IPSOCKET IPSNOSOCKETFN) of PROTOCOLCHAIN)
IP))
(T (APPLY* (ffetch (IPSOCKET IPSINPUTFN) of (COND
((type? IPSOCKET IPSOCKET)
IPSOCKET)
(T PROTOCOLCHAIN)))
IP IPSOCKET))))))
(\IP.DEFAULT.INPUTFN
(LAMBDA (IP IPSOCKET) (* ejs: " 3-Feb-85 19:19")
(COND
((EQ (fetch (IPSOCKET IPSQUEUELENGTH) of IPSOCKET)
(fetch (IPSOCKET IPSQUEUEALLOC) of IPSOCKET))
(\RELEASE.ETHERPACKET IP))
(T (UNINTERRUPTABLY
(\ENQUEUE (fetch (IPSOCKET IPSQUEUE) of IPSOCKET)
IP)
(add (fetch (IPSOCKET IPSQUEUELENGTH) of IPSOCKET)
1)
(NOTIFY.EVENT (fetch (IPSOCKET IPSEVENT) of IPSOCKET)))))))
(\IP.DEFAULT.NOSOCKETFN
(LAMBDA (IP) (* ejs: " 2-Feb-86 11:38")
(COND
((OR (NEQ 0 (fetch (IP IPDESTINATIONHOST) of IP))
(NOT (\IP.BROADCAST.ADDRESS (fetch (IP IPDESTINATIONADDRESS) of IP))))
(\ICMP.DEST.UNREACHABLE IP \ICMP.PORT.UNREACHABLE))
(T (\RELEASE.ETHERPACKET IP)))))
(\IP.ADD.PROTOCOL
(LAMBDA (PROTOCOL SOCKETCOMPAREFN NOSOCKETFN INPUTFN ICMPFN)
(* ejs: " 3-Jun-85 02:29")
(* * Find an existing protocol, or create a new one, and return the socket chain head)
(CAR (OR (SOME \IP.PROTOCOLS (FUNCTION (LAMBDA (SOCKET)
(EQ (fetch (IPSOCKET PROTOCOL) of SOCKET)
PROTOCOL))))
(push \IP.PROTOCOLS (create IPSOCKET
PROTOCOL ← PROTOCOL
IPSDESTSOCKETCOMPAREFN ← SOCKETCOMPAREFN
IPSINPUTFN ←(OR INPUTFN (FUNCTION \IP.DEFAULT.INPUTFN))
IPSNOSOCKETFN ←(OR NOSOCKETFN (FUNCTION
\IP.DEFAULT.NOSOCKETFN))
IPSICMPFN ←(OR ICMPFN (FUNCTION \RELEASE.ETHERPACKET))))))))
(\IP.DELETE.PROTOCOL
(LAMBDA (PROTOCOL) (* ejs: "10-Apr-85 16:24")
(LET ((PROTOCOLCHAIN (\IP.FIND.PROTOCOL PROTOCOL)))
(COND
(PROTOCOLCHAIN (until (NULL (fetch (IPSOCKET IPSLINK) of PROTOCOLCHAIN))
do (\IP.CLOSE.SOCKET (fetch (IPSOCKET IPSOCKET) of (fetch (IPSOCKET IPSLINK)
of PROTOCOLCHAIN))
PROTOCOL))
(SETQ \IP.PROTOCOLS (DREMOVE PROTOCOLCHAIN \IP.PROTOCOLS))
T)))))
(\IP.FIND.PROTOCOL
(LAMBDA (PROTOCOL) (* ejs: "27-Dec-84 11:18")
(* * Find the protocol chain for this protocol#)
(CAR (SOME \IP.PROTOCOLS (FUNCTION (LAMBDA (IPSOCKET)
(EQ (ffetch (IPSOCKET PROTOCOL) of IPSOCKET)
PROTOCOL)))))))
(\IP.FIND.PROTOCOL.SOCKET
(LAMBDA (IP PROTOCOLCHAIN) (* ejs: "28-Dec-84 19:54")
(OR PROTOCOLCHAIN (SETQ PROTOCOLCHAIN (\IP.FIND.PROTOCOL (ffetch (IP IPPROTOCOL) of IP))))
(bind RESULT while PROTOCOLCHAIN do (COND
((SETQ RESULT (APPLY* (ffetch (IPSOCKET
IPSDESTSOCKETCOMPAREFN)
of PROTOCOLCHAIN)
IP PROTOCOLCHAIN))
(RETURN (COND
((NEQ RESULT T)
RESULT)
(T PROTOCOLCHAIN))))
(T (SETQ PROTOCOLCHAIN (ffetch (IPSOCKET IPSLINK)
of PROTOCOLCHAIN)))))))
(\IP.FIND.SOCKET
(LAMBDA (SOCKET# SOCKETCHAIN) (* ejs: "27-Dec-84 11:39")
(* * Called to find the socket open on the socketchain, or NIL if no such open socket. Socketchain comes from
\IP.FIND.PROTOCOL)
(while SOCKETCHAIN until (COND
((EQUAL SOCKET# (ffetch (IPSOCKET IPSOCKET) of SOCKETCHAIN))
SOCKETCHAIN)
(T (SETQ SOCKETCHAIN (ffetch (IPSOCKET IPSLINK) of SOCKETCHAIN))
NIL))
finally (RETURN SOCKETCHAIN))))
(\IP.OPEN.SOCKET
(LAMBDA (PROTOCOL SOCKET NOERRORFLG DESTSOCKETCOMPAREFN NOSOCKETFN INPUTFN)
(* ejs: "27-Dec-84 11:28")
(* * Open a new socket for a protocol. The last three fns default to those specified when the protocol was enabled)
(PROG ((MasterSocket (\IP.FIND.PROTOCOL PROTOCOL))
OldSocket NewSocket)
(RETURN (COND
((type? IPSOCKET MasterSocket)
(COND
((SETQ OldSocket (\IP.FIND.SOCKET SOCKET MasterSocket))
(COND
(NOERRORFLG OldSocket)
(T (ERROR "Attempt to open an existing socket" OldSocket))))
(T (SETQ NewSocket (create IPSOCKET
IPSLINK ←(fetch (IPSOCKET IPSLINK) of MasterSocket)
IPSOCKET ← SOCKET
PROTOCOL ← PROTOCOL
IPSDESTSOCKETCOMPAREFN ←(OR DESTSOCKETCOMPAREFN
(fetch (IPSOCKET
IPSDESTSOCKETCOMPAREFN)
of MasterSocket))
IPSNOSOCKETFN ←(OR NOSOCKETFN (fetch (IPSOCKET
IPSNOSOCKETFN)
of MasterSocket))
IPSINPUTFN ←(OR INPUTFN (fetch (IPSOCKET
IPSINPUTFN)
of MasterSocket))))
(replace (IPSOCKET IPSLINK) of MasterSocket with NewSocket)
NewSocket))))))))
(\IP.CLOSE.SOCKET
(LAMBDA (SOCKET PROTOCOL NOERRORFLG) (* ejs: " 3-Feb-85 22:57")
(* * Close the given socket. SOCKETCHAIN defaults as necessary. Call this only after the higher level protocol has
finished doing its closing operations)
(bind (SOCKETCHAIN ←(\IP.FIND.PROTOCOL PROTOCOL)) while SOCKETCHAIN
do (COND
((AND (fetch (IPSOCKET IPSLINK) of SOCKETCHAIN)
(EQ SOCKET (fetch (IPSOCKET IPSOCKET) of (fetch (IPSOCKET IPSLINK) of SOCKETCHAIN)))
)
(replace (IPSOCKET IPSLINK) of SOCKETCHAIN with (fetch (IPSOCKET IPSLINK)
of (fetch (IPSOCKET IPSLINK)
of SOCKETCHAIN)))
(RETURN))
(T (SETQ SOCKETCHAIN (fetch (IPSOCKET IPSLINK) of SOCKETCHAIN))))
finally (COND
((AND (NOT SOCKETCHAIN)
(NOT NOERRORFLG))
(ERROR "Socket not found" SOCKET))))))
)
(* * Fragmentation Handling)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
[DECLARE: EVAL@COMPILE
(RECORD AssemblyRecord (Packet FirstHole Fragments Timeout)
Packet ←(\ALLOCATE.ETHERPACKET)
FirstHole ← 0)
(RECORD FragmentRecord (Start Length LastFragment))
(RECORD FragmentID (AssemblyRecord SourceAddress ID Protocol . DestinationAddress))
]
(* END EXPORTED DEFINITIONS)
)
(RPAQ? \IP.FRAGMENT.LIST )
(RPAQ? \IP.FRAGMENT.LOCK (CREATE.MONITORLOCK "IP Fragment Processing Lock"))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \IP.FRAGMENT.LIST \IP.FRAGMENT.LOCK)
)
(DECLARE: EVAL@COMPILE
(RPAQQ \IP.FRAGMENTATION.UNIT 8)
(CONSTANTS (\IP.FRAGMENTATION.UNIT 8))
)
(DEFINEQ
(\HANDLE.RAW.IP.FRAGMENT
(LAMBDA (IP) (* ejs: " 1-Feb-86 14:24")
(* * Add the next fragment to a packet under assembly. If this fragment completes a packet, return the completed
packet to be processed by higher-level protocol routines.)
(WITH.MONITOR \IP.FRAGMENT.LOCK (LET ((AssemblyRecord (\IP.FIND.MATCHING.FRAGMENTS IP)))
(COND
(AssemblyRecord (\IP.ADD.FRAGMENT AssemblyRecord IP))
(T (\IP.NEW.FRAGMENT.LST IP)
NIL))))))
(\IP.NEW.FRAGMENT.LST
(LAMBDA (IP) (* ejs: " 3-Feb-86 10:57")
(* * Add a new fragment to the fragment list)
(PROG ((Source (ffetch (IP IPSOURCEADDRESS) of IP))
(Dest (ffetch (IP IPDESTINATIONADDRESS) of IP))
(Protocol (ffetch (IP IPPROTOCOL) of IP))
(ID (ffetch (IP IPID) of IP))
NewFragmentID FragmentRecord AssemblyPacket AssemblyRecord)
(SETQ NewFragmentID
(create FragmentID
SourceAddress ← Source
ID ← ID
Protocol ← Protocol
DestinationAddress ← Dest
AssemblyRecord ←(SETQ AssemblyRecord
(create AssemblyRecord
Timeout ←(SETUPTIMER (ITIMES 1000 (ffetch (IP IPTIMETOLIVE)
of IP)))
Fragments ←(LIST (SETQ FragmentRecord
(create FragmentRecord
Start ←(UNFOLD
(ffetch (IP IPFRAGMENTOFFSET)
of IP)
\IP.FRAGMENTATION.UNIT)
Length ←(IDIFFERENCE
(ffetch (IP IPTOTALLENGTH)
of IP)
(UNFOLD (ffetch (IP
IPHEADERLENGTH)
of IP)
BYTESPERCELL)))))))))
(COND
((EQ IPTRACEFLG T)
(\IP.PRINT.FRAGMENT NewFragmentID IP IPTRACEFILE)))
(SETQ AssemblyPacket (fetch (AssemblyRecord Packet) of AssemblyRecord))
(\IP.COPY.FRAGMENT.HEADER.TO.PACKET.HEADER AssemblyPacket IP)
(* * Copy the packet data to the packet)
(\BLT (\ADDBASE (\IPDATABASE AssemblyPacket)
(FOLDLO (fetch (FragmentRecord Start) of FragmentRecord)
BYTESPERWORD))
(\IPDATABASE IP)
(FOLDLO (fetch (FragmentRecord Length) of FragmentRecord)
BYTESPERWORD))
(\RELEASE.ETHERPACKET IP)
(push \IP.FRAGMENT.LIST NewFragmentID))))
(\IP.COPY.FRAGMENT.HEADER.TO.PACKET.HEADER
(LAMBDA (Packet Fragment) (* ejs: " 1-Feb-86 14:14")
(* * Copy information from the header of the fragment packet into the header of the reassembled packet)
(\MOVEBYTES (fetch (IP IPBASE) of Fragment)
0
(fetch (IP IPBASE) of Packet)
0
(UNFOLD (fetch (IP IPHEADERLENGTH) of Fragment)
BYTESPERCELL))))
(\IP.ADD.FRAGMENT
(LAMBDA (FragmentID NewIP) (* ejs: " 1-Feb-86 18:41")
(* * Called to add a fragment to a fragment list. The fragment is added in order. If the fragment completes a
fragmented IP packet, a new packet is assembled and returned, else NIL is returned)
(LET* ((AssemblyRecord (fetch (FragmentID AssemblyRecord) of FragmentID))
(NewFrag (create FragmentRecord
Start ←(UNFOLD (ffetch (IP IPFRAGMENTOFFSET) of NewIP)
\IP.FRAGMENTATION.UNIT)
Length ←(IDIFFERENCE (ffetch (IP IPTOTALLENGTH) of NewIP)
(UNFOLD (ffetch (IP IPHEADERLENGTH)
of NewIP)
BYTESPERCELL))
LastFragment ←(NOT (fetch (IP IPMOREFRAGMENTS) of NewIP))))
(Fragments (fetch (AssemblyRecord Fragments) of AssemblyRecord))
Status NextHole AssemblyPacket)
(COND
((EQ IPTRACEFLG T)
(\IP.PRINT.FRAGMENT FragmentID NewIP IPTRACEFILE)))
(SETQ AssemblyPacket (fetch (AssemblyRecord Packet) of AssemblyRecord))
(replace (AssemblyRecord Timeout) of AssemblyRecord
with (SETUPTIMER (ITIMES 1000 (ffetch (IP IPTIMETOLIVE) of NewIP))
(fetch (AssemblyRecord Timeout) of AssemblyRecord)))
(SETQ Status (COND
((ILESSP (fetch (FragmentRecord Start) of NewFrag)
(fetch (FragmentRecord Start) of (CAR Fragments)))
(* Earlier than the earliest existing fragment)
(SETQ Fragments (push (fetch (AssemblyRecord Fragments) of AssemblyRecord)
NewFrag))
(QUOTE INSERTED.FRAGMENT))
((EQ (fetch (FragmentRecord Start) of NewFrag)
(fetch (FragmentRecord Start) of (CAR Fragments)))
(* Duplicate of earliest fragment)
(QUOTE DUPLICATE))
(T (* Have to search)
(for OldFragTail on Fragments while (CDR OldFragTail)
thereis (COND
((EQ (fetch (FragmentRecord Start) of NewFrag)
(fetch (FragmentRecord Start) of (CADR OldFragTail)))
(* Duplicate)
(SETQ Status (QUOTE DUPLICATE))
T)
((ILESSP (fetch (FragmentRecord Start) of NewFrag)
(fetch (FragmentRecord Start) of (CADR OldFragTail)))
(* Found the hole to insert)
T))
finally (COND
(Status (* Duplicate)
(RETURN Status))
((CDR OldFragTail) (* Inserted in middle of list)
(RPLACD OldFragTail (CONS NewFrag (CDR OldFragTail)))
(RETURN (QUOTE INSERTED.FRAGMENT)))
(T (* Inserted at end of list)
(NCONC1 OldFragTail NewFrag)
(RETURN (QUOTE INSERTED.FRAGMENT))))))))
(PROG1 (SELECTQ
Status
(DUPLICATE NIL)
(INSERTED.FRAGMENT (* Copy bytes into assembly)
(\MOVEBYTES (\IPDATABASE NewIP)
0
(\IPDATABASE AssemblyPacket)
(fetch (FragmentRecord Start) of NewFrag)
(fetch (FragmentRecord Length) of NewFrag))
(add (ffetch (IP IPTOTALLENGTH) of AssemblyPacket)
(fetch (FragmentRecord Length) of NewFrag))
(* Update Assembly record)
(COND
((ILESSP (fetch (FragmentRecord Start) of NewFrag)
(fetch (AssemblyRecord FirstHole) of AssemblyRecord))
(ERROR "Error in IP fragment reassembly!" NewFrag))
(T (COND
((EQ (bind End Status for FragTail on Fragments
while (CDR FragTail)
thereis (COND
((NEQ (SETQ End (IPLUS (fetch
(FragmentRecord
Start)
of
(CAR FragTail))
(fetch
(FragmentRecord
Length)
of
(CAR FragTail))
))
(fetch (FragmentRecord Start)
of (CADR FragTail)))
(replace (AssemblyRecord FirstHole)
of AssemblyRecord with End)
(SETQ Status (QUOTE FOUND.HOLE))))
finally (RETURN (COND
((NULL Status)
(COND
((fetch (FragmentRecord
LastFragment)
of (CAR FragTail))
(COND
((EQ IPTRACEFLG T)
(printout IPTRACEFILE T
"Complete IP Fragment received"
T)))
(QUOTE COMPLETE.PACKET))
(T (replace (AssemblyRecord
FirstHole)
of AssemblyRecord
with End)
(QUOTE INCOMPLETE.BUT.NO.HOLES)
)))
(T Status))))
(QUOTE COMPLETE.PACKET))
(\IP.DELETE.FRAGMENT FragmentID)
AssemblyPacket)))))
NIL)
(\RELEASE.ETHERPACKET NewIP)))))
(\IP.FIND.MATCHING.FRAGMENTS
(LAMBDA (IP) (* ejs: " 1-Feb-86 14:41")
(* * Find the list of fragments matching this IP packet, or NIL if none exists)
(DECLARE (GLOBALVARS \IP.FRAGMENT.LIST))
(LET* ((Source (ffetch (IP IPSOURCEADDRESS) of IP))
(Dest (ffetch (IP IPDESTINATIONADDRESS) of IP))
(Protocol (ffetch (IP IPPROTOCOL) of IP))
(ID (ffetch (IP IPID) of IP))
(FragmentEntry))
(for FragmentID in \IP.FRAGMENT.LIST thereis (AND (EQP (fetch (FragmentID
SourceAddress)
of FragmentID)
Source)
(EQ (fetch (FragmentID ID)
of FragmentID)
ID)
(EQ (fetch (FragmentID
Protocol)
of FragmentID)
Protocol)
(EQP (fetch (FragmentID
DestinationAddress)
of FragmentID)
Dest))))))
(\IP.FRAGMENTED.PACKET
(LAMBDA (IP) (* ejs: " 1-Feb-86 16:50")
(* * Return T if IP packet is a fragment)
(OR (ffetch (IP IPMOREFRAGMENTS) of IP)
(NEQ 0 (ffetch (IP IPFRAGMENTOFFSET) of IP)))))
(\IP.CHECK.REASSEMBLY.TIMEOUTS
(LAMBDA NIL (* ejs: " 3-Feb-86 11:00")
(* * Kill any fragments in the process of reassembly if their timeout has expired. Report timeout via ICMP)
(WITH.MONITOR \IP.FRAGMENT.LOCK (bind AssemblyRecord for Fragment in \IP.FRAGMENT.LIST
when (TIMEREXPIRED? (fetch (AssemblyRecord Timeout)
of (SETQ AssemblyRecord
(fetch (FragmentID
AssemblyRecord)
of Fragment))))
do (COND
((EQ IPTRACEFLG T)
(printout IPTRACEFILE T "IP Fragment timeout expired"
T)))
(\ICMP.TIME.EXCEEDED (fetch (AssemblyRecord Packet)
of AssemblyRecord)
\ICMP.FRAGMENT.TIME.EXCEEDED)
(\IP.DELETE.FRAGMENT Fragment T)))))
(\IP.DELETE.FRAGMENT
(LAMBDA (FragmentID FreePacketToo) (* ejs: " 3-Feb-86 10:59")
(* * Delete FragmentID from the list of Fragment ID's)
(PROG ((IP (fetch (AssemblyRecord Packet) of (fetch (FragmentID AssemblyRecord)
of FragmentID))))
(SETQ \IP.FRAGMENT.LIST (DREMOVE FragmentID \IP.FRAGMENT.LIST))
(AND FreePacketToo (\RELEASE.ETHERPACKET IP)))))
(\IP.PRINT.FRAGMENT
(LAMBDA (FragmentID IPFragment File) (* ejs: " 2-Feb-86 10:39")
(* * Print information about this fragement to File)
(printout File T "Received IP Fragment:" T "Source " (\IP.ADDRESS.TO.STRING
(fetch (FragmentID SourceAddress) of FragmentID))
" Dest "
(\IP.ADDRESS.TO.STRING (fetch (FragmentID DestinationAddress) of FragmentID))
T "Protocol ")
(PRINTCONSTANT (fetch (FragmentID Protocol) of FragmentID)
IPPROTOCOLTYPES File)
(printout File " ID " (fetch (FragmentID ID) of FragmentID)
T "Covering [" (UNFOLD (ffetch (IP IPFRAGMENTOFFSET) of IPFragment)
\IP.FRAGMENTATION.UNIT)
".."
(IPLUS (UNFOLD (ffetch (IP IPFRAGMENTOFFSET) of IPFragment)
\IP.FRAGMENTATION.UNIT)
(IDIFFERENCE (ffetch (IP IPTOTALLENGTH) of IPFragment)
(UNFOLD (ffetch (IP IPHEADERLENGTH) of IPFragment)
BYTESPERCELL)))
"]" T)
(bind C for I from 0 to (SUB1 (IMIN 40 (IDIFFERENCE (ffetch (IP IPTOTALLENGTH)
of IPFragment)
(UNFOLD (ffetch (IP
IPHEADERLENGTH)
of IPFragment)
BYTESPERCELL))))
do (SETQ C (\GETBASEBYTE (\IPDATABASE IPFragment)
I))
(COND
((AND (IGEQ C (CHARCODE SPACE))
(ILEQ C 126))
(BOUT File C))
(T (printout File "[" C "]"))))))
)
(* * Option Processing)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
(RPAQQ IPOPTIONTYPES ((IPOPT.END 0)
(IPOPT.NOP 1)
(IPOPT.SECURITY 2)
(IPOPT.LSRR 3)
(IPOPT.TIMESTAMP 4)
(IPOPT.RECRT 7)
(IPOPT.STREAMID 8)
(IPOPT.SSSR 9)))
(DECLARE: EVAL@COMPILE
(RPAQQ IPOPT.END 0)
(RPAQQ IPOPT.NOP 1)
(RPAQQ IPOPT.SECURITY 2)
(RPAQQ IPOPT.LSRR 3)
(RPAQQ IPOPT.TIMESTAMP 4)
(RPAQQ IPOPT.RECRT 7)
(RPAQQ IPOPT.STREAMID 8)
(RPAQQ IPOPT.SSSR 9)
(CONSTANTS (IPOPT.END 0)
(IPOPT.NOP 1)
(IPOPT.SECURITY 2)
(IPOPT.LSRR 3)
(IPOPT.TIMESTAMP 4)
(IPOPT.RECRT 7)
(IPOPT.STREAMID 8)
(IPOPT.SSSR 9))
)
(DECLARE: EVAL@COMPILE
(RPAQ IP.OPTION.NUMBER.BYTESPEC (BYTE 5 0))
(CONSTANTS (IP.OPTION.NUMBER.BYTESPEC (BYTE 5 0)))
)
(* END EXPORTED DEFINITIONS)
)
(DEFINEQ
(\IP.PROCESS.OPTIONS
(LAMBDA (IP) (* ejs: "28-Dec-84 19:48")
(* * Process option fields in IP header. Return T if OK, else handle internally needed actions like redirection or
reporting of parameter problems)
(PROG ((OPTIONSSTART (LOCF (ffetch (IP IPOPTIONSSTART) of IP)))
(INDEX 0)
(RESULT T)
REROUTING OPTION)
(while (NOT (NUMBERP RESULT)) until (EQ INDEX (IDIFFERENCE (UNFOLD (fetch (IP
IPHEADERLENGTH)
of IP)
BYTESPERCELL)
\IPOVLEN))
do (SELECTC (SETQ OPTION (LDB (BYTE 5 0)
(\GETBASEBYTE OPTIONSSTART INDEX)))
(IPOPT.END (GO $$OUT))
(IPOPT.NOP (add INDEX 1))
(IPOPT.SECURITY (add INDEX 1))
(IPOPT.LSRR (COND
(REROUTING (SETQ RESULT INDEX))
((EQ (SETQ RESULT (\IP.OPTION.STRICT.SOURCE.ROUTE IP INDEX))
(QUOTE REROUTE))
(SETQ REROUTING T)
(add INDEX (\GETBASEBYTE OPTIONSSTART (ADD1 INDEX))))))
(IPOPT.SSSR (COND
(REROUTING (SETQ RESULT INDEX))
((EQ (SETQ RESULT (\IP.OPTION.STRICT.SOURCE.ROUTE IP INDEX))
(QUOTE REROUTE))
(SETQ REROUTING T)
(add INDEX (\GETBASEBYTE OPTIONSSTART (ADD1 INDEX))))))
(IPOPT.RECRT (SETQ RESULT (\IP.OPTION.RECORD.ROUTE IP INDEX))
(add INDEX (\GETBASEBYTE OPTIONSSTART (ADD1 INDEX))))
(IPOPT.STREAMID (add INDEX 1))
(IPOPT.TIMESTAMP (\IP.OPTION.TIMESTAMP IP INDEX)
(add INDEX (\GETBASEBYTE OPTIONSSTART (ADD1 INDEX))))
(ERROR "Unknown option code" OPTION)))
(RETURN (COND
((NUMBERP RESULT)
(\ICMP.PARAMETER.PROBLEM IP (IPLUS \IPOVLEN RESULT))
NIL)
(T RESULT))))))
)
(* * Packet Transmission and routing)
(RPAQ? \IP.ROUTING.TABLE (CONS))
(RPAQ? \IP.DEFAULT.GATEWAY )
(RPAQ? \IP.LOCAL.NETWORKS )
(RPAQ? \IP.GATEWAY.FORWARDING.FUNCTIONS )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \IP.ROUTING.TABLE \IP.DEFAULT.GATEWAY \IP.LOCAL.NETWORKS \IP.GATEWAY.FORWARDING.FUNCTIONS)
)
(DEFINEQ
(\IP.SETUPIP
(LAMBDA (IP DESTHOST ID SOCKET REQUEUE) (* ejs: " 1-Feb-86 16:49")
(* * Initialize IP header of packet. REQUEUE defaults to FREE)
(replace (IP IPVERSION) of IP with \IP.PROTOCOLVERSION)
(replace (IP IPHEADERLENGTH) of IP with (FOLDHI \IPOVLEN BYTESPERCELL))
(replace (IP IPTOTALLENGTH) of IP with \IPOVLEN)
(replace (IP IPID) of IP with (OR (SMALLP ID)
(LOGAND (DAYTIME)
(MASK.1'S 0 16))))
(replace (IP IPMOREFRAGMENTS) of IP with NIL)
(replace (IP IPFRAGMENTOFFSET) of IP with 0)
(replace (IP IPTIMETOLIVE) of IP with \IP.DEFAULT.TIME.TO.LIVE)
(replace (IP IPPROTOCOL) of IP with (fetch (IPSOCKET PROTOCOL) of SOCKET))
(replace (IP IPSOURCEADDRESS) of IP with (CAR \IP.LOCAL.ADDRESSES))
(replace (IP IPDESTINATIONADDRESS) of IP with DESTHOST)
(replace EPREQUEUE of IP with (OR REQUEUE (QUOTE FREE)))
IP))
(\IP.TRANSMIT
(LAMBDA (IP ROUTINGREADONLY) (* ejs: "27-Jan-86 15:59")
(* * Sends an IP packet, after first computing the IP header checksum)
(PROG (NDB)
(SETQ IP (\DTEST IP (QUOTE ETHERPACKET)))
(until \IP.READY do (AWAIT.EVENT \IP.READY.EVENT))
(\RCLK (LOCF (ffetch EPTIMESTAMP of IP)))
(replace EPTYPE of IP with \EPT.IP)
(RETURN (COND
((ffetch EPTRANSMITTING of IP)
(AND IPTRACEFLG (printout IPTRACEFILE
"[Put fails--packet already being transmitted]"))
(QUOTE AlreadyQueued))
((NOT (SETQ NDB (\IP.ROUTE.PACKET IP ROUTINGREADONLY)))
(AND IPTRACEFLG (PRINTPACKET IP (QUOTE PUT)
IPTRACEFILE "[Put fails--no routing]"))
(\REQUEUE.ETHERPACKET IP)
(QUOTE NoRouting))
(T (\IP.SET.CHECKSUM IP (ffetch (IP IPBASE) of IP)
(LLSH (ffetch (IP IPHEADERLENGTH) of IP)
2)
(LOCF (ffetch (IP IPHEADERCHECKSUM) of IP)))
(COND
(IPTRACEFLG (COND
((EQ IPTRACEFLG T)
(PRINTPACKET IP (QUOTE PUT)
IPTRACEFILE))
(T (PRIN1 "!" IPTRACEFILE)))))
(TRANSMIT.ETHERPACKET NDB IP)
NIL))))))
(\IP.ROUTE.PACKET
(LAMBDA (IP READONLY) (* ejs: "19-Aug-85 11:25")
(* Encapsulates XIP, choosing the right network and immediate destination host. Returns an NDB for the transmission.
Unless READONLY is true, defaults source and destination nets if needed)
(DECLARE (GLOBALVARS \10MBLOCALNDB \3MBLOCALNDB \IP.LOCAL.NETWORKS \IP.DEFAULT.GATEWAY))
(PROG ((DESTADDRESS (fetch (IP IPDESTINATIONADDRESS) of IP))
DESTNET SUBNETMASK SOURCEHOSTADDRESS SUBNETINUSE PDH ROUTE NDB EPTYPE)
(SETQ DESTNET (\IPNETADDRESS DESTADDRESS))
(* * Try to resolve a destination network of 0.0 If we have two attached networks, fail.)
(COND
((AND (EQ 0 DESTADDRESS)
\10MBLOCALNDB \3MBLOCALNDB)
(RETURN))
((EQ 0 DESTADDRESS)
(SETQ DESTADDRESS (\IP.MAKE.BROADCAST.ADDRESS (fetch NDBIPHOST#
of (OR \10MBLOCALNDB \3MBLOCALNDB))))
(SETQ DESTNET (\IPNETADDRESS DESTADDRESS))))
(* * First see if the destination network is one of our local networks)
(COND
((AND (SETQ NDB (CDR (SASSOC DESTNET \IP.LOCAL.NETWORKS)))
(SETQ SUBNETMASK (CDR (SASSOC (SETQ SOURCEHOSTADDRESS (fetch (NDB NDBIPHOST#)
of NDB))
\IP.SUBNET.MASKS)))
(OR (EQP (LOGAND SOURCEHOSTADDRESS SUBNETMASK)
(LOGAND DESTADDRESS SUBNETMASK))
(PROGN (SETQ SUBNETINUSE T)
NIL)))
(* * A local net. Try to find the Ethernet address of the host)
(COND
((SETQ PDH (SELECTQ (fetch (NDB NETTYPE) of NDB)
(10 (SETQ EPTYPE \EPT.IP)
(\AR.TRANSLATE.TO.10MB DESTADDRESS))
(3 (SETQ EPTYPE \EET.IP)
(\AR.TRANSLATE.TO.3MB DESTADDRESS))
(SHOULDNT))))
(T (* Nope)
(RETURN))))
(T
(* * The host is not on a local net. See if we have a route to that host, or use the default route if necessary)
(COND
((SETQ ROUTE (OR (COND
(SUBNETINUSE (CDR (SASSOC (LOGAND DESTADDRESS SUBNETMASK)
\IP.ROUTING.TABLE)))
(T (CDR (SASSOC DESTNET \IP.ROUTING.TABLE))))
\IP.DEFAULT.GATEWAY))
(* * We've got the IP address of the gateway)
(COND
((SETQ NDB (CDR (SASSOC (\IPNETADDRESS ROUTE)
\IP.LOCAL.NETWORKS)))
(* * We know what network it's on)
(COND
((SETQ PDH (SELECTQ (fetch (NDB NETTYPE) of NDB)
(10 (SETQ EPTYPE \EPT.IP)
(\AR.TRANSLATE.TO.10MB ROUTE))
(3 (SETQ EPTYPE \EET.IP)
(\AR.TRANSLATE.TO.3MB ROUTE))
(SHOULDNT))))
(T (RETURN))))
(T (ERROR "IP routing table contains non-local gateway address for network"
DESTNET))))
(T (RETURN)))))
(freplace EPNETWORK of IP with NDB)
(ENCAPSULATE.ETHERPACKET NDB IP PDH (ffetch (IP IPTOTALLENGTH) of IP)
EPTYPE)
(replace EPTYPE of IP with EPTYPE)
(COND
((NOT READONLY)
(COND
((EQ 0 (fetch (IP IPDESTINATIONADDRESS) of IP))
(freplace (IP IPDESTINATIONADDRESS) of IP with DESTADDRESS)))
(freplace (IP IPSOURCEADDRESS) of IP with (fetch NDBIPHOST# of NDB))))
(RETURN NDB))))
)
(* * Client functions for building packets)
(DEFINEQ
(\IP.APPEND.BYTE
(LAMBDA (IP BYTE INHEADER) (* ejs: "28-Dec-84 08:23")
(* * Append a byte to an IP packet. If INHEADER is not NIL, we adjust the header length field as well.)
(PROG (NEWLENGTH)
(\PUTBASEBYTE (fetch (IP IPBASE) of IP)
(fetch (IP IPTOTALLENGTH) of IP)
BYTE)
(SETQ NEWLENGTH (add (ffetch (IP IPTOTALLENGTH) of IP)
1))
(COND
(INHEADER (freplace (IP IPHEADERLENGTH) of IP with (FOLDHI NEWLENGTH 4))))
(RETURN NEWLENGTH))))
(\IP.APPEND.CELL
(LAMBDA (IP CELL INHEADER) (* ejs: "28-Dec-84 08:33")
(* * Append a cell to an IP packet. If INHEADER is not NIL, we adjust the header length field as well.)
(PROG (NEWLENGTH (OFFSET (fetch (IP IPTOTALLENGTH) of IP)))
(COND
((EVENP OFFSET)
(\PUTBASEFIXP (fetch (IP IPBASE) of IP)
(FOLDLO OFFSET 2)
CELL))
(T (\PUTBASEBYTE (fetch (IP IPBASE) of IP)
OFFSET
(LDB (BYTE 8 24)
CELL))
(\PUTBASEBYTE (fetch (IP IPBASE) of IP)
(\ADDBASE OFFSET 1)
(LDB (BYTE 8 16)
CELL))
(\PUTBASEBYTE (fetch (IP IPBASE) of IP)
(\ADDBASE OFFSET 2)
(LDB (BYTE 8 8)
CELL))
(\PUTBASEBYTE (fetch (IP IPBASE) of IP)
(\ADDBASE OFFSET 3)
(LDB (BYTE 8 0)
CELL))))
(SETQ NEWLENGTH (add (ffetch (IP IPTOTALLENGTH) of IP)
4))
(COND
(INHEADER (add (ffetch (IP IPHEADERLENGTH) of IP)
1)))
(RETURN NEWLENGTH))))
(\IP.APPEND.STRING
(LAMBDA (IP STRING) (* ejs: " 9-Feb-85 19:44")
(PROG ((LENGTH (fetch (STRINGP LENGTH) of STRING)))
(\MOVEBYTES (fetch (STRINGP BASE) of STRING)
(fetch (STRINGP OFFST) of STRING)
(fetch (IP IPBASE) of IP)
(fetch (IP IPTOTALLENGTH) of IP)
LENGTH)
(RETURN (add (ffetch (IP IPTOTALLENGTH) of IP)
LENGTH)))))
(\IP.APPEND.WORD
(LAMBDA (IP WORD INHEADER) (* ejs: "28-Dec-84 08:28")
(* * Append a word to an IP packet. If INHEADER is not NIL, we adjust the header length field as well.)
(PROG (NEWLENGTH (OFFSET (fetch (IP IPTOTALLENGTH) of IP)))
(COND
((EVENP OFFSET)
(\PUTBASE (fetch (IP IPBASE) of IP)
(FOLDLO OFFSET 2)
WORD))
(T (\PUTBASEBYTE (fetch (IP IPBASE) of IP)
OFFSET
(LDB (BYTE 8 8)
WORD))
(\PUTBASEBYTE (fetch (IP IPBASE) of IP)
(\ADDBASE OFFSET 1)
(LDB (BYTE 8 0)
WORD))))
(SETQ NEWLENGTH (add (ffetch (IP IPTOTALLENGTH) of IP)
2))
(COND
(INHEADER (freplace (IP IPHEADERLENGTH) of IP with (FOLDHI NEWLENGTH 4))))
(RETURN NEWLENGTH))))
)
(PUTPROPS \CANONICAL.HOSTNAME READVICE (NIL (AROUND NIL (COND ((NUMBERP NAME)
(IPHOSTNAME NAME))
((IPHOSTADDRESS NAME)
NAME)
(T *)))))
(READVISE \CANONICAL.HOSTNAME)
(PUTPROPS TCPLLIP COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (17899 27174 (DODIP.HOSTP 17909 . 18077) (IPHOSTADDRESS 18079 . 18548) (IPHOSTNAME 18550
. 18773) (IPTRACE 18775 . 19415) (IPTRACEWINDOW.BUTTONFN 19417 . 19818) (PRINTIP 19820 . 21629) (
PRINTIPDATA 21631 . 22277) (\IPADDRESSCLASS 22279 . 22770) (\IPHOSTADDRESS 22772 . 23283) (
\IPNETADDRESS 23285 . 23792) (\IP.ADDRESS.TO.STRING 23794 . 24174) (\IP.BROADCAST.ADDRESS 24176 .
24636) (\IP.LEGAL.ADDRESS 24638 . 25089) (\IP.MAKE.BROADCAST.ADDRESS 25091 . 25475) (\IP.PRINT.ADDRESS
25477 . 25999) (\IP.READ.STRING.ADDRESS 26001 . 27172)) (27538 35900 (STOPIP 27548 . 27864) (\IPINIT
27866 . 35242) (\IPLISTENER 35244 . 35898)) (39408 46291 (\HANDLE.RAW.IP 39418 . 41285) (\FORWARD.IP
41287 . 43016) (\IP.LOCAL.DESTINATION 43018 . 44282) (\IPCHECKSUM 44284 . 45731) (\IP.CHECKSUM.OK
45733 . 45915) (\IP.SET.CHECKSUM 45917 . 46289)) (46798 53847 (\IP.HAND.TO.PROTOCOL 46808 . 47556) (
\IP.DEFAULT.INPUTFN 47558 . 48115) (\IP.DEFAULT.NOSOCKETFN 48117 . 48515) (\IP.ADD.PROTOCOL 48517 .
49317) (\IP.DELETE.PROTOCOL 49319 . 49851) (\IP.FIND.PROTOCOL 49853 . 50190) (\IP.FIND.PROTOCOL.SOCKET
50192 . 50862) (\IP.FIND.SOCKET 50864 . 51424) (\IP.OPEN.SOCKET 51426 . 52836) (\IP.CLOSE.SOCKET
52838 . 53845)) (54574 67336 (\HANDLE.RAW.IP.FRAGMENT 54584 . 55149) (\IP.NEW.FRAGMENT.LST 55151 .
57072) (\IP.COPY.FRAGMENT.HEADER.TO.PACKET.HEADER 57074 . 57529) (\IP.ADD.FRAGMENT 57531 . 63014) (
\IP.FIND.MATCHING.FRAGMENTS 63016 . 64093) (\IP.FRAGMENTED.PACKET 64095 . 64391) (
\IP.CHECK.REASSEMBLY.TIMEOUTS 64393 . 65294) (\IP.DELETE.FRAGMENT 65296 . 65754) (\IP.PRINT.FRAGMENT
65756 . 67334)) (68186 70138 (\IP.PROCESS.OPTIONS 68196 . 70136)) (70475 76607 (\IP.SETUPIP 70485 .
71583) (\IP.TRANSMIT 71585 . 72948) (\IP.ROUTE.PACKET 72950 . 76605)) (76658 79919 (\IP.APPEND.BYTE
76668 . 77285) (\IP.APPEND.CELL 77287 . 78471) (\IP.APPEND.STRING 78473 . 78989) (\IP.APPEND.WORD
78991 . 79917)))))
STOP