-- File: INRImpl.mesa - last edit:
-- AOF 5-Feb-88 13:54:58
-- Leong 28-Sep-87 18:40:59
-- Kluger 22-Oct-85 8:01:39
-- Copyright (C) 1985, 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
-- Function: The implementation module for the NS Internetwork Router.
<<
IMPLEMENTATION NOTES:
(1) In an attempt to fix the flapping routing table problem, gratuitous Routing Information response packets are sent one at a time. This should help when the inr/phonenet is congested with other packets.
>>
DIRECTORY
Buffer, --EXPORT Device
NSBuffer USING [AccessHandle, Body, MakePool, DestroyPool, Buffer, GetBuffer],
Checksums USING [IncrNSTransportControlAndUpdateChecksum, SetChecksum],
CommFlags USING [doStats, doDebug],
CommHeap USING [zone],
CommunicationInternal USING [],
Driver USING [
ChangeNumberOfInputBuffers, Device, GetDeviceChain, PutOnGlobalDoneQueue],
Environment USING [bytesPerWord],
Protocol1 USING [EncapsulateAndTransmit, GetContext],
NSConstants USING [routingInformationSocket],
NSTypes USING [bytesPerIDPHeader, RoutingInfoTuple, RoutingInfoType,
TransportControl, maxIDPDataBytes, maxIDPBytesPerPacket],
Process USING [MsecToTicks, Pause, SetTimeout, DisableTimeout,
SecondsToTicks, Abort, Detach, EnableAborts],
ProcessorFace USING [SetMP],
RoutingTable USING [Object, Handle, Register, FlushCacheProc, NetworkContext],
Router USING [FindMyHostID, NoTableEntryForNet, RoutersFunction],
RouterInternal USING [BroadcastThisPacket, checkIt, SendErrorPacket,
SendPacket],
Runtime USING [CallDebugger],
Inr USING [],
InrDebug,
InrFriends USING [RoutingTableObject, HopCount, RoutingTableEntry,
MisnumberedNetTrap],
InrInternal,
InrStats USING [Stats, RoutingTableSearch],
InrTypes USING [RoutingInfoType, ExtendedRoutingInfoTuple,
ExtendedRoutingInformation],
Inline USING [LowHalf, BITAND],
Socket USING [ChannelHandle, Create, Delete, GetPacket, SetWaitTime,
ReturnBuffer, infiniteWaitTime, GetBufferPool],
Stats USING [StatIncr],
SpecialSystem USING [HostNumber, NetworkNumber, SocketNumber],
System USING [broadcastHostNumber, GetClockPulses, GetGreenwichMeanTime,
gmtEpoch, GreenwichMeanTime, HostNumber, NetworkAddress, NetworkNumber,
nullNetworkNumber, nullHostNumber, Pulses],
RoutingFudges USING [];
INRImpl: MONITOR LOCKS inrLock
IMPORTS InrInternal,
NSBuffer, Inline, Checksums, CommHeap, Driver, Process, ProcessorFace,
Protocol1, Router, RouterInternal, Socket, Stats, System, RoutingTable,
Runtime
EXPORTS
Inr, InrDebug, InrFriends, InrInternal, InrStats, Buffer, System,
RoutingFudges =
BEGIN
inrLock: PUBLIC MONITORLOCK; --monitors proc accessing the routing table
doNSStats: BOOLEAN = TRUE OR CommFlags.doStats; --tied to TRUE for now
---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
-- TYPEs
---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
NetworkNumber: PUBLIC TYPE = SpecialSystem.NetworkNumber;
HostNumber: PUBLIC TYPE = SpecialSystem.HostNumber;
SocketNumber: PUBLIC TYPE = SpecialSystem.SocketNumber;
Device: PUBLIC TYPE = Driver.Device; --LOOPHOLEs into b.fo.context
-- clear the opaque type in Buffer
Context: TYPE = RoutingTable.NetworkContext;
RoutingTableObject: TYPE = InrFriends.RoutingTableObject;
RoutingTableEntry: TYPE = InrFriends.RoutingTableEntry;
HopCount: TYPE = InrFriends.HopCount;
---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
-- CONSTANTS that make it all happen
---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
unknownHostID: HostNumber = System.nullHostNumber;
extraBuffersForForwarding: CARDINAL = 40;
singleGratuitousResponseBuffer: CARDINAL = 1;
-- The single sent buffer count ensures that Routing Information
-- response packets are sent one at a time. The inr cannot get a
-- second sent buffer until the first one has gone through the system.
mask: CARDINAL = 31; -- for masking out the high eleven bits of the incoming
-- delay, as we don't use them (yet).
bitsHashed: CARDINAL ← InrInternal.defaultNumberOfHashBits;
-- number of bits used to index into the routing table
markDead: BOOLEAN ← TRUE; -- flag indicating invalid entries
-- are to be marked dead instead of deallocated
allLocalInternetRouters: System.NetworkAddress = [
net: nullNetworkNumber, host: System.broadcastHostNumber,
socket: NSConstants.routingInformationSocket];
anyNetNetworkNumber: NetworkNumber = [177777B, 177777B];
anyNetNetworkNumberFor860: NetworkNumber = [0AAFFH, 0FFFFH];
nullNetworkNumber: NetworkNumber = System.nullNetworkNumber;
-- routing info request network number that indicates all networks
nullEnum: NetworkNumber = nullNetworkNumber;
-- used for the various enumerations
initialTransportControl: NSTypes.TransportControl = [
trace: FALSE, filler: 0, hopCount: 0];
updateCycles: CARDINAL = InrInternal.updateCycles;
-- timeUnits gets reset to this; number of routing table update cycles.
alternatePathTimeUnitThreshHold: CARDINAL = 2;
-- we look for alternate routing path if timeUnits fall BELOW this value.
-- various hop counts
localHop: HopCount = InrInternal.localHop;
-- rte delay for attached network(s) is zero hops.
maxInternetrouterHops: CARDINAL = InrInternal.maxInternetrouterHops;
infinityHopCount: CARDINAL = InrInternal.infinityHopCount;
-- sizes of the Routing Information protocol objects
bytesPerRoutingInfoType: CARDINAL = (2*SIZE[NSTypes.RoutingInfoType]);
bytesPerRoutingInfoTuple: CARDINAL = (2*SIZE[NSTypes.RoutingInfoTuple]);
-- sizes of buffer
smallBuffer: CARDINAL = 130; --Pre Pilot 13.0 small buffer size
fullBuffer: CARDINAL = NSTypes.maxIDPBytesPerPacket;
-- Environment stuff
bpw: CARDINAL = Environment.bytesPerWord;
-- sizes of the extended Routing Information protocol objects
bytesPerExtendedRoutingInfoTuple: CARDINAL =
(2*SIZE[InrTypes.ExtendedRoutingInfoTuple]);
maxTuplesPerExtendedRoutingPacket: CARDINAL =
(NSTypes.maxIDPDataBytes - bytesPerRoutingInfoType) /
bytesPerExtendedRoutingInfoTuple;
---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
-- VARIABLES or semi-Variables
---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
bufferHandle: NSBuffer.AccessHandle ← NIL;
-- this is a global variable, instead of local to InternetRouterServer proc,
-- so that SendGratuitousResponse proc may use the buffer account to send
-- routing information
myHostID: HostNumber; -- host ID of this system element
pleaseStop: PUBLIC BOOLEAN ← TRUE; -- controls the processes.
<< TRUE if we are OFF, FALSE if we are ON >>
privateCH: PUBLIC Socket.ChannelHandle;
-- Note: this is PUBLIC and in global frame as a hook for access
-- to the Well Known routing information socket
internetRouterTimer, -- times out to send gratuitous routing packets
auxInternetRouterTimer: -- times out by a random amount so we don't all send the gratuitous packets at the same time.
CONDITION;
routingInformationSupplierFork, internetRouterServerFork,
decrementRoutingTableEntriesFork, routingTableChangedFork: PROCESS ← NIL;
stats: PUBLIC LONG POINTER TO InrStats.Stats ← NIL;
misnumberedNetTrap: InrFriends.MisnumberedNetTrap ← DefaultMisnumberedNetTrap;
lastGetStats: System.GreenwichMeanTime ← System.gmtEpoch;
--mark the last time a snap of the statistics was taken
--Routing Table Object
rto: PUBLIC RoutingTable.Object ← [
type: interNetworkRouting, start: Start, stop: Stop,
startEnumeration: nullEnum, endEnumeration: nullEnum,
enumerate: InrInternal.EnumerateByDistance, fillTable: Fill,
getDelay: GetDelay, transmit: Transmit,
forward: Forward, findNetwork: InrInternal.FindNetID,
addNetwork: InrInternal.AddNet, removeNetwork: InrInternal.RemoveNet,
flushCache: FlushCacheNoOp, stateChanged: ChangedState];
ptrToRto:RoutingTable.Handle ← @rto;
extraHops: CARDINAL ← 0; -- fudge factor on the hop count to trick other
-- routers into using another path for forwarding packets
---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
-- Development-debugging utilities
---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
doMPCodes: BOOLEAN = TRUE; -- should we munge the MP Codes?
MPCodes: TYPE = InrDebug.MPCodes;
mpCode: MPCodes ← default;
gratuitousStats: ARRAY MPCodes OF LONG CARDINAL ← ALL[0];
ResetMPCodes: PUBLIC PROCEDURE [new: MPCodes]
RETURNS [old: MPCodes] =
BEGIN
mp, offset: CARDINAL;
old ← mpCode;
mpCode ← new;
IF ~doMPCodes THEN RETURN;
mp ← Inline.LowHalf[gratuitousStats[mpCode]];
offset ← SELECT mpCode FROM
phonenetResponseSent => 9000,
phonenetResponseRecv => 7000,
ENDCASE => 8000;
mp ← (mp MOD 1000) + offset;
ProcessorFace.SetMP [mp];
END; --of ResetMPCodes
---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
-- Routing Table (list) handling Routines
---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- PROCESS FORKED IN RoutingInformationSupplier[]
-- This routine broadcasts a routing information request on all attached
-- networks. If <net> is supplied, the request will be for info on that net
-- only, else information will be requested for information on all networks
-- the routing information suppliers know about.
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
BroadcastRoutingRequest: PROCEDURE [
cH: Socket.ChannelHandle, net: NetworkNumber ← anyNetNetworkNumber] =
BEGIN
b: NSBuffer.Buffer;
body: NSBuffer.Body;
FOR i:CARDINAL IN [1..3) DO
IF (b ← NSBuffer.GetBuffer [aH: Socket.GetBufferPool[cH],
function: send, size: smallBuffer, wait: TRUE]) # NIL THEN
BEGIN
body ← b.ns; --got to set it before using it
b.fo.type ← ns;
body.packetType ← routingInformation;
body.transportControl ← initialTransportControl;
body.source.host ← myHostID;
body.destination.socket ← body.source.socket ←
NSConstants.routingInformationSocket;
body.pktLength ← NSTypes.bytesPerIDPHeader +
bytesPerRoutingInfoType + bytesPerRoutingInfoTuple;
body.routingType ← routingInfoRequest;
body.routingTuple[0] ← [net, infinityHopCount];
RouterInternal.BroadcastThisPacket[b];
END;
Process.Pause [Process.SecondsToTicks [1]];
ENDLOOP;
END; -- of BroadcastRoutingRequest
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- ChangedState is passed in to the Pilot Router.
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
ChangedState: PROCEDURE [context: Context] =
BEGIN
--used by driver when a network changes.
InrInternal.RemoveNetDeviceLocked[context];
InrInternal.AddNet[context];
END; --ChangedState
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- This routine just takes a trip to debugger with the given message.
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
DefaultMisnumberedNetTrap: InrFriends.MisnumberedNetTrap = {
Runtime.CallDebugger ["Misnumbered net trap."L]};
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- Client requests that we gather routing table information. This is passed
-- to the Pilot Router.
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
Fill: PROCEDURE [maxDelay: CARDINAL] =
BEGIN
<< Since we are already an inr this proc. is a NOP, (we leave it in for the time being because its part of the routing object). >>
END; -- of Fill
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- FlushCacheNoOp is a no operation routine and is passed to the Pilot Router.
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
FlushCacheNoOp: RoutingTable.FlushCacheProc = {};
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- This routine forwards a packet onto the next host in the route after
-- checking the packet has not been forwarded too many times and a route
-- exists to the destination network. Forward is passed to the Pilot Router.
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
Forward: PROCEDURE [b: NSBuffer.Buffer] =
BEGIN
ENABLE UNWIND => NULL;
body: NSBuffer.Body = b.ns;
nextHost: HostNumber;
e: RoutingTableEntry;
context: Context;
NotFoundDestinationNetworkLocked: ENTRY PROCEDURE RETURNS [BOOLEAN] = INLINE
BEGIN ENABLE UNWIND => NULL;
RETURN[
((e ← InrInternal.FindNetworkNumber[body.destination.net]) = NIL)
OR ((context ← e.context) = NIL) OR (context.network = NIL)];
END; -- of NotFoundDestinationNetworkLocked
--see if we have traversed max number of internet routers already
SELECT TRUE FROM
(maxInternetrouterHops <= body.transportControl.hopCount) =>
-- note that it is "<=" - this prevents a packet from being
-- forwarded past the farthest net a source knows about (15 hops)
BEGIN
<< *** AR#6979 Shouldn't munge packet before sending Error packet ***
body.destination ← [InrInternal.FindNetIDInternal [nullNetworkNumber],
myHostID, NSConstants.routingInformationSocket];
>>
-- the destination will get flipped with the source by
-- SendErrorPacket
RouterInternal.SendErrorPacket[b, excessHops, 0];
IF doNSStats THEN Stats.StatIncr[statNSNotForwarded];
StatIncr [@stats.tooManyHops]
END;
(NotFoundDestinationNetworkLocked[]) =>
BEGIN --outgoing packet for unknown net
IF (body.source.host # myHostID) THEN
BEGIN
<< *** AR#6979 Shouldn't munge packet before sending Error packet ***
body.destination ← [InrInternal.FindNetIDInternal [nullNetworkNumber],
myHostID, NSConstants.routingInformationSocket];
>>
-- the destination will get flipped with the source by
-- SendErrorPacket
RouterInternal.SendErrorPacket[b, cantGetThere, 0];
END
ELSE
BEGIN
b.fo.status ← noRouteToNetwork;
--return b to the system buffer pool
Driver.PutOnGlobalDoneQueue[LOOPHOLE[b]];
END;
IF doNSStats THEN Stats.StatIncr[statNSNotForwarded];
StatIncr [@stats.unknownNet];
END;
ENDCASE =>
BEGIN --outgoing packet
Checksums.IncrNSTransportControlAndUpdateChecksum[body];
--now transmit it over the correct network
IF ((nextHost ← e.route) = unknownHostID) THEN --already on dest. net
nextHost ← body.destination.host;
b.fo.network ← context.network; -- mark the network being used
b.fo.context ← context;
b.fo.type ← ns;
b.fo.status ← goodCompletion;
--maintain the crude counters of packets and bytes forwarded
StatIncr [@stats.statNSForwarded];
StatBump [@stats.bytesForwarded, body.pktLength];
Protocol1.EncapsulateAndTransmit[LOOPHOLE[b], @nextHost]; --same net
IF doNSStats THEN Stats.StatIncr[statNSForwarded];
END;
END; --Forward
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- Provide the crude counters of packets forwarded by the router
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
ForwardingStats: PUBLIC PROCEDURE RETURNS [packets, bytes: LONG CARDINAL] =
BEGIN
IF (stats = NIL) THEN RETURN [0, 0]; --forwarding hasn't been activated
packets ← stats.statNSForwarded;
bytes ← stats.bytesForwarded;
END; --ForwardingStats
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- GetDelay returns the number of hops away from the given network number.
-- This routine is passed to the Pilot Router.
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
GetDelay: PROCEDURE [net: NetworkNumber] RETURNS [delay: CARDINAL] =
BEGIN
LockedFindNet: ENTRY PROC = INLINE
{ENABLE UNWIND => NULL; e ← InrInternal.FindNetworkNumber[net, FALSE]};
e: RoutingTableEntry;
LockedFindNet[]; --try searching first time
IF (e = NIL) OR (e.context = NIL) THEN
ERROR Router.NoTableEntryForNet; -- a net is not accessible unless
-- we have a rte AND a network pointer
delay ← e.delay; --value of interest
END; --GetDelay
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- GetFarNet returns a non-null network number. The monitor lock is required
-- here because of the possible table search.
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- <net> can be a network driver that is anonyomous. In other words, it
-- isn't assigned its own network number. Point to Point connections
-- between INRs are anonymous E.g. a phoneline between two INRs.
-- An anonyomous network invokes a routing table search to find the entry
-- that uses the given driver and has the lowest delay to a destination
-- net of all the rtes that use <net>. That entry's destNetwork should be
-- a viable network.
GetFarNet: INTERNAL PROCEDURE [net: Context]
RETURNS [farNet: NetworkNumber] =
BEGIN
farNet ← IF (net.netNumber = nullNetworkNumber) THEN
InrInternal.FindFarNet[net] ELSE net.netNumber;
END; --of GetFarNet
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- FORKED INTERNETWORK ROUTER PROCESS
-- This process wakes up every 30 seconds and sends out Routing Information
-- Protocol Response packets gratuitously, if this system element is an
-- internet router.
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
InternetRouterServer: PROCEDURE =
BEGIN
Wait: ENTRY PROCEDURE [condition: CONDITION] = INLINE {
ENABLE UNWIND => NULL;
WAIT condition;
}; --end of Wait
-- start of procedure, when this process is first started it waits
-- a while to allow the routing table to be built by the incoming
-- routing response packets.
Process.Pause[Process.MsecToTicks[100]];
Driver.ChangeNumberOfInputBuffers[TRUE];
-- create extra buffers because we are an inr
bufferHandle ← NSBuffer.MakePool [
send: singleGratuitousResponseBuffer, --slows down rate of sending
-- The single sent buffer count ensures that Routing Information
-- response packets are sent one at a time. The inr cannot get a
-- second sent buffer until the first one has gone through the system.
receive: extraBuffersForForwarding];
-- inr's buffer account established (system pool is allowed to grow)
UNTIL pleaseStop DO
ENABLE ABORTED => EXIT;
Wait[internetRouterTimer];
IF pleaseStop THEN EXIT;
-- wait a random amount of time [0..7] seconds before sending out the
-- gratuitous response packet. This will help prevent all inrs
-- from sending at the same time.
Process.SetTimeout[@auxInternetRouterTimer,
Process.SecondsToTicks[Inline.LowHalf[System.GetClockPulses[]] MOD 8]];
Wait[auxInternetRouterTimer];
IF pleaseStop THEN EXIT;
SendGratuitousResponse [to: allLocalInternetRouters];
StatIncr [@stats.gratuitousRoutingResponseSent];
ENDLOOP;
-- At this point, the Inr has been stopped and it must inform everyone
-- that it should no longer use it as a route anymore.
SendGratuitousResponse [to: allLocalInternetRouters, b: NIL,
allAreUnreachable: TRUE]; --tell everyone not to use as a route anymore
StatIncr [@stats.gratuitousRoutingResponseSent];
-- delete the buffers allocated for the INR
NSBuffer.DestroyPool [bufferHandle];
bufferHandle ← NIL;
Driver.ChangeNumberOfInputBuffers[FALSE];
END; --InternetRouterServer
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- This routine routs a routing inforamtion response packet for its
-- destination and sends it. A few of the packet's field should already be
-- set coming into here. Note the two special case: sending to self and
-- sending to everyone. If returned value <success> is TRUE then the buffer
-- was returned by this routine, otherwise the caller must return the buffer.
--
-- Return buffer by making a call to either Socket.ReturnBuffer or
-- Driver.PutOnGlobalDoneQueue
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
RoutAndSendRoutingInfoResponse: INTERNAL PROCEDURE [
b: NSBuffer.Buffer, extended: BOOLEAN ← FALSE]
RETURNS [success: BOOLEAN ← TRUE] =
BEGIN
-- Routs and sends a routing information response.
-- Should be called from inside the monitor.
-- The incoming b.network, b.destination, and body.pktLength should
-- be already set. Source net is set to be the network's, unless = 0 and
-- destination socket not #1 - then it's set to a more informative number.
--
-- Note the special case handling when the destination is us!
body: NSBuffer.Body = b.ns;
context: Context ← b.fo.context;
immediateHost: HostNumber ← body.destination.host;
e: RoutingTableEntry;
destinationIsMe: BOOLEAN ← body.destination.host = myHostID;
-- fill packet type information
b.fo.type ← ns;
body.packetType ← routingInformation;
body.transportControl ← initialTransportControl;
body.routingType ← IF ~extended THEN routingInfoResponse
ELSE LOOPHOLE[InrTypes.RoutingInfoType[routingInfoExtendedResponse]];
body.source ← [IF (context # NIL) THEN context.netNumber ELSE
nullNetworkNumber, myHostID, NSConstants.routingInformationSocket];
IF (body.destination.socket # NSConstants.routingInformationSocket) AND
(body.source.net = nullNetworkNumber) THEN
-- give them better information (network management)
body.source.net ← InrInternal.FindNetIDInternal [nullNetworkNumber];
<< "Valid" net numbers now can consume two words. Ex: 132-132, 132-001..132-009
IF CommFlags.doDebug AND (LOOPHOLE[body.source.net, NetworkNumber].a#0 OR
LOOPHOLE[body.destination.net, NetworkNumber].a#0)
THEN ERROR; -- BogusNetNumber! (high order bits non-zero)
>>
IF destinationIsMe THEN
BEGIN
b.fo.context ← LOOPHOLE[b.fo.network, Device] ← NIL;
-- packet is locally sent
RouterInternal.SendPacket [b]; -- hey, special treatment
RETURN;
END;
-- destination is someone else, determine correct network
IF body.destination.host = System.broadcastHostNumber THEN
BEGIN
RouterInternal.BroadcastThisPacket [b]; -- router sets b.fo.context
-- broadcast on all attached networks
IF doMPCodes THEN
BEGIN
-- for gratuitous response on phonenet accounting
FOR n: Driver.Device ← Driver.GetDeviceChain[], n.next UNTIL (n = NIL) DO
IF NOT ((n.device = phonenet) AND n.alive) THEN LOOP;
StatIncr[@gratuitousStats[phonenetResponseSent]];
IF (mpCode = phonenetResponseSent) THEN
BEGIN
mp: CARDINAL ← Inline.LowHalf[gratuitousStats[phonenetResponseSent]];
mp ← (mp MOD 1000) + 9000;
ProcessorFace.SetMP [mp]; -- show 9XXX for sent
END;
EXIT;
ENDLOOP;
END; --of accounting work
RETURN;
END;
IF (body.destination.net # nullNetworkNumber) THEN
-- if the dest. is net 0, use immediateHost's default (set in declaration)
BEGIN -- find the route to this guy
e ← InrInternal.FindNetworkNumber [body.destination.net, FALSE];
IF (e = NIL) OR (e.context = NIL)
THEN RETURN [FALSE];
-- no route to destination (assume we already know about all routes
-- since we are an internetwork router)
context ← e.context;
b.fo.context ← e.context;
b.fo.network ← e.context.network;
immediateHost ← IF (e.route = unknownHostID) THEN
body.destination.host -- we are attached to destination net --
ELSE e.route -- send to next inr on path to destination net;
END;
IF RouterInternal.checkIt THEN Checksums.SetChecksum[body]
ELSE body.checksum ← 177777B;
-- now call proc to encapsulate and send the buffer, after which
-- the proc will put the buffer on the done queue
b.fo.status ← goodCompletion;
Protocol1.EncapsulateAndTransmit[LOOPHOLE[b], @immediateHost];
END; -- of RoutAndSendRoutingInfoResponse
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- RoutingInformationPacket either sends or examine the packet depending
-- on if the packet is a routingInfoRequest or routingInfoResponse. As part
-- of an examination of a routingInfoResponse packet, the routing table is
-- updated.
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
RoutingInformationPacket: PROCEDURE [b: NSBuffer.Buffer]
RETURNS [bufferWasReturned: BOOLEAN] =
BEGIN
body: NSBuffer.Body = b.ns;
newRoute: HostNumber = body.source.host;
routingPacketType: NSTypes.RoutingInfoType = body.routingType;
incomingNetwork: Context ← b.fo.context; -- check before using since
-- we aren't always holding the monitor
ExamineResponsePacket: ENTRY PROCEDURE =
BEGIN ENABLE UNWIND => NULL;
IF (body.source.socket # NSConstants.routingInformationSocket) THEN
-- why isn't the response pkt's source socket 1?
IF CommFlags.doDebug THEN ERROR ELSE --don't use-- RETURN;
IF (body.transportControl.hopCount > 0) THEN
BEGIN
-- routing response packets should never be forwarded
StatIncr [@stats.forwardedRoutingResponsesRecv];
RETURN; -- don't use
END;
IF NOT incomingNetwork.network.alive THEN RETURN; -- don't use
-- for gratuitous response on phonenet accounting
IF doMPCodes AND (body.destination.host = System.broadcastHostNumber)
AND (incomingNetwork.network.device = phonenet) THEN
BEGIN
StatIncr[@gratuitousStats[phonenetResponseRecv]];
IF (mpCode = phonenetResponseRecv) THEN
BEGIN
mp: CARDINAL ← Inline.LowHalf[gratuitousStats[phonenetResponseRecv]];
mp ← (mp MOD 1000) + 7000;
ProcessorFace.SetMP [mp]; -- show 7XXX for receive
END;
END;
IF UpdateUnnumberedNetTable[].use THEN UpdateRoutingTable[b];
END; -- of ExamineResponsePacket
UpdateUnnumberedNetTable: INTERNAL PROCEDURE
RETURNS [use: BOOLEAN] =
BEGIN << Sets a null network number. body.source.net is the field to use
for setting the incomingNetwork.netNumber because we know this is a routing
response which came from the INR on this net! >>
use ← TRUE;
SELECT TRUE FROM
(incomingNetwork.netNumber = body.source.net) => NULL; -- we know our
-- net number and it matches with the routing response
(incomingNetwork.netNumber = nullNetworkNumber) =>
BEGIN -- our driver wants the new net number
incomingNetwork.netNumber ← body.source.net; -- update
InrInternal.AddNetDeviceInternal[incomingNetwork];
END;
(body.source.net # nullNetworkNumber) => -- since the incoming net
-- number is interesting ('cause it isn't zero) and it didn't match,
-- then the network has two different, non-zero net numbers. Log
-- the occurance and tell someone.
BEGIN
StatIncr [@stats.misnumberedNetTrapHits];
misnumberedNetTrap[from: body.source, net: incomingNetwork.netNumber];
-- tell someone
END;
ENDCASE => NULL;
END; --UpdateUnnumberedNetTable
-- START of procedure's main body
SELECT TRUE FROM
-- notice that no check is done for the socket number at this point
(body.packetType # routingInformation), --TBD: Error protocolViolation
(body.source.host = myHostID AND routingPacketType = routingInfoResponse),
-- don't need to listen to myself
(newRoute = unknownHostID), -- would be unhelpful
(incomingNetwork = NIL AND body.source.host # myHostID)
-- driver didn't note the network in the object?
=> RETURN [FALSE]; -- NO, don't use this packet
ENDCASE; --can continue
IF CommFlags.doDebug AND (body.source.host # myHostID)
AND (incomingNetwork = NIL) THEN ERROR;
-- driver didn't note the incoming network in the object?
-- do we handle this packet?
-- YES, a routingInfo packet for us (Yeah!)
IF doNSStats THEN Stats.StatIncr[statNSGatewayPacketsRecv];
-- be aware that this count is incremented also for extended RIP
SELECT routingPacketType FROM
routingInfoRequest =>
BEGIN
SendRoutingInfoResponse[body.source, b]; -- we respond to request
-- note that body.source.net can be non null
bufferWasReturned ← TRUE; -- SendRoutingInfoResponse proc
-- always returns the buffer that it is given
StatIncr [@stats.routingRequestRecv];
END;
routingInfoResponse =>
BEGIN
pulses: System.Pulses ← System.GetClockPulses[];
ExamineResponsePacket[];
bufferWasReturned ← FALSE; -- we merely examined it
pulses ← System.Pulses[System.GetClockPulses[] - pulses];
PulsesBump [@stats.pulsesProcessingRoutingResponse, pulses];
StatIncr [@stats.routingResponseRecv];
END;
-- Is this an extended Routing Information Protocol operation?
LOOPHOLE[InrTypes.RoutingInfoType[routingInfoExtendedRequest]] =>
BEGIN
SendRoutingInfoExtendedResponse[body.source, b];
bufferWasReturned ← TRUE;
StatIncr [@stats.routingRequestRecv]; --do we want to do this?
END;
LOOPHOLE[InrTypes.RoutingInfoType[routingInfoExtendedResponse]] =>
BEGIN -- no support for handling extended response!
bufferWasReturned ← FALSE;
StatIncr [@stats.routingResponseRecv]; --do we want to do this?
END;
ENDCASE => bufferWasReturned ← FALSE; -- we should never get to this arm
END; --RoutingInformationPacket
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- FORKED INTERNETWORK ROUTER PROCESS
-- This process handles packets that come in over Socket # 1
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
RoutingInformationSupplier: PROCEDURE =
BEGIN
cH: Socket.ChannelHandle;
b: NSBuffer.Buffer;
privateCH ← cH ← Socket.Create [socket: NSConstants.routingInformationSocket,
send: 1, receive: 5, type: routingInformation];
Socket.SetWaitTime [cH, Socket.infiniteWaitTime];
Process.Detach [FORK BroadcastRoutingRequest[cH]]; --to build routing table.
UNTIL pleaseStop DO
ENABLE ABORTED => EXIT; -- the condition variable that we would
-- get aborted on is in the Socket.Get routine
b ← Socket.GetPacket [cH];
IF NOT RoutingInformationPacket[b].bufferWasReturned THEN
Socket.ReturnBuffer [b]; -- if the buffer wasn't returned, then we
-- return it here. Driver.PutOnGlobalDoneQueue would be overkill since
-- we know that we got the buffer through the Socket.Get procedure.
ENDLOOP;
Socket.Delete [cH];
END; -- of RoutingInformationSupplier
<< *** Begin comment out
CopyBuffer: PROCEDURE[b: NSBuffer.Buffer, aH: NSBuffer.AccessHandle]
RETURNS [cb: NSBuffer.Buffer] = INLINE
BEGIN
cb ← NSBuffer.GetBuffer [aH: aH, function: receive,
size: NSBuffer.DataBytesPerRawBuffer[b], wait: FALSE];
IF (cb = NIL) THEN RETURN;
Inline.LongCOPY[
from: b.linkLayer.blockPointer, --@buffer.encapsulation
nwords: (b.fo.driver.length + (bpw-1))/bpw, --length is in bytes
to: cb.linkLayer.blockPointer];
-- finish up the link layer info
cb.linkLayer.startIndex ← b.linkLayer.startIndex;
cb.linkLayer.stopIndexPlusOne ← b.linkLayer.stopIndexPlusOne;
-- do the high layer info
cb.ns ← LOOPHOLE[
cb + LOOPHOLE[b.ns, LONG CARDINAL] - LOOPHOLE[b, LONG CARDINAL]];
cb.filler1 ← b.filler1;
cb.filler2 ← b.filler2;
-- set the fixed overhead info
cb.fo.network ← b.fo.network;
cb.fo.context ← b.fo.context;
cb.fo.status ← b.fo.status;
cb.fo.type ← b.fo.type;
cb.fo.driver.length ← b.fo.driver.length;
END; --of CopyBuffer
*** End comment out >>
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- RoutingTableDeactivate aborts all forked process.
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
RoutingTableDeactivate: ENTRY PROCEDURE = INLINE
BEGIN ENABLE UNWIND => NULL;
pleaseStop ← TRUE; << TRUE shows that we are OFF >>
Process.Abort [routingInformationSupplierFork];
-- poke him out of the Socket.Get on socket # 1
Process.Abort [internetRouterServerFork];
-- poke him out of WAITing to send a gratuitous pkt
Process.Abort [decrementRoutingTableEntriesFork];
-- poke him out of the WAIT timer statement
Process.Abort [routingTableChangedFork];
-- poke him out of the WAIT routingTableChanged statement
END; --RoutingTableDeactivate
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- This routine will send a gratuitous type of routing response (information
-- will be sent on all of the entries we know about).
-- (1) Most often, this proc is called to send a broadcast gratuitous
-- reponse to everyone every 30 seconds or so.
-- (2) But it is also called when a request for information comes in that
-- asks for info on all/some of the nets we know about.
-- (3) And it is called when the we want to announce to everyone, via a
-- broadcast, recent routing table changes.
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- Buffers for sending routing information response packets are acquired
-- one at a time. A large routing table may require more than one buffer.
-- Thus sending gratuitous responses can take a long time. With this being
-- the case, this procedure should not be called with the monitor.
EntryChanged: ENTRY PROC [net: NetworkNumber]
RETURNS [changed: BOOLEAN] = INLINE {
ENABLE UNWIND => NULL;
e: RoutingTableEntry ← InrInternal.FindNetworkNumber[net, FALSE];
changed ← IF (e = NIL) THEN FALSE ELSE e.changed;
}; --end of EntryChanged
ResetEntry: ENTRY PROC [net: NetworkNumber] = INLINE {
ENABLE UNWIND => NULL;
e: RoutingTableEntry ← InrInternal.FindNetworkNumber[net, FALSE];
IF (e # NIL) THEN e.changed ← FALSE;
}; --end of ResetEntry
RoutAndSendRoutingInfoResponseLocked: ENTRY PROC [
b: NSBuffer.Buffer, extended: BOOLEAN ← FALSE]
RETURNS [success: BOOLEAN ← TRUE] = INLINE {
ENABLE UNWIND => NULL;
success ← RoutAndSendRoutingInfoResponse[b, extended];
}; --end of RoutAndSendRoutingInfoResponseLocked
SendGratuitousResponse: PUBLIC PROCEDURE [
to: System.NetworkAddress, b: NSBuffer.Buffer ← NIL,
allAreUnreachable, onlyChangedEntries: BOOLEAN ← FALSE] =
BEGIN
-- If we are supplied with a buffer, then we'll use it and use its b.network
-- if the destination net address is the nullNetNumber. (b.network is the
-- network from which the packet came.) This is for sending on the same
-- network the packet was received.
-- If allAreUnreachable is TRUE, then the delay we'll use in all the tuples
-- will be <infinityHopCount>. This tells all listeners that we
-- are not a good route for any destinatination nets
-- This proc will send two or more pkts if there are too many tuples for one
-- packet.
body: NSBuffer.Body ← NIL;
maxTuplesPerRoutingPacket: CARDINAL =
(NSTypes.maxIDPDataBytes - bytesPerRoutingInfoType) /
bytesPerRoutingInfoTuple;
packetsSent: CARDINAL ← 0; --for debugging!
tupleNumber: CARDINAL ← 0;
destContext: RoutingTable.NetworkContext ← NIL;
destNetwork: Driver.Device ← NIL;
DoSendResponse: PROC [] RETURNS [nil: NSBuffer.Buffer ← NIL] =
BEGIN
sent: BOOLEAN ← RoutAndSendRoutingInfoResponseLocked[b];
IF NOT sent THEN Driver.PutOnGlobalDoneQueue[LOOPHOLE[b]];
packetsSent ← packetsSent + 1;
END; --of DoSendResponse
IF (b # NIL) THEN --we are supplied with a buffer
BEGIN
body ← b.ns;
destContext ← b.fo.context;
destNetwork ← b.fo.network;
body.destination ← to;
body.pktLength ← NSTypes.bytesPerIDPHeader + bytesPerRoutingInfoType;
END;
FOR hops: HopCount IN [localHop..infinityHopCount) DO
net: NetworkNumber ← nullEnum;
net ← InrInternal.EnumerateByDistance[net, hops];
UNTIL (net = nullEnum) DO --get entries with this hop count
--* fill in buffer with (net, hops) pair
SELECT TRUE FROM
(net = nullNetworkNumber), --no ultimate dest
(onlyChangedEntries AND ~EntryChanged[net]) => NULL;
ENDCASE =>
BEGIN
-- handle this valid rte; Do we have a buffer?
IF (b = NIL) THEN
BEGIN
-- get and set a new buffer. Other fields of buffer are set by
-- RoutAndSendRoutingInfoResponse proc
b ← NSBuffer.GetBuffer [aH: bufferHandle, function: send,
size: fullBuffer, wait: TRUE ! ABORTED => {b ← NIL; CONTINUE}];
-- The buffer was charged it to the inr's account. inr's sent
-- buffer account (from <bufferHandle>) is only one.
-- By having a single send buffer, the rate of sending gratuitous
-- response packet is slowed down since a second send buffer
-- cannot be acquired until the first one has been through the
-- system (and thus out the door).
IF (b = NIL) THEN RETURN; -- give up!
body ← b.ns;
body.destination ← to;
b.fo.context ← destContext;
b.fo.network ← destNetwork; -- RoutAndSendRoutingInfoResponse proc
-- will check that the b.fo.network is valid, and set it if we are
-- broadcasting this response.
body.pktLength ← NSTypes.bytesPerIDPHeader + bytesPerRoutingInfoType;
tupleNumber ← 0;
END; -- of getting a new buffer
body.routingTuple[tupleNumber] ← [net,
IF allAreUnreachable THEN infinityHopCount ELSE
-- we increment the hop count here!
MIN [(hops + 1 + extraHops), infinityHopCount] ];
ResetEntry[net];
tupleNumber ← tupleNumber + 1;
body.pktLength ← body.pktLength + bytesPerRoutingInfoTuple;
END; -- of handling a valid rte
--* time to get next routing table entry
net ← InrInternal.EnumerateByDistance[net, hops]; --next rte
--* Is it time to send this buffer?
IF (b # NIL) AND (tupleNumber >= maxTuplesPerRoutingPacket) THEN
-- packet is full, go ahead and send the packet
b ← DoSendResponse[];
ENDLOOP; --end of getting entries with this hop count
ENDLOOP; --end of enumeration
-- Now all the routing table entries have been enumerated. If a sparse
-- buffer exists, sent it on its way.
IF (b # NIL) THEN b ← DoSendResponse[];
END; --SendGratuitousResponse
-- This is a special case! Send extended routing information.
SendGratuitousExtendedResponse: PROCEDURE [
to: System.NetworkAddress, b: NSBuffer.Buffer ← NIL,
allAreUnreachable, onlyChangedEntries: BOOLEAN ← FALSE,
alwaysDetermineViaNet: BOOLEAN ← TRUE] =
BEGIN
body: NSBuffer.Body ← NIL;
tupleNumber: CARDINAL ← 0;
destContext: RoutingTable.NetworkContext ← NIL;
destNetwork: Driver.Device ← NIL;
e: RoutingTableEntry ← NIL;
extended: LONG POINTER TO InrTypes.ExtendedRoutingInformation;
DoSendResponse: PROC [] RETURNS [nil: NSBuffer.Buffer ← NIL] =
BEGIN
sent: BOOLEAN ← RoutAndSendRoutingInfoResponseLocked[b, --extended--TRUE];
IF NOT sent THEN Driver.PutOnGlobalDoneQueue[LOOPHOLE[b]];
END; --of DoSendResponse
LockedGetFarNet: ENTRY PROC [net: Context]
RETURNS [farNet: NetworkNumber] =
BEGIN ENABLE UNWIND => NULL;
farNet ← GetFarNet [net];
END;
-- Mainline of the procedure ...
IF (b # NIL) THEN --we are supplied with a buffer
BEGIN
destContext ← b.fo.context;
destNetwork ← b.fo.network;
body.destination ← to;
body.pktLength ← NSTypes.bytesPerIDPHeader + bytesPerRoutingInfoType;
extended ← LOOPHOLE[@body.routingType];
END;
FOR hops: HopCount IN [localHop..infinityHopCount) DO
net: NetworkNumber ← nullEnum;
net ← InrInternal.EnumerateByDistance[net, hops];
e ← InrInternal.FindNetworkNumber[net, FALSE];
UNTIL (net = nullEnum) DO --get entries with this hop count
--* fill in buffer with [net, hops, immediate inr]
SELECT TRUE FROM
(net = nullNetworkNumber), --no ultimate dest
(onlyChangedEntries AND ~EntryChanged[net]) => NULL;
ENDCASE =>
BEGIN
IF (b = NIL) THEN
BEGIN
b ← NSBuffer.GetBuffer [aH: bufferHandle, function: send,
size: fullBuffer, wait: TRUE ! ABORTED => {b ← NIL; CONTINUE}];
IF (b = NIL) THEN RETURN; -- give up!
body ← b.ns; --set before using
body.destination ← to;
b.fo.context ← destContext;
b.fo.network ← destNetwork;
body.pktLength ← NSTypes.bytesPerIDPHeader + bytesPerRoutingInfoType;
extended ← LOOPHOLE[@body.routingType];
tupleNumber ← 0;
END; -- of getting a new buffer
IF allAreUnreachable OR (e = NIL) OR (e.context = NIL) THEN
BEGIN
extended.routingTuple[tupleNumber] ← [
objectNetID: net, interrouterDelay: infinityHopCount,
viaNet: nullNetworkNumber, viaHost: System.nullHostNumber];
END
ELSE BEGIN
farNet: NetworkNumber ← IF alwaysDetermineViaNet
AND (e.context.netNumber = nullNetworkNumber)
THEN LockedGetFarNet [e.context] ELSE e.context.netNumber;
extended.routingTuple[tupleNumber] ← [ objectNetID: net,
interrouterDelay: MIN [(hops + 1 + extraHops), infinityHopCount],
viaNet: farNet, viaHost: e.route];
END;
<< ResetEntry[net]; --don't do for Extended Response >>
tupleNumber ← tupleNumber + 1;
body.pktLength ← body.pktLength + bytesPerExtendedRoutingInfoTuple;
END; -- of handling a valid rte
net ← InrInternal.EnumerateByDistance[net, hops]; --next rte
e ← InrInternal.FindNetworkNumber[net, FALSE];
IF (b # NIL) AND (tupleNumber >= maxTuplesPerExtendedRoutingPacket)
THEN b ← DoSendResponse[];
ENDLOOP; --end of getting entries with this hop count
ENDLOOP; --end of enumeration
-- Now all the routing table entries have been enumerated. If a sparse
-- buffer exists, sent it on its way.
IF (b # NIL) THEN b ← DoSendResponse[];
END; --SendGratuitousExtendedResponse
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- This proc will send out a response packet. It is given the incoming
-- routing request packet, which it will properly handle. It will set the
-- destination to be <to>. (i.e. will use the request to send the response)
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
SendRoutingInfoResponse: PROCEDURE [
to: System.NetworkAddress, b: NSBuffer.Buffer] =
BEGIN
body: NSBuffer.Body = b.ns;
maxTuplesPerRoutingPacket: CARDINAL =
(NSTypes.maxIDPDataBytes - bytesPerRoutingInfoType) /
bytesPerRoutingInfoTuple;
numberOfTuples: CARDINAL =
(body.pktLength - NSTypes.bytesPerIDPHeader - bytesPerRoutingInfoType) /
bytesPerRoutingInfoTuple;
SendRoutingInfoResponseLocked: ENTRY PROCEDURE
RETURNS [sent: BOOLEAN ← TRUE] =
BEGIN ENABLE UNWIND => NULL;
e: RoutingTableEntry;
FOR i: CARDINAL IN [0..numberOfTuples) DO
IF (body.routingTuple[i].objectNetID = anyNetNetworkNumber) OR
(body.routingTuple[i].objectNetID = anyNetNetworkNumberFor860)
-- Hack for the dumb 860!
THEN
RETURN [FALSE]; -- we'll send him a gratitous packet with all the rte's
e ← InrInternal.FindNetworkNumber [body.routingTuple[i].objectNetID, FALSE];
body.routingTuple[i].interrouterDelay ←
IF (e = NIL) OR (e.context = NIL) THEN infinityHopCount -- no route
-- we increment the hop count here!
ELSE MIN [(e.delay + 1 + extraHops), infinityHopCount];
ENDLOOP;
body.pktLength ← NSTypes.bytesPerIDPHeader + bytesPerRoutingInfoType
+ (numberOfTuples*bytesPerRoutingInfoTuple);
body.destination ← to;
IF NOT RoutAndSendRoutingInfoResponse[b] THEN
Socket.ReturnBuffer[b];
<< Driver.PutOnGlobalDoneQueue would be overkill since we know that
we got the buffer through the Socket.Get procedure. We don't
return[False] since the source would then be sent a gratuitous
type of packet. >>
END; -- of SendRoutingInfoResponseLocked
-- start of procedure
IF (numberOfTuples = 0) OR (numberOfTuples > maxTuplesPerRoutingPacket)
OR NOT SendRoutingInfoResponseLocked[] THEN
SendGratuitousResponse [to, b];
StatIncr [@stats.specificRoutingResponseSent];
END; -- of SendRoutingInfoResponse
SendRoutingInfoExtendedResponse: PROCEDURE [
to: System.NetworkAddress, b: NSBuffer.Buffer,
alwaysDetermineViaNet: BOOLEAN ← TRUE] =
BEGIN
body: NSBuffer.Body = b.ns;
maxTuplesPerRoutingPacket: CARDINAL =
(NSTypes.maxIDPDataBytes - bytesPerRoutingInfoType) /
bytesPerExtendedRoutingInfoTuple;
numberOfTuples: CARDINAL =
(body.pktLength - NSTypes.bytesPerIDPHeader - bytesPerRoutingInfoType) /
bytesPerExtendedRoutingInfoTuple;
SendRoutingInfoExtendedResponseLocked: ENTRY PROCEDURE
RETURNS [sent: BOOLEAN ← TRUE] =
BEGIN ENABLE UNWIND => NULL;
e: RoutingTableEntry;
extended: LONG POINTER TO InrTypes.ExtendedRoutingInformation
= LOOPHOLE[@body.routingType];
dest: NetworkNumber ← nullNetworkNumber;
FOR i: CARDINAL IN [0..numberOfTuples) DO
dest ← extended.routingTuple[i].objectNetID;
IF (dest = anyNetNetworkNumber) OR (dest = anyNetNetworkNumberFor860)
THEN RETURN [FALSE];
e ← InrInternal.FindNetworkNumber [dest, FALSE];
IF (e = NIL) OR (e.context = NIL) THEN
BEGIN
extended.routingTuple[i] ← [
objectNetID: dest, interrouterDelay: infinityHopCount,
viaNet: nullNetworkNumber, viaHost: System.nullHostNumber];
END
ELSE BEGIN
farNet: NetworkNumber ← IF alwaysDetermineViaNet
AND (e.context.netNumber = nullNetworkNumber)
THEN GetFarNet [e.context] ELSE e.context.netNumber;
extended.routingTuple[i] ← [ objectNetID: dest,
interrouterDelay: MIN [(e.delay + 1 + extraHops), infinityHopCount],
viaNet: farNet, viaHost: e.route];
END;
ENDLOOP;
body.pktLength ← NSTypes.bytesPerIDPHeader + bytesPerRoutingInfoType
+ (numberOfTuples*bytesPerExtendedRoutingInfoTuple);
body.destination ← to;
IF NOT RoutAndSendRoutingInfoResponse[b: b, extended: TRUE] THEN
Socket.ReturnBuffer[b];
END; -- of SendRoutingInfoExtendedResponseLocked
-- start of procedure
IF (numberOfTuples = 0) OR (numberOfTuples > maxTuplesPerRoutingPacket)
OR NOT SendRoutingInfoExtendedResponseLocked[] THEN
SendGratuitousExtendedResponse [to, b];
StatIncr [@stats.specificRoutingResponseSent];
END; -- of SendRoutingInfoExtendedResponse
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- This proc sets the misnumbered net trap. Allows the client to learn about
-- bogus routers on the network
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
SetMisnumberedNetTrap: PUBLIC -- InrFriends-- PROCEDURE
[proc: InrFriends.MisnumberedNetTrap] =
BEGIN
misnumberedNetTrap ← IF proc = NIL THEN DefaultMisnumberedNetTrap ELSE
proc;
END;
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- This hot procedure fills in some routing information and sends the buffer
-- out on the appropriate network. The send is asynchronous; the caller
-- owns the buffer and receives its back from the the dispatcher via
-- b.requeueProcedure (when the send is completed). Transmit is passed to
-- the Pilot Router.
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
Transmit: PROCEDURE[b: NSBuffer.Buffer] =
BEGIN
body: NSBuffer.Body = b.ns;
destHost: HostNumber ← body.destination.host;
nextHost: HostNumber;
destNetNumber: NetworkNumber ← body.destination.net;
context: Context;
e: RoutingTableEntry;
FindNetworkNumberLocked: ENTRY PROCEDURE [n: NetworkNumber]
RETURNS [e: RoutingTableEntry] = INLINE
BEGIN
ENABLE UNWIND => NULL;
e ← InrInternal.FindNetworkNumber[n];
END; -- of FindNetworkNumberLocked
-- start of procedure
e ← FindNetworkNumberLocked[destNetNumber]; --first find in routing entry
IF (e = NIL) OR ((context ← e.context) = NIL) THEN
BEGIN --outgoing packet for unknown net
--return b to the system buffer pool
b.fo.status ← noRouteToNetwork;
Driver.PutOnGlobalDoneQueue[LOOPHOLE[b]];
IF doNSStats THEN Stats.StatIncr[statNSSentNowhere];
RETURN; --goodbye!
END;
--outgoing packet to be transmitted over the correct network
nextHost ← IF (e.route # unknownHostID) THEN
e.route -- next inr's address
ELSE destHost; -- we are attached to the destination net
b.fo.status ← goodCompletion;
b.fo.network ← context.network; -- mark the network being used
b.fo.context ← context;
b.fo.type ← ns;
--synchronous buffer send
Protocol1.EncapsulateAndTransmit[LOOPHOLE[b], @nextHost];
--start packet on its way
StatIncr [@stats.pktsTransmitted];
END; --Transmit
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- This routine examines the routing tuples in the passed in Routing
-- Information Response packet and uses them to update its routing table.
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
UpdateRoutingTable: INTERNAL PROCEDURE [b: NSBuffer.Buffer] =
BEGIN
body: NSBuffer.Body = b.ns;
i: CARDINAL;
e: RoutingTableEntry ← NIL;
newDelay: CARDINAL;
changed: BOOLEAN ← FALSE;
t: NSTypes.RoutingInfoTuple;
tuples: CARDINAL = -- number of tuples in the packet.
(body.pktLength - NSTypes.bytesPerIDPHeader - bytesPerRoutingInfoType) /
bytesPerRoutingInfoTuple;
FOR i IN [0..tuples) DO
<< this is all reasonably hairy. See page 28 of Yogen's Internet Transport Protocols book for further information >>
t ← body.routingTuple[i];
newDelay ← Inline.BITAND[mask, t.interrouterDelay]; -- ignore high bits.
-- <newDelay> must be greater than local hop (0), otherwise error
IF (newDelay = localHop) THEN IF CommFlags.doDebug
THEN ERROR ELSE LOOP; -- misleading tuple
IF ((e ← InrInternal.FindNetworkNumber[t.objectNetID, FALSE]) # NIL) THEN
BEGIN -- update an already present tuple
SELECT TRUE FROM
((e.route = body.source.host) AND (e.context = b.fo.context)),
-- new info from our supplier (case 2 from the spec)
(e.timeUnits < alternatePathTimeUnitThreshHold),
-- time to get better info (case 3)
(e.context = NIL), --need better info
(newDelay < e.delay) --better route (case 4)-- =>
BEGIN
e.changed ← (e.delay # newDelay);
changed ← (changed OR e.changed);
-- to the outside world (who hear via routing info packets),
-- there has been a change only if the <delay> has changed.
-- Or if a destination net has been added
e.delay ← newDelay;
e.route ← body.source.host;
e.context ← b.fo.context;
IF (e.delay < infinityHopCount) THEN e.timeUnits ← updateCycles
ELSE
BEGIN
e.delay ← infinityHopCount; -- this ensures that the delay
-- isn't > infinityHopCount
e.context ← NIL;
e.route ← System.nullHostNumber;
END;
END;
ENDCASE;
END -- End of update of existing tuple.
ELSE -- no tuple so far
-- collect new info because, as an INR, we know about every net
IF (newDelay < infinityHopCount) -- is it accessable?
AND (t.objectNetID # anyNetNetworkNumber) -- Paranoia
AND (t.objectNetID # System.nullNetworkNumber) -- Paranoia
THEN
BEGIN
e ← CommHeap.zone.NEW[RoutingTableObject];
e↑ ← [
nextRTE:, nextNSE:, destNetwork: t.objectNetID, delay: newDelay,
timeUnits: updateCycles, route: body.source.host,
context: b.fo.context, changed: TRUE];
InrInternal.AddEntry[e]; --it will set linkage
changed ← TRUE;
END;
ENDLOOP; --FOR i IN [0..tuples) do
--if something has changed then propagate the information
IF changed THEN NOTIFY InrInternal.routingTableChanged;
END; --UpdateRoutingTable
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- Start-up/ Shut-down routines. When a new INR is register with Pilot
-- with the routine RoutingTable.Register[], the old INR is automatically
-- unregistered. Upon the call to register, Pilot calls the stop routine
-- for the previously registered INR and then subsequently calls the start
-- routine of the newly registered INR.
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
ActivateINR: PUBLIC PROCEDURE =
BEGIN --will be called by IRS to start INR
IF pleaseStop THEN RoutingTable.Register[ptrToRto];
--made call only if we are not already started
END;
DeactivateINR: PUBLIC PROCEDURE =
BEGIN --will be called by IRS to stop INR.
IF NOT pleaseStop THEN RoutingTable.Register[NIL];
END;
SetNSFudge: PUBLIC PROCEDURE [hops: CARDINAL] =
BEGIN
extraHops ← hops;
END;
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- Stop the Internetwork Router. This routine is passed to the Pilot Router.
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
Stop: PROCEDURE =
BEGIN
RoutingTableDeactivate[]; -- inline to abort all forked process
JOIN routingInformationSupplierFork;
JOIN internetRouterServerFork;
JOIN decrementRoutingTableEntriesFork;
InrInternal.CleanUpRoutingTable[];
StopStats[];
END; --Stop
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
-- Start the Internetwork Router. This routine is passed to the Pilot Router.
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --
Start: PROCEDURE =
BEGIN
pleaseStop ← FALSE; << FALSE shows that we are ON >>
StartStats[];
myHostID ← Router.FindMyHostID[];
InrInternal.RoutingTableActivate[bitsHashed, markDead];
FOR n: Driver.Device ← Driver.GetDeviceChain[], n.next UNTIL (n = NIL) DO
InrInternal.AddNet[Protocol1.GetContext[n, ns]];
ENDLOOP;
routingInformationSupplierFork ← FORK RoutingInformationSupplier [];
internetRouterServerFork ← FORK InternetRouterServer [];
decrementRoutingTableEntriesFork ← FORK InrInternal.DecrementRoutingTableEntries [];
routingTableChangedFork ← FORK InrInternal.RoutingTableChanged [];
END; --Start
--**************** Statistics ****************
GetStats: PUBLIC PROCEDURE RETURNS [
LONG POINTER TO READONLY InrStats.Stats, System.GreenwichMeanTime] =
{RETURN [stats, lastGetStats ← System.GetGreenwichMeanTime[]]};
StartStats: PROCEDURE =
BEGIN
stats ← CommHeap.zone.NEW [InrStats.Stats ← [System.GetGreenwichMeanTime[]]];
END;
StopStats: PROCEDURE =
BEGIN
CommHeap.zone.FREE [@stats];
IF doMPCodes THEN
BEGIN
FOR i: MPCodes IN [MPCodes.FIRST..MPCodes.LAST] DO
gratuitousStats[i] ← 0;
ENDLOOP;
ProcessorFace.SetMP[8000];
END;
END; --of StopStats
StatIncr: PROCEDURE [counter: LONG POINTER TO LONG CARDINAL] = INLINE
--add one to counter
BEGIN
--locals
counter↑ ← (counter↑ + 1) MOD (LAST[LONG CARDINAL] - 1);
END;
StatBump: PROCEDURE [
counter: LONG POINTER TO LONG CARDINAL, bumpAmount: CARDINAL] = INLINE
BEGIN
--locals
<<
--add bumpAmount to counter; if bumpAmount < 10000, there will never
--be overflow
counter↑ ← (counter↑ + bumpAmount) MOD (LAST[LONG CARDINAL] - 10000);
>>
counter↑ ← MIN[(counter↑ + bumpAmount), (LAST[LONG CARDINAL] - 10000)];
END;
PulsesBump: PROCEDURE [
counter: LONG POINTER TO System.Pulses, bumpAmount: System.Pulses] = INLINE
BEGIN
overflow: System.Pulses = LOOPHOLE[LAST[LONG CARDINAL]];
counter↑ ← System.Pulses[MIN[(counter↑ + bumpAmount), overflow]];
END;
--**************** Main Program ****************
--initialization (Cold)
Process.SetTimeout[@internetRouterTimer, Process.MsecToTicks[25500]];
-- set for 26.5 seconds so that when the extra random wait [0..7] seconds
-- is added, the average time between gratuitous pkts is 30 seconds
Process.SetTimeout[@auxInternetRouterTimer, Process.MsecToTicks[500]];
Process.DisableTimeout [@InrInternal.routingTableChanged];
Process.EnableAborts [@internetRouterTimer];
Process.EnableAborts [@auxInternetRouterTimer];
Process.EnableAborts [@InrInternal.routingTableChanged];
END. --RoutingTableImpl module.
<<
LOG
5-Feb-88 13:43:52 AOF Trimmed for PupGateway
>>