+-+-+-+ Beginning of part 6 +-+-+-+
X`0091`009//DECnet_Node(:L_Node-2)//'"'
X
Xc  Establish DECnet link
X`009Open(`009Unit=OutboundLinkUnit,
X`0091`009File=Next_Node//'::"117="',
X`0092`009Type='UNKNOWN',
X`0093`009CarriageControl='NONE',
X`0094`009Err=145,
X`0095`009UserOpen=OutLink_UserOpen,
X`0096`009Recl=32000,
X`0097`009BlockSize=32000)
Xc  Get network name
X`009Network = Get_Network('D')
Xc  Finish message
X`009Call Finger_Out_Routine('.'//Network(:Btrim(Network))//']'//CR//LF)
X`009GoTo 150
X
Xc  Error establishing link
X145`009Continue
X`009If ( OutLinkOpenStatus .eq. SS$_NOSUCHNODE ) then
X`009    DECnet_Finger = %Loc(Fing_NoNode)
X`009    Return
X`009End if
X`009If ( OutLinkOpenStatus .eq. SS$_NOSUCHOBJ ) then
X`009    DECnet_Finger = %Loc(Fing_NoService)
X`009    Return
X`009End if
X`009If ( OutLinkRMSStatus .eq. RMS$_NOD ) then`009! Bad node name for
X`009    DECnet_Finger = %Loc(Fing_NoNode)`009`009! DECnet may be OK
X`009    Return`009`009`009`009`009! on another net.
X`009End if
X`009If ( OutLinkOpenStatus .eq. RMS$_SYN ) then`009! Bad node name for
X`009    DECnet_Finger = %Loc(Fing_NoNode)`009`009! DECnet may be OK
X`009    Return`009`009`009`009`009! on another net.
X`009End if
X`009If ( OutLinkOpenStatus .eq. SS$_DEVNOTMOUNT ) then
X`009    DECnet_Finger = %Loc(Fing_NoNet)
X`009    Return
X`009End if
X`009Call Finger_Out_Routine(': link failed]'//CR//LF)
X`009Call Lib$Signal(%Val(OutLinkOpenStatus.or.2**27)) !turn on customer bit
X`009DECnet_Finger = %Loc(Fing_Abort)
X`009Return
X
Xc  Send command over link
X150`009Continue
Xc
Xc ** Site-Specific ** uncomment next for bypass switch stuff
X 151`009IBCZ=INDEX(NET_COMMAND,'/BY')
X`009IF(IBCZ.eq.0) goto 152
X`009IIBCZ=LEN(NET_COMMAND)
X`009IBCZEND=INDEX(NET_COMMAND(IBCZ+1:IIBCZ),'/')
X`009IF(IBCZEND.EQ.0) IBCZEND=INDEX(NET_COMMAND(IBCZ+1:IIBCZ),' ')
X`009IF(IBCZEND.EQ.0) THEN
X`009    IBCZEND=IIBCZ+1
X`009ELSE
X`009    IBCZEND=IBCZEND+IBCZ
X`009ENDIF
X`009If (ibczend .gt. iibcz) Then
X`009    net_command = net_command(:ibcz-1)
X`009Else
X`009    net_command = net_command(:ibcz-1)//
X`0091   net_command(ibczend:iibcz)//NUL
X`009EndIf
X`009FLAG_BYPASS = .TRUE.
X`009Goto 151
Xc  end of bypass logic
X
Xc !** Site-specific - If you will be fingering DECnet nodes running V4 of
Xc finger, you may wish to select the version below which does not send the
Xc /IAM qualifier (which will return a harmless error message when sent to
Xc these old versions of finger).
Xc !** Site-specific: Uncomment *this* for /IAM...
X
Xc  Ship command out, tacking on /IAM stuff if we are the originating node
X 152`009If (Access .eq. 1) Then
X`009    Write(OutboundLinkUnit,1002)
X`0091`009Net_Command(:Btrim(Net_Command))//LocalQualifier//CR//LF
X`009Else
X`009    Write(OutboundLinkUnit,1002)
X`0091`009Net_Command(:Btrim(Net_Command))//CR//LF
X`009EndIf
X
Xc !** Site-specific: ... Or *this* for no /IAM
Xc  Ship command out
Xc152`009Write(OutboundLinkUnit,1002)
Xc`0091   Net_Command(:Btrim(Net_Command))//CR//LF
X
XC  Read response from network
X`009DoWhile(.true.)
XC ** Site-Specific
XC uncomment next for bypass logic
X`009      IF (.NOT.FLAG_BYPASS) THEN
X`009`009do ibcz=1,il
X`009`009  if(line(ibcz:ibcz).lt.' ')then
X`009`009     iibcz=ichar(line(ibcz:ibcz))
X`009`009     if(iibcz.ne.9.and.iibcz.ne.10
X`0091`009        .and.iibcz.ne.13)line(ibcz:ibcz)='.'
X`009`009  endif
X`009`009enddo
X`009      ENDIF
Xc end of bypass logic
X`009    Read(OutboundLinkUnit,1001,End=200) il,Line
X`009    nl = il/80
X`009    Do ii = 1,nl
X`009`009Call Finger_Out_Routine(Line((ii-1)*80+1:ii*80))
X`009    EndDo
X`009    If (nl*80+1 .le. il) then
X`009`009Call Finger_Out_Routine(Line(nl*80+1:il))
X`009    Endif
X`009EndDo
X200`009Continue
X
Xc  Make sure link is closed
X`009Close( Unit=OutboundLinkUnit, Err=201)
X201`009Continue
X
X`009Return
X
X1001`009Format(Q,A)
X1002`009Format(A)
X
X`009End
X`012
Xc------------------------------------------------------------------------
X`009Integer Function jnet_Finger(Next_Node,Net_Command,
X`0091`009`009`009Finger_Out_Routine,Node_Type)
X
Xc  Do a Finger of a remote jnet node.  Establish the link, send
Xc  the command, and relay the output back to the requestor.
X
Xc  The routine calls to the jnet network are based on interfaces
Xc  to jnet (tm), a software product available from Joiner Associates
Xc  of Madison Wisconsin.  This software allows a VAX/VMS system to
Xc  emulate a full VM (IBM) RSCS node.  jnet is a trademark of
Xc  Joiner Associates.  BITnet is a network of Universities pri-
Xc  marily using IBM systems and RSCS protocols.
X
Xc  use new jnet interface`009`00931-Aug-1985`009Rg
X
X`009Character`009Next_Node*(*), Net_Command*(*), Node_Type*1
X`009External`009Finger_Out_Routine
X
X`009Include`009`009'FingerDef.inc'
X
X`009Integer`009`009Btrim
X`009Integer`009`009IDaemon /.false./
X`009Common`009`009/jnet_Daemon/ IDaemon
X`009Logical`009`009TimedOut
X`009Common`009`009/jnet_Common/ TimedOut
X`009Integer`009`009Status, Mode
X        Character`009Line*99, Line2*99
X`009Character`009Str$Upcase*99
X        Character       Node*8, User*8
X`009Character`009InitialTimeout*13 /'0 00:01:00.00'/
X`009Character`009Timeout*13 /'0 00:00:20.00'/
X`009Integer`009`009InitialTime(2)
X`009Integer`009`009DeltaTime(2)
X`009Character`009CR /13/, LF /10/, Flush/255/, NUL/0/
X`009Logical`009`009started
X`009Character`009Network*20,`009Get_Network*20
X
X`009External`009Fing_Complete,`009Fing_Abort,  Fing_Multj
X`009External`009Rou_NoNode
X`009External`009Fing_jNA, Fing_NoNode, Fing_NoNet
X`009External`009jnet_Timer_AST
X`009Integer`009`009Privilege(2) /0,0/
X    `032
Xc  Set default return status
X`009jnet_Finger = %Loc(Fing_Complete)
Xc  check for (reentrant) call from DAE
X`009If ( IDaemon ) then
X`009    If ( Node_Type .eq. '*' ) then
X`009`009jnet_Finger = %Loc(Fing_NoNode)
X`009    Else
X`009`009jnet_Finger = %Loc(Fing_Multj)
X`009    End if
X`009    Return
X`009End if
X    `032
Xc  upcase the node name
X`009next_node=str$upcase(next_node)
X
Xc  initialize hook to jnet
X
Xc  Turn on SYSPRV privilege
X`009Privilege(1) =  Prv$M_Sysprv
X`009Call Sys$Setprv(%Val(1),Privilege,,)
Xc  Create jnet HOOK
X`009Mode = 0
X`009Status = Jan_Hook_Init(Mode,' ')
Xc  Turn off SYSPRV privilege
X`009Call Sys$Setprv(,Privilege,,)
Xc  check status
X        If (.Not.Status) then
X`009    If ( Status .eq. %Loc(Fing_jNA)) then
X`009`009jnet_Finger = %Loc(Fing_NoNet)
X`009`009Return
X`009    Else
X`009`009Call Lib$Signal(%Val(Status))
X`009`009jnet_Finger = %Loc(Fing_Abort)
X`009`009Return
X`009    End if
X`009End if
X
Xc  Format the timeout times
X`009Call Sys$BinTim(InitialTimeout,InitialTime)
X`009Call Sys$BinTim(Timeout,DeltaTime)
X
Xc  Format the line
X
Xc  First, remove any present /IAM information from the RSCS command line
X`009Ibcz=Index(Net_Command,'/IAM=')
X`009If (ibcz .eq. 0) Goto 152
X`009Iibcz=Len(Net_Command)
X`009Ibczend=Index(Net_Command(Ibcz+1:Iibcz),'/')
X`009If (Ibczend .eq. 0) Ibczend=Index(Net_Command(Ibcz+1:Iibcz),' ')
X`009If (Ibczend .eq. 0) Then
X`009    Ibczend=Iibcz+1
X`009Else
X`009    Ibczend=Ibczend+Ibcz
X`009EndIf
X`009If (Ibczend .gt. Iibcz) Then
X`009    Net_Command = Net_Command(:Ibcz-1)
X`009Else
X`009    Net_Command = Net_Command(:Ibcz-1)//
X`0091   Net_Command(Ibczend:Iibcz)//NUL
X`009EndIf
Xc  end of logic to remove /IAM stuff from RSCS commands
X
X 152`009Line = Net_Command
X`009Len1 = BTrim(Net_Command)
X`009If ( Node_Type .eq. 'J' .or. Node_Type .eq. '*' ) then`009! jnet and unix
X`009    Mode = 0
X            User = ' '
X`009Else if ( Node_Type .eq. 'I' ) then`009`009! IBM types a'la Vace
X`009    Mode = 2
X            User = 'FINGER'
X`009    Line(1:6) = ' '`009 `009! get rid of "FINGER"
X`009    If ( Line .eq. ' ' ) Line = '*'
X`009    Line(Len1+1:Len1+4) = ' MSG' ! this so we get whole output
X`009    Len1 = Len1 + 4
X        End if
X
Xc and send it out
Xc  Turn on WORLD privilege
X`009Privilege(1) =  Prv$M_World
X`009Call Sys$Setprv(%Val(1),Privilege,,)
X        Status = Jan_Send_Msg(Mode,Next_Node,User,Line(:Len1))
Xc  Turn off WORLD privilege
X`009Call Sys$Setprv(,Privilege,,)
X        If (.Not.Status) then
X`009    If ( Status .eq. %Loc(Rou_NoNode) ) then
X`009`009jnet_Finger = %Loc(Fing_NoNode)
X`009`009Goto 101
X`009    End if
X`009    Call Finger_Out_Routine(': link failed]'//CR//LF)
X`009    Call Lib$Signal(%Val(Status))
X`009    jnet_Finger = %Loc(Fing_Abort)
X`009    GoTo 101
X`009End if
X    `032
Xc  clear timer flags
X`009Started = .false.
X`009TimedOut = .false.
Xc  Start the initial timeout
X`009Call Sys$SeTimr(,InitialTime,jnet_Timer_Ast,)
Xc  get the return messages
X10      If ( Jan_Receive_Msg(Mode,Node,User,Line2,Len2) ) Goto 20
X15`009    If (started) Call Sys$SeTimr(,DeltaTime,jnet_Timer_Ast,)
X`009    Call Sys$Hiber()
X`009    Call Sys$CanTim(,)
X`009    If ( TimedOut ) GoTo 100
X`009    Goto 10
X20`009Continue
X        If (Len2 .eq. 0) Go to 15
Xc  See if an intermediate node responded
X`009If ( Node .ne. Next_Node ) then
X`009    If ( .not. started )`032
X`0091   Call Finger_Out_Routine(': link failed]'//CR//LF)
X`009    Call Finger_Out_Routine(LF//'%FINGER-E-NETERR, error from node '//
X`0091`009Node//' - '//Line2(:Len2)//CR)
X`009    jnet_Finger = %Loc(Fing_Abort)
X`009    GoTo 101
X`009End if
Xc  Notify requester that link is open
X`009If ( .not. started ) then
Xc         Get network name
X`009    Network = Get_Network('J')
Xc         finish connection message
X`009    Call Finger_Out_Routine('.'//
X`0091`009Network(:Btrim(Network))//']'//CR//LF)
X`009    started = .true.
X`009Endif
Xc  Output the line    `032
X`009Call Finger_Out_Routine(LF//Line2(:Len2)//CR)
Xc  Check for end of command
X`009If ( Index(Str$UpCase(Line2(:Len2)),
X`0091`009'COMMAND COMPLETE').ne.0)`032
X`0092`009GoTo 100
Xc back for next line    `032
X        Goto 10
X    `032
Xc Here when done
X100`009Continue
X`009If ( .not. started ) then
X`009    Call Finger_Out_Routine(': link failed]'//CR//LF)
X`009    Call Finger_Out_Routine(LF//'%FINGER-E-TMO, timeout for node '//
X`0092`009`009Next_Node//CR)
X`009    jnet_Finger = %Loc(Fing_Abort)
X`009End if
X`009Call Finger_Out_Routine(LF)
Xc  some last minute clean up
X101`009Call Sys$CanTim(,)
X`009Call Jan_Remove_Hook
X`009Return
X
X1001`009Format(Z8)
X
X        End
X`012
Vc----------------------------------------------------------------------------
X--
X`009Integer Function jnet_Timer_Ast
X
X`009Logical`009TimedOut
X`009Common`009/jnet_Common/ TimedOut
X
X`009TimedOut = .True.
X`009jnet_Timer_Ast = 1
X`009Call Sys$Wake(,)
X
X`009Return
X
X`009End
X`012
Xc------------------------------------------------------------------------
X`009Integer Function Local_Finger(Command,Finger_Out_Routine,Access)
X
X`009Character VersionMsg*51
X`009Common`009/Version_Common/ VersionMsg
X
X`009External`009Finger_Out_Routine
X`009Integer`009`009Access
X
X`009Character`009Command*(*)
X`009Character`009Name*31,`009Get_PersonalName*31
X`009Character`009Make_Pretty*31
X`009Character`009ComName*12, Get_Username*12, TComName*12
X`009Character`009CR /13/, LF /10/, NUL/0/, Flush/255/
X`009Integer`009`009SS$_Status, Sys$Waitfr, Btrim
X`009Integer*2`009NewMes
X`009Integer`009`009LastLogin(2)
X`009Integer`009`009TestOutput,`009FlagProcess
X`009Logical`009`009ValidID,`009Validata_ID,`009TestName
X`009Logical`009`009Get_ID,`009`009Check_Name,`009Check_Process
X`009Logical`009`009LoggedIn,`009HeaderWritten
X`009External lbr$output_help, lib$get_input, lib$put_output
X`009Integer`009`009Lbr$Ini_Control,Lbr$Open,`009Lbr$Get_Help
X`009Integer`009`009LbrIndex,`009LbrFunc,`009Lbr$C_Read/1/
X`009External`009Fing_Complete,`009Fing_Abort
X`009External`009Do_Help
X`009Character`009CCC*8
X`009Integer`009`009Privilege(2) /0,0/
X`009Logical`009`009Wild_Parse
X`009Integer`009`009NonWild
XC ! site-specific: Set minimum non-wildcard characters if wildcards
XC are present in the username
X`009Parameter`009Minimum_NonWild = 3
X
XC  Include all GETJPI and flag definitions
X`009Include`009`009'GETJPIDEF.FOR'
X`009Include`009`009'FingerFlg.For'
X`009Include`009`009'Fingerdef.Inc'
X
X`009structure /itmlist/
X`009 union
X`009  map
X`009   integer*2 bufferlen
X`009   integer*2 itemcode
X`009   integer*4 bufferaddr
X`009   integer*4 lengthaddr
X`009  end map
X`009  map
X`009   integer*4 endlist
X`009  end map
X`009 end union
X`009end structure
X
X`009character*12 username_uai
X`009include '($uaidef)'
X
X`009record /itmlist/ uai_list(2)
X
X`009uai_list(1).bufferlen = 12
X`009uai_list(1).itemcode = uai$_username
X`009uai_list(1).bufferaddr = %loc(username_uai)
X`009uai_list(2).endlist = uai$c_listend
X
Xc  Set default return status
X`009Local_Finger = %Loc(Fing_Complete)
Xc  initialize a few things
X`009l_Com = Len(Command)
X
XC  Parse command
X`009Call Parse_Command(Command(:l_Com),ComName,
X`0091`009`009TestName,TestOutput,Finger_Out_Routine,
X`0092`009`009Access)
X
Xc  Print version if required
X`009If ( (TestOutput.and.FlagVersion) .ne. 0 ) Then
X`009    Call Finger_Out_Routine(LF//VersionMsg//CR)
X`009EndIf
X
Xc Check for wildcards in username
X`009If ( TestName .and. Wild_Parse( ComName, NonWild) ) Then
X`009    If ( NonWild .lt. Minimum_NonWild ) Then
X`009`009Call Finger_Out_Routine(LF//'%FINGER-E-WILD, too few'//
X`0091`009' non-wild characters in username '//CR//LF//
X`0092`009' \'//ComName(:Btrim(ComName))//'\'//CR)
X`009`009Local_Finger = %Loc(Fing_Abort)
X`009`009Return
X`009    EndIf
X`009EndIf
X
Xc Output HELP if required
X`009If ( (TestOutput.and.FlagHelp) .ne. 0 ) Then
X`009    Call Header_Brief(Finger_Out_Routine)
X
X`009    If ((Access .eq. 2) .or. (Access .eq. 3)) then
X`009        LbrFunc = Lbr$C_Read
X`009        ii = Lbr$Ini_Control(LbrIndex,LbrFunc)
X`009        If ( .not. ii ) then
X`009`009    Call Lib$Signal(%Val(ii_stat1))
X`009`009    Local_Finger = %Loc(Fing_Abort)
X`009`009    Return
X`009        End if
Xc ! Site-specific: You may change the help library name below (also see
Xc one other location below).
X`009        ii = Lbr$Open(LbrIndex,'SYS$HELP:HELPLIB.HLB')`009
X`009        If ( .not. ii ) then
X`009`009    Call Lib$Signal(%Val(ii_stat2))
X`009`009    Call Lbr$Close(LbrIndex)
X`009`009    Local_Finger = %Loc(Fing_Abort)
X`009`009    Return
X`009        End if
X`009        ii = Lbr$Get_Help(LbrIndex,,Do_Help,
X`0091`009    Finger_Out_Routine,'FINGER...')`032
X`009        If ( .not. ii ) then
X`009`009    Call Lib$Signal(%Val(ii_stat3))
X`009`009    Call Lbr$Close(LbrIndex)
X`009`009    Local_Finger = %Loc(Fing_Abort)
X`009`009    Return
X`009        End if
X`009        Call Finger_Out_Routine(LF)
X`009        Call Lbr$Close(LbrIndex)
X`009    Else
X`009    If (Access .eq. 1) then
X`009`009ii = Lbr$output_help( lib$put_output,,'FINGER',
Xc ! Site-specific: You may change the help library name below (also see
Xc one other location above).
X`0091`009'SYS$HELP:HELPLIB',, lib$get_input)
X`009    Else
X`009`009Call Finger_Out_Routine(LF//'%FINGER-W-UKNMODE, unknown access'
X`0091`009//' mode.'//CR)
X`009    Endif
X`009Endif
X
X`009If (.not.ii) call exit(ii)
X`009    Return
X`009EndIf
X
X`009LoggedIn = .False.
X
XC  Set up item list
X`009I = 1`009`009`009`009`009! 1st item - process name
X`009II = 1
X`009ITEM_LIST2(II+IC) =`009JPI$_PRCNAM
X`009ITEM_LIST2(II+BL) =`009L_PRCNAM
X`009ITEM_LIST(I+BA)  =`009%LOC(PRCNAM)
X`009ITEM_LIST(I+RL)  =`009%LOC(RL_PRCNAM)
X`009I = I + 3`009`009`009`009! 2nd item - status flags
X`009II = II + 6
X`009ITEM_LIST2(II+IC) =`009JPI$_STS
X`009ITEM_LIST2(II+BL) =`009L_STS
X`009ITEM_LIST(I+BA)  =`009%LOC(STS)
X`009ITEM_LIST(I+RL)  =`009%LOC(RL_STS)
-+-+-+-+-+ End of part 6 +-+-+-+-+-