From: carl@SOL1.GPS.CALTECH.EDU (Carl J Lydick)
Subject: Re: Summary of responses re: Ethernet monitoring tools
Reply-To: carl@SOL1.GPS.CALTECH.EDU
Organization: HST Wide Field/Planetary Camera
Date: Wed, 22 Jul 1992 01:30:29 GMT

In article <10993@rls.UUCP>, randy@rls.UUCP (randy) writes:
>> Carl Lydick actually sent me Fortran source code of ETHERLOG.  This is a
>> rudimentary, but very effective, packet grabber for VMS that actually
>> helped me over the weekend find a system that was sending out bad MOP
>> packets.  It loops until it has seen 10,000 packets and then gives a
>> listing of who was talking to who using what protocol. 
>
>If it's not too big, maybe Carl or yourself could post it. :-)

It's about 300 lines long.  It was originally written by J.J. Bunn at CERN, but
his version simply listed each packet as it arrived.  I added code to use the
LIB$*TREE routines to let it gather statistics on the packets without having it
write out the information on each individual packet.  Here it is:

C	************************************************************************
      program ether_log
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 XQA0 as the code was intended for use with a deqna or delqa.
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 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*(lbuffer) cbuf
      real mbs,t1,t2
      integer p1desc(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 (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
      structure /plist/
        integer*2 param_id
        integer*4 param_value
      end structure
c
      record /plist/ p1_list(10),p2_list(10)
c
	structure /iosb_struct/
		integer*2	conval
		integer*2	trncnt
		integer*4	devspc
	end structure

	record /iosb_struct/ iosb
c
C Assign the controller port (for VS 3100)
C
      STATUS = SYS$ASSIGN('XQA0:',channel,,)
      if (.not.status) then
         status = lib$stop(%val(status))
      endif

      iofunc = io$_setmode .or. io$m_ctrl .or. io$m_startup
c
      p1desc(1) = 0
      p1desc(2) = %loc(p1_list)
c
      p2_list(1).param_id    = 2770    ! nma$c_pcli_fmt is packet format
      p2_list(1).param_value = 1       ! value is Ethernet !
      p2_list(2).param_id    = 2840    ! nma$c_pcli_prm is promiscuous 
      p2_list(2).param_value = 0       ! nma$c_state_on
      p2_list(3).param_id    = 2830    ! nma$c_cpli_pty
      p2_list(3).param_value = 24582   ! pick a protocol
      p2desc(1) = 18                   ! 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,,,
     &         p1desc,p2desc,,,,)
	IF((STATUS .AND. 7) .NE. 1) CALL SYS$EXIT(%VAL(STATUS))
	IF((IOSB.CONVAL .AND. 7) .NE. 1) CALL SYS$EXIT(%VAL(IOSB.CONVAL))
c
c read a packet
c
      iofunc = io$_readpblk
c
      npackets = 0
      sum = 0
1     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 (most packets conform to standard, rather
c than 802/802 extended.)
c
      if(packet(17).ne.0.or.packet(18).ne.0) then
        istart = 7
      else if(packet(15).ne.0.or.packet(16).ne.0) then
        istart = 6
      else
        write(cprot,501) protocol
        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                          
c	write (1,502) csorc, cdest, cprot
c502	format(3(1x,a))
C
C	Add packet to balanced B-Tree
C
	CALL ADD_PACKET(SOURCE, DESTINATION, PROTOCOL, IOSB.TRNCNT)
c
c we stop after 10000 packets
c
      if(npackets.lt.10000) 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
     &         ,,,,,,,,)
	IF((STATUS .AND. 7) .NE. 1) CALL SYS$EXIT(%VAL(STATUS))
	IF((IOSB.CONVAL .AND. 7) .NE. 1) CALL SYS$EXIT(%VAL(IOSB.CONVAL))
c
c deassign the channel
c
      status = sys$dassgn(%val(channel))
C	PRINT OUT LIST OF PACKETS
	CALL PRINT_TREE()
      status = sys$exit(%val(1)) 
