+-+-+-+ Beginning of part 8 +-+-+-+
X`009Integer`009`009SS$_Status
X`009External`009SS$_NoTran
X`009Integer`009`009Sys$AscTim, Sys$GetTim, Sys$TrnLnm, Sys$GetSYIW
X`009Integer`009`009Btrim
X`009Integer`009`009TRN_ItemList(4)
X`009Integer*2`009TRN_ItemList2(8)
X`009Equivalence`009(TRN_ItemList,TRN_ItemList2)
X`009Integer`009`009TRN$_String /Z00000002/
X`009Character*32`009CPU_Type
X`009Integer`009`009l_CPU, l_Vrsn
X`009Character`009System_Version*8
X`009Character`009Node*32
X`009Character`009AscTime*23, AscSince*23, Make_Pretty*23
X`009Character`009AscDelsince*23 ! gce retrofit
X`009Character`009Day_OfTheWeek*9, Today*9, Upday*9
X`009Character`009MsgLine*132
X`009Real`009`009Load1,`009load5,`009load15
X
X`009External`009Sys$gw_IJobCnt
X`009External`009Sys$gw_BJobCnt
X`009External`009Exe$gl_AbsTim
X`009External`009Priv_UserOpen
X`009Integer*2`009Get_w_Val
X`009Integer`009`009Get_l_Val
X`009Integer`009`009Ijobs, Bjobs`032
X`009Integer`009`009UpTime(2), SysTime(2), UpSince(2), UpDelta(2)
X
X`009Character`009NUL/0/, LF/10/, CR /13/, SP /' '/
X`009Character`009Temp*23
X`009Logical`009`009LoadAvailable`009/.false./
X`009Logical`009`009WroteSomething`009/.false./
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`009record /itmlist/ syi_list(3)
X
XC  Get node name, system stuff, time, load averages etc., print header
X
Xc  Set up item list for GetSYI and call it. It returns a four character
Xc  cpu type, e.g., 2000, V780, 8300, 8530, 8700, 8800...
X
X`009syi_list(1).bufferlen = 4
X`009syi_list(1).itemcode = syi$_hw_name
X`009syi_list(1).bufferaddr = %loc(CPU_Type)
X`009syi_list(1).bufferlen = len(CPU_Type)
X`009syi_list(1).lengthaddr = %loc(L_cpu)
X`009syi_list(2).bufferlen = 8
X`009syi_list(2).itemcode = syi$_Version
X`009syi_list(2).bufferaddr = %loc(System_Version)
X`009syi_list(2).lengthaddr = %loc(l_vrsn)
X`009syi_list(3).endlist = syi$c_listend
X
X`009Call Sys$GetSYIW(,,,SYI_list,,,)
X
Xc Rip off the V if it has one (V7xx)
X
XC`009If (CPU_Type(1:1).eq.'V') CPU_Type(1:1) = ' '
X
Xc Fix up the CPU type, replace "MicroVAX " by "uVAX-", "VAXstation " by
Xc "VS-" and "VAXserver" by "Vs-"
X`009If (CPU_Type(1:9) .eq. 'MicroVAX ') Then
X`009    CPU_Type = 'VAX-' // CPU_Type(10:L_cpu)
X`009ElseIf (CPU_Type(1:11) .eq. 'VAXstation ') Then
X`009    CPU_Type = 'VS-' // CPU_Type(12:L_cpu)
X`009ElseIf (CPU_Type(1:10) .eq. 'VAXserver ') Then
X`009    CPU_Type = 'Vs-' // CPU_Type(11:L_cpu)
X`009Endif
X`009Call Str$Trim( CPU_Type, CPU_Type, L_cpu)
X`009If ( CPU_Type(L_cpu-5:L_cpu) .eq. 'Series') Then
X`009    L_cpu = L_cpu - 6
Xc`009    If (CPU_Type(L_cpu-1:L_cpu) .eq. '00')
Xc`0091`009CPU_Type(L_cpu-1:L_cpu) - 'xx'
X`009EndIf
X`009Call Str$Trim( CPU_Type, CPU_Type(1:L_cpu), L_cpu)
X
X`009TRN_ItemList2(1) = 8
X`009TRN_ItemList2(2) = TRN$_String
X`009TRN_ItemList(2) = %Loc(DECnet_Node)
X`009TRN_ItemList(3) = %Loc(L_node)
X`009TRN_ItemList2(7) = 0
X`009TRN_ItemList2(8) = 0
X
X`009SS$_Status = Sys$TrnLnm(,'LNM$SYSTEM_TABLE',
X`0091`009'SYS$NODE', 1, TRN_ItemList)
X
X`009If (( Net$C_Local_Host_Name(1:1) .eq. ' ' ) .OR.
X`0091   ( Net$C_Local_Host_Name(1:1) .eq. NUL)) Then
X`009    If ( SS$_Status .eq. %LOC(SS$_Notran) ) Then
X`009`009Node = 'Finger'
X`009    Else
X`009`009Node = DECnet_Node(:l_Node-2)
X`009    EndIf
X`009Else
X`009    Node = Net$C_Local_Host_Name`009`009! use set value
X`009End if
X`009l_Node = Btrim(Node)
X`009Call Sys$AscTim(,AscTime,,)`009`009`009`009! Time now
X`009AscTime = Make_Pretty(AscTime)
X`009Today = Day_OfTheWeek(%Val(0))
X`009UpTime(1) = 0
X`009UpTime(2) = 0
X`009UpTime(1) = Get_l_Val(Exe$gl_AbsTim)`009`009`009! up time (sec)
X`009UpDelta(1) = 0
X`009UpDelta(2) = 0
X`009Call Lib$EMul(10000000,UpTime,0,UpTime)`009`009`009! 64 bit format
X`009Call Sys$GetTim(SysTime)
X`009Call Lib$Subx(SysTime,UpTime,UpSince)
X`009Call Sys$AscTim(,AscSince,UpSince,)`009`009`009! Up since
X`009AscSince = Make_Pretty(AscSince)
Xc  get delta time to ASCII format ... then shift out spaces  ! gce retrofit
X`009Call Lib$Subx(Updelta,UpTime,Updelta) ! gceretro
X`009Call Sys$AscTim(,Ascdelsince,updelta,) !gce retro
X`009i_nospace = 1 ! gce retrofit
X`009do while (ascdelsince(i_nospace:i_nospace) .eq. ' ')  !gce retro
X`009`009i_nospace = i_nospace + 1  !gce retro
X`009end do
X`009Upday = Day_OfTheWeek(UpSince)
X`009Ijobs = Get_w_Val(Sys$gw_IJobCnt)`009`009`009! # users
X`009Bjobs = Get_w_Val(Sys$gw_BJobCnt)`009`009`009! # batch
X
Xc  ! Site-specific: This is the load average pseudo-device.  If not
Xc  available, omit this section.  Or leave it and it will still be OK.
X`009Open(Unit=ScratchUnit,
X`0091`009File=LoadDevice,
X`0092`009Type='NEW',
X`0093`009RecordSize=36,
X`0094`009Err=101)
X`009Read(ScratchUnit,2000,Err=101) Load1, Load5, Load15
X`009Close(Unit=ScratchUnit)
X`009LoadAvailable = .true.
X101`009Continue
X
XC  Print full header
XC`009`009Organization name if defined
X`009If ( Net$C_Organization .ne. ' ' )
X`0091`009Call Finger_Out_Routine(
X`0092`009LF//
X`0093`009Net$C_Organization(:BTrim(Net$C_Organization))//
X`0094`009CR)
XC`009`0091st full line
X`009Call Finger_Out_Routine(LF//
X`0091`009`009`009Node(:l_Node)//' '//
X`0092`009`009`009CPU_Type(:Btrim(CPU_Type))//', '//
X`0094`009`009`009'VMS '//
X`0095`009`009 `009System_Version(:Btrim(System_Version))//
X`0096`009`009`009', '//
X`0097`009`009`009Today(:Btrim(Today))//', '//
X`0098`009`009`009AscTime(:17)//', ')
X`009If ( Ijobs .eq. 1 ) then
X`009    Write(Temp,1001)`009Ijobs, ' User, '
X`009Else
X`009    Write(Temp,1001)`009Ijobs, ' Users, '
X`009End if
X`009Call Finger_Out_Routine(Temp(:10))
X`009Write(Temp,1001)`009Bjobs, ' Batch.'
X`009Call Finger_Out_Routine(Temp(:9))
X`009Call Finger_Out_Routine(CR)
Xc`009`0092nd line
X`009Call Finger_Out_Routine(LF//
X`0091`009`009`009'Uptime '//Ascdelsince(i_nospace:10)//
X`0092`009`009`009', since '//
X`0093`009`009`009Upday(:Btrim(Upday))//', '//
X`0094`009`009`009AscSince(:17))
X`009If ( LoadAvailable ) Then
X`009    Write(Temp,1002) `009', Load: '`009! Site-specific
X`0091`009`009`009,Load1 `009`009! Site-specific
X`0092    `009`009`009,Load5`009`009! Site-specific
X`0093    `009`009`009,Load15`009`009! Site-specific
Xc`009    Call Finger_Out_Routine(Temp(:13))
X`009    Call Finger_Out_Routine(Temp)
X`009EndIf
X`009Call Finger_Out_Routine(CR//LF)
X
XC  Print message if any
X`009If ( (TestOutput.and.FlagMessage) .ne. 0 ) then
X`009    Open`009(Unit=ScratchUnit,
X`0091`009File='FINGER$MESSAGE:',
Xc`0092`009UserOpen = Priv_UserOpen, ! Uncomment this to prevent
Xc`009`009`009`009`009! redirection of message lognamm
X`0092`009Type='OLD',
X`0093`009ReadOnly,
X`0094`009Shared,
X`0095`009Err=201)
X`009    DoWhile(.True.)`009`009! Loop through message file
X`009`009Read(ScratchUnit,3000,Err=201,End=200) l_Msg, MsgLine
X`009`009Call Finger_Out_Routine(LF//MsgLine(:l_Msg)//CR)
X`009`009WroteSomething = .True.
X`009    EndDo
X200`009    Call Priv_Close(ScratchUnit)
X201`009    Continue
XC`009    1 blank line if there was any message
X`009    If ( WroteSomething ) Call Finger_Out_Routine(LF//CR)
X`009EndIf
X
X`009Return
X
X1001`009Format(I2,A)
X1002`009Format(A,3F5.2)
X
X2000`009Format(3A4)
X
X3000`009Format(Q,A)`009
X
X`009End
X
X`012
Xc---------------------------------------------------------------------------
X`009Subroutine Header_Brief(Finger_Out_Routine)
X
X`009Include`009`009'Fingercom'
X`009Include`009`009'Finger_Context'
X
X`009External`009Finger_Out_Routine
X
X`009Integer`009`009TRN$_String /Z00000002/
X`009Integer`009`009TRN_ItemList(4)
X`009Integer*2`009TRN_ItemList2(8)
X`009Equivalence`009(TRN_ItemList,TRN_ItemList2)
X
X`009Integer`009`009SS$_Status
X`009External`009SS$_NoTran
X`009Integer`009`009Sys$AscTim, Sys$GetTim, Sys$TrnLnm
X`009Integer`009`009Btrim
X`009Character`009Node*9
X`009Character`009Day_OfTheWeek*9,`009Today*9
X`009Character`009AscTime*23, Make_Pretty*23
X
X`009Character`009NUL/0/, LF/10/, CR /13/, SP /' '/
X
XC  Get node name, system time
X`009TRN_ItemList2(1) = 8
X`009TRN_ItemList2(2) = TRN$_String
X`009TRN_ItemList(2) = %Loc(DECnet_Node)
X`009TRN_ItemList(3) = %Loc(L_node)
X`009TRN_ItemList2(7) = 0
X`009TRN_ItemList2(8) = 0
X
X`009SS$_Status = Sys$TrnLnm(,'LNM$SYSTEM_TABLE',
X`0091`009'SYS$NODE', 1, `009TRN_ItemList)
X
X`009If (( Net$C_Local_Host_Name(1:1) .eq. ' ' ) .OR.
X`0091   ( Net$C_Local_Host_Name(1:1) .eq. NUL)) Then
X`009    If ( SS$_Status .eq. %LOC( SS$_Notran) ) Then
X`009`009Node = 'Finger'
X`009    Else
X`009`009Node = DECnet_Node(:l_Node-2)
X`009    EndIf
X`009Else
X`009    Node = Net$C_Local_Host_Name`009`009! use set value
X`009End if
X`009l_Node = Btrim(Node)
X`009Call Sys$AscTim(,AscTime,,)`009`009`009! Time now
X`009AscTime = Make_Pretty(AscTime)
X`009Today = Day_OfTheWeek(%Val(0))
X
XC  Print brief header
X`009Call Finger_Out_Routine(LF//
X`0091`009`009`009Node(:l_node)//
X`0092`009`009`009' VAX/VMS, '//
X`0093`009`009`009Today(:Btrim(Today))//', '//
X`0094`009`009`009AscTime(:17)//
X`0095`009`009`009CR//LF)
X
X`009Return
X`009End
X`012
Xc---------------------------------------------------------------------------
X`009Logical`009Function Check_Name(Username,ComName)
X
Xc  Check if the Username of a process matches the name from the
Xc  input command.
X
X`009Logical`009`009Wild_Match
X`009Character`009Username*(*), ComName*(*)
X
X`009Check_Name = .false.
X
X`009If ( Username .eq. ComName ) Then
X`009    Check_Name = .true.
X`009    Return
X`009EndIf
X
Xc  Check for wild-card
X`009Check_Name = Wild_Match(ComName,Username)
X
X`009Return
X`009End
X
X`012
Vc----------------------------------------------------------------------------
X-
X`009Subroutine User_Info(PID,STS,Prcnam,Username,Terminal,
X`0091`009State, PgCnt, HeaderWritten,
X`0092`009TestOutput,FlagProcess,Finger_Out_Routine)
X
X`009External`009Finger_Out_Routine
X
X`009Integer`009`009
X`0091`009`009OutboundLinkUnit,`032
X`0092`009`009UafUnit,
X`0093`009`009ScratchUnit
X
X`009Common`009/IO_Units/`032
X`0091`009`009OutboundLinkUnit,
X`0092`009`009UafUnit,
X`0093`009`009ScratchUnit
X`009
X`009Include`009`009'GETJPIDEF'
X`009Include`009`009'FingerFlg'
X`009Include`009`009'Fingerdef.Inc'
X
X`009Integer`009`009TestOutput,`009FlagProcess
X`009Integer`009`009CPU_Min,`009CPU_Sec
X`009Character`009PID_String*8
X`009Character`009Location*25,`009Get_Location*25
X`009Character`009Make_Pretty*31,`009Filter_Control_Chars*15
X`009Character`009Name*31,`009Get_PersonalName*31
X`009Character`009Image*20,`009Get_Image*20
X`009Character`009Time_String*11,`009Login_Time*5
X`009Character`009CPU_Time*6,`009Idle_Time*5,`009Get_Idle*5
X`009Character`009TTType*25,`009TermOrType*8
X`009Character`009Quename*18
X`009Character`009CR /13/, LF /10/, NUL /0/
X`009Integer`009`009PgCnt
X`009Character*5`009States(15) /
X`0091`009'ColPg','MWait',' CEF ',' PFW ',' LEF ',' LEFO',' Hib ',
X`0091`009' HibO',' Susp','SuspO',' FPg ',' Com ',' ComO',' Cur ',
X`0091`009'     '/
X`009Integer`009`009LEF_State /5/, Blank_State /15/
X`009Integer`009`009State_COMO /13/, State_HIBO /8/
X`009Integer`009`009State_LEFO /6/, State_SUSPO /10/
X`009Character*5`009Size
X`009Logical`009`009HeaderWritten`032
X`009Integer`009`009Privilege(2) /0,0/
X`009character*31`009get_queue, queue_name
X
Xc  ! site-specific
Xc  Note - this routine is set up so you can select the information
Xc  you desire printed.  Set the defaults for your site in the FINGERCLI.CLD
Xc  file.  The user can override these with explicit qualifiers to the
Xc  FINGER command. If all fields are selected the line is 135 characters long
Vc  (3 more for long terminal line number).  You could vary the size of certai
Xn`032
Xc  fields (e.g. PERSONALNAME or LOCATION) if you wanted to customize things
Vc  further.  I use only 15 out of 25 characters of the location, and the TTTy
Xpe
Vc  may wrap.  The size of these could be varied.  I would never use certain`0
X32
Xc  combinations together, e.g. PROCESSNAME and USERNAME (they are practically
Vc  redundant) - but to each his own. (USERNAME is useful for MAIL and PHONE,`
X032
Xc  PROCESSNAME is unique.) `009`009- Rg
X
Xc  first some petty preprocessing
X`009If ( (Testoutput.and.FlagPID) .ne. 0 ) then
X`009    Write(PID_String,1001) PID
X`009    Do II = 1,8
X`009`009If ( PID_String(II:II) .eq. ' ') PID_String(II:II) = '0'
X`009    End do
X`009End if
X`009Call NULToSP(Terminal,8)
X`009If ( (Testoutput.and.FlagProcessname) .ne. 0 ) then
X`009    Call NULToSP(Prcnam,15)
X`009    Prcnam = Filter_Control_Chars(Prcnam)
X`009End if
X`009If ( Username(1:1) .eq. NUL ) Then
X`009    If ( Prcnam(1:4) .eq. 'NULL' ) Then
X`009`009Username = '<Null>'
X`009    Else If ( Prcnam(1:7) .eq. 'SWAPPER' ) Then
X`009`009Username = '<Swapper>'
X`009    Else
X`009`009Username = ' '
X`009    EndIf
X`009EndIf
X`009If ( (Testoutput.and.FlagPersonalName) .ne. 0 )
Xc ! site-specifc: choose one of the two following lines
X`0091   Name = Get_PersonalName(Username)
Xc`0091   Name = Make_Pretty(Get_PersonalName(Username))
Xc  only get P1 stuff for inswapped processes unless asked otherwise
X`009If ( (Testoutput.and.FlagSwapped) .ne. 0 ) then
X`009    Image = Make_Pretty(Get_Image(PID,LoginTim,CPUTim))
X`009Else
X           IF (`009State .ne. State_COMO .and.
X`0091`009State .ne. State_HIBO .and.
X`0092`009State .ne. State_LEFO .and.
X`0093`009State .ne. State_SUSPO) then
X`009`009Image = Make_Pretty(Get_Image(PID,LoginTim,CPUTim))
X`009    Else
X`009`009Image = '<swapped>'
X`009`009Logintim(1)= 0
X`009`009Logintim(2)= 0
X`009`009CPUTim=      0
X`009    End if
X`009End if
Xc  If in DCL and LEF state, don't print STATE. (keep picture cleaner)
X`009If (Image.eq.'$' .and. State.eq.LEF_State ) State = Blank_State
X`009Call Sys$Asctim(,Time_String,LoginTim,%Val(1))
X`009Login_Time = Time_String(1:5)
Xc  convert CPU time to min and sec
X`009CPU_Sec = CPUTim/100
X`009CPU_Min = CPU_Sec/60
X`009CPU_Sec = CPU_Sec - (60*CPU_Min)
X`009If ( CPU_Min .le. 999 ) then
X`009    Write(CPU_Time,1002) CPU_Min, CPU_Sec
X`009    If ( CPU_Time(5:5) .eq. ' ' ) CPU_Time(5:5) = '0'
X`009Else
Xc  if more than 999 min, omit seconds
X`009    Write(CPU_Time,10021) CPU_Min
X`009Endif
Xc  scratch Login and CPU time for outswapped processes
X`009If ( Image(1:1) .eq. '<' ) Login_Time = ' --- '
X`009If ( Image(1:1) .eq. '<' ) CPU_Time = '  --- '
X`009Write(Size,1003) PgCnt
X`009Location = Get_Location(Terminal,TTType,PID)
Xc  If not an interactive process, replace terminal by process type
X`009TermOrType = Terminal
X`009If ( (FlagProcess .and. FlagBatch) .ne. 0 ) Then
X`009    TermOrType = ' Bat '
X`009    TTType = ' '
X`009ElseIf ( (FlagProcess .and. FlagNetwork) .ne. 0 ) Then
X`009    TermOrType = ' Net '
X`009    TTType = ' '
X`009ElseIf ( (FlagProcess .and. FlagSubProcess) .ne. 0 ) Then
X`009    TermOrType = ' Sub '
X`009    TTType = ' '
X`009ElseIf ( (FlagProcess .and. FlagSystem) .ne. 0 ) Then
X`009    TermOrType = ' Sys '
X`009    TTType = ' '
X`009ElseIf ( TermOrType .eq. ' ' ) Then
X`009    TermOrType = ' Det '
X`009    TTType = ' '
X`009EndIf
Xc  Turn on CMKRNL privilege
X`009Privilege(1) = Prv$M_Cmkrnl
X`009Call Sys$Setprv(%Val(1),Privilege,,)
X`009If ( (Testoutput.and.FlagIdleTime) .ne. 0 )
X`0091`009Idle_Time = Get_Idle(Terminal)
Xc  Turn off CMKRNL privilege
X`009Call Sys$Setprv(,Privilege,,)
X`009If ( (FlagProcess.and.FlagSubprocess) .ne. 0 ) then
X`009    Location = '- Subprocess -'
X`009    TTType = ' '
X`009Else If ( (STS.and.Pcb$m_Batch) .ne. 0 ) Then
Xc  Turn on SYSPRV privilege
X`009    Privilege(1) = Prv$M_Sysprv
-+-+-+-+-+ End of part 8 +-+-+-+-+-