*=*=*=*= 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,lpacketcblank(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)') t1sum = 0
1 continue
cpacket = cblankstatus = 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) protocolstatus = 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_shutdownstatus = 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