-- File: ArpaRouterImpl.mesa - last edit:
-- JAV                 10-Dec-87 12:49:33
-- AOF                 26-May-87 11:07:23
-- SMA                 27-Jun-86 13:40:56
-- Copyright (C) 1985, 1986, 1987 by Xerox Corporation. All rights reserved.

DIRECTORY
  ArpaBuffer USING [
    Body, Buffer, Enqueue, ExtractFromQueue, DataBytesPerRawBuffer,
    From, QueueObject, QueueCleanup, QueueInitialize, ReturnBuffer, To],
  ArpaFlags USING [doStats],
  ArpaInit USING [GetArpaInitInfo],
  ArpaPortInternal USING [AddrMatch, AddrMismatch, Checksum, DestType, 
    InitUniquePort, QueueForClient],
  ArpaPort USING [minIPHeaderBytes, SwapSourceAndDestination],
  Arpa10MBit USING [Capsulators, CreateCapsulators],
  ArpaRouter USING [unknownInternetAddress],
  ArpaRoutingTable USING [ContextObject, defaultRth, Handle, InfoReply,
    NetworkContext, Object, ProbeGateway, Redirect, RoutersFunction],
  ArpaStats USING [Incr],
  ArpaTypes USING [Cardinal32, Icmp, IcmpType, InternetAddress, Port, Timestamp],
  Buffer USING [],
  ByteBlt USING [ByteBlt],
  CommHeap USING [zone],
  CommunicationInternal USING [CommPackageGo],
  Driver USING [GetDeviceChain, Device, nilDevice, PutOnGlobalDoneQueue],
  Environment USING [Byte, bytesPerWord],
  IEEE8023 USING [EncapObject, maxDataBytesPerEthernetPacket],
  Inline USING [DBITAND, UDDivMod],
  Mopcodes USING [zEXCH],
  Process USING [Abort, EnableAborts, Pause, priorityNormal, SecondsToTicks,
    SetPriority, SetTimeout, Yield],
  ProcessorFace USING [mp, SetMP],
  Protocol1 USING [
    Action, AddFamilyMember, EncapsulateAndTransmit, EvictFamily, Family, FamilyUnit,
    MatrixRecord, RegisterFamily, SetMaximumBufferSize],
  System USING [GetClockPulses, GetGreenwichMeanTime, PulsesToMicroseconds];

