+-+-+-+ Beginning of part 11 +-+-+-+ X`009 Return X`009EndIf X X`009TRN_ItemList(2) = %Loc(username) X`009TRN_ItemList(3) = %Loc(L_name) X Xc Turn on SYSPRV privilege X`009Privilege(1) = Prv$M_Sysprv X`009Call Sys$Setprv(%Val(1),Privilege,,) X`009status = Sys$TrnLnm(,jobtable(1:l_jobtable), X`0091`009`009`009'SYS$REM_ID', 1, TRN_ItemList) Xc Turn off SYSPRV privilege X`009Call Sys$Setprv(,Privilege,,) X`009If (.Not. status) Then X`009 Call Lib$Signal( %Val(status)) X`009 Return X`009EndIf X X`009Get_DECnet_Remote = DECnet_node(1:L_node)// X`0091`009`009`009username(1:l_name) X`009Node = DECnet_node(1:L_node-2) X X`009return X X`009end X`012 Vc---------------------------------------------------------------------------- X- X`009Character*5 Function Get_Idle(Terminal) X X`009Include`009`009'Fingercom.for' X X`009Integer`009`009I_hr, I_min, Status, Offset X`009Character*(*)`009Terminal X`009Integer*4`009I_Idle, Term_PID X`009Integer*2`009RTT_Link X`009Integer*4`009Term_info X`009Integer`009`009Btrim X`009Character*16`009lterminal X X`009Common`009/Term_Info_Struct/ I_Idle, Term_PID, RTT_Link X X`009Get_Idle = ' ' X Xc Call TERM_INFO to get the idle time for terminals. Make sure that Xc I_Idle is zero first or it will use the previous value. TERM_INFO Xc wants the ':' in the terminal name, so make sure we have at least Xc one. X X`009I_Idle = 0 X`009lterminal = terminal(:btrim(terminal))//':' X`009Offset = Index(lTerminal, ':') X`009Status = TERM_INFO(lTerminal(:Offset), I_Idle) X`009If ( I_Idle .le. 0 ) Return X`009I_hr = I_Idle/3600 X`009I_Min = I_Idle/60 - 60*I_hr X`009Write (Get_Idle,1000,Err=300) I_hr, I_Min X`009If ( I_hr .eq. 0 ) then X`009 If ( I_Min .le. 0 ) then X`009 Get_Idle = ' .' X`009 else X`009 Get_Idle(1:3) = ' ' X`009 end if X`009Else X`009 If ( Get_Idle(4:4) .eq. ' ' ) Get_Idle(4:4) = '0' X`009End if X300`009Return X X1000`009Format(I2,':',I2) X X`009End X`012 Vc---------------------------------------------------------------------------- X- X`009Character*8`009Function Get_jnet_Node(Terminal) X Xc`009This routine finds the jnet node name using a /SYSTEM Xc`009Logical name of the form JNET_PTYxxxx 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`009Character`009Terminal*8 X X`009Get_jnet_Node = '?'`009! default X`009If ( Index(Terminal,'PT') .eq. 0 ) Return`009! Wrong terminal type X`009ii = Index(Terminal,':') - 1 X X`009TRN_ItemList2(1) = 8 X`009TRN_ItemList2(2) = TRN$_String X`009TRN_ItemList(2) = %Loc(Get_jnet_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'JNET_'//Terminal(:ii),, X`0093`009TRN_ItemList) X X`009Return X`009End`009 Xc--------------------------------------------------------------------------- X`009Character*20`009Function Get_Image(Input_PID,LOGINTIM,CPUTIM) X Xc This routine does an additional GETJPI to get the image name, the Login Vc time, and the CPU time. This is not done in the main loop in Local_Finger X`032 Xc because this Getjpi may take a long time for low priority or swapped out Vc processes and these processes are typically not listed by finger anyway. ` X032 X Vc ! Site-specific note: Only images from "public" directories are identified X`032 Xc by finger for reasons of privacy (basically so "Joe" won't complain that Vc "Harry" is running Adventure all day.) The several site-specific public`0 X32 Vc directories are set as parameters here and should be changed for your site X. Xc You could also, for example, just check the disk and decide all images on Xc a certain disk are public etc. Or just eliminate the check altogether`032 Xc and all images, public or private, will be identified. Xc`009`009`009`009`009- Rg Xc`009Parameter`009PublicDirectory1 = 'SYS$SYSROOT:[SYSEXE]'! obviously. Xc`009Parameter`009PublicDirectory2 = 'SYS$UTILITIES:'! These 2 for.. Xc`009Parameter`009PublicDirectory3 = 'SYS$SYSUTL:[VPW]'`009! my site -Rg Xc`009Parameter`009PublicDirectory4 = 'DUA0:'`009`009! an example Xc`009Parameter`009PublicDirectory5 = 'DRA1:[LOCAL]'`009! an example Xc Xc ! Site-specific: end of note X X`009Integer`009`009Input_PID X XC Include all GETJPI data and definitions X`009Include`009`009'GETJPIDEF.FOR' X`009integer`009`009sys$getjpiw X X`009Get_Image = '' X XC Set up item list for GETJPI X`009I = 1 X`009II = 1 X`009ITEM_LIST2(II+IC) =`009JPI$_IMAGNAME X`009ITEM_LIST2(II+BL) =`009L_IMAGNAME X`009ITEM_LIST(I+BA) =`009%LOC(IMAGNAME) X`009ITEM_LIST(I+RL) =`009%LOC(RL_IMAGNAME) X`009I = I + 3 X`009II = II + 6 X`009ITEM_LIST2(II+IC) =`009JPI$_LOGINTIM X`009ITEM_LIST2(II+BL) =`009L_LOGINTIM X`009ITEM_LIST(I+BA) =`009%LOC(LOGINTIM) X`009ITEM_LIST(I+RL) =`009%LOC(RL_LOGINTIM) X`009I = I + 3 X`009II = II + 6 X`009ITEM_LIST2(II+IC) =`009JPI$_CPUTIM X`009ITEM_LIST2(II+BL) =`009L_CPUTIM X`009ITEM_LIST(I+BA) =`009%LOC(CPUTIM) X`009ITEM_LIST(I+RL) =`009%LOC(RL_CPUTIM) X X`009ITEM_LIST(I+3) = 0`009`009! End of list X X Xc Do Getjpi X`009IStatus = Sys$Getjpiw(,Input_PID,,Item_List,,,) X`009If ( .not. IStatus ) Return X Xc Check for no image (DCL) X`009If ( Rl_Imagname .eq. 0 ) Then X`009 Get_Image = '$'`009! DCL X`009 Return X`009EndIf X Xc Check for public directory Xc ! Site-specific: If you want all images printed, delete this whole block. Xc`009i_Dir1 = Index(Imagname,PublicDirectory1)`009! Xc`009i_Dir2 = Index(Imagname,PublicDirectory2)`009! to be set Xc`009i_Dir3 = Index(Imagname,PublicDirectory3)`009! above for Xcc`009i_Dir4 = Index(Imagname,PublicDirectory4)`009! each site.`032 Xcc`009i_Dir5 = Index(Imagname,PublicDirectory5)`009!`032 Xc`009If (`032 Xc`0091`009`009i_Dir1 .eq. 0 `009! one of`032 Xc`0092`009.and. `009i_Dir2 .eq. 0 `009! these for`032 Xc`0093`009.and. `009i_Dir3 .eq. 0 `009! each public`032 Xcc`0094`009.and. `009i_Dir4 .eq. 0 `009! directory Xcc`0095`009.and. `009i_Dir5 .eq. 0 `009! at your site. Xc`0096 ) Then Xc`009 Get_Image = '' ! default for image in private directory Xc`009 Return`009`009 ! (for privacy) Xc`009EndIf Xc ! Site-specific - end of block X Xc Image good. Just get file name. X X`009Do i = Rl_Imagname,0,-1 X`009 If ( Imagname(i:i) .eq. ']' ) Goto 101 X`009 If ( Imagname(i:i) .eq. '>' ) Goto 101 X`009 If ( Imagname(i:i) .eq. ':' ) Goto 101 X`009End do X X101`009ii = i + 1 X`009iii = Index(Imagname(ii:Rl_Imagname),'.') + ii - 2 X`009Get_Image = Imagname(ii:iii) X X`009Return X`009End X`012 Xc--------------------------------------------------------------------------- X`009Character*31`009Function Get_PersonalName(Username) X X`009Include`009`009'FingerCom.For' X X`009Character*12`009UserName`009`009! User's login name X`009Character*31`009Owner, Fix_Name*31 X X`009Call NULToSP(Username,12) X Xc search for Userame in shared common database X`009Do ii = 1,Usr$I_Last X`009 If ( Usr$C_Username(ii) .eq. Username ) then X`009`009Owner = Usr$C_PersonalName(ii) X`009`009Go to 122 X`009 End if X`009End do X`009Get_PersonalName = ' '`009!default if name not found X`009Return X X122`009Continue X`009Get_PersonalName = Fix_Name(Owner) X X`009Return X`009End X`012 Xc--------------------------------------------------------------------------- X`009Character*12`009Function Get_Username(PersonalName, X`0091`009`009`009NMatches,OutFlag,Out_Routine) Xc Xc This routine searches the username <--> Personalname database Xc for a match in part (or all) with the personal name and returns Xc the Username. If there is more than 1 match the last match is Xc returned. "minimum_match_length" requires at least that many Xc characters for the compare (to avoid matching all kinds of small Xc strings). The routine also returns the number of matches and will Xc output the match on option. Xc Xc Note: If "minimum match" is omitted, Finger can be easily used to Xc obtain lists of users at a site by searching for all names containing Xc a few common letter combinarions (e.g., vowels). The minimum match Xc effectively prevents this. Xc Xc ! site-specific:`009set minimum match length or omit. (see below) X`009Parameter`009minimum_match_length = 3 X X`009Include`009`009'FingerCom.For' X X`009Integer`009`009NMatches, Btrim X`009Logical`009`009OutFlag, ExactMatch, Match X`009Logical`009`009Wild, Wild_Match X`009External`009Out_Routine X`009Character`009C_Temp*31, Str$UpCase*31 X`009Character`009Fix_Name*31, Make_Pretty*31 X`009Character*(*)`009PersonalName X`009Character*1`009LF/10/, CR/13/ X X`009Get_Username = ' ' X`009NMatches = 0 Xc ! site-specific: use following code for minimum match length X`009If ( Len(PersonalName) .lt. minimum_match_length ) then X`009 ExactMatch = .true. X`009Else X`009 ExactMatch = .false. X`009End if Xc check if wildcards (a bit useless considering...) X`009If ((Index(PersonalName,'*') + Index(PersonalName,'%')).gt.0) X`0091`009Wild = .true. Xc search for PersonalName in shared common database X`009Do ii = 1,Usr$I_Last X`009 Match = .false. X`009 If ( ExactMatch ) then X`009`009If ( Str$UpCase(Usr$C_Personalname(ii)) X`0091`009`009 .eq. Personalname ) Match = .true. X`009 Else if ( Wild ) then X`009`009iii = Btrim(Usr$C_Personalname(ii)) X`009`009C_Temp = Str$Upcase(Usr$C_Personalname(ii)) X`009`009Match = Wild_Match('*'//PersonalName//'*',`009! add wild X`0091`009`009C_Temp(:iii))`009`009`009`009! front & back X`009 Else X`009`009If ( Index(Str$UpCase(Usr$C_PersonalName(ii)), X`0091`009 PersonalName) .ne. 0 ) Match = .true. X`009 End if X`009 If ( Match ) then X`009`009NMatches = NMatches + 1 X`009`009Get_Username = Usr$C_Username(ii) X`009`009If ( OutFlag ) then X`009`009 Call Out_Routine(LF//Usr$C_Username(ii)//' - '// Xc ! site-specific: Choose one of the following two lines X`0091`009`009Fix_Name(Usr$C_PersonalName(ii)) Xc`0091`009`009Make_Pretty(Fix_Name(Usr$C_PersonalName(ii))) X`0092`009`009//CR) X`009`009End if X`009 End if X`009End do X X`009Return X`009End X`012 Xc--------------------------------------------------------------------------- X`009Character*9`009Function Day_OfTheWeek(BinTime) X X`009Character*9`009Day(7) / X`0091`009`009'Monday', X`0092`009`009'Tuesday', X`0093`009`009'Wednesday', X`0094`009`009'Thursday', X`0095`009`009'Friday', X`0096`009`009'Saturday', X`0097`009`009'Sunday'/ X X`009Integer`009`009BinTime(2), DayNumber X X`009Call Lib$Day_of_Week(BinTime,DayNumber) X`009Day_OfTheWeek = Day(DayNumber) X X`009Return X`009End X`012 Xc--------------------------------------------------------------------------- X`009Subroutine`009NULToSP(String,Length) X X`009Character`009String*(*) X`009Character`009NUL/0/, SP/' '/ X X`009Do ii=1,Length X`009 If ( String(ii:ii) .eq. NUL ) String(ii:ii) = SP X`009EndDo X X`009Return X`009End X`012 Xc------------------------------------------------------------------------ X`009Character*31 Function Fix_Name(Name) X X`009Character`009Name*31, First_Name*31, Last_Name*31 X`009Character`009SP /' '/ X X`009Fix_Name = Name X X`009If ( Name .eq. ' ' ) Return X X`009If ( Name(1:1) .eq. '(' ) GoTo 200 X`009i_Comma = Index(Name,',') X`009If ( i_Comma .eq. 0 ) GoTo 200 X X`009i_Last = i_Comma-1 X`009If ( i_Last .le. 0 ) Then X`009 Last_Name = ' ' X`009 i_Last = 1 X`009EndIf X`009Last_Name = Name(:i_Last) X X`009First_Name = Name(i_Comma+1:) X`009i_First = 31 - i_Comma X`009Do ii=i_First,2,-1 X`009 If ( First_Name(ii:ii) .ne. SP ) GoTo 110 X`009EndDo X X110`009i_First = ii X`009Do ii = 1,i_First X`009 If ( First_Name(ii:ii) .ne. SP ) GoTo 120 X`009EndDo X X120`009First_Name = First_Name(ii:i_First) X`009i_First = i_First - ii + 1 X Xc ! site-specific: Uncomment next line if your usernames are stored as Xc lastname, firstname. Xc`009Fix_Name = First_name(:i_First)//SP//Last_name(:i_Last) X X200`009Return X X`009END X X`012 Xc------------------------------------------------------------ X`009Character*(*) Function Make_Pretty(String) X Xc`009! Site-specific note Xc This implements one person's idea of what constitutes "pretty" Xc text: all words capitalized, with other letters lower case. If Xc you like all UPPER-CASE (like VMS) or all lower-case (like unix) Xc feel free to change this as per comments below.`009`009- Rg X X`009Character*(*)`009String X`009Character`009Item X`009Character`009Down_Case, Str$UpCase`009! May have to specify length X`009Logical`009`009NewWord, Alpha X X`009NewWord = .true. X`009Make_Pretty = ' ' X X`009Do i = 1, Len(String) X`009 Item = String(i:i) X`009 Alpha = (Item .ge. 'A' .and. Item .le. 'Z') .or. X`0091`009 (Item .ge. 'a' .and. Item .le. 'z') X`009 Item = Down_Case(Item) X`009 If ( NewWord ) Item = Str$UpCase(Item) X`009 NewWord = .not. Alpha X`009 Make_Pretty(i:i) = Item X`009EndDo X Xc Following are alternate possibilities.`009! Site-specific Xc Must give "Down_Case" and "Str$UpCase" correct length specification above. Xc`009Make_Pretty = Down_Case(String)`009`009! For all lower case Xc`009Make_Pretty = Str$UpCase(String)`009! For all UPPER CASE X X`009Return X`009End X`012 Xc------------------------------------------------------------ X`009Character*(*) Function Filter_Control_Chars(String) X Xc`009This routine can be used to filter control characters Xc`009from the output stream and put a period (".") in their Xc`009place to prevent wierd process names etc. from messing`032 Xc`009up the terminal screen. X X`009Character*(*)`009String X X`009Character*256`009FilterTable`032 X X`009 Parameter ( FilterTable = X`0091`009'................................' // X`0092`009' !"#$%&''()*+,-./0123456789:;<=>?'// X`0093`009'@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]`094_' // X`0094`009'`096abcdefghijklmnopqrstuvwxyz`123`124`125`126.' // X`0095`009'................................' // X`0096`009'................................' // X`0097`009'................................' // X`0098`009'................................' ) X X`009Call Lib$Movtc(String,' ',FilterTable,Filter_Control_Chars) X X`009Return X`009End X`012 Xc------------------------------------------------------------ X`009Character*(*) Function Down_Case(Item) X X`009Character*(*)`009Item X X`009Do i = 1,Len(Item) X`009 Down_Case(i:i) = Item(i:i) X`009 If ( Item(i:i) .ge. 'A' .and. Item(i:i) .le. 'Z' )`032 X`0091`009Down_case(i:i) = Char(Ichar(Item(i:i)) + 32) X`009EndDo X X`009Return X`009End X`012 Xc------------------------------------------------------------ X`009Integer Function OutLink_UserOpen(FAB,RAB,Unit) X X`009Integer`009`009FAB(30), RAB(30) X`009Integer`009`009Rab$L_Rop/2/, Rab$M_Loc/Z00010000/ X`009Integer`009`009Sys$Create, Sys$Connect X`009Integer`009`009Unit, OutLinkOpenStatus, OutLinkRMSStatus X X`009Common`009/OutLinkOpen_Common/ OutLinkOpenStatus, OutLinkRMSStatus X X`009iii = Sys$Create(FAB) X`009OutLinkRMSStatus = iii`009`009! RMS Status X`009OutLinkOpenStatus = FAB(4)`009! This is the Fab$l_STS field: status X X`009If ( .not. iii ) Then X`009 IF ( OutLinkOpenStatus .eq. 0 ) OutLinkOpenStatus = iii X`009 OutLink_UserOpen = iii X`009 Return X`009EndIf X X`009RAB(Rab$L_Rop) = RAB(Rab$L_Rop) .or. Rab$M_Loc`009! Locate option X`009OutLink_UserOpen = Sys$Connect(RAB) X X`009Return X`009End X`012 Xc-------------------------------------------------------------------------- X`009integer function btrim (string) X Xc Integer function to determine the length of a character string with -+-+-+-+-+ End of part 11 +-+-+-+-+-