c
      end

	SUBROUTINE ADD_PACKET(SOURCE, DESTINATION, PROTOCOL, COUNT)
	BYTE SOURCE(6),DESTINATION(6),PROTOCOL(2), ENT(14)

	INTEGER*2 COUNT
	INTEGER*4 TREEHD /0/, NODE
	EXTERNAL COMP, ALLOC, SHONODE

	DO 10 I = 1, 6
	ENT(I) = SOURCE(I)
10	ENT(I + 6) = DESTINATION(I)
	ENT(13) = PROTOCOL(1)
	ENT(14) = PROTOCOL(2)
	
	ISTAT = LIB$INSERT_TREE(TREEHD,ENT,0,COMP,ALLOC,NODE,)
	IF((ISTAT .AND. 7) .NE. 1) CALL SYS$EXIT(%VAL(ISTAT))
	CALL INCREMENT(%VAL(NODE), COUNT)
	RETURN
	ENTRY PRINT_TREE()
	CALL LIB$TRAVERSE_TREE(TREEHD, SHONODE)
	END

	INTEGER*4 FUNCTION COMP(SYMBOL, NODE, DUMMY)
	BYTE SYMBOL(14)
	STRUCTURE /NODE_TYPE/
		INTEGER*2 HEADER(5)
		BYTE KEYVAL(14)
		INTEGER*2 COUNT
		INTEGER*4 XFER
	END STRUCTURE
	RECORD /NODE_TYPE/ NODE

	DO 10 I = 1, 14
	IF(SYMBOL(I) .LT. NODE.KEYVAL(I)) THEN
		COMP = -1
		RETURN
	ELSE IF (SYMBOL(I) .GT. NODE.KEYVAL(I)) THEN
		COMP = 1
		RETURN
	ENDIF
10	CONTINUE
	COMP = 0
	RETURN
	END

	INTEGER*4 FUNCTION ALLOC(SYMBOL, NEW_NODE, DUMMY)
	BYTE SYMBOL(14)
	INTEGER*4 NEW_NODE

	ISTAT = LIB$GET_VM(26, NEW_NODE,)
	IF((ISTAT .AND. 7) .NE. 1) THEN
		ALLOC = ISTAT
		RETURN
	ENDIF
	CALL COPY(SYMBOL, %VAL(NEW_NODE))
	ALLOC = 1
	RETURN
	END

	SUBROUTINE COPY(SYMBOL, NODE)
	BYTE SYMBOL(14)
	STRUCTURE /NODE_TYPE/
		INTEGER*2 HEADER(5)
		BYTE KEYVAL(14)
		INTEGER*2 COUNT
		INTEGER*4 XFER
	END STRUCTURE
	RECORD /NODE_TYPE/ NODE
	
	DO 10 I = 1, 14
10	NODE.KEYVAL(I) = SYMBOL(I)
	NODE.COUNT = 0
	NODE.XFER = 0
	RETURN
	END

	SUBROUTINE INCREMENT(NODE, COUNT)
	STRUCTURE /NODE_TYPE/
		INTEGER*2 HEADER(5)
		BYTE KEYVAL(14)
		INTEGER*2 COUNT
		INTEGER*4 XFER
	END STRUCTURE
	RECORD /NODE_TYPE/ NODE
	INTEGER*2 COUNT
	NODE.XFER = NODE.XFER + COUNT
	NODE.COUNT = NODE.COUNT + 1
	RETURN
	END

	INTEGER*4 FUNCTION SHONODE(NODE, DUMMY)
	STRUCTURE /NODE_TYPE/
		INTEGER*2 HEADER(5)
		BYTE KEYVAL(14)
		INTEGER*2 COUNT
		INTEGER*4 XFER
	END STRUCTURE
	RECORD /NODE_TYPE/ NODE
	CHARACTER*14 PROTOCOL_NAME

	WRITE(6, 10) (NODE.KEYVAL(I), I = 1, 12),
	1	PROTOCOL_NAME(NODE.KEYVAL(13)), NODE.COUNT, NODE.XFER
