! Ether module for (Moose) INet proceess, GDMR, Jan 1988

! This module contains an external procedure which is called by the main
! dispatcher to send a buffer out to the ether, and an autonomous process
! which takes packets from the ether and fills in the relevant fields in the
! buffer before putting it on the inbound IP queue.  ARP processing is also
! performed by an autonomous process

%option "-NonStandard-NoCheck-NoDiag-NoLine"

%constinteger inbound priority = 7
%constinteger inbound size = 16384
%constinteger out done priority = 7
%constinteger out done size = 16384
%constinteger ARP priority = 7
%constinteger ARP size = 16384

%constinteger ARP table size = 1023;  ! 2^^n - 1, used for masking

%constinteger IP protocol type = 16_0800
%constinteger ARP protocol type = 16_0806

%include "INet:Control.Inc"
%externalintegerspec control

%include "INet:Formats.Inc"
%include "INet:Utility.Inc"
%include "INet:Stats.Inc"

%include "GDMR_E:Ether.Inc"

%externalintegerfnspec free store

%externalroutinespec FS insert(%string(31) what, %integer value)
%externalpredicatespec FS lookup(%string(31) what, %integername value)

%systemroutinespec phex(%integer x)
%systemroutinespec phex2(%integer x)
%systemroutinespec phex4(%integer x)

%externalrecord(semaphore fm)%spec dispatch semaphore
%externalrecord(queue fm)%spec IP inbound queue

%externalintegerspec ether IP address
%owninteger broadcast 0 = 0
%owninteger broadcast 1 = 0
%owninteger broadcast 2 = -1

%externalrecord(INet statistics fm)%spec stats

%ownrecord(mailbox fm)%name ether mailbox

%ownrecord(semaphore fm) TX semaphore = 0
%ownrecord(mailbox fm) TX response = 0

%ownrecord(semaphore fm) RX semaphore = 0
%ownrecord(ether request fm) RX request = 0
%ownrecord(mailbox fm) RX response = 0

%ownrecord(semaphore fm) ARP TX semaphore = 0
%ownrecord(ether request fm) ARP TX request = 0
%ownrecord(mailbox fm) ARP TX response = 0

%ownrecord(semaphore fm) ARP RX semaphore = 0
%ownrecord(ether request fm) ARP RX request = 0
%ownrecord(mailbox fm) ARP RX response = 0

%owninteger IP slot = 0
%owninteger ARP slot = 0

%externalroutinespec add local route(%integer network, metric, via)

!recordformat ether address fm(%bytearray x(0 : 5))

%ownrecord(ether address fm) our ether address = 0
%ownrecord(ether address fm) broadcast address = 0

%recordformat ether header fm(%record(ether address fm) destination,
                              %record(ether address fm) source,
                              %short type)

%recordformat ARP fm(%short format,
                     %short protocol,
                     %byte hardware length,
                     %byte protocol length,
                     %short op,
                     %record(ether address fm) source hardware,
                     %integer source protocol,
                     %record(ether address fm) target hardware,
                     %integer target protocol,
                     %string(47) padding)

%constinteger ARP ether protocol = 1
%constinteger ARP IP type        = IP protocol type
%constinteger ARP request code   = 1
%constinteger ARP reply   code   = 2

%recordformat ARP buffer fm((%record(ether header fm) h,
                             %record(ARP fm) ARP) %c
                        %or %bytearray x(0 : 1499))


! ARP tables and table manipulation procedures.  The tables are hashed into,
! based on the low-order bits of the IP address.

%recordformat ARP entry fm(%integer IP address,
                           %record(ether address fm) ether address)
! This version doesn't maintain a timestamp and doesn't time anything out.

%ownrecord(ARP entry fm)%array ARP table(0 : ARP table size) = 0(*)

%record(ARP entry fm)%map find ARP entry(%integer IP address)
   %record(ARP entry fm)%name e
   %integer slot, end
      !! printstring("Find ARP entry for ")
      !! print INet address(IP address);  newline
      slot = IP address & ARP table size
      end = (slot - 1) & ARP table size
      %cycle
         e == ARP table(slot)
         %result == e %if e_IP address = IP address
         %result == nil %if e_IP address = 0 %or slot = end
         slot = (slot + 1) & ARP table size
      %repeat
