*=*=*=*= ether_listen.html =*=*=*=*
program ether_listen

 

program ether_listen


      program ether_listen
c
c This program runs against the ethernet adapter in
c promiscuous mode, examining all the packets and
c distinguishing between them. The name of the controller
c is ESA0 as the code was intended for use on a VS3100.
c Change this to whatever the device name of the controller
c you in fact have is (see the I/O users manual for details)
c
c The subroutine "display" uses SMG routines to display
c real time graphs of the ethernet traffic.
c
c This program does not look at the contents of each packet,
c although it could easily do so: the data in buffer(istart:)
c is the place.
c
c (c) J.J.Bunn 1991 CERN
c
      parameter (lbuffer=1500,lpacket=20)
      implicit integer(a-z)
C
      INCLUDE '($SSDEF)'
      INCLUDE '($IODEF)'
      INCLUDE '($DVIDEF)'
C
      character*17 cdest,csorc
      character*5 cprot
      character*8 cform
      character*(lbuffer) cbuf
      character*(lpacket) cblank,cpacket
      character*50 ctime
      real mbs,t1,t2
      integer*4 iosb(2),p2desc(2)
      integer*2 channel,transfer,completion,errsum
      integer*2 ldata
      byte destination(6),source(6)
      byte protocol(2)
      byte packet(lpacket)
      byte buffer(lbuffer)
      byte b1(4),b2(4)
      equivalence (buffer,cbuf)
      equivalence (b1,iosb(1))
      equivalence (b2,iosb(2))
      equivalence (b1(1),completion)
      equivalence (b1(3),transfer)
      equivalence (b2(3),errsum)
      equivalence (cpacket,packet)
      equivalence (packet(1),destination(1))
      equivalence (packet(7),source(1))
      equivalence (packet(13),protocol)
      equivalence (buffer(1),ldata)
C
      STRUCTURE /ITEMLIST/
        INTEGER*2 BUFLEN
        INTEGER*2 ITEMCODE
        INTEGER*4 BUFFADD
        INTEGER*4 RETLADD
      END STRUCTURE
C
      RECORD /ITEMLIST/ ITEM_LIST(10)
c
cdec$ options/align=(records=packed)
      structure /plist/
        integer*2 param_id
        integer*4 param_value
      end structure
c
      record /plist/ p2_list(10)
cdec$ end options
c
C Assign the controller port (for VS 3100)
C
      STATUS = SYS$ASSIGN('ESA0:',channel,,)
      status = lib$signal(%val(status))
c
      iofunc = io$_setmode .or. io$m_ctrl .or. io$m_startup
c
      nma$c_pcli_prm  = 2840            ! promiscuous
      nma$c_pcli_pad  = 2842            ! padding
      nma$c_pcli_mlt  = 2841            ! multicast/broadcast
      nma$c_pcli_pty  = 2830            ! protocol type
      nma$c_pcli_fmt  = 2770            ! packet format
      nma$c_pcli_bfn  = 1105            ! receive buffers
      nma$c_pcli_bus  = 2801            ! max port receive size in bytes
      nma$c_state_on  = 0
      nma$c_state_off = 1
      nma$c_linfm_eth = 1
      nma$c_linfm_802 = 2
      p2_list(1).param_id    = nma$c_pcli_prm
      p2_list(1).param_value = nma$c_state_on
      p2_list(2).param_id    = nma$c_pcli_pad
      p2_list(2).param_value = nma$c_state_off

      p2desc(1) = 12                   ! bytes in p2_list
      p2desc(2) = %loc(p2_list)
c
c NB you'll need privilege to do this. Probably PHY_IO at least.
c
      status = sys$qiow(,%val(channel),%val(iofunc),iosb
     &         ,,,,p2desc,,,,)
      status = lib$signal(%val(status))
      write(6,*) ' promiscuous '
      write(6,*) ' completion ',completion
      write(6,*) ' transfer ',transfer
      write(6,*) ' errsum ',errsum
      if(completion.eq.ss$_badparam) write(6,*) iosb
c
      do i=1,lpacket
         cblank(i:i) = char(0)
      end do
c
c read a packet
c
      iofunc = io$_readpblk ! .or. io$m_now
c
      npackets = 0
      status = lib$date_time(ctime)
      read(ctime(19:23),'(f5.2)') t1
      sum = 0
    1 continue
      cpacket = cblank
      status = sys$qiow(,%val(channel),%val(iofunc),iosb
     &         ,,,buffer,%val(lbuffer),,,packet,)
      npackets = npackets + 1
      write(cdest,500) destination
      write(csorc,500) source
c
c determine packet type
c
      if(packet(17).ne.0.or.packet(18).ne.0) then
        cform = '802 ext.'
        istart = 7
      else if(packet(15).ne.0.or.packet(16).ne.0) then
        cform = '802'
        istart = 6
      else
        cform = 'Standard'
        write(cprot,501) protocol
        status = lib$date_time(ctime)
c        call display(transfer,cprot,ctime)
        istart = 1
        if(ldata.eq.transfer-2) istart = 3
      endif
  500 format(z2.2,'-',z2.2,'-',z2.2,'-',z2.2,'-',z2.2,'-',z2.2)
  501 format(z2.2,'-',z2.2)
c
c write source and destination addresses in standard format, if needed
c
      write(6,*) ' Source ',csorc
      write(6,*) ' Destination ',cdest
      write(6,*) ' IEEE ',cform,' PROTOCOL ',cprot
      write(6,*) ' IOSB ',iosb
      write(6,*) ' Transfer ',transfer,' bytes'
      write(6,*) ' --------------------------------------'
