(FILECREATED "14-Mar-85 13:34:02" {ERIS}<LISPCORE>LIBRARY>LLIP.;5 63935
changes to: (VARS IPPROTOCOLTYPES)
previous date: " 9-Feb-85 22:38:07" {ERIS}<LISPCORE>LIBRARY>LLIP.;4)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT LLIPCOMS)
(RPAQQ LLIPCOMS ((COMS (* IP definitions and addressing)
(DECLARE: DONTCOPY (EXPORT (RECORDS IP IPSOCKET)
(CONSTANTS \IPOVLEN \MAX.IPDATALENGTH
\IP.PROTOCOLVERSION
\IP.MAX.EPKTS.ON.QUEUE
\IP.DEFAULT.TIME.TO.LIVE
\IP.WAKEUP.INTERVAL)
(CONSTANTS * IPPACKETTYPES)
(MACROS \IPDATABASE \IPDATALENGTH)))
(INITVARS (IPONLYTYPES)
(IPIGNORETYPES)
(IPPRINTMACROS)
(IPTRACEFLG)
(IPTRACEFILE)
(\IP.HTE.FILE)
(\IP.HOSTNAMES (HASHARRAY 40 1.1)))
(INITRECORDS IP IPSOCKET)
(GLOBALVARS IPTRACEFILE IPTRACEFLG IPIGNORETYPES IPONLYTYPES IPPRINTMACROS
\IP.HOSTNAMES \IP.HTE.FILE)
(FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
HTE LLICMP LLAR)
(ADDVARS (\PACKET.PRINTERS (2048 . PRINTIP)))
(FNS DODIP.HOSTP IPHOSTADDRESS PRINTIP PRINTIPDATA \IPADDRESSCLASS
\IPHOSTADDRESS \IPNETADDRESS \IP.ADDRESS.TO.STRING \IP.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))
(COMS (* * Early IP reception functions)
(DECLARE: DONTCOPY (EXPORT (CONSTANTS * IPADDRESSTYPES)))
(INITVARS (\IP.LOCAL.ADDRESSES))
(GLOBALVARS \IP.LOCAL.ADDRESSES)
(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)))
(INITRECORDS AssemblyRecord FragmentRecord)
(INITVARS (\IP.FRAGMENTS)
(\IP.FRAGMENT.NET)
(\IP.FRAGMENT.LOCK (CREATE.MONITORLOCK "IP Fragment Processing Lock")
))
(GLOBALVARS \IP.FRAGMENTS \IP.FRAGMENT.NET \IP.FRAGMENT.LOCK)
(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))
(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)
[DECLARE: DONTCOPY (EXPORT (CONSTANTS (\RT.INFINITY 16]
(INITVARS (\IP.ROUTING.TABLE (CONS)))
(GLOBALVARS \IP.ROUTING.TABLE)
(FNS \IP.SETUPIP \IP.TRANSMIT \IP.ROUTE.PACKET \IP.LOCATE.NET))
(COMS (* * Client functions for building packets)
(FNS \IP.APPEND.BYTE \IP.APPEND.CELL \IP.APPEND.STRING \IP.APPEND.WORD))))
(* 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 BITS 1) (* Don't fragment me)
(IPMOREFRAGMENTS BITS 1) (* 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 ([IPDESTINATIONNET (COND
((EQ \IP.CLASS.A
(LDB
\IP.CLASS.A.BYTESPEC
DATUM))
(LDB
\IP.CLASS.A.NET.BYTESPEC
DATUM))
((EQ \IP.CLASS.B
(LDB
\IP.CLASS.B.BYTESPEC
DATUM))
(LDB
\IP.CLASS.B.NET.BYTESPEC
DATUM))
((EQ \IP.CLASS.C
(LDB
\IP.CLASS.C.BYTESPEC
DATUM))
(LDB
\IP.CLASS.C.NET.BYTESPEC
DATUM))
(T (ERROR
"Illegal address class"
DATUM)))
(COND
((EQ \IP.CLASS.A
(LDB
\IP.CLASS.A.BYTESPEC
DATUM))
(DPB NEWVALUE
\IP.CLASS.A.NET.BYTESPEC
DATUM))
((EQ \IP.CLASS.B
(LDB
\IP.CLASS.B.BYTESPEC
DATUM))
(DPB NEWVALUE
\IP.CLASS.B.NET.BYTESPEC
DATUM))
((EQ \IP.CLASS.C
(LDB
\IP.CLASS.C.BYTESPEC
DATUM))
(DPB NEWVALUE
\IP.CLASS.C.NET.BYTESPEC
DATUM))
(T (ERROR
"Illegal address class"
DATUM]
(IPDESTINATIONHOST (COND
((EQ \IP.CLASS.A (LDB
\IP.CLASS.A.BYTESPEC
DATUM))
(LDB \IP.CLASS.A.HOST.BYTESPEC DATUM))
((EQ \IP.CLASS.B (LDB
\IP.CLASS.B.BYTESPEC
DATUM))
(LDB \IP.CLASS.B.HOST.BYTESPEC DATUM))
((EQ \IP.CLASS.C (LDB
\IP.CLASS.C.BYTESPEC
DATUM))
(LDB \IP.CLASS.C.HOST.BYTESPEC DATUM))
(T (ERROR "Illegal address class" DATUM)))
(COND
((EQ \IP.CLASS.A (LDB
\IP.CLASS.A.BYTESPEC
DATUM))
(DPB NEWVALUE \IP.CLASS.A.HOST.BYTESPEC
DATUM))
((EQ \IP.CLASS.B (LDB
\IP.CLASS.B.BYTESPEC
DATUM))
(DPB NEWVALUE \IP.CLASS.B.HOST.BYTESPEC
DATUM))
((EQ \IP.CLASS.C (LDB
\IP.CLASS.C.BYTESPEC
DATUM))
(DPB NEWVALUE \IP.CLASS.C.HOST.BYTESPEC
DATUM))
(T (ERROR "Illegal address class" DATUM]
(ACCESSFNS IPSOURCEADDRESS ([IPSOURCENET (COND
((EQ \IP.CLASS.A
(LDB \IP.CLASS.A.BYTESPEC
DATUM))
(LDB \IP.CLASS.A.NET.BYTESPEC
DATUM))
((EQ \IP.CLASS.B
(LDB \IP.CLASS.B.BYTESPEC
DATUM))
(LDB \IP.CLASS.B.NET.BYTESPEC
DATUM))
((EQ \IP.CLASS.C
(LDB \IP.CLASS.C.BYTESPEC
DATUM))
(LDB \IP.CLASS.C.NET.BYTESPEC
DATUM))
(T (ERROR
"Illegal address class"
DATUM)))
(COND
((EQ \IP.CLASS.A
(LDB \IP.CLASS.A.BYTESPEC
DATUM))
(DPB NEWVALUE
\IP.CLASS.A.NET.BYTESPEC
DATUM))
((EQ \IP.CLASS.B
(LDB \IP.CLASS.B.BYTESPEC
DATUM))
(DPB NEWVALUE
\IP.CLASS.B.NET.BYTESPEC
DATUM))
((EQ \IP.CLASS.C
(LDB \IP.CLASS.C.BYTESPEC
DATUM))
(DPB NEWVALUE
\IP.CLASS.C.NET.BYTESPEC
DATUM))
(T (ERROR
"Illegal address class"
DATUM]
(IPSOURCEHOST (COND
((EQ \IP.CLASS.A (LDB \IP.CLASS.A.BYTESPEC
DATUM))
(LDB \IP.CLASS.A.HOST.BYTESPEC DATUM))
((EQ \IP.CLASS.B (LDB \IP.CLASS.B.BYTESPEC
DATUM))
(LDB \IP.CLASS.B.HOST.BYTESPEC DATUM))
((EQ \IP.CLASS.C (LDB \IP.CLASS.C.BYTESPEC
DATUM))
(LDB \IP.CLASS.C.HOST.BYTESPEC DATUM))
(T (ERROR "Illegal address class" DATUM)))
(COND
((EQ \IP.CLASS.A (LDB \IP.CLASS.A.BYTESPEC
DATUM))
(DPB NEWVALUE \IP.CLASS.A.HOST.BYTESPEC
DATUM))
((EQ \IP.CLASS.B (LDB \IP.CLASS.B.BYTESPEC
DATUM))
(DPB NEWVALUE \IP.CLASS.B.HOST.BYTESPEC
DATUM))
((EQ \IP.CLASS.C (LDB \IP.CLASS.C.BYTESPEC
DATUM))
(DPB NEWVALUE \IP.CLASS.C.HOST.BYTESPEC
DATUM))
(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)
)
IPSQUEUE ←(create SYSQUEUE)
IPSQUEUEALLOC ← \IP.MAX.EPKTS.ON.QUEUE IPSEVENT ←(CREATE.EVENT)
IPSINPUTFN ←(FUNCTION \IP.DEFAULT.INPUTFN))
]
(/DECLAREDATATYPE (QUOTE IPSOCKET)
(QUOTE (BYTE POINTER BYTE POINTER WORD WORD POINTER POINTER POINTER POINTER POINTER)
))
(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))
)
(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.HTE.FILE )
(RPAQ? \IP.HOSTNAMES (HASHARRAY 40 1.1))
(/DECLAREDATATYPE (QUOTE IPSOCKET)
(QUOTE (BYTE POINTER BYTE POINTER WORD WORD POINTER POINTER POINTER POINTER POINTER)
))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS IPTRACEFILE IPTRACEFLG IPIGNORETYPES IPONLYTYPES IPPRINTMACROS \IP.HOSTNAMES \IP.HTE.FILE)
)
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
HTE LLICMP LLAR)
(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: " 9-Feb-85 13:45")
(LET ((ENTRY (GETHASH (U-CASE NAME)
\IP.HOSTNAMES)))
(COND
(ENTRY (CAR (fetch (HOSTS.TXT.ENTRY HTE.ADDRESSES) of ENTRY)))))))
(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: "27-Dec-84 15:54")
(COND
((EQ \IP.CLASS.A (LDB \IP.CLASS.A.BYTESPEC IPADDRESS))
(QUOTE \IP.CLASS.A))
((EQ \IP.CLASS.B (LDB \IP.CLASS.B.BYTESPEC IPADDRESS))
(QUOTE \IP.CLASS.B))
((EQ \IP.CLASS.C (LDB \IP.CLASS.C.BYTESPEC 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: "27-Dec-84 15:04")
(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.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: " 9-Feb-85 16:45")
(* Initialize IP protocol)
(DECLARE (GLOBALVARS (\IP.HTE.FILE)))
(PROG ((PROC (FIND.PROCESS (QUOTE \IPLISTENER)))
(NDB (OR \10MBLOCALNDB \3MBLOCALNDB))
(IPHOSTNAME (U-CASE (MKATOM (ETHERHOSTNAME)))))
(* * This is a kludge until we know more about IP routing and reverse address resolution)
(COND
((NOT \IP.HTE.FILE)
(SETQ \IP.HTE.FILE (OR (FINDFILE (QUOTE HOSTS.TXT)
NIL HOSTS.TEXT.DIRECTORIES)
(MKATOM (PROMPTFORWORD
"Please supply the name of a HOSTS.TXT file, or <CR> to ignore this: "))))
(COND
(\IP.HTE.FILE (\HTE.READ.FILE \IP.HTE.FILE)))))
(COND
((AND IPHOSTNAME (DODIP.HOSTP IPHOSTNAME))
(SETQ \IP.LOCAL.ADDRESSES (LIST (DODIP.HOSTP IPHOSTNAME))))
(T (SETQ \IP.LOCAL.ADDRESSES (LIST (\IP.READ.STRING.ADDRESS (PROMPTFORWORD
"Please enter this machine's IP host address (e.g. 39.9.0.9)"))))
(COND
((NOT IPHOSTNAME)
(SETQ IPHOSTNAME (U-CASE (MKATOM (PROMPTFORWORD
"Please give this machine a name (or <CR> for no name): ")))))
)
(COND
(IPHOSTNAME (PUTHASH IPHOSTNAME (create HOSTS.TXT.ENTRY
HTE.TYPE ←(QUOTE HOST)
HTE.ADDRESSES ← \IP.LOCAL.ADDRESSES
HTE.NAMES ←(LIST IPHOSTNAME)
HTE.MACHINE.TYPE ←(MACHINETYPE)
HTE.OS.TYPE ←(SYSTEMTYPE)
HTE.PROTOCOLS ←(QUOTE ((TCP)
(IP))))
\IP.HOSTNAMES)))))
(COND
(\IP.LOCAL.ADDRESSES (SETQ \IP.ROUTING.TABLE
(COND
((EQ NDB \10MBLOCALNDB)
(CONS NIL (LIST (create ROUTING
RTNET# ←(\IPNETADDRESS (CAR
\IP.LOCAL.ADDRESSES))
RTHOPCOUNT ← 0
RTGATEWAY# ←(CAR \IP.LOCAL.ADDRESSES)
RTNDB ← NDB
RTTIMER ← 0
RTRECENT ← T))))
(T (CONS NIL (for RT in (CDR \PUP.ROUTING.TABLE)
collect (create ROUTING
RTNET# ←(\IPNETADDRESS
(CAR \IP.LOCAL.ADDRESSES))
RTHOPCOUNT ←(fetch (ROUTING
RTHOPCOUNT)
of RT)
RTGATEWAY# ←(COND
((ZEROP (fetch (ROUTING
RTHOPCOUNT)
of RT))
(LOGAND \LOCALPUPNETHOST 255)
)
(T (fetch (ROUTING RTGATEWAY#)
of RT)))
RTNDB ← \3MBLOCALNDB
RTTIMER ←(fetch (ROUTING RTNET#)
of RT)))))))
(replace (NDB NDBIPNET#) of NDB with (\IPNETADDRESS (CAR
\IP.LOCAL.ADDRESSES)))
(replace (NDB NDBIPHOST#) of NDB with (CAR \IP.LOCAL.ADDRESSES))))
(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))))
(\IPLISTENER
[LAMBDA NIL (* ejs: "28-Dec-84 09:39")
(* * IP background process)
(SETQ \IP.WAKEUP.TIMER (SETUPTIMER \IP.WAKEUP.INTERVAL))
(while T
do (AWAIT.EVENT \IP.WAKEUP.EVENT \IP.WAKEUP.INTERVAL)
(\IP.CHECK.REASSEMBLY.TIMEOUTS) (* SETUPTIMER \IP.WAKEUP.INTERVAL \IP.WAKEUP.TIMER)
])
)
(* * 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 14 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 21 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 14 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 21 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 14 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 21 8))
(\IP.CLASS.C.HOST.BYTESPEC (BYTE 8 0)))
)
(* END EXPORTED DEFINITIONS)
)
(RPAQ? \IP.LOCAL.ADDRESSES )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \IP.LOCAL.ADDRESSES)
)
(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 IPDESTINATIONNET) of IP with (ffetch (NDB NDBIPNET#)
of NDB])
(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: "31-Dec-84 13:47")
(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.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 (add (ffetch (IP IPTIMETOLIVE) of IP)
-1))
(\ICMP.TIME.EXCEEDED 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))
(AND IPTRACEFLG (PRINTPACKET IP (QUOTE GET)
IPTRACEFILE NIL T))
(\IP.HAND.TO.PROTOCOL IP))))
(T (AND IPTRACEFLG (PRINTPACKET IP (QUOTE GET)
IPTRACEFILE NIL T))
(\IP.HAND.TO.PROTOCOL IP)))))
(RETURN T))))
(\FORWARD.IP
[LAMBDA (IP) (* ejs: "26-Dec-84 18:06")
(\RELEASE.ETHERPACKET IP])
(\IP.LOCAL.DESTINATION
(LAMBDA (IP) (* ejs: "28-Dec-84 08:14")
(* * Return T if IP packet is destined for us)
(COND
((MEMBER (fetch (IP IPDESTINATIONADDRESS) of IP)
\IP.LOCAL.ADDRESSES)
T)
((ZEROP (ffetch (IP IPDESTINATIONNET) of IP)) (* Source doesn't know its network?)
(\IP.FIX.DEST.NET IP (ffetch (ETHERPACKET EPNETWORK) of IP))
(\IP.LOCAL.DESTINATION IP))
((ZEROP (ffetch (IP IPDESTINATIONHOST) of IP)) (* Broadcast packet?)
(\IP.FIX.DEST.HOST IP (ffetch (ETHERPACKET EPNETWORK) of IP))
(\IP.LOCAL.DESTINATION IP)))))
(\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: "31-Dec-84 13:57")
(PROG ((CHECKSUM (\IPCHECKSUM PACKET CHECKSUMBASE NBYTES CHECKSUMWORD)))
(\PUTBASE CHECKSUMWORD 0 (COND
((EQ CHECKSUM (MASK.1'S 0 16))
CHECKSUM)
(T (BITCLEAR (LOGNOT CHECKSUM)
(MASK.1'S 16 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: " 9-Feb-85 14:22")
(\ICMP.DEST.UNREACHABLE IP \ICMP.PORT.UNREACHABLE)))
(\IP.ADD.PROTOCOL
(LAMBDA (PROTOCOL SOCKETCOMPAREFN NOSOCKETFN INPUTFN) (* ejs: " 9-Feb-85 14:23")
(* * 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))))))))
(\IP.DELETE.PROTOCOL
(LAMBDA (PROTOCOL) (* ejs: " 9-Feb-85 21:01")
(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 Timeout)
Packet ←(ALLOCATE.ETHERPACKET)
FirstHole ← 0)
(RECORD FragmentRecord (Start Length LastFragment))
]
(* END EXPORTED DEFINITIONS)
)
(RPAQ? \IP.FRAGMENTS )
(RPAQ? \IP.FRAGMENT.NET )
(RPAQ? \IP.FRAGMENT.LOCK (CREATE.MONITORLOCK "IP Fragment Processing Lock"))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \IP.FRAGMENTS \IP.FRAGMENT.NET \IP.FRAGMENT.LOCK)
)
(DEFINEQ
(\HANDLE.RAW.IP.FRAGMENT
[LAMBDA (IP) (* ejs: "28-Dec-84 09:36")
(* * Handle an IP packet fragement. Return NIL if this packet does not complete a fragment, else return the newly
completed packet as an unfragmented IP packet)
(PROG ((FragmentLst (\IP.FIND.MATCHING.FRAGMENTS IP)))
(RETURN (COND
(FragmentLst (\IP.ADD.FRAGMENT FragmentLst IP))
(T (\IP.NEW.FRAGMENT.LST IP)
NIL])
(\IP.NEW.FRAGMENT.LST
[LAMBDA (IP) (* ejs: "27-Dec-84 10:26")
(* * Add a new fragment list to the fragment discrimination net.)
(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))
SubLst NewFragList AssemblyPacket AssemblyRecord)
[SETQ AssemblyRecord (create AssemblyRecord
Timeout ←(IPLUS (CLOCK 0)
(ITIMES 1000 (ffetch (IP IPTIMETOLIVE)
of IP]
(SETQ AssemblyPacket (fetch (AssemblyRecord Packet) of AssemblyRecord))
[SETQ NewFragList
(BQUOTE (, ID (, Source (, Protocol (, Dest , AssemblyRecord ,
(create FragmentRecord
Start ←(LLSH (ffetch (IP IPFRAGMENTOFFSET)
of IP)
3)
Length ←(IDIFFERENCE
(ffetch (IP IPTOTALLENGTH) of IP)
(LLSH (ffetch (IP IPHEADERLENGTH)
of IP)
2]
(COND
[(SETQ SubLst (for IDChain in \IP.FRAGMENT.NET thereis (EQ (CAR IDChain)
ID)))
(COND
[(SETQ SubLst (for SourceChain in (CDR SubLst) thereis (EQP (CAR SourceChain)
Source)))
(COND
[(SETQ SubLst (for ProtocolChain in (CDR SubLst) thereis (EQ (CAR ProtocolChain)
Protocol)))
(COND
((SETQ SubLst (for DestChain in (CDR SubLst) thereis (EQP (CAR DestChain)
Dest)))
(ERROR
"Tried to add a fragment list to the discrimination net and the same one already exists!"
NewFragList))
(T (push (CDR SubLst)
(CADDDR NewFragList]
(T (push (CDR SubLst)
(CADDR NewFragList]
(T (push (CDR SubLst)
(CADR NewFragList]
(T (push \IP.FRAGMENT.NET NewFragList)))
(\IP.COPY.FRAGMENT.HEADER.TO.PACKET.HEADER AssemblyPacket IP)
(push \IP.FRAGMENTS (CADDDR NewFragList])
(\IP.COPY.FRAGMENT.HEADER.TO.PACKET.HEADER
[LAMBDA (Packet Fragment) (* ejs: "27-Dec-84 19:52")
(* * 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
(LLSH (fetch (IP IPHEADERLENGTH) of Fragment)
2])
(\IP.ADD.FRAGMENT
[LAMBDA (FragmentLst NewIP) (* ejs: "27-Dec-84 14:16")
(* * 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)
(PROG ((AssemblyRecord (CAR FragmentLst))
[NewFrag (create FragmentRecord
Start ←(LLSH (ffetch (IP IPFRAGMENTOFFSET) of NewIP)
3)
Length ←(IDIFFERENCE (ffetch (IP IPTOTALLENGTH) of NewIP)
(LLSH (ffetch (IP IPHEADERLENGTH) of NewIP)
2]
(Fragments (CDR FragmentLst))
Status NextHole AssemblyPacket)
(SETQ AssemblyPacket (fetch (AssemblyRecord Packet) of AssemblyRecord))
(replace (AssemblyRecord Timeout) of AssemblyRecord
with (IMAX (IPLUS (CLOCK 0)
(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 Fragments))
(* Earlier than the earliest existing fragment)
(push (CDR FragmentLst)
NewFrag)
(SETQ Fragments (CDR FragmentLst))
(QUOTE INSERTED.FRAGMENT))
((EQ (fetch (FragmentRecord Start) of NewFrag)
(fetch (FragmentRecord Start) of 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 (RETURN Status))
((CDR OldFragTail)
(push (CDR OldFragTail)
NewFrag)
(RETURN (QUOTE INSERTED.FRAGMENT]
(RETURN
(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 "Screwup in reassembly!" NewFrag))
((EQ (fetch (FragmentRecord Start) of NewFrag)
(fetch (AssemblyRecord FirstHole) of AssemblyRecord))
(COND
((AND [NOT (bind End 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)
T]
(NOT (ffetch (IP IPMOREFRAGMENTS) of NewIP)))
(\IP.DELETE.FRAGMENT FragmentLst)
AssemblyPacket]
NIL)
(\RELEASE.ETHERPACKET NewIP])
(\IP.FIND.MATCHING.FRAGMENTS
[LAMBDA (IP) (* ejs: "27-Dec-84 10:46")
(* * Find the list of fragments matching this IP packet, or NIL if none exists)
(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))
SubLst)
(RETURN (COND
((SETQ SubLst (for IDChain in \IP.FRAGMENT.NET thereis (EQ (CAR IDChain)
ID)))
(COND
((SETQ SubLst (for SourceChain in (CDR SubLst) thereis (EQP (CAR SourceChain)
Source)))
(COND
((SETQ SubLst (for ProtocolChain in (CDR SubLst)
thereis (EQ (CAR ProtocolChain)
Protocol)))
(COND
((SETQ SubLst (for DestChain in (CDR SubLst)
thereis (EQP (CAR DestChain)
Dest)))
(CDR SubLst])
(\IP.FRAGMENTED.PACKET
[LAMBDA (IP) (* ejs: "27-Dec-84 10:47")
(* * Return T if IP packet is a fragment)
(NOT (AND (ZEROP (ffetch (IP IPMOREFRAGMENTS) of IP))
(ZEROP (ffetch (IP IPFRAGMENTOFFSET) of IP])
(\IP.CHECK.REASSEMBLY.TIMEOUTS
[LAMBDA NIL (* ejs: "28-Dec-84 09:36")
(* * Kill any fragments in the process of reassembly if their timeout has expired. Report timeout via ICMP)
(for Fragment in \IP.FRAGMENTS when (IGREATERP (CLOCK 0)
(fetch (AssemblyRecord Timeout)
of (CAR Fragment)))
do (\ICMP.TIME.EXCEEDED (fetch (AssemblyRecord Packet) of (CAR Fragment)))
(\IP.DELETE.FRAGMENT Fragment])
(\IP.DELETE.FRAGMENT
[LAMBDA (FragmentLst) (* ejs: "27-Dec-84 10:51")
(* * Delete the fragment record in FragmentLst from both the fragment discrimination net and the linear list of
fragment records)
(PROG ((IP (fetch (AssemblyRecord Packet) of (CAR FragmentLst)))
Source Dest Protocol ID SubLst Backpointers)
(SETQ Source (ffetch (IP IPSOURCEADDRESS) of IP))
(SETQ Dest (ffetch (IP IPDESTINATIONADDRESS) of IP))
(SETQ Protocol (ffetch (IP IPPROTOCOL) of IP))
(SETQ ID (ffetch (IP IPID) of IP))
[COND
((SETQ SubLst (for IDChain in \IP.FRAGMENT.NET thereis (EQ (CAR IDChain)
ID)))
(push Backpointers SubLst)
(COND
((SETQ SubLst (for SourceChain in (CDR SubLst) thereis (EQP (CAR SourceChain)
Source)))
(push Backpointers SubLst)
(COND
((SETQ SubLst (for ProtocolChain in (CDR SubLst) thereis (EQ (CAR ProtocolChain)
Protocol)))
(push Backpointers SubLst)
(COND
((SETQ SubLst (for DestChain in (CDR SubLst) thereis (EQP (CAR DestChain)
Dest)))
(DREMOVE SubLst (CAR Backpointers]
(while Backpointers
do [COND
((EQLENGTH (CAR Backpointers)
1)
(DREMOVE (CAR Backpointers)
(CADR Backpointers]
(pop Backpointers))
(SETQ \IP.FRAGMENTS (DREMOVE FragmentLst \IP.FRAGMENTS))
(\RELEASE.ETHERPACKET IP])
)
(* * 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)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(RPAQQ \RT.INFINITY 16)
(CONSTANTS (\RT.INFINITY 16))
)
(* END EXPORTED DEFINITIONS)
)
(RPAQ? \IP.ROUTING.TABLE (CONS))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \IP.ROUTING.TABLE)
)
(DEFINEQ
(\IP.SETUPIP
(LAMBDA (IP DESTHOST ID SOCKET REQUEUE) (* ejs: "27-Dec-84 18:55")
(* * 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 ID)
(replace (IP IPMOREFRAGMENTS) of IP with 0)
(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) (* ejs: "31-Dec-84 14:13")
(* * 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)))
(AND IPTRACEFLG (PRINTPACKET IP (QUOTE PUT)
IPTRACEFILE "[Put fails--no routing]"))
(\REQUEUE.ETHERPACKET IP)
(QUOTE NoRouting))
(T (replace EPTYPE of IP with (SELECTQ (ffetch (NDB NETTYPE) of NDB)
(10 \EPT.IP)
(3 \EET.IP)
(ERROR "\IP.TRANSMIT: Unknown net type"
NDB)))
(\IP.SET.CHECKSUM IP (ffetch (IP IPBASE) of IP)
(LLSH (ffetch (IP IPHEADERLENGTH) of IP)
2)
(LOCF (ffetch (IP IPHEADERCHECKSUM) of IP)))
(AND IPTRACEFLG (PRINTPACKET IP (QUOTE PUT)
IPTRACEFILE))
(TRANSMIT.ETHERPACKET NDB IP)
NIL))))))
(\IP.ROUTE.PACKET
(LAMBDA (IP READONLY) (* ejs: " 2-Jan-85 19:27")
(* 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))
(PROG ((NET (fetch (IP IPDESTINATIONNET) of IP))
PDH ROUTE NDB)
(COND
((EQ 0 NET)
(OR (SETQ NDB (OR \10MBLOCALNDB \3MBLOCALNDB))
(RETURN)))
((SETQ ROUTE (\IP.LOCATE.NET (fetch (IP IPDESTINATIONADDRESS) of IP)))
(SETQ NDB (fetch RTNDB of ROUTE)))
(T (RETURN)))
(SETQ PDH (COND
((AND ROUTE (NEQ (fetch RTHOPCOUNT of ROUTE)
0))
(fetch RTGATEWAY# of ROUTE))
((EQ (fetch NETTYPE of NDB)
10)
(COND
((\AR.TRANSLATE.TO.10MB (ffetch (IP IPDESTINATIONADDRESS) of IP)))
(T (RETURN))))
(T (\AR.TRANSLATE.TO.3MB (ffetch (IP IPDESTINATIONADDRESS) of IP)))))
(freplace EPNETWORK of IP with NDB)
(ENCAPSULATE.ETHERPACKET NDB IP PDH (ffetch (IP IPTOTALLENGTH) of IP)
(SELECTQ (fetch NETTYPE of NDB)
(10 \EPT.IP)
(3 \EET.IP)
(ERROR "\IP.ROUTE.PACKET: Unknown net type" NDB)))
(COND
((NOT READONLY)
(COND
((EQ 0 NET)
(freplace (IP IPDESTINATIONNET) of IP with (fetch NDBIPNET# of NDB))))
(freplace (IP IPSOURCENET) of IP with (fetch NDBIPNET# of NDB))))
(RETURN NDB))))
(\IP.LOCATE.NET
(LAMBDA (ADDRESS DONTPROBE) (* ejs: " 2-Jan-85 19:45")
(PROG ((NET (\IPNETADDRESS ADDRESS)))
(RETURN (COND
(\10MBLOCALNDB (for (PREVTAIL ← \IP.ROUTING.TABLE) bind TAIL DATA
while (LISTP (SETQ TAIL (CDR PREVTAIL)))
do (SETQ DATA (CAR TAIL))
(COND
((OR (IEQP NET (fetch (ROUTING RTNET#) of DATA))
(AND (EQ 0 NET)
(EQ 0 (fetch (ROUTING RTHOPCOUNT) of DATA))))
(COND
((NEQ PREVTAIL \IP.ROUTING.TABLE)
(* Promote this entry to the front, so we find it
faster in the future)
(FRPLACD \IP.ROUTING.TABLE
(PROG1 TAIL (FRPLACD PREVTAIL (CDR TAIL))
(FRPLACD TAIL (CDR \IP.ROUTING.TABLE)
)))))
(RETURN (AND (ILESSP (fetch RTHOPCOUNT of DATA)
\RT.INFINITY)
DATA))))
(SETQ PREVTAIL TAIL)))
((for RT in \IP.ROUTING.TABLE thereis (AND (EQ (fetch (ROUTING RTNET#)
of RT)
NET)
(EQ (fetch (ROUTING RTTIMER)
of RT)
(LDB (BYTE 8 16)
ADDRESS)))))
(T (for RT in \IP.ROUTING.TABLE thereis (EQ (fetch (ROUTING RTNET#) of RT)
NET))))))))
)
(* * 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 LLIP COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (13076 20018 (DODIP.HOSTP 13086 . 13254) (IPHOSTADDRESS 13256 . 13532) (PRINTIP 13534 .
15355) (PRINTIPDATA 15357 . 16001) (\IPADDRESSCLASS 16003 . 16458) (\IPHOSTADDRESS 16460 . 16968) (
\IPNETADDRESS 16970 . 17474) (\IP.ADDRESS.TO.STRING 17476 . 17853) (\IP.BROADCAST.ADDRESS 17855 .
18324) (\IP.PRINT.ADDRESS 18326 . 18847) (\IP.READ.STRING.ADDRESS 18849 . 20016)) (20382 24836 (STOPIP
20392 . 20706) (\IPINIT 20708 . 24403) (\IPLISTENER 24405 . 24834)) (28123 32432 (\HANDLE.RAW.IP
28133 . 29677) (\FORWARD.IP 29679 . 29822) (\IP.LOCAL.DESTINATION 29824 . 30543) (\IPCHECKSUM 30545 .
31883) (\IP.CHECKSUM.OK 31885 . 32071) (\IP.SET.CHECKSUM 32073 . 32430)) (32935 39634 (
\IP.HAND.TO.PROTOCOL 32945 . 33693) (\IP.DEFAULT.INPUTFN 33695 . 34252) (\IP.DEFAULT.NOSOCKETFN 34254
. 34434) (\IP.ADD.PROTOCOL 34436 . 35104) (\IP.DELETE.PROTOCOL 35106 . 35638) (\IP.FIND.PROTOCOL
35640 . 35977) (\IP.FIND.PROTOCOL.SOCKET 35979 . 36649) (\IP.FIND.SOCKET 36651 . 37211) (
\IP.OPEN.SOCKET 37213 . 38623) (\IP.CLOSE.SOCKET 38625 . 39632)) (40203 51550 (\HANDLE.RAW.IP.FRAGMENT
40213 . 40730) (\IP.NEW.FRAGMENT.LST 40732 . 43004) (\IP.COPY.FRAGMENT.HEADER.TO.PACKET.HEADER 43006
. 43445) (\IP.ADD.FRAGMENT 43447 . 47814) (\IP.FIND.MATCHING.FRAGMENTS 47816 . 48919) (
\IP.FRAGMENTED.PACKET 48921 . 49240) (\IP.CHECK.REASSEMBLY.TIMEOUTS 49242 . 49796) (
\IP.DELETE.FRAGMENT 49798 . 51548)) (52435 54387 (\IP.PROCESS.OPTIONS 52445 . 54385)) (54715 60561 (
\IP.SETUPIP 54725 . 55738) (\IP.TRANSMIT 55740 . 57244) (\IP.ROUTE.PACKET 57246 . 59038) (
\IP.LOCATE.NET 59040 . 60559)) (60612 63855 (\IP.APPEND.BYTE 60622 . 61234) (\IP.APPEND.CELL 61236 .
62415) (\IP.APPEND.STRING 62417 . 62933) (\IP.APPEND.WORD 62935 . 63853)))))
STOP