%end

%routine add ARP entry(%integer IP address,
                       %record(ether address fm)%name ether address)
   %record(ARP entry fm)%name e
   %integer slot, end
      !! printstring("Add ARP entry: ");  print INet address(IP address)
      !! space;  print ether address(ether address);  newline
      %return %if IP address & 16_F0000000 = 0;  ! Bogus, probably a Sun booting
      slot = IP address & ARP table size
      end = (slot - 1) & ARP table size
      %cycle
         e == ARP table(slot)
         %return %if e_IP address = IP address %or slot = end
         %if e_IP address = 0 %start
            ! Found a free slot
            !! printstring("Adding at ");  write(slot, 0);  newline
            e_IP address = IP address
            e_ether address = ether address
            %return
         %finish
         slot = (slot + 1) & ARP table size
      %repeat
%end


! Tracing

!T!   %constinteger ether trace slots = 127;  ! 2^n - 1
!T!   %constinteger ether trace bytes = 96
!T!   %recordformat ether trace fm(%integer inout, bytes,
!T!                                %bytearray data(1 : ether trace bytes))
!T!   %recordformat ether trace buffer fm(%integer next,
!T!                                       %record(ether trace fm)%array t(0 : ether trace slots))
!T!   %ownrecord(ether trace buffer fm) etb = 0
!T!   
!T!   %constinteger trace in = 0
!T!   %constinteger trace out = 1
!T!   
!T!   %ownrecord(semaphore fm) trace semaphore = 0
!T!   
!T!   %routine trace(%integer direction, bytes, %bytename packet)
!T!      %record(ether trace fm)%name t
!T!      %integer i,  n
!T!         n = bytes;  n = ether trace bytes %if n > ether trace bytes
!T!         semaphore wait(trace semaphore)
!T!         t == etb_t(etb_next)
!T!         etb_next = (etb_next + 1) & ether trace slots
!T!         signal semaphore(trace semaphore)
!T!         t_inout = direction
!T!         t_bytes = bytes
!T!         %for i = 1, 1, n %cycle
!T!            t_data(i) = packet
!T!            packet == packet [1]
!T!         %repeat
!T!   %end


! Outbound packet handler, including ARP requests

%routine make ARP request(%integer IP address)
   %owninteger ARP sequence = 0
   %record(ARP buffer fm) ARP = 0
   %record(ether request fm)%name r
   %integer i
      %if control & trace ARP out # 0 %start
         printstring("Make ARP request for ")
         print INet address(IP address);  newline
      %finish
!L!   lights or B(ARP light)
      ARP_ARP_format = ARP ether protocol
      ARP_ARP_protocol = ARP IP type
      ARP_ARP_hardware length = 6
      ARP_ARP_protocol length = 4
      ARP_ARP_op = ARP request code
      ARP_ARP_source hardware = our ether address
      ARP_ARP_source protocol = ether IP address
      ARP_ARP_target hardware = 0
      ARP_ARP_target protocol = IP address
      ARP_h_destination_x(i) = 255 %for i = 0, 1, 5
!T!   trace(trace out, 60, ARP_x(0))
      ARP TX request_code = ether write
      ARP TX request_slot = ARP slot
      ARP TX request_tag = ARP sequence
      ARP TX request_buffer == ARP_x(0)
      ARP TX request_bytes = 60
      send message(ARP TX request, ether mailbox, ARP TX response)
      r == receive message(ARP TX response)
      %if r ## ARP TX request %or r_tag # ARP sequence %start
         printstring("INet ARP: bogus ether response");  newline
         stats_ARP errors out = stats_ARP errors out + 1
      %else %if r_status # ether success
         printstring("INet ARP: ether status ")
         write(r_status, 0);  newline
         stats_ARP errors out = stats_ARP errors out + 1
      %else
         stats_ARP out = stats_ARP out + 1
      %finish
      ARP sequence = ARP sequence + 1