ArpaRouterImpl: MONITOR
  IMPORTS
    ArpaBuffer, ArpaInit, ArpaPort, ArpaPortInternal, Arpa10MBit, ArpaRouter,
    ArpaRoutingTable, ArpaStats, ByteBlt, CommHeap, CommunicationInternal,
    Driver, Inline, Process, ProcessorFace, Protocol1, System
  EXPORTS ArpaPortInternal, ArpaPort, ArpaRouter, ArpaRoutingTable, Buffer =
  BEGIN  --IP implementation.

  Port: PUBLIC --ArpaRouter-- TYPE = ArpaTypes.Port;
  InternetAddress: PUBLIC --ArpaRouter-- TYPE = ArpaTypes.InternetAddress;

  Device: PUBLIC --Buffer-- TYPE = Driver.Device;
  
  driverLoopback: BOOLEAN ¬ FALSE;
  bpw: NATURAL = Environment.bytesPerWord;
  routersFunction: ArpaRoutingTable.RoutersFunction;
  unknownInternetAddress: PUBLIC <<ArpaRouter>> InternetAddress ¬ [0, 0];
  
  --Start up and addresses for the primary ethernet.
  findAddrMP: CARDINAL = 982;  --set in MP when searching for my address
  myArpaAddr, myBroadcastAddr, myGWAddr, mySubnetMask, myDomainNameServer,
  myNullAddr: InternetAddress ¬ unknownInternetAddress;

  rto: PUBLIC ArpaRoutingTable.Object;  --the routing object

  arpaProtocolFamily: PUBLIC Protocol1.FamilyUnit ¬ [
    name: <<Protocol1.ProtocolFamily>> arpa,
    state: <<LONG POINTER>> NIL,
    status: <<Protocol1.FamilyStatus>> dead,
    maxBufferSize: <<CARDINAL>> IEEE8023.maxDataBytesPerEthernetPacket, --1500
    receive: <<PROC[Buffer.Buffer]>> LOOPHOLE[ReceivePacket],
    broadcast: <<PROC[Buffer.Buffer]>> LOOPHOLE[Broadcast],
    stateChanged: <<PROC[
      Buffer.Device, LONG POINTER, Protocol1.Action]>> StateChanged,
    spy: <<PROC[
      Buffer.Buffer, Buffer.Function] RETURNS [Buffer.Buffer]>> NIL];

  useCount: CARDINAL ¬ 0;
  
  --IP reassembly.
  ListEntry: TYPE = LONG ORDERED POINTER TO ListObject;
  ListObject: TYPE = RECORD [next: ListEntry, first, last: CARDINAL];
      
  fragQueue: ArpaBuffer.QueueObject;  --queue of packets being reassembled.
  fragTimeout: CARDINAL = 15;  --in seconds
  fragTimer: CONDITION;
  fragWatcher: PROCESS ¬ NIL;
  
  --addressing classes
  classA: InternetAddress = [0B, 0B];
  classB: InternetAddress = [100000B, 0B];
  classC: InternetAddress = [140000B, 0B];
  classAMask: InternetAddress = [100000B, 0B];
  classBMask: InternetAddress = [140000B, 0B];
  classCMask: InternetAddress = [160000B, 0B];


  ArpaPackageMake: PUBLIC PROC =
    BEGIN
    AlreadyStarted: ENTRY PROC RETURNS[BOOLEAN] = INLINE
      {RETURN[(useCount ¬ useCount + 1) > 1]};

    driver: Device;
    matrix: Protocol1.MatrixRecord;
    oldMp: CARDINAL = ProcessorFace.mp;

    IF AlreadyStarted[] THEN RETURN;
    CommunicationInternal.CommPackageGo[];  --we need the basics
    driverLoopback ¬ TRUE;
    ArpaPortInternal.InitUniquePort[];
    <<
    --This should eventually be done by something like RARP.
    This proc should eventually broadcast an ICMP address mask reply and
    Receive should parse ICMP address mask replies.  But for now (and until we
    know if any gateways actually support ICMP address mask replies), I used
    our favorite host table hack in GetArpaAddr...
    >>
    ProcessorFace.SetMP[findAddrMP];
    <<UNTIL myArpaAddr # ArpaRouter.unknownInternetAddress>> DO
      [myArpaAddr, myGWAddr, mySubnetMask, myDomainNameServer] ¬
        ArpaInit.GetArpaInitInfo[];
      IF myArpaAddr # unknownInternetAddress THEN EXIT;
      Process.Pause[Process.SecondsToTicks[10]];
      ENDLOOP;
    ProcessorFace.SetMP[oldMp];  --back to original value
    myBroadcastAddr ¬ SELECT TRUE FROM
      Inline.DBITAND[LOOPHOLE[myArpaAddr], LOOPHOLE[classAMask]] =
        LOOPHOLE[classA, LONG UNSPECIFIED] => [77777B, 177777B],
      Inline.DBITAND[LOOPHOLE[myArpaAddr], LOOPHOLE[classBMask]] =
        LOOPHOLE[classB, LONG UNSPECIFIED] => [137777B, 177777B],
      Inline.DBITAND[LOOPHOLE[myArpaAddr], LOOPHOLE[classCMask]] =
        LOOPHOLE[classC, LONG UNSPECIFIED] => [157777B, 177777B],
      ENDCASE => unknownInternetAddress;
    myNullAddr ¬ SELECT TRUE FROM
      Inline.DBITAND[LOOPHOLE[myArpaAddr], LOOPHOLE[classAMask]] =
        LOOPHOLE[classA, LONG UNSPECIFIED] => classA,
      Inline.DBITAND[LOOPHOLE[myArpaAddr], LOOPHOLE[classBMask]] =
        LOOPHOLE[classB, LONG UNSPECIFIED] => classB,
      Inline.DBITAND[LOOPHOLE[myArpaAddr], LOOPHOLE[classCMask]] =
        LOOPHOLE[classC, LONG UNSPECIFIED] => classC,
      ENDCASE => ArpaRouter.unknownInternetAddress;

    BEGIN
    OPEN c: LOOPHOLE[matrix.context, ArpaRoutingTable.NetworkContext];
    Protocol1.RegisterFamily[@arpaProtocolFamily];  --make us known
    matrix.family ¬ @arpaProtocolFamily;  --this is the same for all drivers
    FOR driver ¬ Driver.GetDeviceChain[], driver.next UNTIL driver = NIL DO
      IF (driver.device # ethernet) OR ~driver.alive THEN LOOP;
      matrix.context ¬ CommHeap.zone.NEW[ArpaRoutingTable.ContextObject];
      c.network ¬ driver;
      c.stats ¬ NIL;
      c.protocol ¬ Arpa10MBit.CreateCapsulators[driver];
      [matrix.decapsulator, matrix.encapsulator] ¬ Arpa10MBit.Capsulators[];
      --after the call to ProbeGateway, c.net will either be set, or will be null
      --with the correct class bits turned on.
      c.net ¬ ArpaRouter.unknownInternetAddress;
      c.host ¬ myArpaAddr;
      [c.hostMask, c.netMask] ¬ BuildMasks[c.host];
      IF (mySubnetMask ¬ GetSubnetMask[]) # ArpaRouter.unknownInternetAddress THEN
        c.netMask ¬ mySubnetMask;  --are subnets in use?
      Protocol1.AddFamilyMember[driver, @matrix];
      Protocol1.SetMaximumBufferSize[driver, @arpaProtocolFamily, IEEE8023.maxDataBytesPerEthernetPacket];
      ENDLOOP;
    Register[];  --register default table impl
    ArpaBuffer.QueueInitialize[@fragQueue];
    Process.SetTimeout[@fragTimer, Process.SecondsToTicks[7]];
    Process.EnableAborts[@fragTimer];
    END;  --OPEN context

    ArpaRoutingTable.ProbeGateway[];  --for our own net number.
    END;  --ArpaPackageMake
    

  ArpaPackageDestroy: PUBLIC PROC =
    BEGIN
    
    StillInUse: ENTRY PROC RETURNS[BOOLEAN] =
      {RETURN [(useCount ¬ useCount - 1) # 0]};
    
    IF StillInUse[] THEN RETURN;  
    Protocol1.EvictFamily[arpa];  --stop dispatcher's access
    IF (fragWatcher # NIL) THEN
      BEGIN
      Process.Abort[fragWatcher];
      JOIN fragWatcher;
      END;
    ArpaBuffer.QueueCleanup[@fragQueue];
    IF rto.stop # NIL THEN rto.stop[];
    END;  --ArpaPackageDestroy
    
  
  Broadcast: PROC[b: ArpaBuffer.Buffer] =
    BEGIN
    network: Device = b.fo.network;
    body: ArpaBuffer.Body = b.arpa;
    IF ~network.alive THEN
      {Driver.PutOnGlobalDoneQueue[ArpaBuffer.To[b]]; RETURN};
    body.ipHeader.source ¬ myArpaAddr;
    body.ipHeader.destination ¬ myBroadcastAddr;
    body.ipHeader.checksum ¬ 0;
    body.ipHeader.checksum ¬ ArpaPortInternal.Checksum[
      0, body.ipHeader.ihl * bpw, @body.ipHeader];
    b.fo.status ¬ goodCompletion;
    Protocol1.EncapsulateAndTransmit[ArpaBuffer.To[b], @myBroadcastAddr];
    IF ArpaFlags.doStats THEN ArpaStats.Incr[broadcastsSent];
    END;  --Broadcast
    
  BuildMasks: PUBLIC PROC [addr: InternetAddress]
    RETURNS [hostMask, netMask: InternetAddress] =
    BEGIN
    SELECT TRUE FROM
      (Inline.DBITAND[LOOPHOLE[addr], LOOPHOLE[classAMask]] =
        LOOPHOLE[classA, LONG UNSPECIFIED]) =>
        {hostMask ¬ [100377B, 177777B];
	netMask ¬ [177400B, 0B]};
      (Inline.DBITAND[LOOPHOLE[addr], LOOPHOLE[classBMask]] =
        LOOPHOLE[classB, LONG UNSPECIFIED]) =>
        {hostMask ¬ [140000B, 177777B];
	netMask ¬ [177777B, 0B]};
      (Inline.DBITAND[LOOPHOLE[addr], LOOPHOLE[classCMask]] =
        LOOPHOLE[classC, LONG UNSPECIFIED]) => 
        {hostMask ¬ [160000B, 377B];
	netMask ¬ [177777B, 177400B]};
      ENDCASE =>  --unimplemented extended addressing or unrecognizable.
        hostMask ¬ netMask ¬ [0B, 0B];
    END;  --BuildMasks
    
    
  GetArpaAddr, GetAddress: PUBLIC <<ArpaPortInternal, ArpaRouter>> ENTRY PROC
    RETURNS [ArpaTypes.InternetAddress] = {RETURN[myArpaAddr]};
    
  GetGatewayAddr: PUBLIC <<ArpaPortInternal>> ENTRY PROC
    RETURNS [addr: ArpaTypes.InternetAddress] = {RETURN[myGWAddr]};
  
  SetGatewayAddr: PUBLIC <<ArpaPortInternal>> ENTRY PROC
    [addr: ArpaTypes.InternetAddress] = {myGWAddr ¬ addr};

  GetDomainNameServer: PUBLIC <<ArpaPortInternal>> ENTRY PROC
    RETURNS [addr: ArpaTypes.InternetAddress] = {RETURN[myDomainNameServer]};
  
  SetDomainNameServer: PUBLIC <<ArpaPortInternal>> ENTRY PROC
    [addr: ArpaTypes.InternetAddress] = {myDomainNameServer ¬ addr};
    
  GetSubnetMask: PUBLIC PROC RETURNS[InternetAddress] = {RETURN[mySubnetMask]};

  GetMyBroadcastAddr: PUBLIC <<ArpaPortInternal>> PROC[]
    RETURNS[InternetAddress] = {RETURN[myBroadcastAddr]};  --GetMyBroadcastAddr    
    
  GetMyNullAddr: PUBLIC <<ArpaPortInternal>> PROC[] RETURNS[InternetAddress] =
    {RETURN[myNullAddr]};  --GetMyNullAddr

  GetIPLengths: PUBLIC PROC [body: ArpaBuffer.Body]
    RETURNS [optionsLen, dataLen: CARDINAL] =
    BEGIN
    dataLen ¬ body.ipHeader.length - body.ipHeader.ihl*4;
    optionsLen ¬ body.ipHeader.ihl*4 - ArpaPort.minIPHeaderBytes - dataLen;
    END;  --GetIPLengths
    
      
  ProcessICMPPacket: PROC [b: ArpaBuffer.Buffer]
    RETURNS [keeper: BOOLEAN ¬ FALSE] =
    BEGIN
    OPEN c: LOOPHOLE[b.fo.context, ArpaRoutingTable.NetworkContext];
    body: ArpaBuffer.Body = b.arpa;
    hmsk: InternetAddress = c.hostMask;
    bytes: CARDINAL ¬ body.ipHeader.length - (body.ipHeader.ihl*4);
    words: CARDINAL ¬ (bytes + bpw - 1) / bpw;
    PTag: TYPE = LONG POINTER TO Tag;
    Tag: TYPE = ARRAY[0..2) OF ArpaTypes.IcmpType;
    
    IF ArpaFlags.doStats THEN ArpaStats.Incr[
      SELECT body.icmp.type FROM
	unreachable => icmpUnreachable,
	timeExceeded => icmpTimeExceeded,
	paramProblem => icmpParam,
	quench => icmpQuench,
	redirect => icmpRedirect,
	infoRequest => icmpInfoReq,
	infoReply => icmpInfoRep,
	echo => icmpEcho,
	echoReply => icmpEchoRep,
	timestamp => icmpTimestamp,
	timestampReply => icmpTimestampRep,
	ENDCASE => icmpUnknown];
	
    --Check the checksum.
    IF (bytes MOD 2) # 0 THEN body.ipBytes[bytes] ¬ 0;  --zero the pad byte.
    IF ArpaPortInternal.Checksum[0, words, @body.icmp] # 0 THEN
      BEGIN
      IF ArpaFlags.doStats THEN ArpaStats.Incr[icmpChecksum];
      ArpaBuffer.ReturnBuffer[b]; RETURN;
      END;
	
    WITH icmp: body.icmp SELECT FROM
      --for the routing table implementation.
      redirect =>
        {ArpaRoutingTable.Redirect[b]; ArpaBuffer.ReturnBuffer[b]};
      infoReply =>
        {ArpaRoutingTable.InfoReply[b]; ArpaBuffer.ReturnBuffer[b]};
      --echo and timestamp can be taken care of right here.
      echo =>
	BEGIN
	<<
	Need to modify the IcmpType from 'echo' to 'echoReply'. That's no
	small feat considering that it's also the variant tag field.
	>>
	tag: Tag = ALL[ArpaTypes.IcmpType[echoReply]];
	LOOPHOLE[@body.icmp.body, PTag]­[0] ¬ tag[0];
	ArpaPort.SwapSourceAndDestination[b];
	icmp.checksum ¬ 0;  --first you set it to zero
	icmp.checksum ¬ ArpaPortInternal.Checksum[0, words, @body.icmp];
	SendPacket[b,
	  IF ArpaPortInternal.AddrMatch[hmsk, body.ipHeader.source,
	  body.ipHeader.destination] THEN local ELSE remote];
	END;
      timestamp =>
	BEGIN
	<<
	Need to modify the IcmpType from 'timestamp' to 'timestampReply'.
	That's no small feat considering that it's also the variant tag field.
	>>
	CardToTime: PROC[LONG CARDINAL] RETURNS[ArpaTypes.Cardinal32] =
	  MACHINE CODE {Mopcodes.zEXCH};
	tag: Tag = ALL[ArpaTypes.IcmpType[timestampReply]];
	secondsInDay: LONG CARDINAL = LONG[24 --hr-- * 60 --min--] * 60  --sec--;
	now: LONG CARDINAL ¬ System.GetGreenwichMeanTime[];  --that's current
	now ¬ now MOD secondsInDay;  --so that would have been midnight
	icmp.receive ¬ icmp.transmit ¬ CardToTime[now * 1000];  --in msecs
	LOOPHOLE[@body.icmp.body, PTag]­[0] ¬ tag[0];
	ArpaPort.SwapSourceAndDestination[b];  --get ready to send packet back
	icmp.checksum ¬ 0;  --first you set it to zero
	icmp.checksum ¬ ArpaPortInternal.Checksum[0, words, @body.icmp];
	SendPacket[b, IF ArpaPortInternal.AddrMatch[hmsk,
	  body.ipHeader.source, body.ipHeader.destination]
	  THEN local ELSE remote];
	END;
      --These are turned over to the client to handle
      unreachable, timeExceeded, paramProblem, quench, echoReply => keeper ¬ TRUE;
      --infoRequest, timestampReply, and unknowns just get ignored right here
      ENDCASE => ArpaBuffer.ReturnBuffer[b];
       
    END;  --ProcessICMPPacket

  ReceivePacket: PROC[b: ArpaBuffer.Buffer] =
    BEGIN
    OPEN
      ArpaPortInternal,  --for AddrMismatch and Checksum.
      c: LOOPHOLE[b.fo.context, ArpaRoutingTable.NetworkContext];
    body: ArpaBuffer.Body = b.arpa;
    hmsk: InternetAddress = c.hostMask;
    
    CleanFragList: ENTRY PROC = INLINE {NOTIFY fragTimer};

    CleanFragList[];  --get rid of possible old fragments
    IF ArpaFlags.doStats THEN ArpaStats.Incr[ipRecvd];
    
    SELECT TRUE FROM
      (rto.type # gateway AND
        AddrMismatch[hmsk, c.host, b.arpa.ipHeader.destination] AND
        AddrMismatch[hmsk, myBroadcastAddr, b.arpa.ipHeader.destination] AND
        AddrMismatch[hmsk, myNullAddr, b.arpa.ipHeader.destination]) =>	-- this is in violation fo protocol for 4.2Bsd broadcast
	  {IF ArpaFlags.doStats THEN ArpaStats.Incr[badDest];
	  ArpaBuffer.ReturnBuffer[b]};  --not for us.
      (Checksum[0, body.ipHeader.ihl * bpw, body] # 0) =>
	{IF ArpaFlags.doStats THEN ArpaStats.Incr[badChecksum];
	ArpaBuffer.ReturnBuffer[b]};  --bad checksum in header.
      (body.ipHeader.lifetime = 0) =>
        {IF ArpaFlags.doStats THEN ArpaStats.Incr[tooOld];
	ArpaBuffer.ReturnBuffer[b]};   --been around too long.
      ((body.ipHeader.fragment # 0) OR body.ipHeader.flags.moreFragment) AND
        ((b ¬ Reassemble[b]) = NIL) => NULL;  --Reassemble will return b.
      (rto.type = gateway) AND   --packet to forward.
        (AddrMismatch[hmsk, myBroadcastAddr, b.arpa.ipHeader.destination]) AND
          (AddrMismatch[hmsk, myNullAddr, b.arpa.ipHeader.destination]) AND -- don't forward broadcasts!!!
            (AddrMismatch[c.hostMask, c.host, body.ipHeader.destination]) =>
	      {IF ArpaFlags.doStats THEN ArpaStats.Incr[forwarded];
	      rto.forward[b]};
      (body.ipHeader.protocol = icmp) AND (~ProcessICMPPacket[b]) =>
        --icmp, maybe to client.
        NULL;  --ProcessICMPPacket will turn around or return the buffer.
      (~ArpaPortInternal.QueueForClient[b: b, copy: FALSE]) =>  --to client
        ArpaBuffer.ReturnBuffer[b];
      ENDCASE;
    END;  --ReceivePacket
    

  Reassemble: ENTRY PROC[frag: ArpaBuffer.Buffer]
    RETURNS [b: ArpaBuffer.Buffer] =
    BEGIN
    <<
    Takes an IP fragment and puts it into the reassembly buffer.  If this is 
    the first fragment of a packet to arrive, its buffer will be used as the
    reassembly buffer.  The reassembly is managed via hole descriptors and the
    algorthms in RFC 815.  The only difference is that the header is also
    managed with hole descriptors, hence all the additions of hdrLen in the
    calculations.
    >>
    body: ArpaBuffer.Body ¬ frag.arpa;
    IF fragWatcher = NIL THEN fragWatcher ¬ FORK FragWatcher[];
    IF ArpaFlags.doStats THEN ArpaStats.Incr[fragRcvd];
    IF (b ¬ FindReassembly[body]) = NIL THEN
      BEGIN
      listHead: ListEntry;
      --fragment of a new packet - this buffer will be used to reassemble into.
      ArpaBuffer.Enqueue[@fragQueue, frag];
      IF body.ipHeader.fragment = 0 THEN  --this has the header we want.
        BEGIN
	listHead ¬ LOOPHOLE[body + (body.ipHeader.length + 1)/2];
	listHead­ ¬ [NIL, body.ipHeader.length, LAST[CARDINAL]];
	END
      ELSE
        BEGIN  --we just want the data from any subsequent ones.
	listHead ¬ LOOPHOLE[body];
	listHead­ ¬ [NIL, 0, body.ipHeader.fragment * 8 - 1];
	listHead.next ¬ LOOPHOLE[body + (body.ipHeader.fragment * 8 + 1)/2];
	listHead.next­ ¬ [NIL, body.ipHeader.length, LAST[CARDINAL]]
	END;

      <<
      requeueData is used to hold the timeout for assembling this buffer.
      This is truly slimy, but it means we can use the queue package and not
      have to carry another state object around for the timeout info.
      >>
	 
      frag.requeueData ¬ MAX[body.ipHeader.lifetime, fragTimeout];
      frag.fo.driver.iocb ¬ LOOPHOLE[listHead];
      END
    ELSE
      BEGIN
      b ¬ AddFrag[frag, b];
      ArpaBuffer.ReturnBuffer[frag];
      END;
    END;  --Reassemble
    
  FindReassembly: INTERNAL PROC [tIp: ArpaBuffer.Body]
    RETURNS [b: ArpaBuffer.Buffer] =
    BEGIN
    --searches list of reassembly buffers for the one containing this fragment.
    FOR b ¬ ArpaBuffer.From[fragQueue.first], ArpaBuffer.From[b.fo.next]
      UNTIL b = NIL DO
      bIp: ArpaBuffer.Body = b.arpa; 
      SELECT TRUE FROM
        (bIp.ipHeader.source # tIp.ipHeader.source) => NULL;
	(bIp.ipHeader.destination # tIp.ipHeader.destination) => NULL;
	(bIp.ipHeader.identification # tIp.ipHeader.identification) => NULL;
	(bIp.ipHeader.protocol # tIp.ipHeader.protocol) => NULL;
        ENDCASE => EXIT;  --got it!
      ENDLOOP;
    END;  --FindReassembly
    
    
  FragWatcher: ENTRY PROC =
    BEGIN
    elapsedSeconds: LONG CARDINAL;
    b, newB: ArpaBuffer.Buffer ¬ NIL;
    Process.SetPriority[Process.priorityNormal];
    DO  --until aborted
      ENABLE ABORTED => EXIT;
      WAIT fragTimer;
      IF fragQueue.length > 0 THEN
        FOR b ¬ ArpaBuffer.From[fragQueue.first], newB UNTIL newB = NIL DO
	  newB ¬ ArpaBuffer.From[b.fo.next];  --in case we delete b
	  <<
	  b.fo.time is in Pulses.
	  b.requeueData is in seconds.
	  uSecs * 1D6 is a real small time!
	  This is going to be messy.
	  >>
	  [elapsedSeconds, ] ¬ Inline.UDDivMod[
	    (System.PulsesToMicroseconds[
	      [System.GetClockPulses[] - b.fo.time]]), 1D6];
	  IF elapsedSeconds > b.requeueData THEN
	    BEGIN
	    b ¬ ArpaBuffer.ExtractFromQueue[@fragQueue, b];
	    ArpaBuffer.ReturnBuffer[b];
	    --**send ICMP time exceeded.
	    END;
	  ENDLOOP;
      ENDLOOP;
    END;  --FragWatcher
    
        
  Ripple: INTERNAL PROC [b: ArpaBuffer.Buffer, offset: CARDINAL]
    RETURNS [success: BOOLEAN ¬ TRUE] =
    BEGIN  
    <<
    ripples the IP data in the buffer by offset to make room for a
    "larger than anticipated" header when reassembling. The hole descriptors
    also have to be adjusted.  The actual entries will be moved along with the 
    data.

    This code is bogus! There's something wrong with the computation of
    'length'. It can't be a long pointer plus a SIZE that gives a length.
    I suspect that the offset has to be subtracted from the beginning of
    some buffer, and I suspect that it's 'b'. The following is the original
    code just commented out. Also, note the comparison of the length times
    something that's obvoiously bytes to "DataWordsPerRawBuffer[]".
    e, next: ListEntry;
    length: LONG CARDINAL;
    FOR e ¬ LOOPHOLE[b.driver.iocb], next UNTIL next = NIL DO
      next ¬ e.next;  --save link, since we are going add the offset to it.
      e.first ¬ e.first + offset;
      e.last ¬ e.last + offset;
      e.next ¬ e.next + offset;
      ENDLOOP;
    --e points to last hole descriptor, which is last piece of valuable info.
    length ¬ LOOPHOLE[e + SIZE[ListObject]];
    length ¬ LOOPHOLE[(@b.bufferBody + length * 2) - @b.bufferBody];
    IF length + SIZE[DriverTypes.Encapsulation] * 2 >
      Buffer.DataWordsPerRawBuffer[] THEN success ¬ FALSE;
    [] ¬ ByteBlt.ByteBlt[
      to: [LOOPHOLE[@b.bufferBody + offset], 0, Inline.LowHalf[length]],
      from: [LOOPHOLE[@b.bufferBody], 0, Inline.LowHalf[length]]];
    >>
    END;  --Ripple

    
  AddFrag: INTERNAL PROC [frag, b: ArpaBuffer.Buffer]
    RETURNS [completed: ArpaBuffer.Buffer ¬ NIL] =
    BEGIN OPEN ip: frag.arpa.ipHeader;
    <<
    Pieces the fragment into the specified reassembly buffer.  If this
    fragment completes the reassembly, the reassembly buffer will be returned;
    if it is not completed, NIL will be returned.  The hole descripter resides
    in the hole itself, which we know to be at least 8 bytes, and the 
    descriptors are linked, with the head being in the iocb field of the fixed
    overhead.  This field is not used at this point, and we need someplace to
    put a long pointer.  Slimy, but it works!
    >> 
    offset: CARDINAL ¬ 0;  --difference in header from default size.
    hdrLen, dataLen: CARDINAL;
    first, last: CARDINAL ¬ 0;  --fragment offsets.
    listHead: ListEntry ¬ LOOPHOLE[b.fo.driver.iocb];
    hole, prev: ListEntry;
    use: BOOLEAN;
    
     
    AddHole: PROC [f, l: CARDINAL] =
      BEGIN
      p, e, previous: ListEntry;
      --this is where the hole descriptor will be stored.
      p ¬ LOOPHOLE[b.arpa + (first + 1)/2 + (hdrLen + 1)/2];  
      previous ¬ NIL;
      FOR e ¬ listHead, e.next UNTIL e = NIL DO
        IF (f + hdrLen < e.first) THEN EXIT;
	previous ¬ e;
        ENDLOOP;
      IF previous = NIL THEN listHead ¬ p
      ELSE previous.next ¬ p;
      p­ ¬ [e, f + hdrLen, l + hdrLen];
      END;  --AddHole
      
     
    <<
    Either we know the header length, or we will guess at the default. Ripple
    will take care of us if we guess wrong.  If this is the first fragment,
    hdrLen will be updated by the code that copies the header.
    >>
    hdrLen ¬ IF listHead.first = 0 THEN ArpaPort.minIPHeaderBytes
    ELSE b.arpa.ipHeader.ihl * 4;
    dataLen ¬ ip.length - ip.ihl * 4;
    first ¬ ip.fragment * 8;
    last ¬ first + ip.length - (ip.ihl * 4) - 1;
    
    SELECT TRUE FROM
      <<
      Can only reassemble to size of our buffers.  Again, Ripple will take
      care of the case where we guessed wrong at the header size.
      >>
      last > (ArpaBuffer.DataBytesPerRawBuffer[frag] - hdrLen -
        (SIZE[ethernet IEEE8023.EncapObject] * bpw)) =>
        {IF ArpaFlags.doStats THEN ArpaStats.Incr[reassemblyTooBig]; RETURN};
      (ip.fragment = 0) =>  --first fragment processing (need to save header).
        SELECT TRUE FROM
	  --already have header, let's ignore header in this fragment.
	  (listHead.first > 0) => NULL;
	   --first to arrive, plenty of hdr room.
          (listHead.last = LAST[CARDINAL]),
	  ip.ihl = 5 =>  --reassembly buffer not empty, but header fits.
	    BEGIN
	    hdrLen ¬ ip.ihl * 4;
	    IF hdrLen > arpaProtocolFamily.maxBufferSize THEN  --sanity check.
	      {IF ArpaFlags.doStats THEN ArpaStats.Incr[reassemblyTooBig];
	      RETURN};
            [] ¬ ByteBlt.ByteBlt[to: [LOOPHOLE[b.arpa], 0, hdrLen],
	      from: [LOOPHOLE[frag.arpa], 0, hdrLen]];
	    listHead.first ¬ hdrLen;  --update the hole descriptor
	    END;
	  ENDCASE =>  --oops, header was greater than the size we allowed for.
	    BEGIN
	    hdrLen ¬ ip.ihl * 4;
	    IF hdrLen > arpaProtocolFamily.maxBufferSize THEN  --sanity check.
	      {IF ArpaFlags.doStats THEN ArpaStats.Incr[reassemblyTooBig];
	      RETURN};
	    offset ¬ hdrLen - ArpaPort.minIPHeaderBytes;
	    IF ~Ripple[b, offset] THEN
	      {IF ArpaFlags.doStats THEN ArpaStats.Incr[reassemblyTooBig];
	      ArpaBuffer.ReturnBuffer[frag]};
	    [] ¬ ByteBlt.ByteBlt[to: [LOOPHOLE[b.arpa], 0, hdrLen],
	      from: [LOOPHOLE[frag.arpa], 0, hdrLen]];
	    listHead.first ¬ hdrLen;  --update the hole descriptor
	    END;
      ENDCASE;
    
    IF ((last + 1) MOD 8) # 0 AND ip.flags.moreFragment THEN  
      --next frag won't be 32 aligned, but if last who cares.
      {IF ArpaFlags.doStats THEN ArpaStats.Incr[fragAlign];
      RETURN};
    use ¬ FALSE;  --is this fragment usable at all (overlaps a hole?).
    --find out where this fragment goes.
    prev ¬ NIL;
    
    FOR hole ¬ listHead, hole.next UNTIL hole = NIL DO
      IF (first + hdrLen > hole.last) THEN {prev ¬ hole; LOOP};
      IF (last + hdrLen < hole.first) THEN {prev ¬ hole; LOOP};
      use ¬ TRUE;
      
      --remove current entry from list.
      IF prev = NIL THEN listHead ¬ hole.next  --first entry
      ELSE prev.next ¬ hole.next;
      
      --new hole descriptors?
      IF first + hdrLen > hole.first THEN
	AddHole[hole.first, ip.fragment * 8 - 1];
      IF (last + hdrLen < hole.last) AND (ip.flags.moreFragment) THEN
	AddHole[last + 1 , hole.last];
      ENDLOOP;
      
    IF use THEN
      BEGIN
      [] ¬ ByteBlt.ByteBlt[
        to: [LOOPHOLE[
	  b.arpa + (hdrLen + first)/2], 0, ip.length - ip.ihl * 4],
        from: [LOOPHOLE[
	  @frag.arpa.ipBytes], 0, ip.length - ip.ihl * 4]];
      << length will not be correct (i.e., will not include header), until just
         before we return the assembled buffer to the client! >>
      IF ~ip.flags.moreFragment THEN b.arpa.ipHeader.length ¬ last + 1;
      IF listHead = NIL THEN
        BEGIN  --add in the header length.
	b.arpa.ipHeader.length ¬ b.arpa.ipHeader.length + b.arpa.ipHeader.ihl * 4;
        RETURN[ArpaBuffer.ExtractFromQueue[@fragQueue, b]];
	END;
      END;  --use
    b.fo.driver.iocb ¬ LOOPHOLE[listHead];  --restore
    END;  --AddFrag
    
    
  Register: PUBLIC PROC[h: ArpaRoutingTable.Handle ¬ NIL] =
    BEGIN
    ExchangeObjects: ENTRY PROC =
      BEGIN
      IF h # NIL THEN rto ¬ h­  --copy in new object
      ELSE rto ¬ ArpaRoutingTable.defaultRth­;  --default to old
      routersFunction ¬ rto.type;
      END;  --ExchangeObjects
    arpaProtocolFamily.status ¬ dead;  --slow things up a while
    Process.Pause[Process.SecondsToTicks[1]];  --wait for traffic to clear
    IF rto.stop # NIL THEN rto.stop[];  --stop current
    ExchangeObjects[];  --reregister
    IF rto.start # NIL THEN rto.start[];  --start new
    arpaProtocolFamily.status ¬ alive;  --and let the good times role
    END;  --Register
    

  SendPacket: PUBLIC PROC[
    b: ArpaBuffer.Buffer, destType: ArpaPortInternal.DestType] =
    BEGIN
    body: ArpaBuffer.Body = b.arpa;
    body.ipHeader.version ¬ vers4;
    body.ipHeader.fragment ¬ 0;
    body.ipHeader.flags.moreFragment ¬ FALSE;
    SELECT TRUE FROM
      --broadcasts and local w/loopback included here
      driverLoopback, (destType = remote) =>
        BEGIN
	body.ipHeader.checksum ¬ 0;
	body.ipHeader.checksum ¬ ArpaPortInternal.Checksum[
	  0, body.ipHeader.ihl*2, @body.ipHeader];
	IF ArpaFlags.doStats THEN ArpaStats.Incr[ipSent];
	[] ¬ rto.transmit[b];
	END;
      --sending to myself in non-loopback mode
      (~ArpaPortInternal.QueueForClient[b: b, copy: TRUE]) => 
	{b.fo.network ¬ Driver.nilDevice;
	--**Send some icmp packet here?
	IF ArpaFlags.doStats THEN ArpaStats.Incr[noLocalPort];
	Process.Yield[]};
      ENDCASE =>  --we copied it for the receiver, now requeue it for the sender.
        {Driver.PutOnGlobalDoneQueue[ArpaBuffer.To[b]]; Process.Yield[]};
    END;  --SendPacket
    
    
  SetIPLengths: PUBLIC PROC[
    body: ArpaBuffer.Body, optionsLen, dataLen: CARDINAL] =
    BEGIN
    body.ipHeader.ihl ¬ (optionsLen + ArpaPort.minIPHeaderBytes+3)/4;
    body.ipHeader.length ¬ body.ipHeader.ihl*4 + dataLen;
    END;  --SetIPLengths
    
    
  SetOptions: PUBLIC PROC =
    BEGIN
    END;  --SetOptions
    

  StateChanged: PROC[
    driver: Device, context: LONG POINTER, why: Protocol1.Action] =
    BEGIN
    SELECT why FROM
     add => IF rto.addNetwork # NIL THEN rto.addNetwork[context];
     remove => rto.removeNetwork[context];  --tell routing table to stop
     modify => rto.stateChanged[context];  --see if routing table cares
     ENDCASE;
    END;  --StateChanged
    
  END....  --ArpaRouterImpl module.

LOG

25-Jun-84 13:33:44  AOF  Created file.
 8-Feb-85 15:51:44  SMA  Development. 
13-Jul-85 13:52:31  SMA  Added stats.
18-Oct-85 12:15:36  SMA  Move queueing code to ArpaPortImpl - now has only IP.      8-Jan-86 10:40:03  SMA  ICMP support.
10-Mar-86 13:24:25  SMA  ICMP checksums.
21-Jun-86 13:13:07  SMA  IP reassembly.
24-Sep-86 16:42:50  JAV  Fixed IP reassembly.
 9-Mar-87 20:30:15  AOF  Funston buffer management
24-Mar-87 18:39:06  AOF  Just tweaking
15-Jun-87 11:14:13  JAV  Added SetGatewayAddr & SetDomainNameServer