10	FORMAT(1X,2(5(Z2.2,'-'),Z2.2,7X),A,2X,I5,I10)
	SHONODE = 1
	RETURN
	END

	CHARACTER*14 FUNCTION PROTOCOL_NAME(PROTOCOL)
	INTEGER*2 PROTOCOL

	IF(PROTOCOL .EQ. 8) THEN
		PROTOCOL_NAME = 'IP'
	ELSE IF(PROTOCOL .EQ. 264) THEN
		PROTOCOL_NAME = 'X.75'
	ELSE IF(PROTOCOL .EQ. 1544) THEN
		PROTOCOL_NAME = 'ARP'
	ELSE IF(PROTOCOL .EQ. 96) THEN
		PROTOCOL_NAME = 'DEC???'
	ELSE IF(PROTOCOL .EQ. 352) THEN
		PROTOCOL_NAME = 'Dump/Load'
	ELSE IF(PROTOCOL .EQ. 608) THEN
		PROTOCOL_NAME = 'DEC Rem. Cons.'
	ELSE IF(PROTOCOL .EQ. 864) THEN
		PROTOCOL_NAME = 'DECnet IV'
	ELSE IF(PROTOCOL .EQ. 1120) THEN
		PROTOCOL_NAME = 'LAT'
	ELSE IF(PROTOCOL .EQ. 1376) THEN
		PROTOCOL_NAME = 'DEC Diag.'
	ELSE IF(PROTOCOL .EQ. 1632) THEN
		PROTOCOL_NAME = 'DEC Cust.'
	ELSE IF(PROTOCOL .EQ. 1888) THEN
		PROTOCOL_NAME = 'LAVC'
	ELSE IF(PROTOCOL .EQ. 2144) THEN
		PROTOCOL_NAME = 'DEC???'
	ELSE IF(PROTOCOL .EQ. 2400) THEN
		PROTOCOL_NAME = 'DEC???'
	ELSE IF(PROTOCOL .EQ. 6528) THEN
		PROTOCOL_NAME = 'Apollo Dom'
	ELSE IF(PROTOCOL .EQ. 14464) THEN
		PROTOCOL_NAME = 'DEC Bridge'
	ELSE IF(PROTOCOL .EQ. 14720) THEN
		PROTOCOL_NAME = 'X.75'
	ELSE IF(PROTOCOL .EQ. 16512) THEN
		PROTOCOL_NAME = 'X.75'
	ELSE IF(PROTOCOL .EQ. 16768) THEN
		PROTOCOL_NAME = 'X.75'
	ELSE IF(PROTOCOL .EQ. 17024) THEN
		PROTOCOL_NAME = 'X.75'
	ELSE IF(PROTOCOL .EQ. 32896) THEN
		PROTOCOL_NAME = 'Vitalink'
	ELSE IF(PROTOCOL .EQ. 39808) THEN
		PROTOCOL_NAME = 'EtherTalk'
	ELSE IF(PROTOCOL .EQ. 62336) THEN
		PROTOCOL_NAME = 'Apple ARP'
	ELSE IF(PROTOCOL .EQ. 14209) THEN
		PROTOCOL_NAME = 'Novell'
	ELSE IF(PROTOCOL .EQ. 144) THEN
		PROTOCOL_NAME = 'Loopback Ass.'
	ELSE IF(PROTOCOL .EQ. 656) THEN
		PROTOCOL_NAME = 'TCP Sys'
	ELSE IF(PROTOCOL .EQ. 43690) THEN
		PROTOCOL_NAME = 'Appletalk'
	ELSE
		PROTOCOL_NAME = '** UNKNOWN **'
	ENDIF
	RETURN
	END
C	************************************************************************
--------------------------------------------------------------------------------
Carl J Lydick | INTERnet: CARL@SOL1.GPS.CALTECH.EDU | NSI/HEPnet: SOL1::CARL

Disclaimer:  Hey, I understand VAXen and VMS.  That's what I get paid for.  My
understanding of astronomy is purely at the amateur level (or below).  So
unless what I'm saying is directly related to VAX/VMS, don't hold me or my
organization responsible for it.  If it IS related to VAX/VMS, you can try to
hold me responsible for it, but my organization had nothing to do with it.
Newsgroups: comp.os.vms