!L!   lights and B(\ ARP light)
%end

%externalroutine ether outbound(%record(buffer fm)%name b)
   %record(ether request fm)%name TX request
   %record(ARP entry fm)%name ARP entry
   %record(ether header fm)%name h
      %if control & trace ether out # 0 %start
         printstring("Ether outbound: ");  phex(addr(b))
         write(b_bytes, 1);  newline
         dump(byteinteger(addr(b_IP header)), b_bytes)
      %finish
      -> none %if ether mailbox == nil
      ARP entry == find ARP entry(b_IP target)
      %if ARP entry == nil %start
         ! Not there, we'll have to ask
         !! printstring("Not there...");  newline
         make ARP request(b_IP target)
         ! Drop/enqueue the packet.  It will be retransmitted
         ! by the higher layers if required....
none:    %if b_next queue == nil %start
            !! printstring("No next queue");  newline
            release buffer(b)
         %else
            %if b_flags & requeue flag # 0 %start
               !! printstring("Requeue on ");  phex(addr(b_next queue));  newline
               requeue(b, b_next queue)
            %else
               !! printstring("Enqueue on ");  phex(addr(b_next queue));  newline
               enqueue(b, b_next queue)
            %finish
         %finish
      %else
         ! Address known, send it on its way....
         !! printstring("Found: ")
         !! print ether address(ARP entry_ether address);  newline
!L!      lights or B(ether light)
         h == record(addr(b_IP header) - 14)
         h_destination = ARP entry_ether address
         h_type = IP protocol type
         TX request == record(addr(b_message(0)))
         setup message(TX request, size of(TX request))
         TX request_code = ether write
         TX request_tag = addr(b)
         TX request_slot = IP slot
         TX request_buffer == h_destination_x(0)
         TX request_bytes = b_bytes + 14
         TX request_bytes = 60 %if TX request_bytes < 60
!T!      trace(trace out, TX request_bytes, h_destination_x(0))
         send message(TX request, ether mailbox, TX response)
         ! Response will be handled by autonomous process below...
      %finish
%end

%routine outbound done
   %record(ether request fm)%name r
   %record(buffer fm)%name b
      open input(2, ":N");  select input(2)
      open output(2, ":T");  select output(2)
      !! printstring("Outbound done: ");  write(free store, 0);  newline
      %cycle
         r == receive message(TX response)
         %if r_status # ether success %start
            pdate
            printstring("INet ether: ");  write(r_status, 0)
            newline
            stats_fast errors out = stats_fast errors out + 1
         %finish
         ! Finally drop/enqueue the packet.  It will be retransmitted
         ! by the higher layers if required....
         b == record(r_tag)
         stats_fast packets out = stats_fast packets out + 1
         stats_fast bytes out = stats_fast bytes out + b_bytes
         %if addr(b_IP header) - 14 # addr(r_buffer) %start
            printstring("Dubious buffer address: ");  phex(addr(b))
            space;  phex(addr(b_IP header) - 14);  space
            phex(addr(r_buffer));  newline
         %finish
         %if b_next queue == nil %start
            !! printstring("No next queue");  newline
            release buffer(b)
         %else
            %if b_flags & requeue flag # 0 %start
               !! printstring("Requeue on ");  phex(addr(b_next queue));  newline
               requeue(b, b_next queue)
            %else
               !! printstring("Enqueue on ");  phex(addr(b_next queue));  newline
               enqueue(b, b_next queue)
            %finish
         %finish
!L!      lights and B(\ ether light)
      %repeat
%end

%routine inbound process
   %owninteger RX sequence = 0
   %record(buffer fm)%name b
   %record(ether request fm)%name r
      open input(2, ":N");  select input(2)
      open output(2, ":T");  select output(2)
      !! printstring("Ether inbound handler started");  newline
      !! printstring("Inbound process: ");  write(free store, 0);  newline
      %cycle
         b == claim buffer
         %if b == nil %start
            printstring("No buffers??");  newline
            %stop
         %finish
         !! printstring("Inbound buffer at ");  phex(addr(b));  newline
         RX sequence = RX sequence + 1
         RX request_code = ether read
         RX request_slot = IP slot
         RX request_tag = RX sequence
         RX request_buffer == b_data(32 - 14)
         send message(RX request, ether mailbox, RX response)
         r == receive message(RX response)
