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