c
c we stop after 10000 packets
c
      if(npackets.lt.100000) goto 1
c
c shut down the port
c
  100 continue
      iofunc = io$_setmode .or. io$m_ctrl .or. io$m_shutdown
      status = sys$qiow(,%val(channel),%val(iofunc),iosb
     &         ,,,,,,,,)
      write(6,*) ' shut'
      write(6,*) ' completion ',completion
      write(6,*) ' transfer ',transfer
      write(6,*) ' errsum ',errsum
c
c deassign the channel
c
      status = sys$dassgn(%val(channel))
      status = sys$exit(%val(1))
c
      end
*=*=*=*= DISPLAY.html =*=*=*=*
SUBROUTINE DISPLAY

 

SUBROUTINE DISPLAY


      SUBROUTINE DISPLAY(size,protocol,time)
c
c plots graphs of protocol types in real time.
c Unknown protocol types are dumped in the file 'unknown.protocols'
c
      implicit integer (a-z)
      include '($smgdef)'
c
      parameter (maxprot=20,maxcon=60)
      character*10 cprot_type(maxprot)
      character*(*) time
      character*(*) protocol
      character*(maxcon) cbar
      character*6 cnum
      integer count(maxprot),data(maxprot)
      data icall /0/
c
      IF(icall.LE.0) THEN
         icall = 1
         do 6 ip=1,maxcon
            cbar(ip:ip) = char(113)
    6    continue
         do 1 i=1,maxprot
            count(i) = 0
            data(i) = 0
    1    continue
c
c Here we define the names of the standard protocols of interest
c
         cprot_type(1) = 'Vitalink'
         cprot_type(2) = 'X.75'
         cprot_type(3) = 'Dump/Load'
         cprot_type(4) = 'DEC Cons.'
         cprot_type(5) = 'DECnet IV'
         cprot_type(6) = 'LAT'
         cprot_type(7) = 'TCP Sys'
         cprot_type(8) = 'Novell'
         cprot_type(9) = 'LAVC'
         cprot_type(10)= 'DEC Bridge'
         cprot_type(11)= 'IP'
         cprot_type(12)= 'EtherTalk'
         cprot_type(13)= 'Apollo Dom'
         cprot_type(14)= 'Appletalk'
         cprot_type(15)= 'ARP'
         cprot_type(16)= 'Apple ARP'
         cprot_type(17)= 'Unknown'
         nprot = 17
c
c open the file that will contain the dump of unknown
c protocols
c
         open(1,file='unknown.protocols',status='new')
c
c Create the pasteboard for the Terminal Screen
c
         STATUS = SMG$CREATE_PASTEBOARD(IDP,,ROWS,COLS)
         IF(.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
c
         STATUS=SMG$CREATE_VIRTUAL_DISPLAY
     &          (ROWS-2,COLS-2,ID,SMG$M_BORDER)
         IF(.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
c
         STATUS = SMG$LABEL_BORDER(ID,' Ethernet Listen ',,,SMG$M_BOLD)
         STATUS = SMG$PASTE_VIRTUAL_DISPLAY(ID,IDP,2,2)
         IF(.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
         status = smg$set_broadcast_trapping(id)
c
         do 5 ip=1,nprot
            status=smg$put_chars(id,cprot_type(ip),ip+3,1,,
     &      %ref(smg$m_bold),,%ref(smg$c_ascii))
    5    continue
c
      endif
      STATUS=SMG$PUT_CHARS(ID,'Time is '//time(:24),1,1,,
     &   %REF(SMG$M_normal),,%REF(SMG$C_ASCII))
      if(protocol.eq.'80-80') then
         iprot = 1
      else if(protocol.eq.'08-01') then
         iprot = 2
      else if(protocol.eq.'60-01') then
         iprot = 3
      else if(protocol.eq.'60-02') then
         iprot = 4
      else if(protocol.eq.'60-03') then
         iprot = 5
      else if(protocol.eq.'60-04') then
         iprot = 6
      else if(protocol.eq.'90-02') then
         iprot = 7
      else if(protocol.eq.'81-37') then
         iprot = 8
      else if(protocol.eq.'60-07') then
         iprot = 9
      else if(protocol.eq.'80-38') then
         iprot = 10
      else if(protocol.eq.'80-39') then
         iprot = 2
      else if(protocol.eq.'80-40') then
         iprot = 2
      else if(protocol.eq.'80-41') then
         iprot = 2
      else if(protocol.eq.'80-42') then
         iprot = 2
      else if(protocol.eq.'08-00') then
         iprot = 11
      else if(protocol.eq.'80-9B') then
         iprot = 12
      else if(protocol.eq.'80-19') then
         iprot = 13
      else if(protocol.eq.'AA-AA') then
         iprot = 14
      else if(protocol.eq.'08-06') then
         iprot = 15
      else if(protocol.eq.'80-F3') then
         iprot = 16
      else
         write(1,*) protocol
         iprot = 17
      endif
      count(iprot) = count(iprot) + 1
      data(iprot) = data(iprot) + 1
      if (count(iprot).gt.maxcon) then
c
c counts need re-setting (depending on what we want, we could
c re-scale here instead)
c
         count(iprot) = 1
      endif
      irow = iprot + 3
      ic = count(iprot)
      if(ic.eq.1) status = smg$erase_chars(id,maxcon,irow,11)
      status = smg$put_chars(id,cbar(1:1),irow,10+ic,,
     &%ref(smg$m_bold),,%ref(smg$c_spec_graphics))
      write(cnum,'(i6)') data(iprot)
      status = smg$put_chars(id,cnum,irow,maxcon+13,,
     &%ref(smg$m_normal),,%ref(smg$c_ascii))
      end