+-+-+-+ Beginning of part 9 +-+-+-+
X`009    Call Sys$Setprv(%Val(1),Privilege,,)
Xc  get job controller information
X`009    queue_name = get_queue(pid)
Xc  Turn off SYSPRV privilege
X`009    Call Sys$Setprv(,Privilege,,)
X`009    If (queue_name .eq. ' ') Then
X`009`009Location = 'Q.<Unknown>'
X`009    Else
X`009`009Location = 'Q.'//queue_name
X`009    EndIf
X`009    TTType = ' '
X`009End If
Xc  Column headings
X`009If ( .not. HeaderWritten ) Then
X`009    Call Finger_Out_Routine(LF)
X`009    If ( (Testoutput.and.FlagPID) .ne. 0 )
X`0091`009Call Finger_Out_Routine('PID      ')
X`009    If ( (Testoutput.and.FlagProcessname) .ne. 0 )
X`0091`009Call Finger_Out_Routine('Process         ')
X`009    If ( (Testoutput.and.FlagUsername) .ne. 0 )
X`0091`009Call Finger_Out_Routine('Username     ')
X`009    If ( (Testoutput.and.FlagPersonalName) .ne. 0 )
X`0091`009Call Finger_Out_Routine('Personal name        ')
X`009    If ( (Testoutput.and.FlagImagename) .ne. 0 )
X`0091`009Call Finger_Out_Routine('Program   ')
X`009    If ( (Testoutput.and.FlagTerminal) .ne. 0 )
Xc`0091`009Call Finger_Out_Routine('Term ')`009! short terminal name
X`0091`009Call Finger_Out_Routine('Term     ')`009! long terminal name
X`009    If ( (Testoutput.and.FlagLoginTime) .ne. 0 )
X`0091`009Call Finger_Out_Routine('Login ')
X`009    If ( (Testoutput.and.FlagCPUTime) .ne. 0 )
X`0091`009Call Finger_Out_Routine('  CPU  ')
X`009    If ( (Testoutput.and.FlagIdleTime) .ne. 0 )
X`0091`009Call Finger_Out_Routine(' Idle ')
X`009    If ( (Testoutput.and.FlagState) .ne. 0)
X`0091`009Call Finger_Out_Routine('State ')
X`009    If ( (Testoutput.and.FlagSize) .ne. 0)
X`0091`009Call Finger_Out_Routine(' Size ')
X`009    If ( (Testoutput.and.FlagLocation) .ne. 0 )
X`0091`009Call Finger_Out_Routine('Location         ')
X`009    If ( (Testoutput.and.FlagTTType) .ne. 0 )
X`0091`009Call Finger_Out_Routine('TT Type')
X`009    Call Finger_Out_Routine(CR)
X`009    HeaderWritten = .true.
X`009EndIf
X
Xc  Write out line of user information
X
X`009Call Finger_Out_Routine(LF)
X`009If ( (Testoutput.and.FlagPID) .ne. 0 )
X`0091`009Call Finger_Out_Routine(PID_String//' ')
X`009If ( (Testoutput.and.FlagProcessname) .ne. 0 )
X`0091`009Call Finger_Out_Routine(Prcnam//' ')
X`009If ( (Testoutput.and.FlagUsername) .ne. 0 )
X`0091`009Call Finger_Out_Routine(Username//' ')
X`009If ( (Testoutput.and.FlagPersonalName) .ne. 0 )
X`0091`009Call Finger_Out_Routine(Name(1:20)//' ')
X`009If ( (Testoutput.and.FlagImagename) .ne. 0 )
Xc ** Site-Specific - length of image field (also do the header above...)
X`0091`009Call Finger_Out_Routine(Image(1:9)//' ')
X`009If ( (Testoutput.and.FlagTerminal) .ne. 0 )
Xc`0091`009Call Finger_Out_Routine(TermOrType(1:4)//' ')`009! short
X`0091`009Call Finger_Out_Routine(TermOrType(1:8)//' ')`009! long
X`009If ( (Testoutput.and.FlagLoginTime) .ne. 0 )
X`0091`009Call Finger_Out_Routine(Login_Time//' ')
X`009If ( (Testoutput.and.FlagCPUTime) .ne. 0 )
X`0091`009Call Finger_Out_Routine(CPU_Time//' ')
X`009If ( (Testoutput.and.FlagIdleTime) .ne. 0 )
X`0091`009Call Finger_Out_Routine(Idle_Time//' ')
X`009If ( (Testoutput.and.FlagState) .ne. 0)
X`0091`009Call Finger_Out_Routine(States(State)//' ')
X`009If ( (Testoutput.and.FlagSize) .ne. 0)
X`0091`009Call Finger_Out_Routine(Size//' ')
X`009If ( (Testoutput.and.FlagLocation) .ne. 0 )
X`0091`009Call Finger_Out_Routine(Location(1:16)//' ')
X`009If ( (Testoutput.and.FlagTTType) .ne. 0 )
X`0091`009Call Finger_Out_Routine(TTType(1:8))
X`009Call Finger_Out_Routine(CR)
X
X`009Return
X
X1000`009Format(A)
X1001`009Format(Z8)
X1002`009Format(I3,':',I2)
X10021`009Format(I6)
X1003`009Format(I5)
X
X`009End
X`012
Xc--------------------------------------------------------------------
X`009Subroutine Personal_Info(UserName, LoggedIn,`032
X`0091`009TestOutput, Finger_Out_Routine, Access)
X
Xc   Routine to type a user's Mail info and PLAN file, given his name.
Xc   Adapted from routine "Type_Plan" written at CMU PSYA::
Xc  ! Site-specific note:  If you want different names for plan files,
Xc  change or add to the following list
X
X`009Include`009 'Fingerdef.inc'
X`009Include`009 'Finger_Context'
X`009Include`009 'FingerFlg'
X`009Include  '($FORIOSDEF)'
X
Xc ** Site-Specific
Xc uncomment for BYPASS switch logic
X`009COMMON /BCZCOM/ FLAG_BYPASS
X`009LOGICAL FLAG_BYPASS
Xc end of bypass logic
X
X`009Parameter PlanFileName1 = 'FINGER.PLN'
X`009Parameter PlanFileName2 = 'PLAN.'       ! compatible with EUNICE
Xc`009Parameter PlanFileName3 = 'anything'    ! your choice
X`009External`009Finger_Out_Routine
X`009Integer`009`009Access
X`009Integer`009`009ii, FindCount, FindContext
X`009Character`009FindTemplate*64, FindResult*64
X`009Integer`009`009RMS$_Normal/65537/
X
X`009Integer
X`0091`009       OutboundLinkUnit,
X`0092`009       UafUnit,
X`0093`009       ScratchUnit
X`009Common  /IO_Units/
X`0091`009       OutboundLinkUnit,
X`0092`009       UafUnit,
X`0093`009       ScratchUnit
X
X`009Byte`009`009UAF_Record(1:UAF$K_Length)
X`009Byte`009`009UAF_L_DefDev
X`009Equivalence`009(UAF_L_DefDev,UAF_Record(Uaf$K_DefDev))
X`009Character`009UAF_DefDev*(UAF$S_DefDev)
X`009Equivalence`009(UAF_DefDev,UAF_Record(Uaf$T_DefDev))
X`009Byte`009`009UAF_L_DefDir
X`009Equivalence`009(UAF_L_DefDir,UAF_Record(Uaf$K_DefDir))
X`009Character`009UAF_DefDir*(UAF$S_DefDir)
X`009Equivalence`009(UAF_DefDir,UAF_Record(Uaf$T_DefDir))
X`009Integer`009`009UAF_Flags
X`009Equivalence`009(UAF_Flags, UAF_Record(UAF$L_Flags))
X`009Integer`009`009LastLogin(2), UAF_LastLogin(2)
X`009Equivalence`009(UAF_LastLogin,UAF_Record(UAF$Q_LastLogin_I))
X`009Integer*2 `009NewMes
Xc add longword UIC value also
X`009Integer*4`009UICval
X`009Equivalence`009(UICval,UAF_Record(UAF$K_UIC))
X
X        Structure /VMSMAIL_Structure/
X`009union
X`009 map
X`009  byte`009`009rec(2048)
X`009 end map
X`009 map
X          Character`009crec*2048
X`009 end map
X`009end union
X        End Structure
X
X        Record /VMSMAIL_Structure/ VMSMail_Record
X
X`009Structure /MAIL_Structure/
X`009 union
X`009  map
X`009   character`009rec*3047
X`009  end map
X`009  map
X`009   integer*2`009date(4)
X`009   character`009%fill*1
X`009   character`009folder*39
X`009   union
X`009    map
X`009     character`009rest*3000
X`009    end map
X`009    map
X`009     integer*2`009irest(1500)
X`009    end map
X`009   end union
X`009  end map
X`009 end union
X`009End Structure
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`009include`009`009'($jpidef)'
X`009integer`009`009sys$getjpiw
X`009character`009you*12
X
X`009Character`009SortType*20, WhoAmI*32
X`009Integer`009`009SortField, l_WhoAmI
X`009Common`009`009/Sorter/ SortType, SortField, WhoAmI, l_WhoAmI
X
X`009Integer`009`009FoundSender, Erase
X`009Character*12`009F_User
X`009Character*32`009F_Node
X`009Character*32`009F_ByAt
X`009Character*32`009F_ByColon
X`009Character*80`009UpFrom
X`009Character`009Str$UpCase*256
X
X`009Character*64`009Directory
X`009Character*128`009Mail_Directory
X
X`009Logical  Captive
X`009Logical`009 LoggedIn
X`009Integer`009 Status
X`009Integer`009 SS$_Status
X    `032
X`009Character       Temp*32, Sender*40
X`009Character*50    MailFile, PlanFile
X`009Character*12    UserName
X`009Character*9     Day_oftheWeek, LastLogin_Day, Mail_Day
X`009Character*70    LastLogin_Time, Make_Pretty
X`009Character*17`009Mail_Time
X`009Character*132   Line
X`009Character*1     LF/10/, CR/13/, NUL/0/
X`009Integer`009 Btrim, Sender_len
X`009Integer`009 TestOutput
X`009Integer*4       UserUIC,FlgUIC
X`009Common/UseUIC/UserUIC,FlgUIC
X`009External`009Priv_UserOpen
X
X
X`009logical`009`009foundmail
X`009character`009subject*80,csize*2,tousername*12,from*80
X`009integer`009`009size*2, ptr
X
X`009equivalence`009(size,csize)
X
X`009record /itmlist/ jpi_itmlist(2)
X`009Record /MAIL_Structure/ mailrec
X
X`009character`009maildir*256,cfn*2,cfnlen*2,`032
X`0091`009`009cnewmes*2,fwdinfo*256
X`009integer`009`009fn*2, fnlen*2
X`009logical`009`009got_newmes, got_dir, got_subj, got_fwd
X`009equivalence`009(cfn,fn)
X`009equivalence`009(cfnlen,fnlen)
X`009equivalence`009(cnewmes,newmes)
X
Xc First get stuff from UAF
Xc  open the UAF
X`009FlgUIC=0
Xc FlgUIC=0 to tell priv_useropen not to bother with UIC
X`009Open(Unit=UafUnit,
X`0091`009File = 'SYSUAF',
X`0092`009Default File = 'SYS$SYSTEM:.DAT',
X`0092`009Err=999,
X`0093`009User Open = Priv_UserOpen,
X`0094`009Status = 'Old',
X`0095`009Organization = 'Indexed',
X`0096`009Access = 'Keyed',
X`0097`009Form = 'Formatted',
X`0098`009Readonly,`032
X`0099`009Shared)
Xc  read it
X`009Read(UafUnit,1000,KeyEq=UserName,Err=999) UAF_Record
Xc close it
X`009Call Priv_Close(UafUnit)
Xc   Concatenate the DEFDEV and DEFDIR into one string Directory.
X`009Directory = UAF_DefDev(:UAF_L_DefDev) //
X`0091`009`009UAF_DefDir(:UAF_L_DefDir)
Xc  set up the last login stuff
X`009LastLogin(1) = UAF_LastLogin(1)
X`009LastLogin(2) = UAF_LastLogin(2)
X
X`009Captive = BTEST(UAF_Flags, UAF$V_Captive)
X
Xc Save owner UIC
X`009UserUIC = UICval
X
X`009Call Finger_Out_Routine(LF//CR)
XC Login device/directory information
X`009If ( (TestOutput .and. FlagArea) .ne. 0 ) Then
X`009    If (Captive) Then
X`009`009Call Finger_Out_Routine(LF//' Captive user account.')
X`009    Else
X`009`009Call Finger_Out_Routine(LF//' Default directory: '//
X`0091`009`009Directory(:Btrim(Directory)))
X`009    EndIf
X`009    Call Finger_Out_Routine(CR)
X`009EndIf
X    `032
XC  Last Login info
X`009If ( .not. (LastLogin(1).eq.0 .and. LastLogin(2).eq.0) ) then
X`009  LastLogin_Day = Day_oftheWeek(LastLogin)
X`009  Call Sys$AscTim(,LastLogin_Time,LastLogin,)
X`009  LastLogin_Time = Make_Pretty(LastLogin_Time)
X`009  If ( LoggedIn ) then
X`009    Call Finger_Out_Routine(LF//' Logged in since: ')
X`009  Else
X`009    Call Finger_Out_Routine(LF//' Last logged in: ')
X`009  End if
X`009  Call Finger_Out_Routine(
X`0091      LastLogin_Day(:Btrim(LastLogin_Day))//', '//
X`0092      LastLogin_Time(:17)//CR)
X`009End if
X
XC  Mail information
Xc  !** Site-specific - If you don't want to display any mail information,
Xc  edit the .CLD file and add the keyword ', Default' to the DISMAILREP
Xc  qualifier. However, DISSUBJREP should be adequate for most cases - see
Xc  later items in this source file (search for DISSUBJREP).
X
X`009If ( (TestOutput.and.FlagMail) .ne. 0 ) then
X
Xc    Now get VMSMAIL stuff (system-wide data)
X`009  Open ( Unit=ScratchUnit,
X`0091`009File='VMSMAIL_PROFILE' ,
X`0091`009Default File = 'SYS$SYSTEM:.DATA',
X`0091`009Err = 99,
X`0091`009UserOpen = Priv_UserOpen,
X`0092`009Status='Old' ,
X`0093`009Organization='Indexed' ,
X`0094`009Access='Keyed' ,
X`0095`009Form='Unformatted' ,
X`0097`009Readonly ,
X`0098`009Shared ,
X`0091`009RecordType='Variable' )
Xc
X`009  newmes=0
X`009  got_newmes=.false.
X`009  got_dir=.false.
X`009  got_fwd=.false.
X`009  maildir=' '
X`009  fwdinfo=' '
X`009  ptr=32
X`009  fn=1`009!non-zero
X
Xc  Clear the mail record
X`009  Do Erase = 1, 2048
X`009    vmsmail_record.crec(Erase:Erase) = NUL
X`009  EndDo
X
X`009  Read(`009Unit=ScratchUnit,`032
X`0091`009KeyEQ=UserName,`032
Xc`0092`009Err=99,
X`0093`009KeyID=0,`032
X`0094`009IOStat=Status) VMSMAIL_Record
X
X`009  if (status.eq.FOR$IOS_ATTACCNON) goto 99
X`009  Call Priv_CLOSE (ScratchUnit)
Xc
Xc [rph] see VMSPROFILE_DATA.format for the struture of these records
Xc
X`009  do while ((.not.(got_newmes.and.got_dir.and.got_fwd))
X`0091   .and.(fn.ne.0))
X`009    cfn=vmsmail_record.crec(ptr:ptr+1)
X`009    cfnlen=vmsmail_record.crec(ptr+2:ptr+3)
X`009    if (fn.eq.1) then
X`009      cnewmes=vmsmail_record.crec(ptr+4:ptr+5)
X`009      got_newmes=.true.
X`009    else if (fn.eq.3) then
X`009      maildir=vmsmail_record.crec(ptr+4:ptr+4+fnlen-1)
X`009      got_dir=.true.
X`009    else if (fn.eq.4) then
X`009      fwdinfo=vmsmail_record.crec(ptr+4:ptr+4+fnlen-1)
X`009      got_fwd=.true.
X`009    end if
X`009    ptr=ptr+4+fnlen
X`009  end do`032
X
X`009  If ((got_fwd .eq. .true.) .and.`032
X`0091    (index(Str$UpCase(fwdinfo(:btrim(fwdinfo))),'DELIVER%')`032
X`0092    .eq. 0)) Then
X`009  If (index(Str$UpCase(fwdinfo(:btrim(fwdinfo))),'IN%"`126') .eq. 0) Then
X`009     Call Finger_Out_Routine(LF//' Mail is forwarded to: '//
X`0091`009fwdinfo(:BTrim(fwdinfo))//CR)
X`009     Go To 99
X`009  EndIf
X`009  Endif
X
Xc****`009  If (NewMes .gt. 0) then
X`009    If (maildir(1:1) .eq. '[') Then
X`009      i_brak = Index(maildir,'[')
X              Mail_Directory = Directory(:(BTrim(Directory)-1))//
X`0091`009`009       maildir(i_brak+1:BTrim(maildir))
X`009    Else`032
X`009      Mail_Directory = Directory
X`009    EndIf
X
Xc  ! Site-specific note:
Xc  If you do not wish the mail "From: so-and-so" information printed
Xc  edit the .CLD file and set the DISSUBJREP qualifier 'Default'
Xc`009This section contributed by Todd Aven of U. of Mariland
Xc`009Hacked up by yours truly. Rg
Xc`009Now includes Subject [rph] and pretty much a re-hack job
Xc for v5 [rph] another complete re-hack, the mail file format is similar
Xc       to vmsmail_profile.data (q.v.)
Xc
X
X`009    MailFile = Mail_Directory(:Btrim(Mail_Directory))//
X`0091`009'MAIL.MAI'
X
X`009    Open ( Unit=ScratchUnit,
X`0091`009File=MailFile ,
X`0092`009Status='Old' ,
X`0093`009User Open = Priv_UserOpen,
X`0094`009Form='Formatted' ,
X`0095`009Readonly ,
X`0096`009Shared ,
X`0097`009Err=100,
X`0098`009Record Type='Variable',
X`0099`009Organization='Indexed',
X`0091`009Access='Keyed')
X    `032
X`009    mailrec.rec = ' '
X
X`009    jpi_itmlist(1).bufferlen=12
X`009    jpi_itmlist(1).itemcode=jpi$_username
X`009    jpi_itmlist(1).bufferaddr=%loc(you)
X`009    jpi_itmlist(2).endlist=jpi$c_listend
X`009    call sys$getjpiw(,,,jpi_itmlist,,,)
X
X`009    Read(Unit=ScratchUnit,fmt='(a)',IoStat=Status,Err=20,
X`0091`009KeyID=1,Key='F_PRIVACY') mailrec.rec
X`009    If (Status .ne. 0) GoTo 20
X
X`009    Call Finger_Out_Routine(LF//' Mail: Permission refused by '//
X`0091       'owner.'//CR)
X`009    GoTo 101
X
X 20`009    Temp = ' '
X`009    Call Finger_Out_Routine(LF//' Mail: ')
X`009    If ( NewMes .eq. 0 ) then
X`009      Call Finger_Out_Routine('(no new mail)'//CR)
X`009      GoTo 101
X`009    ElseIf ( NewMes .eq. 1 ) then
X`009      Call Finger_Out_Routine('1 new message.'//CR)
X`009    ElseIf ( NewMes .gt. 1 .and. NewMes .lt. 10 ) then
X`009      Write(Temp,1001)NewMes,' new messages.'//CR
X`009      Call Finger_Out_Routine(Temp(:16))
X`009    ElseIf ( NewMes .ge. 10 ) then
X`009      Write(Temp,1002)NewMes,' new messages.'//CR
X`009      Call Finger_Out_Routine(Temp(:18))
X`009    EndIf
X
X`009    If ((TestOutput .and. FlagDisSubj) .ne. 0) Goto 99
X
X`009    Read(Unit=ScratchUnit,fmt='(a)',IoStat=Status,Err=99,
X`0091`009KeyID=1,Key='NEWMAIL') mailrec.rec
X
X`009    foundMail=.false.
X`009    Do While (status.eq.0)
X`009      If (len(mailrec.folder).GT.1) then
X`009        Mail_Time = ' '
X`009        Mail_day = Day_oftheWeek (mailrec.date)
X`009        call sys$asctim(,mail_time,mailrec.date)
X`009        mail_Time = Make_Pretty(Mail_Time)
X`009        ptr = 91
X`009        csize=mailrec.rec(ptr:ptr+1)
X`009        ptr=ptr+2
X`009        from=mailrec.rec(ptr:ptr+size-1)
X`009        ptr=ptr+size
X
Xc  Here we check for mail from the fingerer. The simplest case is mail on
Xc  the same node. Next is mail from DECnet nodes, stored as node::user.
Xc  Then we also have to check for the Bitnet/jnet case, which is difficult
-+-+-+-+-+ End of part 9 +-+-+-+-+-