!L!      lights or A(ether light)
         %if r_tag # RX sequence %start
            pdate
            printstring("INet ether: dud tag ")
            phex(r_tag);  space;  phex(RX sequence)
            newline
            stats_fast errors in = stats_fast errors in + 1
            release buffer(b)
         %else %if r_status # ether success
            pdate
            printstring("INet ether: ");  write(r_status, 0)
            newline
            stats_fast errors in = stats_fast errors in + 1
            release buffer(b)
         %else
!T!         trace(trace in, r_bytes, b_data(32 - 14))
            b_bytes = r_bytes - 14
            b_IP header == record(addr(b_data(32)))
            b_next queue == nil
            b_flags = broadcast flag %if b_data(32 - 14) & 1 # 0
            b_interface = 2
            stats_fast packets in = stats_fast packets in + 1
            stats_fast bytes in = stats_fast bytes in + b_bytes
            %if control & trace ether in # 0 %start
               printstring("Received ");  write(b_bytes, 0)
               printstring(" into ");  phex(addr(b));  newline
               dump(byteinteger(addr(b_IP header)), b_bytes)
            %finish 
            enqueue(b, IP inbound queue)
            signal semaphore(dispatch semaphore)
         %finish
!L!      lights and A(\ ether light)
      %repeat
%end


! ARP process.  Listen out for ARP packets on the ether.  These will either
! be requests, which we may be expected to reply to, or replies to our
! requests.  Either way, we use the information to update our tables.
! Note that in this implementation we don't keep a list of pending requests:
! instead we just put out an ARP request and then drop/enqueue the packet
! as appropriate, letting the higher layers worry about retransmitting
! (presumably after sufficient time for our requests to be answered!).

! Beware of non-IP ARP requests.

%routine ARP process
   %owninteger ARP sequence = 0
   %record(ARP buffer fm) ARP
   %record(ether request fm)%name r
      open input(2, ":N");  select input(2)
      open output(2, ":T");  select output(2)
      !! printstring("ARP receiver starting");  newline
      !! printstring("ARP process: ");  write(free store, 0);  newline
      %cycle
         ARP sequence = ARP sequence + 1
         ARP RX request_code = ether read
         ARP RX request_slot = ARP slot
         ARP RX request_tag = ARP sequence
         ARP RX request_buffer == ARP_x(0)
         send message(ARP RX request, ether mailbox, ARP RX response)
         r == receive message(ARP RX response)
!L!      lights or A(ARP light)
         %if r ## ARP RX request %or r_tag # ARP sequence %start
            printstring("INet ARP: bogus ether response");  newline
            stats_ARP errors in = stats_ARP errors in + 1
         %else %if r_status # ether success
            printstring("INet ARP: ether status ")
            write(r_status, 0);  newline
            stats_ARP errors in = stats_ARP errors in + 1
         %else
