From: CSBVAX::MRGATE!RELAY-INFO-VAX@CRVAX.SRI.COM@SMTP 4-OCT-1988 13:48
To: ARISIA::EVERHART
Subj: Ethernet ping like utility for VMS
Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Tue, 4 OCT 88 06:57:03 PDT
Received: from ucbvax.Berkeley.EDU by KL.SRI.COM with TCP; Tue, 4 Oct 88 06:33:29 PDT
Received: by ucbvax.Berkeley.EDU (5.59/1.31)
id AA21733; Tue, 4 Oct 88 01:10:47 PDT
Received: from USENET by ucbvax.Berkeley.EDU with netnews
for info-vax@kl.sri.com (info-vax@kl.sri.com)
(contact usenet@ucbvax.Berkeley.EDU if you have questions)
Date: 3 Oct 88 13:48:40 GMT
From: dogie!dorl%vms.macc.wisc.edu@speedy.cs.wisc.edu (Michael Dorl - MACC)
Organization: University of Wisconsin Academic Computing Center
Subject: Ethernet ping like utility for VMS
Message-Id: <737@dogie.edu>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com
Well, no one was able to come up with a satisfactory ping like
utility for VMS so I wrote one. In order to run it, you have
to first run the vmsmirror program on the remote node. Then
run the vmsecho program on the local node. Note that I had no
idea what to use for a protocol number so I grabbed f0ff more
or less at random. If anyone has a good idea on a better choice,
I'd like to hear about it.
-- VMSECHO.DEF ---------------------------------------------------------------
Implicit None
Include '($IODef)'
External Sys$QIO
Integer Sys$QIO
External Sys$QIOW
Integer Sys$QIOW
External Sys$Assign
Integer Sys$Assign
External Sys$WFLOr
Integer Sys$WFLOr
Structure /IOSBDef/
Integer *2 Condition
Integer *2 Count
Integer *4 Specific
End Structure
Structure /HeaderDef/
Union
Map
Byte Destination(6)
Byte Source(6)
EndMap
Map
Byte Addresses(6,2)
EndMap
EndUnion
Union
Map
Integer *2 Protocol
End Map
Map
Byte Protocol_Bytes(2)
End Map
End Union
End Structure
C I can't find a $NMADEF anywhere so define the values I need
Parameter NMA$C_PCLI_BFN = 1105
Parameter NMA$C_PCLI_BUS = 2801
Parameter NMA$C_PCLI_PRM = 2840
Parameter NMA$C_PCLI_PTY = 2830
Parameter NMA$C_PCLI_Pad = 2842
Parameter NMA$C_State_On = 0
Parameter NMA$C_State_Off = 1
Parameter Event_Recv = 0
Parameter Event_Send = 1
Parameter Event_Wait = 2
Parameter Event_Mask_All = 7
C Common variables
Record /IOSBDef/ IOSB_Wait
Integer *2 Channel
Character *4 Device
Common Channel, Device, IOSB_Wait
-- VMSECHO.FOR -----------------------------------------------------------------
Include 'VMSEcho.Def/list'
C External routines
Integer Sys$ClrEF
Integer Sys$Synch
C Local Definitions
Structure /BufferDef/
Union
Map
Byte All(1500)
EndMap
Map
Integer *4 Sequence
Byte Time(8)
EndMap
End Union
End Structure ! /BufferDef/
Record /IOSBDef/ IOSB_Send, IOSB_Recv
Record /BufferDef/ Recv_Buffer, Send_Buffer
Character *11 Time_Asc
Integer *4 NBuffers
Integer *4 NWaits
Integer *4 Delay
Integer *4 Status
Integer *4 I
Character *32 DECNet_Node
Integer *4 Area, Node
Character *1 Ch
Logical Dot
Byte Ether_Address(6) ! These must be
Integer *2 Protocol ! together
Integer *4 DECNet_Address
Byte DECNet_Byte(2)
Equivalence (DECNet_Byte, DECNet_Address)
C Counters for performance statistics
Integer *4 Buffers_Sent, Buffers_Received,
$ Delta_Time(2), Total_Time(2),
$ Time(2), Average_Time(2),
$ Remainder
C Begin VMSEcho
C Get Parameters
Print '(A,$)', ' Number of buffers (1000)? '
Read '(I)', NBuffers
If (NBuffers .le. 0) Then
NBuffers = 1000
EndIf
Print '(A,$)', ' Delay in milliseconds (1000)? '
Read '(I)', Delay
If (Delay .le. 0) Then
Delay = 1000
EndIf
If (Delay .lt. 100) Then
Delay = 100
EndIf
Print '(A,$)', ' Device (XEA0)? '
Read '(A)', Device
If (Device .eq. ' ') Then
Device = 'XEA0'
EndIf
1 Print '(A,$)', ' DECNet node number? '
Read '(A)', DECNet_Node
Area = 0
Node = 0
Dot = .false.
Do I = 1,Len(DECNet_Node)
Ch = DECNet_Node(I:I)
If ((Ch .gt. '0') .and. (Ch .le. '9')) Then
If (.not. Dot) Then
Area = 10 * Area + IChar(Ch) - IChar('0')
Else
Node = 10 * Node + IChar(Ch) - IChar('0')
EndIf
ElseIf (Ch .eq. '.') Then
Dot = .true.
ElseIf (Ch .eq. ' ') Then
Else
Print '(A)', ' Huh?'
Goto 1
EndIf
EndDo
DECNet_Address = 1024 * Area + Node
Ether_Address(1) = 'AA'X
Ether_Address(2) = '00'X
Ether_Address(3) = '04'X
Ether_Address(4) = '00'X
Ether_Address(5) = DECNet_Byte(1)
Ether_Address(6) = DECNet_Byte(2)
C Print '(A,8z3.2)', ' Ethernet address = ', Ether_Address
Print '(x)'
C Start the various asynchronous events
Protocol = 'FFF0'X
Send_Buffer.Sequence = 0
Call Sys$GetTim (Send_Buffer.Time)
Call Ether_Init (IOSB_Recv) ! Setup channel
Call Ether_Recv (IOSB_Recv,Recv_Buffer.All,200) ! Ethernet receive
Call Ether_Send (IOSB_Send,Send_Buffer.All,1500,Ether_address) ! Ethernet send
Call Wait (Delay, IOSB_Wait) ! Timed wait
C Monitor the Ethernet
Buffers_Sent = 1
Buffers_Received = 0
Total_Time(1) = 0
Total_Time(2) = 0
NWaits = 0
Do While (NWaits .lt. (NBuffers+1))
C Wait for completion
Status = Sys$WFLOr (%Val(0),%Val(Event_Mask_All))
If (.not. Status) Then
Print '(A,Z)', ' Sys$WFLOr error, status = ', Status
Stop
EndIf
C Did Ethernet send complete
If (IOSB_Send.Condition .ne. 0) Then
Print '(A,I3,x,A)', ' Sent buffer ', Send_Buffer.Sequence
Status = Sys$ClrEF (%Val(Event_Send))
Status = Sys$Synch (%Val(Event_Send), IOSB_Send)
IOSB_Send.Condition = 0
EndIf
C Did Ethernet receive complete?
If (IOSB_Recv.Condition .ne. 0) Then
Call Sys$GetTim (Time)
Call Lib$SubX (Time, Recv_Buffer.Time, Delta_Time, 2)
Buffers_Received = Buffers_Received + 1
Call Lib$AddX (Total_Time, Delta_Time, Total_Time, 2)
Print '(A,I3,x,I4,A)',
$ ' Received buffer ', Recv_Buffer.Sequence,
$ Delta_Time(1)/10000, ' ms'
Call Ether_Recv (IOSB_Recv,Recv_Buffer.All,1500) ! Ethernet receive
EndIf
C Did timed wait complete
If (IOSB_Wait.Condition .ne. 0) Then
If (Buffers_Sent .lt. NBuffers) Then
Send_Buffer.Sequence = Send_Buffer.Sequence + 1
Call Sys$GetTim (Send_Buffer.Time)
Call Ether_Send (IOSB_Send,Send_Buffer.All,200,Ether_Address) ! Send another buffer
Buffers_Sent = Buffers_Sent + 1
EndIf
Call Wait (Delay, IOSB_Wait) ! Timed wait
NWaits = NWaits + 1
EndIf
End Do
C Print summary
Call Lib$EDiv (Buffers_Received, Total_Time, Average_Time(1),
$ Remainder)
Print '(//)'
Print '(A,I6)', ' Frames sent: ', Buffers_Sent
Print '(A,I6)', ' Frames received: ', Buffers_Received
Print '(A,I6)', ' % Frames lost: ',
$ 100 * (Buffers_Sent - Buffers_Received) / Buffers_Sent
Print '(A,I6,A)', ' Average response time: ',
$ Average_Time(1) / 10000, ' ms'
Print '(//)'
End ! VMSEcho
Subroutine Ether_Init (IOSB)
Include 'VMSEcho.Def/list'
C Parameter definitions
Record /IOSBDef/ IOSB
Structure /SetDef/
Union
Map
Integer *2 BFN ! 2 Number of buffers
Integer *4 BFN_Value ! 4
Integer *2 BUS ! 2 Maximum receive size
Integer *4 BUS_Value ! 4
Integer *2 Pad ! 2 Padding option
Integer *4 Pad_Value ! 4
Integer *2 PTy ! 2 Protocol
Integer *4 Pty_Value ! 4
! --
! 24 bytes total length
End Map
Map
Byte All
End Map
End Union
End Structure
Parameter Set_Lg = 24 ! Try with PTy first
Structure /DescDef/
Integer *2 Length
Byte Type
Byte Class
Integer *4 Address
End Structure
C Local definitions
Integer *4 Function
Logical PTY_Tried ! This is needed because DEC
! changed PTY from a required
! parameter in pre VMS 4.6
! to one which is not allowed
! with PRM in VMS 4.6
Record /SetDef/ Set
Record /DescDef/ Set_Desc
Integer *4 Status
C Open a channel to the DEUNA
Status = Sys$Assign (Device, Channel,,)
If (.not. Status) Then
Print '(A,Z)', ' Assign channel failed, status = ', Status
Stop
EndIf
C Set parameters and start Ethernet channel
Set.BFN = NMA$C_PCLI_BFN ! Number of preallocated
Set.BFN_Value = 4 ! receive buffers
Set.BUS = NMA$C_PCLI_BUS ! Maximum allowable
Set.BUS_Value = 1500 ! buffer length
Set.PTY = NMA$C_PCLI_PTY ! Set protocol type
Set.PTY_Value = 'fff0'X
Set.Pad = NMA$C_PCLI_Pad ! Padding option
Set.Pad_Value = NMA$C_State_Off
PTY_Tried = .false.
Set_Desc.Length = Set_Lg
Set_Desc.Type = 0
Set_Desc.Class = 0
Set_Desc.Address = %Loc(Set.All)
7 Function = IO$_SetMode + IO$M_Ctrl + IO$M_StartUp
Status = Sys$QIOW
$ (, ! efn
$ %Val(Channel), ! chan
$ %Val(Function), ! func
$ IOSB, ! iosb
$ , ! astadr
$ , ! astprm
$ , ! p1
$ Set_Desc, ! p2
$ ,,, ! p3 - p6
$ )
If (.not. Status) Then
Print '(A,Z)', ' SetMode and startup failed, status = ',
$ Status
Stop
EndIf
If (.not. IOSB.Condition) Then
If
$ ((IOSB.Condition .eq. '14'x) .and. (.not. PTY_Tried))
$ Then
Print '(A)', ' IOSB.Condition=14, retrying without PTY'
Set_Desc.Length = Set_Lg - 6
PTY_Tried = .true.
Goto 7
EndIf
Print '(A,Z,A,Z)',
$ ' SetMode and startup failed, IOSB.Condition = ',
$ IOSB.Condition,
$ ' IOSB.Specific = ', IOSB.Specific
Stop
EndIf
Return
End ! Ether_Init
Subroutine Ether_Recv (IOSB, Buffer, Buffer_Lg)
Include 'VMSEcho.Def/list'
C Parameter definitions
Record /IOSBDef/ IOSB
Byte Buffer(*)
Integer *4 Buffer_Lg
C Local variables
Integer *4 Status
Integer *4 Function
C Begin Ether_Receive
Function = IO$_ReadVBlk
Status = Sys$QIO
$ (
$ %Val(Event_Recv), ! efn
$ %Val(Channel), ! chan
$ %Val(Function), ! func
$ IOSB, ! iosb
$ , ! astadr
$ , ! astprm
$ Buffer, ! p1
$ %Val(Buffer_Lg), ! p2
$ , ! p3
$ , ! p4
$ , ! p5
$ ! p6
$ )
If (.not. Status) Then
Print '(A,Z)', ' IOSB ReadVBlk error, status = ', Status
EndIf
C Print '(A)', ' Buffer received'
Return
End ! Ether_Receive
Subroutine Ether_Send (IOSB, Buffer, Buffer_Lg, Ether_Address)
Include 'VMSEcho.Def/list'
C Parameter definitions
Record /IOSBDef/ IOSB
Byte Buffer(*)
Integer *4 Buffer_Lg
Byte Ether_Address(6)
C Local definitions
Integer *4 Status
Integer *4 Function
C Begin Ether_Send
Function = IO$_WriteVBlk
Status = Sys$QIO
$ (
$ %Val(Event_Send), ! efn
$ %Val(Channel), ! chan
$ %Val(Function), ! func
$ IOSB, ! iosb
$ , ! astadr
$ , ! astprm
$ Buffer, ! p1
$ %Val(Buffer_Lg), ! p2
$ , ! p3
$ , ! p4
$ Ether_Address, ! p5
$ ! p6
$ )
If (.not. Status) Then
Print '(A,Z)', ' IOSB WriteVBlk error, status = ', Status
Stop
EndIf
C Print '(A)', ' Buffer sent'
Return
End ! Ether_Send
Subroutine Wait(MS, IOSB)
C Select a AST for MS milli-seconds. IOSB.Condition is set to zero
C now and to one when the AST goes off. Event flag Event_Wait is
C also cleared and set with the AST.
Include 'VMSEcho.Def'
C Parameter definitions
Integer *4 MS
Record /IOSBDef/ IOSB
C External routines
External Wait_Ast
External Sys$GetTim
Integer Sys$GetTim
External Sys$Setimr
Integer Sys$Setimr
C Local definitions
Integer *4 Sys_Time(2), Delta_Time(2), Wait_Time(2)
Integer *4 Status
C Begin Wait
Status = Sys$GetTim (Sys_Time)
If (.not. Status) Then
Print '(A)', ' Error Sys$GetTim'
Call Lib$Signal (%Val(Status))
Stop
EndIf
Call Lib$EMul (10000, MS, 0, Delta_Time)
Call Lib$AddX (Delta_Time, Sys_Time, Wait_Time, 2)
Status = Sys$Setimr
$ (
$ %Val(Event_Wait),
$ Wait_Time,
$ Wait_Ast,
$ )
If (.not. Status) Then
Print '(A)', ' Error Sys$Setimr'
Call Lib$Signal (%Val(Status))
Stop
EndIf
IOSB.Condition = 0
Return
End ! Wait
Subroutine Wait_Ast()
Include 'VMSEcho.Def'
IOSB_Wait.Condition = 1
Return
End
-- VMSMIRROR.FOR -----------------------------------------------------------------
Include 'VMSEcho.Def/list'
C Local Definitions
Record /IOSBDef/ IOSB_Send, IOSB_Recv
Record /HeaderDef/ Header
Byte Recv_Buffer(1500), Send_Buffer(1500)
Integer *4 NBuffers
Integer *4 Buffers_Sent, Buffers_Received
Integer *4 Status
Integer *4 I
Character *32 DECNet_Node
Integer *4 Area, Node
Character *1 Ch
Logical Dot
Byte Ether_Address(6) ! These must be
Integer *2 Protocol ! together
Integer *4 DECNet_Address
Byte DECNet_Byte(2)
Equivalence (DECNet_Byte, DECNet_Address)
C Begin VMSMirror
Print '(A,$)', ' Device (XEA0)? '
Read '(A)', Device
If (Device .eq. ' ') Then
Device = 'XEA0'
EndIf
C Start the various asynchronous events
Protocol = 'FFF0'X
Call Ether_Init (IOSB_Recv) ! Setup channel
Call Ether_Recv (IOSB_Recv,Recv_Buffer,1500,Header) ! Ethernet receive
C Monitor the Ethernet
Buffers_Sent = 0
Buffers_Received = 0
Do While (.true.)
Status = Sys$WFLOr (%Val(0),%Val(Event_Mask_All))
If (.not. Status) Then
Print '(A,Z)', ' Sys$WFLOr error, status = ', Status
Stop
EndIf
C Did Ethernet receive complete?
If (IOSB_Recv.Condition .ne. 0) Then
Buffers_Received = Buffers_Received + 1
Buffers_Sent = Buffers_Sent + 1
Do I = 1,6
Ether_Address(I) = Header.Source(I)
EndDo
Do I = 1, 200
Send_Buffer(I) = Recv_Buffer(I)
EndDo
Print '(A,8z3.2)', ' Buffer received from ', Header.Source
Call Ether_Send (IOSB_Send,Send_Buffer,200,Ether_Address)
Call Ether_Recv (IOSB_Recv,Recv_Buffer,1500,Header)
EndIf
End Do
End ! VMSMirror
Subroutine Ether_Init (IOSB)
Include 'VMSEcho.Def/list'
C Parameter definitions
Record /IOSBDef/ IOSB
Structure /SetDef/
Union
Map
Integer *2 BFN ! 2 Number of buffers
Integer *4 BFN_Value ! 4
Integer *2 BUS ! 2 Maximum receive size
Integer *4 BUS_Value ! 4
Integer *2 Pad ! 2 Padding option
Integer *4 Pad_Value ! 4
Integer *2 PTy ! 2 Protocol
Integer *4 Pty_Value ! 4
! --
! 24 bytes total length
End Map
Map
Byte All
End Map
End Union
End Structure
Parameter Set_Lg = 24 ! Try with PTy first
Structure /DescDef/
Integer *2 Length
Byte Type
Byte Class
Integer *4 Address
End Structure
C Local definitions
Integer *4 Function
Logical PTY_Tried ! This is needed because DEC
! changed PTY from a required
! parameter in pre VMS 4.6
! to one which is not allowed
! with PRM in VMS 4.6
Record /SetDef/ Set
Record /DescDef/ Set_Desc
Integer *4 Status
C Open a channel to the DEUNA
Status = Sys$Assign (Device, Channel,,)
If (.not. Status) Then
Print '(A,Z)', ' Assign channel failed, status = ', Status
Stop
EndIf
C Set parameters and start Ethernet channel
Set.BFN = NMA$C_PCLI_BFN ! Number of preallocated
Set.BFN_Value = 4 ! receive buffers
Set.BUS = NMA$C_PCLI_BUS ! Maximum allowable
Set.BUS_Value = 1500 ! buffer length
Set.PTY = NMA$C_PCLI_PTY ! Set protocol type
Set.PTY_Value = 'fff0'X
Set.Pad = NMA$C_PCLI_Pad ! Padding option
Set.Pad_Value = NMA$C_State_Off
PTY_Tried = .false.
Set_Desc.Length = Set_Lg
Set_Desc.Type = 0
Set_Desc.Class = 0
Set_Desc.Address = %Loc(Set.All)
7 Function = IO$_SetMode + IO$M_Ctrl + IO$M_StartUp
Status = Sys$QIOW
$ (, ! efn
$ %Val(Channel), ! chan
$ %Val(Function), ! func
$ IOSB, ! iosb
$ , ! astadr
$ , ! astprm
$ , ! p1
$ Set_Desc, ! p2
$ ,,, ! p3 - p6
$ )
If (.not. Status) Then
Print '(A,Z)', ' SetMode and startup failed, status = ',
$ Status
Stop
EndIf
If (.not. IOSB.Condition) Then
If
$ ((IOSB.Condition .eq. '14'x) .and. (.not. PTY_Tried))
$ Then
Print '(A)', ' IOSB.Condition=14, retrying without PTY'
Set_Desc.Length = Set_Lg - 6
PTY_Tried = .true.
Goto 7
EndIf
Print '(A,Z,A,Z)',
$ ' SetMode and startup failed, IOSB.Condition = ',
$ IOSB.Condition,
$ ' IOSB.Specific = ', IOSB.Specific
Stop
EndIf
Return
End ! Ether_Init
Subroutine Ether_Recv (IOSB, Buffer, Buffer_Lg, Header)
Include 'VMSEcho.Def/list'
C Parameter definitions
Record /IOSBDef/ IOSB
Byte Buffer(*)
Integer *4 Buffer_Lg
Record /HeaderDef/ Header
C Local variables
Integer *4 Status
Integer *4 Function
C Begin Ether_Receive
Function = IO$_ReadVBlk
Status = Sys$QIO
$ (
$ %Val(Event_Recv), ! efn
$ %Val(Channel), ! chan
$ %Val(Function), ! func
$ IOSB, ! iosb
$ , ! astadr
$ , ! astprm
$ Buffer, ! p1
$ %Val(Buffer_Lg), ! p2
$ , ! p3
$ , ! p4
$ Header, ! p5
$ ! p6
$ )
If (.not. Status) Then
Print '(A,Z)', ' IOSB ReadVBlk error, status = ', Status
EndIf
Print '(A)', ' Buffer received'
Return
End ! Ether_Receive
Subroutine Ether_Send (IOSB, Buffer, Buffer_Lg, Ether_Address)
Include 'VMSEcho.Def/list'
C Parameter definitions
Record /IOSBDef/ IOSB
Byte Buffer(*)
Integer *4 Buffer_Lg
Byte Ether_Address(6)
C Local definitions
Integer *4 Status
Integer *4 Function
C Begin Ether_Send
Function = IO$_WriteVBlk
Status = Sys$QIO
$ (
$ %Val(Event_Recv), ! efn
$ %Val(Channel), ! chan
$ %Val(Function), ! func
$ IOSB, ! iosb
$ , ! astadr
$ , ! astprm
$ Buffer, ! p1
$ %Val(Buffer_Lg), ! p2
$ , ! p3
$ , ! p4
$ Ether_Address, ! p5
$ ! p6
$ )
If (.not. Status) Then
Print '(A,Z)', ' IOSB WriteVBlk error, status = ', Status
EndIf
Print '(A)', ' Buffer sent'
Return
End ! Ether_Send
Subroutine Wait(NSecs, IOSB)
C Suspend current process for Nsecs seconds.
Include 'VMSEcho.Def'
C Parameter definitions
Integer *4 NSecs
Record /IOSBDef/ IOSB
C External routines
External Wait_Ast
External Sys$Bintim
Integer Sys$Bintim
External Sys$Setimr
Integer Sys$Setimr
C Local definitions
Integer *4 Timbuf(2)
Character *17 Timespec
Integer *4 Days, Hours, Minutes, Seconds
Integer *4 Status
C Begin Wait
Days = Nsecs/(3600*24)
Hours = (Nsecs-Days*3600*24)/3600
Minutes = (Nsecs-Days*3600*24-Hours*3600)/60
Seconds = Nsecs-Days*3600*24-Hours*3600-Minutes*60
Write(Timespec,999) Hours, Minutes, Seconds, Days
999 format('0 ',I2.2,':',I2.2,':',I2.2,'.00',I4.4)
D Write(6,fmt='(1x,A)') Timespec
Status = Sys$Bintim(Timespec,Timbuf)
If (.not. Status) Then
Print '(A)', ' Error Sys$Bintim'
Call Lib$Signal (%Val(Status))
Stop
EndIf
Status = Sys$Setimr(%Val(Event_Wait), Timbuf, Wait_Ast,)
If (.not. Status) Then
Print '(A)', ' Error Sys$Setimr'
Call Lib$Signal (%Val(Status))
Stop
EndIf
IOSB.Condition = 0
Print '(A)', ' Wait set'
Return
End ! Wait
Subroutine Wait_Ast()
Include 'VMSEcho.Def'
IOSB_Wait.Condition = 1
Return
End
Michael Dorl (608) 262-0466
dorl@vms.macc.wisc.edu
dorl@wiscmacc.bitnet