!T!         trace(trace in, r_bytes, ARP_x(0))
            !! printstring("ARP format ");  phex4(ARP_ARP_format)
            !! printstring(" protocol ");  phex4(ARP_ARP_protocol)
            !! printstring(" from ");  print ether address(ARP_h_source)
            !! printstring(" for ");  print ether address(ARP_h_destination)
            !! newline
            !! printstring("HW length ");  write(ARP_ARP_hardware length, 0)
            !! printstring(" prot length ");  write(ARP_ARP_protocol length, 0)
            !! printstring(" op ");  phex4(ARP_ARP_op);  newline
            !! printstring("Source HW ")
            !! print ether address(ARP_ARP_source hardware)
            !! printstring(" source prot ")
            !! print INet address(ARP_ARP_source protocol);  newline
            !! printstring("Dest HW ")
            !! print ether address(ARP_ARP_target hardware)
            !! printstring(" dest prot ")
            !! print INet address(ARP_ARP_target protocol)
            !! newline
            stats_ARP in = stats_ARP in + 1
            %if ARP_ARP_format = ARP ether protocol %c
                  %and ARP_ARP_protocol = ARP IP type %c
                  %and ARP_ARP_hardware length = 6 %c
                  %and ARP_ARP_protocol length = 4 %start
               %if control & trace ARP in # 0 %start
                  printstring("ARP from ")
                  print INet address(ARP_ARP_source protocol)
                  printstring(" for ")
                  print INet address(ARP_ARP_target protocol)
                  newline
               %finish
               ! Format is credible.  See if we've to respond.
               ! Either way, we insert the entry in our tables
               %if ARP_ARP_op = ARP request code %start
                  ! A request.  Insert the addresses
                  add ARP entry(ARP_ARP_source protocol,
                                ARP_ARP_source hardware)
                  ! Is it for us?
                  %if ARP_ARP_target protocol = ether IP address %start
                     ! Yes, note it, turn it round and send it back
                     stats_ARP for us = stats_ARP for us + 1
                     !add ARP entry(ARP_ARP_source protocol,
                     !              ARP_ARP_source hardware)
                     %if control & trace ARP in # 0 %start
                        printstring("Responding to ARP request from ")
                        print ether address(ARP_h_source);  newline
                     %finish
!L!                  lights or B(ARP light)
                     ARP_ARP_op = ARP reply code
                     ARP_ARP_target hardware = ARP_ARP_source hardware
                     ARP_ARP_target protocol = ARP_ARP_source protocol
                     ARP_ARP_source hardware = our ether address
                     ARP_ARP_source protocol = ether IP address
                     ARP_h_destination = ARP_h_source
                     ARP sequence = ARP sequence + 1
                     ARP RX request_code = ether write
                     ARP RX request_slot = ARP slot
                     ARP RX request_tag = ARP sequence
                     ARP RX request_buffer == ARP_x(0)
                     ARP RX request_bytes = 60
                     send message(ARP RX request, ether mailbox, ARP RX response)
                     r == receive message(ARP RX response)
                     %if r ## ARP RX request %or r_tag # ARP sequence %start
                        printstring("INet ARP: bogus ether response");  newline
                     %else %if r_status # ether success
                        printstring("INet ARP: ether status ")
                        write(r_status, 0);  newline
                     %finish
!L!                  lights and B(\ ARP light)
                  %else %if ARP_ARP_target protocol = broadcast 0 %c
                        %or ARP_ARP_target protocol = broadcast 1 %c
                        %or ARP_ARP_target protocol = broadcast 2
                     !! printstring("ARP for broadcast received from ")
                     !! print INet address(ARP_ARP_source protocol)
                     !! space;  print ether address(ARP_h_source);  newline
                     stats_ARP for broadcast = stats_ARP for broadcast + 1
                  %finish
               %else %if ARP_ARP_op = ARP reply code
                  ! A response, presumably to a request of ours.
                  ! Insert the addresses.
                  stats_ARP responses = stats_ARP responses + 1
                  add ARP entry(ARP_ARP_source protocol,
                                ARP_ARP_source hardware)
               %finish
            %else
               stats_ARP unknown = stats_ARP unknown + 1
               ! Something unrecognised.  Ignore it.
            %finish
         %finish
!L!      lights and A(\ARP light)
      %repeat
%end

%owninteger slow station = 0

%externalroutine set ether IP address(%integer example)
   ! Ether IP address is now set based on the first RIP packet received.
   ! If it's a thin address then the slow station address is used as the
   ! basis; if it's a fast address then it's table-driven (where the table
   ! size is currently one!)
   %return %if ether mailbox == nil;  ! No LANCE, so how did we get here...!?
   %if example & 16_FFFF0000 = 129 << 24 ! 215 << 16 %start
      ! Thick address:
      !#  129.215.128.49 to 96    : CS-rib
      %if slow station = 16_7E %start
         ether IP address = 129 << 24 ! 215 << 16 ! 128 << 8 ! 96
         broadcast 0 = 129 << 24 ! 215 << 16
      %else %if slow station = 16_14
         ether IP address = 129 << 24 ! 215 << 16 ! 128 << 8 ! 95
         broadcast 0 = 129 << 24 ! 215 << 16
      %else
         printstring("INet: currently only 14 and 7E defined for thick ether")
         newline
         %return
      %finish
   %else %if example & 16_FFFF0000 = 139 << 24 ! 131 << 16
      ! A thin address
      ether IP address = 139 << 24 ! 131 << 16 ! 1 << 8 ! (128 + 64) ! slow station
      broadcast 0 = 139 << 24 ! 131 << 16
   %else
      printstring("Unknown example IP network: ");  phex(example);  newline
      %return
   %finish
   broadcast 1 = broadcast 0 ! 16_FFFF
   {} printstring("Ether IP address is ")
   {} print INet address(ether IP address);  newline
   add local route(ether IP address, 1, 2)
   add ARP entry(broadcast 0, broadcast address)
   add ARP entry(broadcast 1, broadcast address)
%end

%externalroutine start ether(%integer station)
   ! Set up mailboxes, etc, register ourselves as protocols 800 and 806,
   ! and start the receiver process.
   %record(process fm)%name p
   %record(ether request fm)%name r
   %integer x, c
   %label start inbound, start ARP, start out done
      %if FS lookup(ether mailbox name, x) %start
         ether mailbox == record(x)
      %else
         !! printstring("No ether mailbox");  newline
         ether mailbox == nil
         %return
      %finish
      slow station = station
      FS insert("ETHER_ARP_TABLES", addr(ARP table(0)))
      broadcast address_x(x) = 255 %for x = 0, 1, 5
      ! IP address now set from RIP listener
      setup semaphore(TX semaphore)
      setup mailbox(TX response, TX semaphore)
      setup semaphore(RX semaphore)
      setup mailbox(RX response, RX semaphore)
      setup message(RX request, size of(RX request))
      setup semaphore(ARP TX semaphore)
      setup mailbox(ARP TX response, ARP TX semaphore)
      setup message(ARP TX request, size of(ARP TX request))
      setup semaphore(ARP RX semaphore)
      setup mailbox(ARP RX response, ARP RX semaphore)
      setup message(ARP RX request, size of(ARP RX request))
!T!   setup semaphore(trace semaphore)
!T!   signal semaphore(trace semaphore)
!T!   FS insert("ETHER_TRACE_BUFFER", addr(etb))
      ! Make ourselves known to the ether driver
      RX request_code = ether register
      RX request_type = IP protocol type
      send message(RX request, ether mailbox, RX response)
      r == receive message(RX response)
      %if r_status # ether success %start
         printstring("Register IP: ");  write(r_status, 0)
         newline
         %stop
      %finish
      IP slot = r_slot
      RX request_code = ether register
      RX request_type = ARP protocol type
      send message(RX request, ether mailbox, RX response)
      r == receive message(RX response)
      %if r_status # ether success %start
         printstring("Register ARP: ");  write(r_status, 0)
         newline
         %stop
      %finish
      ARP slot = r_slot
      ! Find our station's address
      RX request_code = ether address
      RX request_buffer == our ether address_x(0)
      send message(RX request, ether mailbox, RX response)
      r == receive message(RX response)
      %if r_status # ether success %start
         printstring("Get ether address: ");  write(r_status, 0)
         newline
         %stop
      %finish
      !! printstring("INet ether address is ")
      !! print ether address(our ether address);  newline
      ! Now start the autonomous processes
      p == create process(inbound size, addr(start inbound), inbound priority, nil)
      p == create process(out done size, addr(start out done), out done priority, nil)
      p == create process(ARP size, addr(start ARP), ARP priority, nil)
      !! printstring("INet ether handler started");  newline
      %return

start inbound:
      inbound process
start ARP:
      ARP process
start out done:
      outbound done
%end

%end %of %file