From:	SMTP%"system@camars.unicam.it" 23-SEP-1994 09:44:23.62
To:	EVERHART
CC:	
Subj:	Re: alpha_finger fixes

Date: Fri, 23 Sep 1994 14:54:24 +0200
Message-Id: <94092314542424@camars.unicam.it>
From: system@camars.unicam.it
To: EVERHART@arisia.gce.com
Subject: Re: alpha_finger fixes
X-Vms-To: SMTP%"EVERHART@arisia.gce.com"

Glenn.
I've found a bug on vms axp's ucx. The system crashed when a user fingered
his own machine using an IP address followed by a dot. I've corrected
FINGER.FOR to check for the trailing dot and eliminate it.
Pls substitute it in the package. Ciao Giorgio.


C..Finger.For				Callable finger routine
C..					R. Garland / C.U.Chemistry

	Integer Function Finger(Command_line,Finger_Out_Routine,Access)

C	Function-
C		o To provide detailed information about users on system.
C		o To provide additional information about an individual.
C		o To request out-bound, or to answer in-bound network
C		  requests to/from other hosts supporting finger.
C
C	Author-
C		Dr. Richard Garland
C		Department of Chemistry
C		Box 351 Havemeyer Hall
C		Columbia University
C		New York, NY, 10027
C		(212) 280-3183
C
C	Disclaimer/rights-
C		This software is in the public domain and is
C		provided free though DECUS or other channels.
C
C	Environment-
C		VAX/VMS V5.0 or later
C		Must be installed with CMKRNL, SYSPRV, WORLD & OPER privileges.
C			CMKRNL - to get the idle times from the UCB's.
C			SYSPRV - so it can read SYSUAF.DAT.
C			WORLD - so it can do GETJPI's on processes.
C			OPER - so it can use TSM to query terminal servers.
C
C	Routines required, installation:
c		read FINGER.DOC and use the procedure INSTALL_FINGER.COM
c		and BUILD_FINGER.COM

C
C	Edition/changes-
C
c	Note:	Early update history (pre-V5) is at the end of this source.
c
c	V50.1.00	Works with 5.0-1 with one exception-no one has
c			gotten TT_UCB to work, hence I NoOp'd it. For me this
c			is minor. Included is new load average driver support.
c			Both the Mail.mai and Vmsmail.dat sections were
c			rewritten to support v5 formats. LAT port and Queue
c			name code now uses documented interfaces.
c			By Rand P. Hall				11-Oct-1988
c	V50.1.01	Mods at SPC - Fixed /HELP qualifier, fixed display
c			of unread mail when explicit mail directory is not
c			specified, widened location field to 25, changed dis-
c			play of unread mail slightly, display server and port
c			names without prettying.
c			By Terry Kennedy			02-Mar-1989
c	V50.1.02	Mods at SPC - Fixed to not pretty up personal names,
c			also to not swap text when a comma is found in a per-
c			sonal name (messes up John X. Doe, Jr., for example).
c			By Terry Kennedy			08-Mar-1989
c	V50.1.03	Mods at SPC - Fixed array-bounds problem in get_image
c			when image = DCL, convert null username to spaces for
c			NULL and SWAPPER PIDs (80, 81), fix ACCVIO on get_
c			lastname when no personal name defined.
c			By Terry Kennedy			09-Mar-1989
c	V50.1.04	Mods at SPC - Fixed array-bounds problems when null
c			line in planfile, finger @node with no parameters.
c			By Terry Kennedy			10-Mar-1989
c	V50.1.05	Mods at SPC - Generate warning when sorting on an
c			unknown sort field, eliminate duplicate NONODE mes-
c			sages, use standard error message format throughout.
c			By Terry Kennedy			16-Mar-1989
c	V51.1.06	Mods at SPC - More subscript fixes in DO_HELP, DEC-
c			NET_FINGER, send full help to remote fingerer via
c			jnet, reduce location to 24 columns.
c			By Terry Kennedy			18-Mar-1989
c	V51.1.07	Mods at SPC - Fix finger/sort=login_time not working,
c			add /sort=cpu_time as a new option, add display of
c			VMS mail forwarding address.
c			By Terry Kennedy			26-Mar-1989
c	V51.1.08	Mods at SPC - Merge in Frank Nagy's Fermilab mods.
c			By Terry Kennedy			13-Apr-1989
c	V51.1.09	Mods at SPC - *FINALLY* fix the Jnet finger sort bug
c			(for good this time, I hope...), fixed some cosmetic
c			stuff when running as Jnet finger server.
c			By Terry Kennedy			15-Apr-1989
c	V51.1.10	Mods at SPC - Strip '_' from VTA port names so that
c			_VTA1234: fits in display field, shorten location,
c			default to /TTType, get terminal type from VMS if
c			not in Finger Common Block or if FCB says "Unknown",
c			send help text back to DECnet fingerer instead of
c			writing it to the NETSERVER.LOG file.
c			By Terry Kennedy			19-Apr-1989
c	V51.1.11	Mods at SPC - Add Frank Nagy's fix for null/blank
c			host name in FCB, add /IAM stuff to report mail cor-
c			rectly for net links, fix bug with uninitialized
c			mail records.
c			By Terry Kennedy			25-Apr-1989
c	V51.1.12	Mods at SPC - Finish up /IAM stuff (now we need a
c			victim (er, person) to test it heavily.
c			By Terry Kennedy			27-Apr-1989
c	V51.1.13	Mods at SPC - Fix /IAM in DECNET_FINGER to not add
c			it if in the middle of poor-man's routing. Thus, we
c			preserve the real originating node/user info. A
c			side effect of this also cures sending the 'unrec-
c			ognized qualifier' msg back to the originator when
c			traffic passed through a V51.1.12 node.
c			By Terry Kennedy			29-Apr-1989
c	V51.1.14	Mods at SPC - change '.' to ',' in system_version,
c			fix stupid bug of image name being char*9 instead of
c			char*20 in FINGERSHO.FOR - how stupid...
c			By Terry Kennedy			06-Jun-1989
c	V51.1.15	Mods at AAMRL - Can now determine idle times using
c			TERMINAL.MAR from Joe Meadows.
c			By Ted Nieland				12-Jun-1989
c	V51.1.16	Mods at AAMRL - Allow for mail forwarding using PMDF's
c			DELIVER% and still show new mail count and messages.
c			By Ted Nieland				13-Jun-1989
c	V51.1.17	Mods at SPC - Clean up /BYPASS processing so we don't
c			send blanks out instead, also handle the case where
c			more than one /BYPASS was specified on the command
c			line.
c			By Terry Kennedy			14-Jun-1989
c	V51.1.18	Mods at SPC - Fix up the bug which caused mail for-
c			warding to not display in some (random) cases, try
c			again for the NONODE reporting problem - the previous
c			solution prevented reporting it to DECnet fingerers,
c			add display of RSCS spool file (jnet) count.
c			By Terry Kennedy			27-Jun-1989
c	V51.1.19	Mods at SPC - Make qualifier operation totally de-
c			pendant on the CLD, make no assumptions about "de-
c			faults" here, add DISMAILREP, DISSUBJREP qualifiers
c			for sites who don't want the mail stuff, show process
c			type in terminal field if noninteractive (thanks to
c			Frank Nagy), add ability to finger terminal servers
c			(sort of).
c			By Terry Kennedy			01-Jul-1989
c	V51.1.20	Mods at SPC - Change personal name field to be the
c			same size as in UAF so people's personal names don't
c			get truncated (why do bosses have the longest names?)
c			By Terry Kennedy			03-Jul-1989
c	V51.1.21	Mods at SPC - Correct typo in optional /IAM code in
c			routine decnet_finger, fix get_image to return the
c			full image name even when not in 1st 64 bytes of the
c			image filespec, fix ACCVIO if prettying the personal
c			name is selected. Thanks, Lauri! Fix bug in "common
c			adm DECnet" code which wouldn't compile and wouldn't
c			find local mail, don't propagate /IAM's out onto the
c			RSCS (Bitnet) network, cosmetic corrections.
c			By Terry Kennedy			07-Aug-1989
c	V51.1.22	Mods at SPC - Include Craig Watkins' fixes to speed
c			up ADD/USER/UAF in FINGMAINT, fix spurious error in
c			routine get_decnet_remote if the logical tables aren't
c			set up yet (from CRW and FJN), remove unused TTUCB
c			storage in FINGERCOM (from FJN), report dialups on
c			DECservers a little differently, add check for mail
c			privacy (Print nastygram if the fingeree's mail file
c			contains a folder named F_PRIVACY), fix 2 typos in
c			FINGERLAT, modify GET-IDLE for VMS V5.2.
c			By Terry Kennedy			02-Sep-1989
c	V51.1.23	Mods at SPC - Fix DISSUBJREP, which was completely
c			broken (oops - thanks Lauri!), install temporary
c			workaround for Get_DECnet_Remote blowing up Finger
c			with "No logical name" (thanks, Glenn!).
c			By Terry Kennedy			17-May-1990
c	V51.1.24	Mods at SPC - Fix an obscure looping condition.
c			By Terry Kennedy			20-Jan-1991
c	V51.1.25	Mods at SPC - Support UCX remote user field, new
c			PMDF deliver format, keep a local copy of XABPRODEF
c			since DEC has broken the one in FORSYSDEF again.
c			By Terry Kennedy			11-Jun-1991
c	V51.1.26	Mods at SPC - Add new terminal types to table, fix
c			potential array bound problem there as well. Outbound
c			UCX TCP/IP support. Correct long-standing problems
c			which caused nodenames illegal to DECnet to prevent
c			attempts over other transports. Correct problem with
c			defined (in FINGERSHR) but unknown nodes causing FIN-
c			ger to appear to die (exiting without printing any
c			error message). Increase size of node name from 12 to
c			32 to accomodate TCP/IP hosts. Do TCP finger before
c			Jnet finger.
c			By Terry Kennedy			27-Aug-1991
c	V51.1.27	Mods at SPC - Add FING_NOSERVICE to report "object un-
c			known at remote node" responses.
c			By Terry Kennedy			16-Nov-1991
c	V51.1.28	Mods at SPC - Add support for Interconnections' TES
c			terminals (QTAn: devices), fix idle time code which
c			was broken for an indeterminate period of time.
c			By Terry Kennedy			12-Dec-1991
c	V51.1.29	Mods at SPC - Fix undeclared/uninitialized updelta
c			variable which caused uptime in the daemon versions
c			to fluctuate wildly after the first invocation.
c			By Terry Kennedy			16-Jan-1992
c
C	This routine can be called locally or via a network object.
c	In any case, the output is processed by an external routine
c	specified as an argument.  This makes it somewhat independent
c	of invocation.

	Include		'Fingercom'
	Include		'Fingerdef.inc'

	Character VersionMsg*51
	1	/'VAX/VMS Finger: Version V51.1.29 of 16-Jan-1992'/
	Common	/Version_Common/ VersionMsg

	Integer		Privilege(2) /0,0/
	Integer		Btrim
	Logical		Wild, Wild_Match
	Character	Command_line*(*)
	Character	Expanded_Command*132
	Character	Node*32, Next_Node*32
	Character	Get_Node*32, Save_Node*32
	Character	Route*72, Node_Type*1
	Character	CR /13/,	LF /10/,	SP /' '/
	Character	Slash /'/'/,	Flush/255/

	Integer		
	1		OutboundLinkUnit /11/,
	2		UafUnit /12/,
	3		ScratchUnit /13/

	Common	/IO_Units/ 
	1		OutboundLinkUnit,
	2		UafUnit,
	3		ScratchUnit

	External	Finger_Out_Routine
	External	Fing_NoWild
	External	Fing_NoNode
	External	Fing_NoNet
	External	Fing_NoService
	External	Fing_Unreachable

	Integer		Access
	Integer		Local_Finger,
	1		Remote_Finger

	Integer		TRN_ItemList(4)
	Integer*2	TRN_ItemList2(8)
	Equivalence	(TRN_ItemList, TRN_ItemList2)
	Integer		TRN$_String /Z00000002/
	Character	DECnet_Node*32, My_Node*32
	Integer		l_Node
	Integer		SS$_Status
	Integer		Sys$TrnLnm
	External	SS$_NoTran

c  Turn off privileges
	Privilege(1) = Prv$M_Cmkrnl .or. Prv$M_World .or. Prv$M_Sysprv
	Call Sys$Setprv(,Privilege,,)

c  start processing command
	l_com = Len(Command_line)

C  Strip CR//LF off Command_line
	i_CRLF = Index(Command_line,CR//LF)
	If ( i_CRLF .ne. 0 ) l_Com = i_CRLF - 1

c	write(*,*)Command_line(:l_Com)
c	write(*,*)


c Ucx 3.0 for axp crashes if an attempt to finger  the host using it's number
c and a trailing dot ( e.g. 193.204.9.1. ).
c Just to be sure, strip the trailing dot, if any
c	Giorgio Mancini
	if( Command_line(l_Com:l_Com).eq.'.') l_Com=l_Com-1

c	write(*,*)Command_line(:l_Com)
c	write(*,*)

C  Find node name: look for @-sign
10	Do ii=l_Com,1,-1
	    If ( Command_line(ii:ii) .eq. '@' ) Then
		i_At = ii
		GoTo 110
	    EndIf
	EndDo
c  check also for "::" if there are no @-signs
	i_cc = index(command_line,'::')
	If (i_cc.ne.0) then
	    do ii = i_cc,1,-1
	       if (command_line(ii:ii).eq.slash) goto 20
	       if (command_line(ii:ii).eq.sp   ) goto 20
	    end do
	    ii = 0
20	    node = command_line(ii+1:i_cc-1)
	    l_node = i_cc - ii - 1
	    Command_line(ii+1:i_cc+1) = '@'//node(:l_node)//' '
	    Go to 10
	End if
	
	Finger = Local_Finger(Command_line(:l_Com),
	1   Finger_Out_Routine,Access) ! No node name:
								! local finger
	Return

110	Continue
	Node = Command_line(i_At+1:l_Com)		! This is the node name
	l_Node = l_Com - i_At
	Do ii = 2,l_Node
	    If ( Node(ii:ii) .eq. Slash ) GoTo 111
	    If ( Node(ii:ii) .eq. SP ) GoTo 111
	EndDo
	GoTo 112
111	l_Node = ii - 1
112	Continue
	Save_Node = Node
	l_Save_node = l_node

c  see if there are wildcards in node name
	ii_node = 1
	wild = .false.
	If ( (Index(Node(:l_Node),'*')+Index(Node(:l_Node),'%'))
	1	.gt. 0 ) then
		wild = .true.
		ii_node = Host$I_Last
		Finger = %Loc(Fing_NoWild)
	End if
c  loop though node names, or do just one.
	Do ii = 1,ii_node
	    If ( wild ) then
		l_host = Btrim(Host$C_Host(ii))
		if ( Wild_Match(Save_Node(:l_Save_Node),
	1	Host$C_Host(ii)(:l_host)) ) then
		    Node = Host$C_Host(ii)
		    l_node = l_host
		Else
		    Go to 200	
		End if
	    End if
c  Get routing information
	    Next_Node = Get_Node(Node(:l_Node),Node_Type,Route,.false.)
	    TRN_ItemList2(1) = 8
	    TRN_ItemList2(2) = TRN$_String
	    TRN_ItemList(2) = %Loc(DECnet_Node)
	    TRN_ItemList(3) = %Loc(L_node)
	    TRN_ItemList2(7) = 0
	    TRN_ItemList2(8) = 0

	    SS$_Status = Sys$TrnLnm(,'LNM$SYSTEM_TABLE',
	1	    'SYS$NODE', 1, TRN_ItemList)
	    If ( SS$_Status .eq. %Loc(SS$_Notran)) Then
		My_Node = 'Finger'
	    Else
		My_Node = DECnet_Node(:L_Node-2)
	    Endif

C  Format  command 
c Avoid subscript errors - tmk
	    if (i_AT+l_Save_Node .eq. l_Com) Then
	      Expanded_Command = Command_line(:i_AT-1)//
	1	Route(:Btrim(Route))
	    else
	      Expanded_Command = Command_line(:i_AT-1)//
	1	Route(:Btrim(Route))//
	2	Command_line(i_AT+l_Save_Node+1:l_Com)
	    end if

C  send command out to appropriate network/node

	    If ((wild .eq. .false.) .or. (Node_Type .ne. 'X')) Then
		Finger = Remote_Finger(Next_Node(:Btrim(Next_Node)), 
	1	    Expanded_Command(:Btrim(Expanded_Command)),
	2	    Finger_Out_Routine, Node_Type, Access)
	    EndIf

c  Test - report link failed if fing_noservice or fing_unreachable
	    If (Finger.eq.%Loc(Fing_NoService) .or. 
	1	    Finger.eq.%Loc(Fing_Unreachable) ) then
		Call Finger_Out_Routine(': link failed]'//CR//LF)
	    End if

c  If a wild card net and node not found, see if there is a default router
c bug?	    If ( Node_Type.eq.'*' .and. Finger.eq.%Loc(Fing_NoNode) ) then
	    If (Finger.eq.%Loc(Fing_NoNode) ) then
c	Get routing information for Router
		Next_Node = Get_Node(Node(:l_Node),
	1	    Node_Type,Route,.true.)
		If ( Next_Node .eq. ' ' ) then		! no router: give up.
		    Call Finger_Out_Routine(': link failed]'//CR//LF)
		    Call Lib$Signal(Fing_NoNode)
		    Return
		End if
		If ( Next_Node .eq. My_Node ) then	! I _am_ the router
		    Call Finger_Out_Routine(': link failed]'//CR//LF)
		    Call Lib$Signal(Fing_NoNode)
		    Return
		End if
C	Format  command 
		Expanded_Command = Command_line(:i_AT-1)//
	1	    Route(:Btrim(Route))//
	2	    Command_line(i_AT+l_Save_Node+1:l_Com)

c	notify user we are rerouting
		Call Finger_Out_Routine(': rerouting link via '//
	1	    Next_Node(:Btrim(Next_Node))//']'//CR//LF)

C	send command out to appropriate network/node

		Finger = Remote_Finger(Next_Node(:Btrim(Next_Node)), 
	1	    Expanded_Command(:Btrim(Expanded_Command)),
	2	    Finger_Out_Routine, Node_Type, Access)

	    End if
200	    Continue
	End do

C Done
	Return

	End

c------------------------------------------------------------------------
	Integer Function Remote_Finger(Next_Node, Command,
	1			Finger_Out_Routine, Node_Type, Access)


	Character	Command*(*)
	Character	Next_Node*(*)
	Character	Node_Type*1
	Character	Flush/255/

	Integer		Access
	External	Finger_Out_Routine
	External	Fing_Nonode, Fing_NoNet

	Integer		Local_Finger,
	1		DECnet_Finger,
	3		jnet_Finger,
	4		TCP_Finger

	Logical		WildNet, NoNode

	NoNode = .false.
	If ( Node_Type .eq. '*' ) then
	    WildNet = .true.
	Else
	    WildNet = .false.
	End if

c  see if it's really local
	If ( Node_Type .eq. 'L' ) Then				! Local
	    Remote_Finger = Local_Finger(Command,Finger_Out_Routine,Access)
	    Return
	End if

c  Notify requester trying to open link
	Call Finger_Out_Routine('['//Next_Node//Flush)

c  dispatch by network type
	If ( WildNet .or. (Node_Type.eq.'D') ) then	! DECnet
	    Remote_Finger = DECnet_Finger(Next_Node,Command,
	1   Finger_Out_Routine, Access)
	    If ( WildNet .and. (Remote_Finger.eq.%Loc(Fing_NoNode)) )
	1	NoNode = .true.
	    If ( .not. WildNet ) Return 
	    If ( .not.(	Remote_Finger.eq.%Loc(Fing_NoNode) .or.
	1		Remote_Finger.eq.%Loc(Fing_NoNet) ) ) Return
	End if

	If ( WildNet .or. (Node_Type.eq.'T') ) then	! TCP
	    Remote_Finger = TCP_Finger(Next_Node,Command,
	1   Finger_Out_Routine)
	    If ( WildNet .and. (Remote_Finger.eq.%Loc(Fing_NoNode)) )
	1	NoNode = .true.
	    If ( .not. WildNet ) Return 
	    If ( .not.(	Remote_Finger.eq.%Loc(Fing_NoNode) .or.
	1		Remote_Finger.eq.%Loc(Fing_NoNet) ) ) Return
	End if

	If ( WildNet .or. 
	1	(Node_Type.eq.'J') .or. (Node_Type.eq.'I') ) then ! jnet
	    Remote_Finger = jnet_Finger(Next_Node,Command,
	1   Finger_Out_Routine,Node_Type)
	    If ( WildNet .and. (Remote_Finger.eq.%Loc(Fing_NoNode)) )
	1	NoNode = .true.
	    If ( .not. WildNet ) Return 
	    If ( .not.(	Remote_Finger.eq.%Loc(Fing_NoNode) .or.
	1		Remote_Finger.eq.%Loc(Fing_NoNet) ) ) Return
	End if

	If (Node_Type .eq. 'X') then
	    Remote_Finger = LAT_Finger(Next_Node, Finger_Out_Routine)
	    Return
	EndIf

	If ( WildNet .and. NoNode ) then
	    Remote_Finger = %Loc(Fing_NoNode)
	Else
	    Remote_Finger = %Loc(Fing_NoNet)
	End if

	Return
	End

c------------------------------------------------------------------------
	Character*32 Function Get_Node(Node,Node_Type,Route,Router)

	Include		'FingerCom.For'

	Character	Node*(*), Node_Type*1, Route*72
	Logical		Router


c  see if we want the default router node
	If ( Router ) then
	    Get_Node = Net$C_Router_Host
	    If ( Get_Node .eq. ' ' ) Return
	    Route = '@'//Node//Net$C_Router_Route
	    Node_Type = Net$C_Router_Type
	    Return
	End if

c  otherwise do a regular look up
	Do ii = 1,Host$I_Last
	    If ( Node .eq. Host$C_Host(ii) ) then
		Get_Node = Host$C_Link(ii)
		If ( Get_Node .eq. ' ' ) Get_Node = Node
		Node_Type = Host$C_Type(ii)
		Route = Host$C_Route(ii)
		Return
	    End if
	End do

c  not found: default to Wild card
	Get_Node = Node
	Node_Type = '*'
	Route = ' '
	Return

	End

c------------------------------------------------------------------------
	Character*20 Function Get_Network(Net_Type)

	Include		'FingerCom.For'

c  look up name of network in database.

	Character	Net_Type*1
	Integer		length

c  in case we don't find it, some defaults
c  [rph-25-mar-88] this used to be 4 straight IFs

	Get_Network = 'Net'

	If ( Net_Type .eq. 'D' ) then
	  Get_Network = 'DECnet'
	else If ( Net_Type .eq. 'J' ) then
	  Get_Network = 'jnet'
	else If ( Net_Type .eq. 'I' ) then
	  Get_Network = 'jnet'
	else If ( Net_Type .eq. 'T' ) then
	  Get_Network = 'TCP'
	else If ( Net_Type .eq. 'X' ) then
	  Get_Network = 'LAT'
	endif

	Do ii = 1,Net$I_Last
	    If ( Net_Type .eq. Net$C_Type(ii) ) then
		Get_Network = Net$C_Name(ii)
	    End if
	End do

	Return
	End

c------------------------------------------------------------------------
	Integer Function DECnet_Finger(Next_Node,Net_Command,
	1			Finger_Out_Routine, Access)

c  Do a Finger of a remote DECnet node.  Establish the link, send
c  the command, and relay the output back to the requestor.

	Include		'($RMSDEF)'
	Include		'GETJPIDEF.FOR'

c ** Site-Specific ** needed for BYPASS logic
	COMMON /BCZCOM/ FLAG_BYPASS
	LOGICAL FLAG_BYPASS
c end of bypass logic

	Character	Next_Node*(*), Net_Command*(*)

	Integer		Btrim
	Character	Line*32000,	NUL/0/
	Character	CR /13/,	LF /10/,	SP /' '/
	Character	Flush /255/
	Character	OpenMsg*80
	Character	Network*20,	Get_Network*20

	Integer		
	1		OutboundLinkUnit, 
	2		UafUnit,
	3		ScratchUnit

	Common	/IO_Units/ 
	1		OutboundLinkUnit,
	2		UafUnit,
	3		ScratchUnit

	Integer		OutLinkOpenStatus, OutLinkRMSStatus
	Common		/OutLinkOpen_Common/ OutLinkOpenStatus,
	1			OutLinkRMSStatus

	Integer		SS$_Status
	Integer		Sys$TrnLnm
	Integer		SS$_NOSUCHNODE	/Z028C/
	Integer		SS$_DEVNOTMOUNT	/Z007C/
	Integer		SS$_NOSUCHOBJ	/8356/
	Integer		TRN_ItemList(4)
	Integer*2	TRN_ItemList2(8)
	Equivalence	(TRN_ItemList, TRN_ItemList2)
	Integer		TRN$_String /Z00000002/
	Character	LocalQualifier*32, DECnet_Node*32
	Integer		l_Node

	Integer		Access
	External	Finger_Out_Routine
	External	Fing_Complete,	Fing_Abort
	External	Fing_NoNode, Fing_NoNet
	External	Fing_NoService
	External	OutLink_UserOpen

c  Default return status
	DECnet_Finger = %Loc(Fing_Complete)

c  Construct the /IAM stuff
c  First the username...
	I = 1
	II = 1
	ITEM_LIST2(II+IC) =	JPI$_USERNAME
	ITEM_LIST2(II+BL) =	L_USERNAME
	ITEM_LIST(I+BA)  =	%LOC(USERNAME)
	ITEM_LIST(I+RL)  =	%LOC(RL_USERNAME)
	ITEM_LIST(I+3) = 0		! End of list

	Call Sys$Getjpiw(,,,Item_List,,,)

c  ...then the nodename...
	TRN_ItemList2(1) = 8
	TRN_ItemList2(2) = TRN$_String
	TRN_ItemList(2) = %Loc(DECnet_Node)
	TRN_ItemList(3) = %Loc(L_node)
	TRN_ItemList2(7) = 0
	TRN_ItemList2(8) = 0

	SS$_Status = Sys$TrnLnm(,'LNM$SYSTEM_TABLE',
	1	'SYS$NODE', 1, TRN_ItemList)

c  ...Now glue it together...
	LocalQualifier = '/IAM="'//UserName(:Btrim(UserName))//'~'
	1	//DECnet_Node(:L_Node-2)//'"'

c  Establish DECnet link
	Open(	Unit=OutboundLinkUnit,
	1	File=Next_Node//'::"117="',
	2	Type='UNKNOWN',
	3	CarriageControl='NONE',
	4	Err=145,
	5	UserOpen=OutLink_UserOpen,
	6	Recl=32000,
	7	BlockSize=32000)
c  Get network name
	Network = Get_Network('D')
c  Finish message
	Call Finger_Out_Routine('.'//Network(:Btrim(Network))//']'//CR//LF)
	GoTo 150

c  Error establishing link
145	Continue
	If ( OutLinkOpenStatus .eq. SS$_NOSUCHNODE ) then
	    DECnet_Finger = %Loc(Fing_NoNode)
	    Return
	End if
	If ( OutLinkOpenStatus .eq. SS$_NOSUCHOBJ ) then
	    DECnet_Finger = %Loc(Fing_NoService)
	    Return
	End if
	If ( OutLinkRMSStatus .eq. RMS$_NOD ) then	! Bad node name for
	    DECnet_Finger = %Loc(Fing_NoNode)		! DECnet may be OK
	    Return					! on another net.
	End if
	If ( OutLinkOpenStatus .eq. RMS$_SYN ) then	! Bad node name for
	    DECnet_Finger = %Loc(Fing_NoNode)		! DECnet may be OK
	    Return					! on another net.
	End if
	If ( OutLinkOpenStatus .eq. SS$_DEVNOTMOUNT ) then
	    DECnet_Finger = %Loc(Fing_NoNet)
	    Return
	End if
	Call Finger_Out_Routine(': link failed]'//CR//LF)
	Call Lib$Signal(%Val(OutLinkOpenStatus.or.2**27)) !turn on customer bit
	DECnet_Finger = %Loc(Fing_Abort)
	Return

c  Send command over link
150	Continue
c
c ** Site-Specific ** uncomment next for bypass switch stuff
 151	IBCZ=INDEX(NET_COMMAND,'/BY')
	IF(IBCZ.eq.0) goto 152
	IIBCZ=LEN(NET_COMMAND)
	IBCZEND=INDEX(NET_COMMAND(IBCZ+1:IIBCZ),'/')
	IF(IBCZEND.EQ.0) IBCZEND=INDEX(NET_COMMAND(IBCZ+1:IIBCZ),' ')
	IF(IBCZEND.EQ.0) THEN
	    IBCZEND=IIBCZ+1
	ELSE
	    IBCZEND=IBCZEND+IBCZ
	ENDIF
	If (ibczend .gt. iibcz) Then
	    net_command = net_command(:ibcz-1)
	Else
	    net_command = net_command(:ibcz-1)//
	1   net_command(ibczend:iibcz)//NUL
	EndIf
	FLAG_BYPASS = .TRUE.
	Goto 151
c  end of bypass logic

c !** Site-specific - If you will be fingering DECnet nodes running V4 of
c finger, you may wish to select the version below which does not send the
c /IAM qualifier (which will return a harmless error message when sent to
c these old versions of finger).
c !** Site-specific: Uncomment *this* for /IAM...

c  Ship command out, tacking on /IAM stuff if we are the originating node
 152	If (Access .eq. 1) Then
	    Write(OutboundLinkUnit,1002)
	1	Net_Command(:Btrim(Net_Command))//LocalQualifier//CR//LF
	Else
	    Write(OutboundLinkUnit,1002)
	1	Net_Command(:Btrim(Net_Command))//CR//LF
	EndIf

c !** Site-specific: ... Or *this* for no /IAM
c  Ship command out
c152	Write(OutboundLinkUnit,1002)
c	1   Net_Command(:Btrim(Net_Command))//CR//LF

C  Read response from network
	DoWhile(.true.)
C ** Site-Specific
C uncomment next for bypass logic
	      IF (.NOT.FLAG_BYPASS) THEN
		do ibcz=1,il
		  if(line(ibcz:ibcz).lt.' ')then
		     iibcz=ichar(line(ibcz:ibcz))
		     if(iibcz.ne.9.and.iibcz.ne.10
	1	        .and.iibcz.ne.13)line(ibcz:ibcz)='.'
		  endif
		enddo
	      ENDIF
c end of bypass logic
	    Read(OutboundLinkUnit,1001,End=200) il,Line
	    nl = il/80
	    Do ii = 1,nl
		Call Finger_Out_Routine(Line((ii-1)*80+1:ii*80))
	    EndDo
	    If (nl*80+1 .le. il) then
		Call Finger_Out_Routine(Line(nl*80+1:il))
	    Endif
	EndDo
200	Continue

c  Make sure link is closed
	Close( Unit=OutboundLinkUnit, Err=201)
201	Continue

	Return

1001	Format(Q,A)
1002	Format(A)

	End

c------------------------------------------------------------------------
	Integer Function jnet_Finger(Next_Node,Net_Command,
	1			Finger_Out_Routine,Node_Type)

c  Do a Finger of a remote jnet node.  Establish the link, send
c  the command, and relay the output back to the requestor.

c  The routine calls to the jnet network are based on interfaces
c  to jnet (tm), a software product available from Joiner Associates
c  of Madison Wisconsin.  This software allows a VAX/VMS system to
c  emulate a full VM (IBM) RSCS node.  jnet is a trademark of
c  Joiner Associates.  BITnet is a network of Universities pri-
c  marily using IBM systems and RSCS protocols.

c  use new jnet interface		31-Aug-1985	Rg

	Character	Next_Node*(*), Net_Command*(*), Node_Type*1
	External	Finger_Out_Routine

	Include		'FingerDef.inc'

	Integer		Btrim
	Integer		IDaemon /.false./
	Common		/jnet_Daemon/ IDaemon
	Logical		TimedOut
	Common		/jnet_Common/ TimedOut
	Integer		Status, Mode
        Character	Line*99, Line2*99
	Character	Str$Upcase*99
        Character       Node*8, User*8
	Character	InitialTimeout*13 /'0 00:01:00.00'/
	Character	Timeout*13 /'0 00:00:20.00'/
	Integer		InitialTime(2)
	Integer		DeltaTime(2)
	Character	CR /13/, LF /10/, Flush/255/, NUL/0/
	Logical		started
	Character	Network*20,	Get_Network*20

	External	Fing_Complete,	Fing_Abort,  Fing_Multj
	External	Rou_NoNode
	External	Fing_jNA, Fing_NoNode, Fing_NoNet
	External	jnet_Timer_AST
	Integer		Privilege(2) /0,0/
     
c  Set default return status
	jnet_Finger = %Loc(Fing_Complete)
c  check for (reentrant) call from DAE
	If ( IDaemon ) then
	    If ( Node_Type .eq. '*' ) then
		jnet_Finger = %Loc(Fing_NoNode)
	    Else
		jnet_Finger = %Loc(Fing_Multj)
	    End if
	    Return
	End if
     
c  upcase the node name
	next_node=str$upcase(next_node)

c  initialize hook to jnet

c  Turn on SYSPRV privilege
	Privilege(1) =  Prv$M_Sysprv
	Call Sys$Setprv(%Val(1),Privilege,,)
c  Create jnet HOOK
	Mode = 0
	Status = Jan_Hook_Init(Mode,' ')
c  Turn off SYSPRV privilege
	Call Sys$Setprv(,Privilege,,)
c  check status
        If (.Not.Status) then
	    If ( Status .eq. %Loc(Fing_jNA)) then
		jnet_Finger = %Loc(Fing_NoNet)
		Return
	    Else
		Call Lib$Signal(%Val(Status))
		jnet_Finger = %Loc(Fing_Abort)
		Return
	    End if
	End if

c  Format the timeout times
	Call Sys$BinTim(InitialTimeout,InitialTime)
	Call Sys$BinTim(Timeout,DeltaTime)

c  Format the line

c  First, remove any present /IAM information from the RSCS command line
	Ibcz=Index(Net_Command,'/IAM=')
	If (ibcz .eq. 0) Goto 152
	Iibcz=Len(Net_Command)
	Ibczend=Index(Net_Command(Ibcz+1:Iibcz),'/')
	If (Ibczend .eq. 0) Ibczend=Index(Net_Command(Ibcz+1:Iibcz),' ')
	If (Ibczend .eq. 0) Then
	    Ibczend=Iibcz+1
	Else
	    Ibczend=Ibczend+Ibcz
	EndIf
	If (Ibczend .gt. Iibcz) Then
	    Net_Command = Net_Command(:Ibcz-1)
	Else
	    Net_Command = Net_Command(:Ibcz-1)//
	1   Net_Command(Ibczend:Iibcz)//NUL
	EndIf
c  end of logic to remove /IAM stuff from RSCS commands

 152	Line = Net_Command
	Len1 = BTrim(Net_Command)
	If ( Node_Type .eq. 'J' .or. Node_Type .eq. '*' ) then	! jnet and unix
	    Mode = 0
            User = ' '
	Else if ( Node_Type .eq. 'I' ) then		! IBM types a'la Vace
	    Mode = 2
            User = 'FINGER'
	    Line(1:6) = ' '	 	! get rid of "FINGER"
	    If ( Line .eq. ' ' ) Line = '*'
	    Line(Len1+1:Len1+4) = ' MSG' ! this so we get whole output
	    Len1 = Len1 + 4
        End if

c and send it out
c  Turn on WORLD privilege
	Privilege(1) =  Prv$M_World
	Call Sys$Setprv(%Val(1),Privilege,,)
        Status = Jan_Send_Msg(Mode,Next_Node,User,Line(:Len1))
c  Turn off WORLD privilege
	Call Sys$Setprv(,Privilege,,)
        If (.Not.Status) then
	    If ( Status .eq. %Loc(Rou_NoNode) ) then
		jnet_Finger = %Loc(Fing_NoNode)
		Goto 101
	    End if
	    Call Finger_Out_Routine(': link failed]'//CR//LF)
	    Call Lib$Signal(%Val(Status))
	    jnet_Finger = %Loc(Fing_Abort)
	    GoTo 101
	End if
     
c  clear timer flags
	Started = .false.
	TimedOut = .false.
c  Start the initial timeout
	Call Sys$SeTimr(,InitialTime,jnet_Timer_Ast,)
c  get the return messages
10      If ( Jan_Receive_Msg(Mode,Node,User,Line2,Len2) ) Goto 20
15	    If (started) Call Sys$SeTimr(,DeltaTime,jnet_Timer_Ast,)
	    Call Sys$Hiber()
	    Call Sys$CanTim(,)
	    If ( TimedOut ) GoTo 100
	    Goto 10
20	Continue
        If (Len2 .eq. 0) Go to 15
c  See if an intermediate node responded
	If ( Node .ne. Next_Node ) then
	    If ( .not. started ) 
	1   Call Finger_Out_Routine(': link failed]'//CR//LF)
	    Call Finger_Out_Routine(LF//'%FINGER-E-NETERR, error from node '//
	1	Node//' - '//Line2(:Len2)//CR)
	    jnet_Finger = %Loc(Fing_Abort)
	    GoTo 101
	End if
c  Notify requester that link is open
	If ( .not. started ) then
c         Get network name
	    Network = Get_Network('J')
c         finish connection message
	    Call Finger_Out_Routine('.'//
	1	Network(:Btrim(Network))//']'//CR//LF)
	    started = .true.
	Endif
c  Output the line     
	Call Finger_Out_Routine(LF//Line2(:Len2)//CR)
c  Check for end of command
	If ( Index(Str$UpCase(Line2(:Len2)),
	1	'COMMAND COMPLETE').ne.0) 
	2	GoTo 100
c back for next line     
        Goto 10
     
c Here when done
100	Continue
	If ( .not. started ) then
	    Call Finger_Out_Routine(': link failed]'//CR//LF)
	    Call Finger_Out_Routine(LF//'%FINGER-E-TMO, timeout for node '//
	2		Next_Node//CR)
	    jnet_Finger = %Loc(Fing_Abort)
	End if
	Call Finger_Out_Routine(LF)
c  some last minute clean up
101	Call Sys$CanTim(,)
	Call Jan_Remove_Hook
	Return

1001	Format(Z8)

        End

c------------------------------------------------------------------------------
	Integer Function jnet_Timer_Ast

	Logical	TimedOut
	Common	/jnet_Common/ TimedOut

	TimedOut = .True.
	jnet_Timer_Ast = 1
	Call Sys$Wake(,)

	Return

	End

c------------------------------------------------------------------------
	Integer Function Local_Finger(Command,Finger_Out_Routine,Access)

	Character VersionMsg*51
	Common	/Version_Common/ VersionMsg

	External	Finger_Out_Routine
	Integer		Access

	Character	Command*(*)
	Character	Name*31,	Get_PersonalName*31
	Character	Make_Pretty*31
	Character	ComName*12, Get_Username*12, TComName*12
	Character	CR /13/, LF /10/, NUL/0/, Flush/255/
	Integer		SS$_Status, Sys$Waitfr, Btrim
	Integer*2	NewMes
	Integer		LastLogin(2)
	Integer		TestOutput,	FlagProcess
	Logical		ValidID,	Validata_ID,	TestName
	Logical		Get_ID,		Check_Name,	Check_Process
	Logical		LoggedIn,	HeaderWritten
	External lbr$output_help, lib$get_input, lib$put_output
	Integer		Lbr$Ini_Control,Lbr$Open,	Lbr$Get_Help
	Integer		LbrIndex,	LbrFunc,	Lbr$C_Read/1/
	External	Fing_Complete,	Fing_Abort
	External	Do_Help
	Character	CCC*8
	Integer		Privilege(2) /0,0/
	Logical		Wild_Parse
	Integer		NonWild
C ! site-specific: Set minimum non-wildcard characters if wildcards
C are present in the username
	Parameter	Minimum_NonWild = 3

C  Include all GETJPI and flag definitions
	Include		'GETJPIDEF.FOR'
	Include		'FingerFlg.For'
	Include		'Fingerdef.Inc'

	structure /itmlist/
	 union
	  map
	   integer*2 bufferlen
	   integer*2 itemcode
	   integer*4 bufferaddr
	   integer*4 lengthaddr
	  end map
	  map
	   integer*4 endlist
	  end map
	 end union
	end structure

	character*12 username_uai
	include '($uaidef)'

	record /itmlist/ uai_list(2)

	uai_list(1).bufferlen = 12
	uai_list(1).itemcode = uai$_username
	uai_list(1).bufferaddr = %loc(username_uai)
c	uai_list(2).endlist = uai$c_listend
	uai_list(2).endlist = 0

c  Set default return status
	Local_Finger = %Loc(Fing_Complete)
c  initialize a few things
	l_Com = Len(Command)

C  Parse command
	Call Parse_Command(Command(:l_Com),ComName,
	1		TestName,TestOutput,Finger_Out_Routine,
	2		Access)

c  Print version if required
	If ( (TestOutput.and.FlagVersion) .ne. 0 ) Then
	    Call Finger_Out_Routine(LF//VersionMsg//CR)
	EndIf

c Check for wildcards in username
	If ( TestName .and. Wild_Parse( ComName, NonWild) ) Then
	    If ( NonWild .lt. Minimum_NonWild ) Then
		Call Finger_Out_Routine(LF//'%FINGER-E-WILD, too few'//
	1	' non-wild characters in username '//CR//LF//
	2	' \'//ComName(:Btrim(ComName))//'\'//CR)
		Local_Finger = %Loc(Fing_Abort)
		Return
	    EndIf
	EndIf

c Output HELP if required
	If ( (TestOutput.and.FlagHelp) .ne. 0 ) Then
	    Call Header_Brief(Finger_Out_Routine)

	    If ((Access .eq. 2) .or. (Access .eq. 3)) then
	        LbrFunc = Lbr$C_Read
	        ii = Lbr$Ini_Control(LbrIndex,LbrFunc)
	        If ( .not. ii ) then
			ii_stat1=ii
		    Call Lib$Signal(%Val(ii_stat1))
		    Local_Finger = %Loc(Fing_Abort)
		    Return
	        End if
c ! Site-specific: You may change the help library name below (also see
c one other location below).
	        ii = Lbr$Open(LbrIndex,'SYS$HELP:HELPLIB.HLB')	
	        If ( .not. ii ) then
			ii_stat2=ii
		    Call Lib$Signal(%Val(ii_stat2))
		    Call Lbr$Close(LbrIndex)
		    Local_Finger = %Loc(Fing_Abort)
		    Return
	        End if
	        ii = Lbr$Get_Help(LbrIndex,,Do_Help,
	1	    Finger_Out_Routine,'FINGER...') 
	        If ( .not. ii ) then
			ii_stat3=ii
		    Call Lib$Signal(%Val(ii_stat3))
		    Call Lbr$Close(LbrIndex)
		    Local_Finger = %Loc(Fing_Abort)
		    Return
	        End if
	        Call Finger_Out_Routine(LF)
	        Call Lbr$Close(LbrIndex)
	    Else
	    If (Access .eq. 1) then
		ii = Lbr$output_help( lib$put_output,,'FINGER',
c ! Site-specific: You may change the help library name below (also see
c one other location above).
	1	'SYS$HELP:HELPLIB',, lib$get_input)
	    Else
		Call Finger_Out_Routine(LF//'%FINGER-W-UKNMODE, unknown access'
	1	//' mode.'//CR)
	    Endif
	Endif

	If (.not.ii) call exit(ii)
	    Return
	EndIf

	LoggedIn = .False.

C  Set up item list
	I = 1					! 1st item - process name
	II = 1
	ITEM_LIST2(II+IC) =	JPI$_PRCNAM
	ITEM_LIST2(II+BL) =	L_PRCNAM
	ITEM_LIST(I+BA)  =	%LOC(PRCNAM)
	ITEM_LIST(I+RL)  =	%LOC(RL_PRCNAM)
	I = I + 3				! 2nd item - status flags
	II = II + 6
	ITEM_LIST2(II+IC) =	JPI$_STS
	ITEM_LIST2(II+BL) =	L_STS
	ITEM_LIST(I+BA)  =	%LOC(STS)
	ITEM_LIST(I+RL)  =	%LOC(RL_STS)
	I = I + 3				! 3rd item - terminal name
	II = II + 6
	ITEM_LIST2(II+IC) =	JPI$_TERMINAL
	ITEM_LIST2(II+BL) =	L_TERMINAL
	ITEM_LIST(I+BA)  =	%LOC(TERMINAL)
	ITEM_LIST(I+RL)  =	%LOC(RL_TERMINAL)
	I = I + 3				! 4th item - username
	II = II + 6
	ITEM_LIST2(II+IC) =	JPI$_USERNAME
	ITEM_LIST2(II+BL) =	L_USERNAME
	ITEM_LIST(I+BA)  =	%LOC(USERNAME)
	ITEM_LIST(I+RL)  =	%LOC(RL_USERNAME)
	I = I + 3				! 5th item - PID
	II = II + 6
	ITEM_LIST2(II+IC) =	JPI$_PID
	ITEM_LIST2(II+BL) =	L_PID
	ITEM_LIST(I+BA)  =	%LOC(PID)
	ITEM_LIST(I+RL)  =	%LOC(RL_PID)
	I = I + 3				! 6th item - GRP
	II = II + 6
	ITEM_LIST2(ii+IC) = 	JPI$_GRP
	ITEM_LIST2(ii+BL) =	L_PID
	ITEM_LIST(i+BA)  =	%LOC(GRP)
	ITEM_LIST(i+RL)  =	%LOC(RL_GRP)
	I = I + 3				! 7th item - OWNER
	II = II + 6
	ITEM_LIST2(II+IC) =	JPI$_OWNER
	ITEM_LIST2(II+BL) = 	L_OWNER
	ITEM_LIST(I+BA)  =	%LOC(OWNER)
	ITEM_LIST(I+RL)  = 	%LOC(RL_OWNER)
	I = I + 3				! 8th item - STATE
	II = II + 6
	ITEM_LIST2(II+IC) =	JPI$_STATE
	ITEM_LIST2(II+BL) =	L_STATE
	ITEM_LIST(I+BA) =	%LOC(STATE)
	ITEM_LIST(I+RL) =	%LOC(RL_STATE)
	I = I + 3				! 9th item - Global pages
	II = II + 6
	ITEM_LIST2(II+IC) =	JPI$_GPGCNT
	ITEM_LIST2(II+BL) =	L_GPGCNT
	ITEM_LIST(I+BA) =	%LOC(GPGCNT)
	ITEM_LIST(I+RL) =	%LOC(RL_GPGCNT)
	I = I + 3				! 10th item - process pages
	II = II + 6
	ITEM_LIST2(II+IC) =	JPI$_PPGCNT
	ITEM_LIST2(II+BL) =	L_PPGCNT
	ITEM_LIST(I+BA) =	%LOC(PPGCNT)
	ITEM_LIST(I+RL) =	%LOC(RL_PPGCNT)

	I = I + 3				! End of list
	ITEM_LIST(I) = 0

C  Print header
	If ( TestName ) Then
		Call Header_Brief(Finger_Out_Routine)
	Else
		Call Header_Full(TestOutput,Finger_Out_Routine)
	EndIf

C  Call $GetJpi service in loop
	PIDinput = PID_Wildcard
	HeaderWritten = .false.

c  Turn on WORLD privilege
	Privilege(1) = Prv$M_World
	Call Sys$Setprv(%Val(1),Privilege,,)

c  Issue a dummy call to reset the index for jnet versions
	Call Make_Info(0,STS,Prcnam,Username,Terminal,
	1	State, GPgCnt+PPgCnt,HeaderWritten,
	2	TestOutput,FlagProcess)

	DoWhile(Sys$Getjpi(,PIDinput,,Item_List,,,)) ! assume only failure
	    call sys$waitfr()			      ! is SS$_NoMoreProc
	    If ( Check_Process(TestOutput,FlagProcess,
	1	STS,GRP,Owner,Terminal) )
	1   Then
		If (.not. TestName .or.
	1	Check_Name(Username(:Btrim(Username)),
	2		ComName(:Btrim(ComName)) ) ) Then
		    LoggedIn = .true.
	            If ( (TestOutput .and. FlagSort) .ne. 0 ) Then
                        Call Make_Info(PID,STS,Prcnam,Username,Terminal,
	1                  State, GPgCnt+PPgCnt, HeaderWritten,
	2                  TestOutput, FlagProcess)
		    Else
		        Call User_Info(PID,STS,Prcnam,Username,Terminal,
	1		    State, GPgCnt+PPgCnt, HeaderWritten,
	2		    TestOutput,FlagProcess,Finger_Out_Routine)
		    EndIf
c		    Call User_Info(PID,STS,Prcnam,Username,Terminal,
c	1		State, GPgCnt+PPgCnt, HeaderWritten,
c	2		TestOutput,FlagProcess,Finger_Out_Routine)
		EndIf
	    EndIf
	EndDo
c  Ship out the entire user array
        If ( (TestOutput .and. FlagSort) .ne. 0 ) Then
	    Call Show_Info(HeaderWritten, Finger_Out_Routine,
	1                  TestOutput)
	EndIf

c  Turn off WORLD privilege
	Call Sys$Setprv(,Privilege,,)

	If ( .not. TestName .and. .not. LoggedIn )
	1   Call Finger_Out_Routine(LF//' no such jobs.')

200	Continue

C  Check if personal information is requested

	If (testname) then

c  Check to see if Fingeree is in the UAF
c  Turn on SYSPRV privilege
	  Privilege(1) = Prv$M_Sysprv
	  Call Sys$Setprv(%Val(1),Privilege,,)

	  call sys$getuai(,,ComName,uai_list,,,)

c  Turn off SYSPRV privilege
	  Call Sys$Setprv(,Privilege,,)

	  ValidId = (ComName.eq.username_uai)	!ValidId if in UAF
	endif

c  If the Fingeree isn't logged in then
c    If the Fingeree isn't in the UAF see if a match can be found in the
c       Finger Common Block
c    else see if the Finger is in the FCB.

	if (testname.and.(.not.loggedin)) then
	  If (.not.(validId)) then
	    TComName = Get_Username(ComName(:btrim(ComName)),
	1		NMatches,.true.,Finger_Out_Routine)
	    If ( NMatches .eq. 0 ) Call Finger_Out_Routine(LF//
	2		ComName(1:btrim(ComName))//
	3		': no such user.'//CR)
	  Else
	    name = Get_PersonalName(ComName(:Btrim(ComName)))
	    If (name.eq.' ') then
	      Call Finger_Out_Routine(LF//
	1	    ComName(1:btrim(ComName))//
	3	    ' is not logged in.'//CR)
	    Else 
c ! Site-specific: Uncomment next line to pretty up usernames - note that
c this will destroy things like McDonald. Also note this in two more places.
c	      Name = Make_Pretty(Name)
	      Call Finger_Out_Routine(LF//
	1	    ComName(1:btrim(ComName))//
	2	    ' ('//Name(1:btrim(Name))//')'//
	3	    ' is not logged in.'//CR)
	    EndIf
	  EndIf
	Endif

C  Print out Mail info and Plan if user is valid

	IF (TestName .and. ValidID ) Then
	    Call Personal_Info(ComName,	LoggedIn, 
	1	TestOutput,Finger_Out_Routine,Access)
	EndIf

C  1 last line-feed at end
	Call Finger_Out_Routine(LF)

	Return

1000	Format(A)

	END


c---------------------------------------------------------------------------
	Subroutine Parse_Command(Command,ComName,
	1		TestName,TestOutput,Finger_Out_Routine,
	2		Access)

c  Note: this routine uses a command definition table which is created
c  by the SET COMMAND command from the file FINGERCLI.CLD.  Changes
c  to qualifiers etc. should be reflected both here and in that file.

	Include		'GETJPIDEF.FOR'
	Include		'FingerFlg.For'

c ** Site-Specific
c  Uncomment next for BYPASS logic
	COMMON /BCZCOM/ FLAG_BYPASS
	LOGICAL FLAG_BYPASS
c end of bypass logic

	Character	Command*(*),	ComName*12
	Character	CR /13/, LF /10/, NUL/0/, SP/' '/

	Logical		TestName 
	Integer		TestOutput

	External	FingerCli_Table
	External	Finger_Out_Routine
	Integer		Access
	Integer		Cli$Dcl_Parse,	Cli$Get_Value,	Cli$Present
	Integer		Kludge_Cli$Dcl_Parse, SortField, l_SortType
	Integer		Btrim, l_WhoAmI

	Character	CCC*8, SortType*20, WhoAmI*32

	Common	/Sorter/ SortType, SortField, WhoAmI, l_WhoAmI

	Character	Str$UpCase*32

	TestName = .true.
	TestOutput = 0

	l_Com = Len(Command)
c  In V4.0 the next line would corrupt the stack
c  the Kludge... routine pads the stack first for protection
c	Call Cli$Dcl_Parse(Command(:l_Com),FingerCli_Table)
	Call Kludge_Cli$Dcl_Parse(Command(:l_Com),FingerCli_Table)
	ComName = ' '
	Call Cli$Get_Value('FINGERNAME',ComName)
	If ( ComName .eq. ' ' ) TestName = .false.

c  Check for the /IAM qualifier before trying JPI, but only on jnet or DECnet
	If ( (Access .eq. 2) .or. (Access .eq. 3)) Then
	    If ( Cli$Present('IAM') ) Then
		TestOutput = TestOutput .or. FlagIAM
		Call Cli$Get_Value('IAM', WhoAmI)
		l_WhoAmI = Btrim(WhoAmI)
		WhoAmI = Str$UpCase(WhoAmI)
		If ( ComName .eq. '.' ) 
	1	    ComName = WhoAmI(2:Index(WhoAmI,'~')-1)
	    EndIf
	Endif

	If ( ComName .eq. '.' ) then
	    I = 1
	    II = 1
	    ITEM_LIST2(II+IC) =	JPI$_USERNAME
	    ITEM_LIST2(II+BL) =	L_USERNAME
	    ITEM_LIST(I+BA)  =	%LOC(USERNAME)
	    ITEM_LIST(I+RL)  =	%LOC(RL_USERNAME)
	    ITEM_LIST(I+3) = 0		! End of list
	    Call Sys$Getjpiw(,,,Item_List,,,)
	    ComName = Username
	End if

c  Set flags from command qualifiers
	If ( Cli$Present('INTERACTIVE') ) 
	1	TestOutput = TestOutput .or. FlagInteractive
	If ( Cli$Present('BATCH') )
	1	TestOutput = TestOutput .or. FlagBatch
	If ( Cli$Present('SUBPROCESS') )
	1	TestOutput = TestOutput .or. FlagSubprocess
	If ( Cli$Present('NETWORK') )
	1	TestOutput = TestOutput .or. FlagNetwork
	If ( Cli$Present('SYSTEM') )
	1	TestOutput = TestOutput .or. FlagSystem
	If ( Cli$Present('ALL') )
	1	TestOutput = TestOutput .or. FlagAll
	If ( Cli$Present('HELP') )
	1	TestOutput = TestOutput .or. FlagHelp
C ** Site-Specific
C uncomment next for bypass switch
		FLAG_BYPASS = .FALSE.				! BCZ
	If ( Cli$Present('BYPASS') )				! BCZ
	1	FLAG_BYPASS = .TRUE.				! BCZ
c end of bypass logic

c  If nothing else on, turn on FlagInteractive. Note this is a last-chance
c  trap, the defaults should be changed by editing the .CLD file.
	If ( TestOutput .eq. 0 )
     1   TestOutput = FlagInteractive

c  Miscellaneous stuff
	If ( Cli$Present('SORT') ) Then
	    TestOutput = TestOutput .or. FlagSort
	    Call Cli$Get_Value('SORT', SortType)
	    l_SortType = Btrim(SortType)
	    If (index('LAST_NAME', SortType(:l_SortType)) .eq. 1) then
		SortField = 0
	    Else If (index('USER_NAME', SortType(:l_SortType)) .eq. 1) then
		SortField = 1
	    Else If (index('PROCESS_NAME', SortType(:l_SortType)) .eq. 1) then
		SortField = 2
	    Else If (index('PID', SortType(:l_SortType)) .eq. 1) then
		SortField = 3
	    Else If (index('TERMINAL', SortType(:l_SortType)) .eq. 1) then
		SortField = 4
	    Else If (index('LOGIN_TIME', SortType(:l_SortType)) .eq. 1) then
		SortField = 5
	    Else If (index('IMAGE', SortType(:l_SortType)) .eq. 1) then
		SortField = 6
	    Else If (index('CPU_TIME', SortType(:l_SortType)) .eq. 1) then
	        SortField = 7
	    Else If ((l_SortType .eq. 1) .and. (SortType(1:1) .eq. SP)) then
		SortType = 'Default'
		SortField = 1
	    Else
		Call Finger_Out_Routine(LF//'%FINGER-W-UKNSRT, unknown sort '
	1	    //'field '//CR//LF//' \'//
	2	    SortType(:l_SortType)//'\'//CR)
		SortType = 'Default'
		SortField = 1
	    EndIf
	EndIf
	If ( Cli$Present('VERSION') )
	1	TestOutput = TestOutput .or. FlagVersion
	If ( Cli$Present('MESSAGE') )
	1	TestOutput = TestOutput .or. FlagMessage
c  individual's stuff
	If ( Cli$Present('PLAN') )
	1	TestOutput = TestOutput .or. FlagPlan
	If ( Cli$Present('MAIL') )
	1	TestOutput = TestOutput .or. FlagMail
	If ( Cli$Present('AREA') )
	1	TestOutput = TestOutput .or. FlagArea
	If ( Cli$Present('DISSUBJREP') )
	1	TestOutput = TestOutput .or. FlagDisSubj
c  display qualifiers
	If ( Cli$Present('PID') )
	1	TestOutput = TestOutput .or. FlagPid
	If ( Cli$Present('PROCESSNAME') )
	1	TestOutput = TestOutput .or. FlagProcessname
	If ( Cli$Present('USERNAME') )
	1	TestOutput = TestOutput .or. FlagUsername
	If ( Cli$Present('PERSONALNAME') )
	1	TestOutput = TestOutput .or. FlagPersonalName
	If ( Cli$Present('IMAGENAME') )
	1	TestOutput = TestOutput .or. FlagImagename
	If ( Cli$Present('TERMINAL') )
	1	TestOutput = TestOutput .or. FlagTerminal
	If ( Cli$Present('LOGINTIME') )
	1	TestOutput = TestOutput .or. FlagLoginTime
	If ( Cli$Present('CPUTIME') )
	1	TestOutput = TestOutput .or. FlagCpuTime
	If ( Cli$Present('STATE') )
	1	TestOutput = TestOutput .or. FlagState
	If ( Cli$Present('SIZE') )
	1	TestOutput = TestOutput .or. FlagSize
	If ( Cli$Present('IDLETIME') )
	1	TestOutput = TestOutput .or. FlagIdleTime
	If ( Cli$Present('LOCATION') )
	1	TestOutput = TestOutput .or. FlagLocation
	If ( Cli$Present('TTTYPE') )
	1	TestOutput = TestOutput .or. FlagTTType
	If ( Cli$Present('SWAPPED') )
	1	TestOutput = TestOutput .or. FlagSwapped
c  test for /FULL, it turns all displays on
	If ( Cli$Present('FULL') )
	1	TestOutput = TestOutput .or. FlagFull
c  test for /DISMAILREP, it forces mail display off
	If ( Cli$Present('DISMAILREP') )
	1	TestOutput = TestOutput .and. not(FlagMail)

	Return
	End

c---------------------------------------------------------------------------
	Logical Function Do_Help(Line,HelpFlags,Out_Routine,Level)

	External	Out_Routine

	Character	CR /13/, LF /10/, NUL/0/
	Character	Line*(*),	Space*80/' '/
	Integer		HelpFlags,	Level

	l_Line = Len(Line)

	If (l_Line .gt. 0) then
	    Call Out_Routine(LF//Space(:5*(Level-1)+1)//Line(:l_Line)//CR)
	Else
	    Call Out_Routine(LF//Space(:5*(Level-1)+1)//CR)
	Endif

	Do_Help = .true.
	Return

	End

c---------------------------------------------------------------------------
	Logical Function Check_Process(TestOutput,FlagProcess,
	1				STS,GRP,Owner,Terminal)

	Character	Terminal*8
	Character	NUL/0/

	Integer		STS,	GRP,	Owner
	Integer		Pcb$m_Batch/Z00004000/
	Integer		Pcb$m_Netwrk/Z00200000/

	Integer		FlagProcess
	Integer		TestOutput

	Include		'FingerFlg.For'

	Parameter	SysGRP = 8

	FlagProcess = 0
	Check_Process = .true.

c  set process flags
	If ( Terminal(1:1) .ne. NUL ) Then
	    FlagProcess = FlagProcess .or. FlagInteractive
	ElseIf ( (STS.and.Pcb$m_Batch) .ne. 0 ) Then
	    FlagProcess = FlagProcess .or. FlagBatch
	ElseIf ( (STS.and.Pcb$m_Netwrk) .ne. 0 ) Then
	    FlagProcess = FlagProcess .or. FlagNetwork
	    If ( GRP .le. SysGRP )
	1	FlagProcess = FlagProcess .or. FlagSystem
	ElseIf ( Owner .ne. 0 ) Then
	    FlagProcess = FlagProcess .or. FlagSubprocess
	    If ( GRP .le. SysGRP )
	1	FlagProcess = FlagProcess .or.  FlagSystem
	ElseIf ( GRP .le. SysGRP ) then
	    FlagProcess = FlagProcess .or. FlagSystem
	Else
	EndIf

c  First check for "/ALL"
	If ( (TestOutput.and.FlagAll) .ne. 0 ) Return

c Check process against flags
	If ( (TestOutput.and.FlagProcess) .eq. 0 ) 
	1	Check_Process = .false.
	Return
	End

c---------------------------------------------------------------------------
	Subroutine Header_Full(TestOutput,Finger_Out_Routine)

	include		'($syidef)'
	include		'($prdef)'
	Include		'FingerCom'
	Include		'FingerFlg'
	Include		'Finger_Context'
	Integer		TestOutput

	External	Finger_Out_Routine

	Integer		
	1		OutboundLinkUnit, 
	2		UafUnit,
	3		ScratchUnit

	Common	/IO_Units/ 
	1		OutboundLinkUnit,
	2		UafUnit,
	3		ScratchUnit


c  Site-specific: load pseudodevice gives load averages.
	Parameter	LoadDevice = 'LAV0:'
c	Parameter	LoadDevice = '$$VMS_LOAD_AVERAGE:'	! alternate

	Integer		SS$_Status
	External	SS$_NoTran
	Integer		Sys$AscTim, Sys$GetTim, Sys$TrnLnm, Sys$GetSYIW
	Integer		Btrim
	Integer		TRN_ItemList(4)
	Integer*2	TRN_ItemList2(8)
	Equivalence	(TRN_ItemList,TRN_ItemList2)
	Integer		TRN$_String /Z00000002/
	Character*32	CPU_Type
	Integer		l_CPU, l_Vrsn
	Character	System_Version*8
	Character	Node*32
	Character	AscTime*23, AscSince*23, Make_Pretty*23
	Character	AscDelsince*23 ! gce retrofit
	Character	Day_OfTheWeek*9, Today*9, Upday*9
	Character	MsgLine*132
	Real		Load1,	load5,	load15

	External	Sys$gl_IJobCnt
	External	Sys$gl_BJobCnt
	External	Exe$gl_AbsTim
	External	Priv_UserOpen
	Integer*2	Get_w_Val
	Integer		Get_l_Val
	Integer		Ijobs, Bjobs 
	Integer		UpTime(2), SysTime(2), UpSince(2), UpDelta(2)

	Character	NUL/0/, LF/10/, CR /13/, SP /' '/
	Character	Temp*23
	Logical		LoadAvailable	/.false./
	Logical		WroteSomething	/.false./

	structure /itmlist/
	 union
	  map
	   integer*2 bufferlen
	   integer*2 itemcode
	   integer*4 bufferaddr
	   integer*4 lengthaddr
	  end map
	  map
	   integer*4 endlist
	  end map
	 end union
	end structure

	record /itmlist/ syi_list(3)

C  Get node name, system stuff, time, load averages etc., print header

c  Set up item list for GetSYI and call it. It returns a four character
c  cpu type, e.g., 2000, V780, 8300, 8530, 8700, 8800...

	syi_list(1).bufferlen = 4
	syi_list(1).itemcode = syi$_hw_name
	syi_list(1).bufferaddr = %loc(CPU_Type)
	syi_list(1).bufferlen = len(CPU_Type)
	syi_list(1).lengthaddr = %loc(L_cpu)
	syi_list(2).bufferlen = 8
	syi_list(2).itemcode = syi$_Version
	syi_list(2).bufferaddr = %loc(System_Version)
	syi_list(2).lengthaddr = %loc(l_vrsn)
	syi_list(3).endlist = syi$c_listend

	Call Sys$GetSYIW(,,,SYI_list,,,)

c Rip off the V if it has one (V7xx)

C	If (CPU_Type(1:1).eq.'V') CPU_Type(1:1) = ' '

c Fix up the CPU type, replace "MicroVAX " by "uVAX-", "VAXstation " by
c "VS-" and "VAXserver" by "Vs-"
	If (CPU_Type(1:9) .eq. 'MicroVAX ') Then
	    CPU_Type = 'VAX-' // CPU_Type(10:L_cpu)
	ElseIf (CPU_Type(1:11) .eq. 'VAXstation ') Then
	    CPU_Type = 'VS-' // CPU_Type(12:L_cpu)
	ElseIf (CPU_Type(1:10) .eq. 'VAXserver ') Then
	    CPU_Type = 'Vs-' // CPU_Type(11:L_cpu)
	Endif
	Call Str$Trim( CPU_Type, CPU_Type, L_cpu)
	If ( CPU_Type(L_cpu-5:L_cpu) .eq. 'Series') Then
	    L_cpu = L_cpu - 6
c	    If (CPU_Type(L_cpu-1:L_cpu) .eq. '00')
c	1	CPU_Type(L_cpu-1:L_cpu) - 'xx'
	EndIf
	Call Str$Trim( CPU_Type, CPU_Type(1:L_cpu), L_cpu)

	TRN_ItemList2(1) = 8
	TRN_ItemList2(2) = TRN$_String
	TRN_ItemList(2) = %Loc(DECnet_Node)
	TRN_ItemList(3) = %Loc(L_node)
	TRN_ItemList2(7) = 0
	TRN_ItemList2(8) = 0

	SS$_Status = Sys$TrnLnm(,'LNM$SYSTEM_TABLE',
	1	'SYS$NODE', 1, TRN_ItemList)

	If (( Net$C_Local_Host_Name(1:1) .eq. ' ' ) .OR.
	1   ( Net$C_Local_Host_Name(1:1) .eq. NUL)) Then
	    If ( SS$_Status .eq. %LOC(SS$_Notran) ) Then
		Node = 'Finger'
	    Else
		Node = DECnet_Node(:l_Node-2)
	    EndIf
	Else
	    Node = Net$C_Local_Host_Name		! use set value
	End if
	l_Node = Btrim(Node)
	Call Sys$AscTim(,AscTime,,)				! Time now
	AscTime = Make_Pretty(AscTime)
	Today = Day_OfTheWeek(%Val(0))
	UpTime(1) = 0
	UpTime(2) = 0
	UpTime(1) = Get_l_Val(Exe$gl_AbsTim)			! up time (sec)
	UpDelta(1) = 0
	UpDelta(2) = 0
	Call Lib$EMul(10000000,UpTime,0,UpTime)			! 64 bit format
	Call Sys$GetTim(SysTime)
	Call Lib$Subx(SysTime,UpTime,UpSince)
	Call Sys$AscTim(,AscSince,UpSince,)			! Up since
	AscSince = Make_Pretty(AscSince)
c  get delta time to ASCII format ... then shift out spaces  ! gce retrofit
	Call Lib$Subx(Updelta,UpTime,Updelta) ! gceretro
	Call Sys$AscTim(,Ascdelsince,updelta,) !gce retro
	i_nospace = 1 ! gce retrofit
	do while (ascdelsince(i_nospace:i_nospace) .eq. ' ')  !gce retro
		i_nospace = i_nospace + 1  !gce retro
	end do
	Upday = Day_OfTheWeek(UpSince)
	Ijobs = Get_w_Val(Sys$gl_IJobCnt)			! # users
	Bjobs = Get_w_Val(Sys$gl_BJobCnt)			! # batch

c  ! Site-specific: This is the load average pseudo-device.  If not
c  available, omit this section.  Or leave it and it will still be OK.
	Open(Unit=ScratchUnit,
	1	File=LoadDevice,
	2	Type='NEW',
	3	RecordSize=36,
	4	Err=101)
	Read(ScratchUnit,2000,Err=101) Load1, Load5, Load15
	Close(Unit=ScratchUnit)
	LoadAvailable = .true.
101	Continue

C  Print full header
C		Organization name if defined
	If ( Net$C_Organization .ne. ' ' )
	1	Call Finger_Out_Routine(
	2	LF//
	3	Net$C_Organization(:BTrim(Net$C_Organization))//
	4	CR)
C		1st full line
	Call Finger_Out_Routine(LF//
	1			Node(:l_Node)//' '//
	2			CPU_Type(:Btrim(CPU_Type))//', '//
	4			'VMS '//
	5		 	System_Version(:Btrim(System_Version))//
	6			', '//
	7			Today(:Btrim(Today))//', '//
	8			AscTime(:17)//', ')
	If ( Ijobs .eq. 1 ) then
	    Write(Temp,1001)	Ijobs, ' User, '
	Else
	    Write(Temp,1001)	Ijobs, ' Users, '
	End if
	Call Finger_Out_Routine(Temp(:10))
	Write(Temp,1001)	Bjobs, ' Batch.'
	Call Finger_Out_Routine(Temp(:9))
	Call Finger_Out_Routine(CR)
c		2nd line
	Call Finger_Out_Routine(LF//
	1			'Uptime '//Ascdelsince(i_nospace:10)//
	2			', since '//
	3			Upday(:Btrim(Upday))//', '//
	4			AscSince(:17))
	If ( LoadAvailable ) Then
	    Write(Temp,1002) 	', Load: '	! Site-specific
	1			,Load1 		! Site-specific
	2    			,Load5		! Site-specific
	3    			,Load15		! Site-specific
c	    Call Finger_Out_Routine(Temp(:13))
	    Call Finger_Out_Routine(Temp)
	EndIf
	Call Finger_Out_Routine(CR//LF)

C  Print message if any
	If ( (TestOutput.and.FlagMessage) .ne. 0 ) then
	    Open	(Unit=ScratchUnit,
	1	File='FINGER$MESSAGE:',
c	2	UserOpen = Priv_UserOpen, ! Uncomment this to prevent
c					! redirection of message lognamm
	2	Type='OLD',
	3	ReadOnly,
	4	Shared,
	5	Err=201)
	    DoWhile(.True.)		! Loop through message file
		Read(ScratchUnit,3000,Err=201,End=200) l_Msg, MsgLine
		Call Finger_Out_Routine(LF//MsgLine(:l_Msg)//CR)
		WroteSomething = .True.
	    EndDo
200	    Call Priv_Close(ScratchUnit)
201	    Continue
C	    1 blank line if there was any message
	    If ( WroteSomething ) Call Finger_Out_Routine(LF//CR)
	EndIf

	Return

1001	Format(I2,A)
1002	Format(A,3F5.2)

2000	Format(3A4)

3000	Format(Q,A)	

	End


c---------------------------------------------------------------------------
	Subroutine Header_Brief(Finger_Out_Routine)

	Include		'Fingercom'
	Include		'Finger_Context'

	External	Finger_Out_Routine

	Integer		TRN$_String /Z00000002/
	Integer		TRN_ItemList(4)
	Integer*2	TRN_ItemList2(8)
	Equivalence	(TRN_ItemList,TRN_ItemList2)

	Integer		SS$_Status
	External	SS$_NoTran
	Integer		Sys$AscTim, Sys$GetTim, Sys$TrnLnm
	Integer		Btrim
	Character	Node*9
	Character	Day_OfTheWeek*9,	Today*9
	Character	AscTime*23, Make_Pretty*23

	Character	NUL/0/, LF/10/, CR /13/, SP /' '/

C  Get node name, system time
	TRN_ItemList2(1) = 8
	TRN_ItemList2(2) = TRN$_String
	TRN_ItemList(2) = %Loc(DECnet_Node)
	TRN_ItemList(3) = %Loc(L_node)
	TRN_ItemList2(7) = 0
	TRN_ItemList2(8) = 0

	SS$_Status = Sys$TrnLnm(,'LNM$SYSTEM_TABLE',
	1	'SYS$NODE', 1, 	TRN_ItemList)

	If (( Net$C_Local_Host_Name(1:1) .eq. ' ' ) .OR.
	1   ( Net$C_Local_Host_Name(1:1) .eq. NUL)) Then
	    If ( SS$_Status .eq. %LOC( SS$_Notran) ) Then
		Node = 'Finger'
	    Else
		Node = DECnet_Node(:l_Node-2)
	    EndIf
	Else
	    Node = Net$C_Local_Host_Name		! use set value
	End if
	l_Node = Btrim(Node)
	Call Sys$AscTim(,AscTime,,)			! Time now
	AscTime = Make_Pretty(AscTime)
	Today = Day_OfTheWeek(%Val(0))

C  Print brief header
	Call Finger_Out_Routine(LF//
	1			Node(:l_node)//
	2			' VAX/VMS, '//
	3			Today(:Btrim(Today))//', '//
	4			AscTime(:17)//
	5			CR//LF)

	Return
	End

c---------------------------------------------------------------------------
	Logical	Function Check_Name(Username,ComName)

c  Check if the Username of a process matches the name from the
c  input command.

	Logical		Wild_Match
	Character	Username*(*), ComName*(*)

	Check_Name = .false.

	If ( Username .eq. ComName ) Then
	    Check_Name = .true.
	    Return
	EndIf

c  Check for wild-card
	Check_Name = Wild_Match(ComName,Username)

	Return
	End


c-----------------------------------------------------------------------------
	Subroutine User_Info(PID,STS,Prcnam,Username,Terminal,
	1	State, PgCnt, HeaderWritten,
	2	TestOutput,FlagProcess,Finger_Out_Routine)

	External	Finger_Out_Routine

	Integer		
	1		OutboundLinkUnit, 
	2		UafUnit,
	3		ScratchUnit

	Common	/IO_Units/ 
	1		OutboundLinkUnit,
	2		UafUnit,
	3		ScratchUnit
	
	Include		'GETJPIDEF'
	Include		'FingerFlg'
	Include		'Fingerdef.Inc'

	Integer		TestOutput,	FlagProcess
	Integer		CPU_Min,	CPU_Sec
	Character	PID_String*8
	Character	Location*25,	Get_Location*25
	Character	Make_Pretty*31,	Filter_Control_Chars*15
	Character	Name*31,	Get_PersonalName*31
	Character	Image*20,	Get_Image*20
	Character	Time_String*11,	Login_Time*5
	Character	CPU_Time*6,	Idle_Time*5,	Get_Idle*5
	Character	TTType*25,	TermOrType*8
	Character	Quename*18
	Character	CR /13/, LF /10/, NUL /0/
	Integer		PgCnt
	Character*5	States(15) /
	1	'ColPg','MWait',' CEF ',' PFW ',' LEF ',' LEFO',' Hib ',
	1	' HibO',' Susp','SuspO',' FPg ',' Com ',' ComO',' Cur ',
	1	'     '/
	Integer		LEF_State /5/, Blank_State /15/
	Integer		State_COMO /13/, State_HIBO /8/
	Integer		State_LEFO /6/, State_SUSPO /10/
	Character*5	Size
	Logical		HeaderWritten 
	Integer		Privilege(2) /0,0/
	character*31	get_queue, queue_name

c  ! site-specific
c  Note - this routine is set up so you can select the information
c  you desire printed.  Set the defaults for your site in the FINGERCLI.CLD
c  file.  The user can override these with explicit qualifiers to the
c  FINGER command. If all fields are selected the line is 135 characters long
c  (3 more for long terminal line number).  You could vary the size of certain 
c  fields (e.g. PERSONALNAME or LOCATION) if you wanted to customize things
c  further.  I use only 15 out of 25 characters of the location, and the TTType
c  may wrap.  The size of these could be varied.  I would never use certain 
c  combinations together, e.g. PROCESSNAME and USERNAME (they are practically
c  redundant) - but to each his own. (USERNAME is useful for MAIL and PHONE, 
c  PROCESSNAME is unique.) 		- Rg

c  first some petty preprocessing
	If ( (Testoutput.and.FlagPID) .ne. 0 ) then
	    Write(PID_String,1001) PID
	    Do II = 1,8
		If ( PID_String(II:II) .eq. ' ') PID_String(II:II) = '0'
	    End do
	End if
	Call NULToSP(Terminal,8)
	If ( (Testoutput.and.FlagProcessname) .ne. 0 ) then
	    Call NULToSP(Prcnam,15)
	    Prcnam = Filter_Control_Chars(Prcnam)
	End if
	If ( Username(1:1) .eq. NUL ) Then
	    If ( Prcnam(1:4) .eq. 'NULL' ) Then
		Username = '<Null>'
	    Else If ( Prcnam(1:7) .eq. 'SWAPPER' ) Then
		Username = '<Swapper>'
	    Else
		Username = ' '
	    EndIf
	EndIf
	If ( (Testoutput.and.FlagPersonalName) .ne. 0 )
c ! site-specifc: choose one of the two following lines
	1   Name = Get_PersonalName(Username)
c	1   Name = Make_Pretty(Get_PersonalName(Username))
c  only get P1 stuff for inswapped processes unless asked otherwise
	If ( (Testoutput.and.FlagSwapped) .ne. 0 ) then
	    Image = Make_Pretty(Get_Image(PID,LoginTim,CPUTim))
	Else
           IF (	State .ne. State_COMO .and.
	1	State .ne. State_HIBO .and.
	2	State .ne. State_LEFO .and.
	3	State .ne. State_SUSPO) then
		Image = Make_Pretty(Get_Image(PID,LoginTim,CPUTim))
	    Else
		Image = '<swapped>'
		Logintim(1)= 0
		Logintim(2)= 0
		CPUTim=      0
	    End if
	End if
c  If in DCL and LEF state, don't print STATE. (keep picture cleaner)
	If (Image.eq.'$' .and. State.eq.LEF_State ) State = Blank_State
	Call Sys$Asctim(,Time_String,LoginTim,%Val(1))
	Login_Time = Time_String(1:5)
c  convert CPU time to min and sec
	CPU_Sec = CPUTim/100
	CPU_Min = CPU_Sec/60
	CPU_Sec = CPU_Sec - (60*CPU_Min)
	If ( CPU_Min .le. 999 ) then
	    Write(CPU_Time,1002) CPU_Min, CPU_Sec
	    If ( CPU_Time(5:5) .eq. ' ' ) CPU_Time(5:5) = '0'
	Else
c  if more than 999 min, omit seconds
	    Write(CPU_Time,10021) CPU_Min
	Endif
c  scratch Login and CPU time for outswapped processes
	If ( Image(1:1) .eq. '<' ) Login_Time = ' --- '
	If ( Image(1:1) .eq. '<' ) CPU_Time = '  --- '
	Write(Size,1003) PgCnt
	Location = Get_Location(Terminal,TTType,PID)
c  If not an interactive process, replace terminal by process type
	TermOrType = Terminal
	If ( (FlagProcess .and. FlagBatch) .ne. 0 ) Then
	    TermOrType = ' Bat '
	    TTType = ' '
	ElseIf ( (FlagProcess .and. FlagNetwork) .ne. 0 ) Then
	    TermOrType = ' Net '
	    TTType = ' '
	ElseIf ( (FlagProcess .and. FlagSubProcess) .ne. 0 ) Then
	    TermOrType = ' Sub '
	    TTType = ' '
	ElseIf ( (FlagProcess .and. FlagSystem) .ne. 0 ) Then
	    TermOrType = ' Sys '
	    TTType = ' '
	ElseIf ( TermOrType .eq. ' ' ) Then
	    TermOrType = ' Det '
	    TTType = ' '
	EndIf
c  Turn on CMKRNL privilege
	Privilege(1) = Prv$M_Cmkrnl
	Call Sys$Setprv(%Val(1),Privilege,,)
	If ( (Testoutput.and.FlagIdleTime) .ne. 0 )
	1	Idle_Time = Get_Idle(Terminal)
c  Turn off CMKRNL privilege
	Call Sys$Setprv(,Privilege,,)
	If ( (FlagProcess.and.FlagSubprocess) .ne. 0 ) then
	    Location = '- Subprocess -'
	    TTType = ' '
	Else If ( (STS.and.Pcb$m_Batch) .ne. 0 ) Then
c  Turn on SYSPRV privilege
	    Privilege(1) = Prv$M_Sysprv
	    Call Sys$Setprv(%Val(1),Privilege,,)
c  get job controller information
	    queue_name = get_queue(pid)
c  Turn off SYSPRV privilege
	    Call Sys$Setprv(,Privilege,,)
	    If (queue_name .eq. ' ') Then
		Location = 'Q.<Unknown>'
	    Else
		Location = 'Q.'//queue_name
	    EndIf
	    TTType = ' '
	End If
c  Column headings
	If ( .not. HeaderWritten ) Then
	    Call Finger_Out_Routine(LF)
	    If ( (Testoutput.and.FlagPID) .ne. 0 )
	1	Call Finger_Out_Routine('PID      ')
	    If ( (Testoutput.and.FlagProcessname) .ne. 0 )
	1	Call Finger_Out_Routine('Process         ')
	    If ( (Testoutput.and.FlagUsername) .ne. 0 )
	1	Call Finger_Out_Routine('Username     ')
	    If ( (Testoutput.and.FlagPersonalName) .ne. 0 )
	1	Call Finger_Out_Routine('Personal name        ')
	    If ( (Testoutput.and.FlagImagename) .ne. 0 )
	1	Call Finger_Out_Routine('Program   ')
	    If ( (Testoutput.and.FlagTerminal) .ne. 0 )
c	1	Call Finger_Out_Routine('Term ')	! short terminal name
	1	Call Finger_Out_Routine('Term     ')	! long terminal name
	    If ( (Testoutput.and.FlagLoginTime) .ne. 0 )
	1	Call Finger_Out_Routine('Login ')
	    If ( (Testoutput.and.FlagCPUTime) .ne. 0 )
	1	Call Finger_Out_Routine('  CPU  ')
	    If ( (Testoutput.and.FlagIdleTime) .ne. 0 )
	1	Call Finger_Out_Routine(' Idle ')
	    If ( (Testoutput.and.FlagState) .ne. 0)
	1	Call Finger_Out_Routine('State ')
	    If ( (Testoutput.and.FlagSize) .ne. 0)
	1	Call Finger_Out_Routine(' Size ')
	    If ( (Testoutput.and.FlagLocation) .ne. 0 )
	1	Call Finger_Out_Routine('Location         ')
	    If ( (Testoutput.and.FlagTTType) .ne. 0 )
	1	Call Finger_Out_Routine('TT Type')
	    Call Finger_Out_Routine(CR)
	    HeaderWritten = .true.
	EndIf

c  Write out line of user information

	Call Finger_Out_Routine(LF)
	If ( (Testoutput.and.FlagPID) .ne. 0 )
	1	Call Finger_Out_Routine(PID_String//' ')
	If ( (Testoutput.and.FlagProcessname) .ne. 0 )
	1	Call Finger_Out_Routine(Prcnam//' ')
	If ( (Testoutput.and.FlagUsername) .ne. 0 )
	1	Call Finger_Out_Routine(Username//' ')
	If ( (Testoutput.and.FlagPersonalName) .ne. 0 )
	1	Call Finger_Out_Routine(Name(1:20)//' ')
	If ( (Testoutput.and.FlagImagename) .ne. 0 )
c ** Site-Specific - length of image field (also do the header above...)
	1	Call Finger_Out_Routine(Image(1:9)//' ')
	If ( (Testoutput.and.FlagTerminal) .ne. 0 )
c	1	Call Finger_Out_Routine(TermOrType(1:4)//' ')	! short
	1	Call Finger_Out_Routine(TermOrType(1:8)//' ')	! long
	If ( (Testoutput.and.FlagLoginTime) .ne. 0 )
	1	Call Finger_Out_Routine(Login_Time//' ')
	If ( (Testoutput.and.FlagCPUTime) .ne. 0 )
	1	Call Finger_Out_Routine(CPU_Time//' ')
	If ( (Testoutput.and.FlagIdleTime) .ne. 0 )
	1	Call Finger_Out_Routine(Idle_Time//' ')
	If ( (Testoutput.and.FlagState) .ne. 0)
	1	Call Finger_Out_Routine(States(State)//' ')
	If ( (Testoutput.and.FlagSize) .ne. 0)
	1	Call Finger_Out_Routine(Size//' ')
	If ( (Testoutput.and.FlagLocation) .ne. 0 )
	1	Call Finger_Out_Routine(Location(1:16)//' ')
	If ( (Testoutput.and.FlagTTType) .ne. 0 )
	1	Call Finger_Out_Routine(TTType(1:8))
	Call Finger_Out_Routine(CR)

	Return

1000	Format(A)
1001	Format(Z8)
1002	Format(I3,':',I2)
10021	Format(I6)
1003	Format(I5)

	End

c--------------------------------------------------------------------
	Subroutine Personal_Info(UserName, LoggedIn, 
	1	TestOutput, Finger_Out_Routine, Access)

c   Routine to type a user's Mail info and PLAN file, given his name.
c   Adapted from routine "Type_Plan" written at CMU PSYA::
c  ! Site-specific note:  If you want different names for plan files,
c  change or add to the following list

	Include	 'Fingerdef.inc'
	Include	 'Finger_Context'
	Include	 'FingerFlg'
c	Include  '($FORIOSDEF)'

c ** Site-Specific
c uncomment for BYPASS switch logic
	COMMON /BCZCOM/ FLAG_BYPASS
	LOGICAL FLAG_BYPASS
c end of bypass logic

	Parameter PlanFileName1 = 'FINGER.PLN'
	Parameter PlanFileName2 = 'PLAN.'       ! compatible with EUNICE
c	Parameter PlanFileName3 = 'anything'    ! your choice
	External	Finger_Out_Routine
	Integer		Access
	Integer		ii, FindCount, FindContext
	Character	FindTemplate*64, FindResult*64
	Integer		RMS$_Normal/65537/

	Integer
	1	       OutboundLinkUnit,
	2	       UafUnit,
	3	       ScratchUnit
	Common  /IO_Units/
	1	       OutboundLinkUnit,
	2	       UafUnit,
	3	       ScratchUnit

	Byte		UAF_Record(1:UAF$K_Length)
	Byte		UAF_L_DefDev
	Equivalence	(UAF_L_DefDev,UAF_Record(Uaf$K_DefDev))
	Character	UAF_DefDev*(UAF$S_DefDev)
	Equivalence	(UAF_DefDev,UAF_Record(Uaf$T_DefDev))
	Byte		UAF_L_DefDir
	Equivalence	(UAF_L_DefDir,UAF_Record(Uaf$K_DefDir))
	Character	UAF_DefDir*(UAF$S_DefDir)
	Equivalence	(UAF_DefDir,UAF_Record(Uaf$T_DefDir))
	Integer		UAF_Flags
	Equivalence	(UAF_Flags, UAF_Record(UAF$L_Flags))
	Integer		LastLogin(2), UAF_LastLogin(2)
	Equivalence	(UAF_LastLogin,UAF_Record(UAF$Q_LastLogin_I))
	Integer*2 	NewMes
c add longword UIC value also
	Integer*4	UICval
	Equivalence	(UICval,UAF_Record(UAF$K_UIC))

        Structure /VMSMAIL_Structure/
	union
	 map
	  byte		rec(2048)
	 end map
	 map
          Character	crec*2048
	 end map
	end union
        End Structure

        Record /VMSMAIL_Structure/ VMSMail_Record

	Structure /MAIL_Structure/
	 union
	  map
	   character	rec*3047
	  end map
	  map
	   integer*2	date(4)
	   character	%fill*1
	   character	folder*39
	   union
	    map
	     character	rest*3000
	    end map
	    map
	     integer*2	irest(1500)
	    end map
	   end union
	  end map
	 end union
	End Structure

	structure /itmlist/
	 union
	  map
	   integer*2 bufferlen
	   integer*2 itemcode
	   integer*4 bufferaddr
	   integer*4 lengthaddr
	  end map
	  map
	   integer*4 endlist
	  end map
	 end union
	end structure

	include		'($jpidef)'
	integer		sys$getjpiw
	character	you*12

	Character	SortType*20, WhoAmI*32
	Integer		SortField, l_WhoAmI
	Common		/Sorter/ SortType, SortField, WhoAmI, l_WhoAmI

	Integer		FoundSender, Erase
	Character*12	F_User
	Character*32	F_Node
	Character*32	F_ByAt
	Character*32	F_ByColon
	Character*80	UpFrom
	Character	Str$UpCase*256

	Character*64	Directory
	Character*128	Mail_Directory

	Logical  Captive
	Logical	 LoggedIn
	Integer	 Status
	Integer	 SS$_Status
     
	Character       Temp*32, Sender*40
	Character*50    MailFile, PlanFile
	Character*12    UserName
	Character*9     Day_oftheWeek, LastLogin_Day, Mail_Day
	Character*70    LastLogin_Time, Make_Pretty
	Character*17	Mail_Time
	Character*132   Line
	Character*1     LF/10/, CR/13/, NUL/0/
	Integer	 Btrim, Sender_len
	Integer	 TestOutput
	Integer*4       UserUIC,FlgUIC
	Common/UseUIC/UserUIC,FlgUIC
	External	Priv_UserOpen


	logical		foundmail
	character	subject*80,csize*2,tousername*12,from*80
	integer		size*2, ptr

	equivalence	(size,csize)

	record /itmlist/ jpi_itmlist(2)
	Record /MAIL_Structure/ mailrec

	character	maildir*256,cfn*2,cfnlen*2, 
	1		cnewmes*2,fwdinfo*256
	integer		fn*2, fnlen*2
	logical		got_newmes, got_dir, got_subj, got_fwd
	equivalence	(cfn,fn)
	equivalence	(cfnlen,fnlen)
	equivalence	(cnewmes,newmes)

c First get stuff from UAF
c  open the UAF
	FlgUIC=0
c FlgUIC=0 to tell priv_useropen not to bother with UIC
	Open(Unit=UafUnit,
	1	File = 'SYSUAF',
	2	Default File = 'SYS$SYSTEM:.DAT',
	2	Err=999,
	3	User Open = Priv_UserOpen,
	4	Status = 'Old',
	5	Organization = 'Indexed',
	6	Access = 'Keyed',
	7	Form = 'Formatted',
	8	Readonly, 
	9	Shared)
c  read it
	Read(UafUnit,1000,KeyEq=UserName,Err=999) UAF_Record
c close it
	Call Priv_Close(UafUnit)
c   Concatenate the DEFDEV and DEFDIR into one string Directory.
	Directory = UAF_DefDev(:UAF_L_DefDev) //
	1		UAF_DefDir(:UAF_L_DefDir)
c  set up the last login stuff
	LastLogin(1) = UAF_LastLogin(1)
	LastLogin(2) = UAF_LastLogin(2)

	Captive = BTEST(UAF_Flags, UAF$V_Captive)

c Save owner UIC
	UserUIC = UICval

	Call Finger_Out_Routine(LF//CR)
C Login device/directory information
	If ( (TestOutput .and. FlagArea) .ne. 0 ) Then
	    If (Captive) Then
		Call Finger_Out_Routine(LF//' Captive user account.')
	    Else
		Call Finger_Out_Routine(LF//' Default directory: '//
	1		Directory(:Btrim(Directory)))
	    EndIf
	    Call Finger_Out_Routine(CR)
	EndIf
     
C  Last Login info
	If ( .not. (LastLogin(1).eq.0 .and. LastLogin(2).eq.0) ) then
	  LastLogin_Day = Day_oftheWeek(LastLogin)
	  Call Sys$AscTim(,LastLogin_Time,LastLogin,)
	  LastLogin_Time = Make_Pretty(LastLogin_Time)
	  If ( LoggedIn ) then
	    Call Finger_Out_Routine(LF//' Logged in since: ')
	  Else
	    Call Finger_Out_Routine(LF//' Last logged in: ')
	  End if
	  Call Finger_Out_Routine(
	1      LastLogin_Day(:Btrim(LastLogin_Day))//', '//
	2      LastLogin_Time(:17)//CR)
	End if

C  Mail information
c  !** Site-specific - If you don't want to display any mail information,
c  edit the .CLD file and add the keyword ', Default' to the DISMAILREP
c  qualifier. However, DISSUBJREP should be adequate for most cases - see
c  later items in this source file (search for DISSUBJREP).

	If ( (TestOutput.and.FlagMail) .ne. 0 ) then

c    Now get VMSMAIL stuff (system-wide data)
	  Open ( Unit=ScratchUnit,
	1	File='VMSMAIL_PROFILE' ,
	1	Default File = 'SYS$SYSTEM:.DATA',
	1	Err = 99,
	1	UserOpen = Priv_UserOpen,
	2	Status='Old' ,
	3	Organization='Indexed' ,
	4	Access='Keyed' ,
	5	Form='Unformatted' ,
	7	Readonly ,
	8	Shared ,
	1	RecordType='Variable' )
c
	  newmes=0
	  got_newmes=.false.
	  got_dir=.false.
	  got_fwd=.false.
	  maildir=' '
	  fwdinfo=' '
	  ptr=32
	  fn=1	!non-zero

c  Clear the mail record
	  Do Erase = 1, 2048
	    vmsmail_record.crec(Erase:Erase) = NUL
	  EndDo

	  Read(	Unit=ScratchUnit, 
	1	KeyEQ=UserName, 
c	2	Err=99,
	3	KeyID=0, 
	4	IOStat=Status) VMSMAIL_Record

	  if (status.eq.36) goto 99
c	  if (status.eq.FOR$IOS_ATTACCNON) goto 99
	  Call Priv_CLOSE (ScratchUnit)
c
c [rph] see VMSPROFILE_DATA.format for the struture of these records
c
	  do while ((.not.(got_newmes.and.got_dir.and.got_fwd))
	1   .and.(fn.ne.0))
	    cfn=vmsmail_record.crec(ptr:ptr+1)
	    cfnlen=vmsmail_record.crec(ptr+2:ptr+3)
	    if (fn.eq.1) then
	      cnewmes=vmsmail_record.crec(ptr+4:ptr+5)
	      got_newmes=.true.
	    else if (fn.eq.3) then
	      maildir=vmsmail_record.crec(ptr+4:ptr+4+fnlen-1)
	      got_dir=.true.
	    else if (fn.eq.4) then
	      fwdinfo=vmsmail_record.crec(ptr+4:ptr+4+fnlen-1)
	      got_fwd=.true.
	    end if
	    ptr=ptr+4+fnlen
	  end do 

	  If ((got_fwd .eq. .true.) .and. 
	1    (index(Str$UpCase(fwdinfo(:btrim(fwdinfo))),'DELIVER%') 
	2    .eq. 0)) Then
	  If (index(Str$UpCase(fwdinfo(:btrim(fwdinfo))),'IN%"~') .eq. 0) Then
	     Call Finger_Out_Routine(LF//' Mail is forwarded to: '//
	1	fwdinfo(:BTrim(fwdinfo))//CR)
	     Go To 99
	  EndIf
	  Endif

c****	  If (NewMes .gt. 0) then
	    If (maildir(1:1) .eq. '[') Then
	      i_brak = Index(maildir,'[')
              Mail_Directory = Directory(:(BTrim(Directory)-1))//
	1		       maildir(i_brak+1:BTrim(maildir))
	    Else 
	      Mail_Directory = Directory
	    EndIf

c  ! Site-specific note:
c  If you do not wish the mail "From: so-and-so" information printed
c  edit the .CLD file and set the DISSUBJREP qualifier 'Default'
c	This section contributed by Todd Aven of U. of Mariland
c	Hacked up by yours truly. Rg
c	Now includes Subject [rph] and pretty much a re-hack job
c for v5 [rph] another complete re-hack, the mail file format is similar
c       to vmsmail_profile.data (q.v.)
c

	    MailFile = Mail_Directory(:Btrim(Mail_Directory))//
	1	'MAIL.MAI'

	    Open ( Unit=ScratchUnit,
	1	File=MailFile ,
	2	Status='Old' ,
	3	User Open = Priv_UserOpen,
	4	Form='Formatted' ,
	5	Readonly ,
	6	Shared ,
	7	Err=100,
	8	Record Type='Variable',
	9	Organization='Indexed',
	1	Access='Keyed')
     
	    mailrec.rec = ' '

	    jpi_itmlist(1).bufferlen=12
	    jpi_itmlist(1).itemcode=jpi$_username
	    jpi_itmlist(1).bufferaddr=%loc(you)
	    jpi_itmlist(2).endlist=jpi$c_listend
	    call sys$getjpiw(,,,jpi_itmlist,,,)

	    Read(Unit=ScratchUnit,fmt='(a)',IoStat=Status,Err=20,
	1	KeyID=1,Key='F_PRIVACY') mailrec.rec
	    If (Status .ne. 0) GoTo 20

	    Call Finger_Out_Routine(LF//' Mail: Permission refused by '//
	1       'owner.'//CR)
	    GoTo 101

 20	    Temp = ' '
	    Call Finger_Out_Routine(LF//' Mail: ')
	    If ( NewMes .eq. 0 ) then
	      Call Finger_Out_Routine('(no new mail)'//CR)
	      GoTo 101
	    ElseIf ( NewMes .eq. 1 ) then
	      Call Finger_Out_Routine('1 new message.'//CR)
	    ElseIf ( NewMes .gt. 1 .and. NewMes .lt. 10 ) then
	      Write(Temp,1001)NewMes,' new messages.'//CR
	      Call Finger_Out_Routine(Temp(:16))
	    ElseIf ( NewMes .ge. 10 ) then
	      Write(Temp,1002)NewMes,' new messages.'//CR
	      Call Finger_Out_Routine(Temp(:18))
	    EndIf

	    If ((TestOutput .and. FlagDisSubj) .ne. 0) Goto 99

	    Read(Unit=ScratchUnit,fmt='(a)',IoStat=Status,Err=99,
	1	KeyID=1,Key='NEWMAIL') mailrec.rec

	    foundMail=.false.
	    Do While (status.eq.0)
	      If (len(mailrec.folder).GT.1) then
	        Mail_Time = ' '
	        Mail_day = Day_oftheWeek (mailrec.date)
	        call sys$asctim(,mail_time,mailrec.date)
	        mail_Time = Make_Pretty(Mail_Time)
	        ptr = 91
	        csize=mailrec.rec(ptr:ptr+1)
	        ptr=ptr+2
	        from=mailrec.rec(ptr:ptr+size-1)
	        ptr=ptr+size

c  Here we check for mail from the fingerer. The simplest case is mail on
c  the same node. Next is mail from DECnet nodes, stored as node::user.
c  Then we also have to check for the Bitnet/jnet case, which is difficult
c  as Bitnet/jnet limits usernames to 8 characters, whereas VMS has 12. We
c  address this by tacking a '*' onto the fingerer's username if he came
c  in via Bitnet and the username was 8 characters long. That is done in
c  FINGERDAE.FOR

		UpFrom = Str$UpCase(From)
		FoundSender = 0
		If ( (TestOutput .and. FlagIAM) .ne. 0 ) Then
		    F_User = WhoAmI(2:Index(WhoAmI,'~')-1)
		    F_Node = WhoAmI(Index(WhoAmI,'~')+1:l_WhoAmI-1)
		    F_ByAt = F_User(:Btrim(F_User))//'@'//
	1		     F_Node(:Btrim(F_Node))
c !! Site-specific - If all your DECnet nodes are under common administration
c  such that Username FRED is the same person at all nodes, you can ignore the
c  source node when matching user info for mail reporting. If you select this
c  option, be aware that FRED at any node can see mail sent by FRED at any
c  other node. This only applies to DECnet mail. Jnet mail always must match
c  the username and nodename.
		    F_ByColon = F_Node(:Btrim(F_Node))//'::'//
	1			F_User(:Btrim(F_User))
c  If DECnet access and option selected, allow matching on username alone
c  Comment out the next 5 lines if you do not want this feature.
		    If (Access .eq. 3) Then
			F_ByColon = '::'//F_User(:Btrim(F_User))
		        If (Index(UpFrom,F_User(:Btrim(F_User))) .eq. 1)
	1		    FoundSender = 1
		    EndIf
		    If (Index(UpFrom,F_ByAt(:Btrim(F_ByAT))) .gt. 0) Then
c	Have a match of user@node
			FoundSender = 1
		    Else If (Index(UpFrom,F_ByColon(:Btrim(F_ByColon)))
	1	    .gt. 0) Then
c	Have a match of node::user
			FoundSender = 1
		    Else If (Index(F_User,'*') .gt. 0) Then
c	Was a >8 username...
			If ((Index(UpFrom,F_User(:Btrim(F_User)-1))
	1		 .gt. 0)
c	...and username matched...
	2		.and. (Index(UpFrom,'@'//F_Node(:Btrim(F_Node)))
	3		.gt. 0)) Then
c	...and nodename matched
			    FoundSender = 1
			Endif
		    Endif
		Else
		    if (index(from,you(:btrim(you))).gt.0) then
			FoundSender = 1
		    EndIf
		EndIf

		if (FoundSender .ne. 0) Then
		  got_subj=.false.
		  subject=' '
		  fn=0
		  do while ((.not.(got_subj)).or.(fn.eq.5))
		    cfn=mailrec.rec(ptr:ptr+1)
		    cfnlen=mailrec.rec(ptr+2:ptr+3)
		    if (fn.eq.2) then
		      subject=mailrec.rec(ptr+4:ptr+4+fnlen-1)
		      got_subj=.true.
		    end if
		    ptr=ptr+4+fnlen
		  end do 


		  if (.not.foundMail) then
		    Call Finger_Out_Routine(LF//'  Has the following '//
	1	      'unread message(s) from you:'//CR)
		    foundMail = .true.
		  endif
		  Call Finger_Out_Routine(LF//'  '//
	1		Mail_Day(:btrim(mail_day))//', '//
	2		Mail_Time//'  Subj: '//
	3		subject(1:jmin0(len(subject),40))//CR)
	     endif
	    endif
		mailrec.rec = ' '
		Read(Unit=ScratchUnit,
	1	IoStat=Status,
	2	fmt='(a)',
	3	End=99) Mailrec.rec
	    If (mailrec.folder(1:7).ne.'NEWMAIL') status = -1 !short cut
	   enddo
     
99	    Continue

	    Call Priv_Close(ScratchUnit)

100	    Continue			!newmes out of sync
     
c  See if there are any new RSCS spool files

101	  FindTemplate = 'JAN_COMMON:[RECEIVE]'//
	1   UserName(:btrim(username))//'.RSC;*'
	  FindCount = 0
	  FindContext = 0
102	  ii = Lib$Find_File(FindTemplate(:btrim(FindTemplate)),
	1   FindResult, FindContext, , , , %loc(2))
	  If ( ii .ne. RMS$_Normal ) Goto 103
	  FindCount = FindCount + 1
	  Goto 102
103	  ii = Lib$Find_File_End(FindContext)
	  If ( FindCount .ne. 0 ) Then
	    Call Finger_Out_Routine(LF//'       ')
	    Temp = ' '
	    If ( FindCount .eq. 1 ) Then
	      Call Finger_Out_Routine('1 new RSCS spool file.'//CR)
	    ElseIf ( FindCount .gt. 1 .and. FindCount .lt. 10 ) Then
	      Write(Temp,1001) FindCount,' new RSCS spool files.'//CR
	      Call Finger_Out_Routine(Temp(:24))
	    ElseIf ( FindCount .ge. 10 ) Then
	      Write(Temp,1002) FindCount,' new RSCS spool files.'//CR
	      Call Finger_Out_Routine(Temp(:26))
	    EndIf
	  EndIf     
	EndIf
     
C  Plan information
     
c  ! Site-specific note:
c  You may opt for another standard name for the plan file, see above.
	If ( (TestOutput.and.FlagPlan) .ne. 0 ) then
	  Call Finger_Out_Routine(LF//' Plan: ')
	FlgUIC=1
c flag to test stored UIC if present
	  PlanFile = Directory(1:Btrim(Directory))//PlanFileName1
	  Open (	Unit=ScratchUnit,
	1       File=PlanFile,
	2       User Open = Priv_UserOpen,
	2       Status='old',
	3       Err=201,
	4       Shared,
	5       Readonly)
	  GoTo 250
c  Error opening Plan File - look for an alternate.
201       Continue
	FlgUIC=1
	  PlanFile = Directory(1:Btrim(Directory))//PlanFileName2
	  Open (	Unit=ScratchUnit,
	1       File=PlanFile,
	2       User Open = Priv_UserOpen,
	2       Status='old',
	3       Err=202,
	4       Shared,
	5       Readonly)
	  GoTo 250
c  look for another - or give up ! Site-specific
202       Continue
c	 PlanFile = Directory(1:Btrim(Directory))//PlanFileName3
c	 Open (	Unit=ScratchUnit,
c       1       File=PlanFile,
c       2       User Open = Priv_UserOpen,
c       2       Status='old',
c       3       Err=301,
c       4       Shared,
c       5       Readonly)
c	 GoTo 250
	  GoTo 301
c  Found the file - list it.
250       Call Finger_Out_Routine(CR)
	FlgUIC=0
	UserUIC=0
c zero flag and saved UIC value (just in case)
	  DoWhile(.True.)
	    Read(ScratchUnit,2000,End=300) l_line, Line
C ** Site-Specific
C uncomment to enable BYPASS logic
	      IF(.NOT.FLAG_BYPASS)THEN
		do ibcz=1,l_line
		  if(line(ibcz:ibcz).lt.' ')then
		     iibcz=ichar(line(ibcz:ibcz))
		     if(iibcz.ne.9.and.iibcz.ne.10
	1	        .and.iibcz.ne.13)line(ibcz:ibcz)='.'
		  endif
		enddo
	      ENDIF
c end of bypass logic
	    if (l_line .eq. 0) then
	      Call Finger_Out_Routine(LF//CR)
	    else
	      Call Finger_Out_Routine(LF//Line(1:l_line)//CR)
	    EndIf
	  EndDo
300       Call Priv_Close(ScratchUnit)
	  Return
C  Here if no plan file
301       Continue
	  Call Finger_Out_Routine('(no plan file)'//CR)
	EndIf
	Return

999	Continue
	Call Priv_Close(UafUnit)
	Return
1000	Format(<UAF$K_Length>A1)
1001    Format(I1,A)
1002    Format(I3,A)
2000    Format(Q,A)
	End

c------------------------------------------------------------------------------
	Character*25	Function Get_Location(Terminal,TTType,PID)
c  This routine returns the location and terminal type, given the
c  terminal name.  It user the data in the shared common section.
c  ! site-specific
c  If the terminal begins with LT it is considered a LAT terminal.
c  If the terminal begins with RT it is considered a DECnet terminal.
c  If it begins with PT is ia assumed to be a pseudoterminal.  We use
c  these to connect to a network called jnet.  These can be ignored
c  if you don't have them, otherwise change appropriately.
c  If the terminal begins with VT its considered a VMS V4.x virtual
c  terminal and the associated physical terminal is used.
c  If the terminal begins with WT or TK it is considered to be an
c  emulated VT220 or TEK4014 on a VAXStation.
c  If the terminal begins with TW it is considered to be a DECterm
c  window under DECWindows.
c  If the terminal begins with QT it is considered to be a TES terminal
c  coming from a PC network.
c
c  In the normal situation, the 25 characters returned are
c  the location and 25 for the type.  Obviously these can be 
c  can be shortened for printing (I normally print 15 + 25)
	Include		'FingerCom.For'
c Site-specific
c LAT ident stuff
c [rph] 01-06-88 - Server names and port names can be as large as
c		   16 and 12 characters respectively. By default only
c		   the first 8 characters of each are displayed. This
c		   can easily be changed.
	Include 'fingerdef.inc'
	Include '($DVIDEF)'

	Character Server*16, Port*12, Make_Pretty*70
	Integer  Status
	Integer		Privilege(2) /0,0/
c end LAT ident data
	Character	Terminal*8, TTType*25
	Character	Network*20,	Get_Network*20
	Character	Node*32,	Get_DECnet_Remote*25
	Character	Get_jnet_Node*8
	Integer		Btrim,		PID
	Integer		Lib$GetDVI
	External	Lib$GetDVI
	Character	Phy_Terminal*8, TT_AccPorNam*64
	Integer		L_Phy_Terminal, L_TT_AccPorNam, Slash
	Integer		TermType

	Get_Location = ' '	! If location can't be found
	TTType = ' '

c  first see if a VT (virtual terminal) is connected to a physical
c  terminal.
	If ( Terminal(1:2) .eq. 'VT' ) then
	    terminal='_'//terminal
	    Call Lib$GetDVI(DVI$_TT_PhyDevNam,,Terminal,,
     1	      Phy_Terminal,L_Phy_Terminal)
	    If (L_Phy_Terminal.gt.0)
     1	      Terminal = Phy_Terminal(2:L_Phy_Terminal)
	    If (index(terminal,':').eq.0)
     1	      Terminal=Terminal(:Btrim(terminal))//':'
	    If ( Terminal(1:3) .eq. '_VT' )
     1	      Terminal=Terminal(2:Btrim(Terminal))
	Endif

c  Next, find out what type of terminal VMS thinks it is...
	If ( Terminal(1:1) .ne. ' ' ) Then
	    Call Lib$GetDVI(DVI$_DevType,,Terminal,TermType,,)
	    Call TypeToTerm(TTType, TermType)
	EndIf

	If ( Terminal(1:2) .eq. 'RT' ) Then
	    Get_Location = Get_DECnet_Remote( PID, Node)
	ElseIf ( Terminal(1:2) .eq. 'PT' ) Then	! Site-specific
	    Node = Get_jnet_Node(Terminal)
	    Network = Get_Network('J')
	    If ( Network .eq. '?' ) Network = 'jnet'
	    Get_Location = Node(:Btrim(Node))//
	1	'.'//Network(:Btrim(Network))
	ElseIf ( Terminal(1:2) .eq. 'WT' ) then
	    Get_Location = 'VT220 window'
	ElseIf ( Terminal(1:2) .eq. 'TK' ) then
	    Get_Location = 'TEK4014 window'
	ElseIf ( Terminal(1:2) .eq. 'TW' ) then
	    Get_Location = 'DECterm window'
	ElseIf ( Terminal(1:2) .eq. 'QT' ) then
	    Get_Location = 'PC Network'
	ElseIf ( Terminal(1:2) .eq. 'VT' .or. Terminal(1:3) .eq. 'MBA' ) then
	    Get_Location = '<disconnected>'
	    TTType = ' '
	ElseIf ( Terminal(1:2) .eq. 'LT' .or. Terminal(1:2) .eq. 'TN' ) then
	    If ( Terminal(1:2) .eq. 'LT') then
		Get_Location = 'LAT'
	    EndIf
c ** Site-Specific
c  get LAT info
c
c  getdvi(tt_accpornam) returns a string in the form server/port or for
c  PSI connections, the originating connection
c
		terminal = '_' // terminal
		status = Lib$GetDVI(DVI$_TT_AccPorNam,,Terminal,,
     1		     TT_AccPorNam,L_TT_AccPorNam)

		terminal = terminal(2:len(terminal))
		slash = index(TT_AccPorNam,'/')
		If (Status) then
		 If (slash.gt.0) then
		  Server = TT_AccPorNam(1:slash-1)
		  Port = TT_AccPorNam(slash+1:slash+9)
c  Don't fool with server and port names - tmk
c		  Server = Make_Pretty(Server)
c		  Port = Make_Pretty(Port)
c  If the server port name starts with "DIALUP.", show things a little
c  differently (suppress server name, show as "Dialup "+rest_of_port_name.
		  If (Port(1:7) .eq. 'DIALUP.') Then
		    Get_Location = 'Dialup ' //
     1		      TT_AccPorNam(slash+8:Btrim(TT_AccPorNam))
		  Else
		    Get_Location = Server(:Btrim(Server)) // ' ' // 
     1		      Port(:Btrim(Port))
		  EndIf
		 else	!PSI terminal
		  Get_location = TT_AccPorNam(1:btrim(TT_AccPorNam))
		  if (terminal(1:2) .eq. 'TN') then
		   slash = index(TT_AccPorNam, ' ')
		   Get_location = TT_AccPorNam(slash+1:btrim(TT_AccPorNam))
	           slash = index(Get_location, ' ')
		   Get_location = Get_location(1:slash-1)
		  endif
		 endif
		endif
	ElseIf ( Terminal(1:2) .eq. 'PX' ) then
	    Get_Location = 'PC Network'
	Else
c	  search for Terminal in shared common database
	    Do ii = 1,Loc$I_Last
		If ( Loc$C_Terminal(ii) .eq. Terminal ) then
		    Get_Location = Loc$C_Location(ii)
		    If ( Loc$C_TTType(ii) .ne. 'Unknown' ) Then
			TTType = Loc$C_TTType(ii)
		    EndIf
		    Return
	    	End if
	    End do
	EndIf
	Return
	End

c-----------------------------------------------------------------------------
	Character*25 Function Get_DECnet_Remote(PID,Node)
	Integer		PID
	Character*(*) Node
C
c  Get the remote DECnet node name and username by getting the JIB
C  address using $CMKRNL and a small Macro routine.  The JIB address is
c  then used to make-up the name of the JOB logical name table and then
C  the logcials names SYS$REM_ID and SYS$REM_NODE are translated
c  from this logical name table.
c
C Written by: Frank J. Nagy   Fermilab Research Division/EED Controls
c

	Include		'FingerDef.inc'
	Include		'Fingercom.for'
	Include		'($jpidef)'
	Include		'($ssdef)'					!FJN

	Integer i, status, sys$cmkrnl, sys$trnlnm, jib
	external get_jib_address
	Integer	gja_arglist(3)
	Character   jobtable*20,    DECnet_node*8,  Username*32
	Integer*2   l_jobtable,	    l_node,	    l_name
	Integer		TRN_ItemList(4)
	Integer*2	TRN_ItemList2(8)
	Equivalence	(TRN_ItemList,TRN_ItemList2)
	Integer		TRN$_String /Z00000002/

	Integer		Privilege(2) /0,0/

	gja_arglist(1) = 2
	gja_arglist(2) = PID
	gja_arglist(3) = %LOC( jib)

	Get_DECnet_Remote = ' '
	Node = '?'

c  Turn on CMKRNL privilege
	Privilege(1) =  Prv$M_Cmkrnl
	Call Sys$Setprv(%Val(1),Privilege,,)
	status = sys$cmkrnl( get_jib_address, gja_arglist)
c  Turn off CMKRNL privilege
	Call Sys$Setprv(,Privilege,,)
	If (.Not. status) Then
	    Call Lib$Signal( %Val(status))
	    Return
	EndIf

	If (jib .eq. 0) Return

	Call Sys$Fao( 'LNM$JOB_!XL', l_jobtable, jobtable, %Val(jib))

	TRN_ItemList2(1) = 8
	TRN_ItemList2(2) = TRN$_String
	TRN_ItemList(2) = %Loc(DECnet_Node)
	TRN_ItemList(3) = %Loc(L_node)
	TRN_ItemList2(7) = 0
	TRN_ItemList2(8) = 0

c  Turn on SYSPRV privilege
	Privilege(1) =  Prv$M_Sysprv
	Call Sys$Setprv(%Val(1),Privilege,,)
	status = Sys$TrnLnm(,jobtable(1:l_jobtable),
	1			'SYS$REM_NODE', 1, TRN_ItemList)
	If (status .eq. SS$_NOLOGNAM) Then				!FJN
c  Often fails due to new remote login just starting, wait and retry	!FJN
	    Call Lib$Wait( 0.3)						!FJN
	    status = Sys$TrnLnm(,jobtable(1:l_jobtable),		!FJN
	1			'SYS$REM_NODE', 1, TRN_ItemList)	!FJN
	EndIf								!FJN
c  Turn off SYSPRV privilege
	Call Sys$Setprv(,Privilege,,)
	If (.Not. status) Then
c**	    Call Lib$Signal( %Val(status))
	    Get_DECnet_Remote = 'No info available'
	    Return
	EndIf

	TRN_ItemList(2) = %Loc(username)
	TRN_ItemList(3) = %Loc(L_name)

c  Turn on SYSPRV privilege
	Privilege(1) =  Prv$M_Sysprv
	Call Sys$Setprv(%Val(1),Privilege,,)
	status = Sys$TrnLnm(,jobtable(1:l_jobtable),
	1			'SYS$REM_ID', 1, TRN_ItemList)
c  Turn off SYSPRV privilege
	Call Sys$Setprv(,Privilege,,)
	If (.Not. status) Then
	    Call Lib$Signal( %Val(status))
	    Return
	EndIf

	Get_DECnet_Remote = DECnet_node(1:L_node)//
	1			username(1:l_name)
	Node = DECnet_node(1:L_node-2)

	return

	end

c-----------------------------------------------------------------------------
	Character*5 Function Get_Idle(Terminal)

	Include		'Fingercom.for'

	Integer		I_hr, I_min, Status, Offset
	Character*(*)	Terminal
	Integer*4	I_Idle, Term_PID
	Integer*2	RTT_Link
	Integer*4	Term_info
	Integer		Btrim
	Character*16	lterminal

	Common	/Term_Info_Struct/ I_Idle, Term_PID, RTT_Link

	Get_Idle = ' '

c  Call TERM_INFO to get the idle time for terminals. Make sure that
c  I_Idle is zero first or it will use the previous value. TERM_INFO
c  wants the ':' in the terminal name, so make sure we have at least
c  one.

	I_Idle = 0
	lterminal = terminal(:btrim(terminal))//':'
	Offset = Index(lTerminal, ':')
	Status = TERM_INFO(lTerminal(:Offset), I_Idle)
	If ( I_Idle .le. 0 ) Return
	I_hr = I_Idle/3600
	I_Min = I_Idle/60 - 60*I_hr
	Write (Get_Idle,1000,Err=300) I_hr, I_Min
	If ( I_hr .eq. 0 ) then
	    If ( I_Min .le. 0 ) then
	      Get_Idle = '    .'
	    else
	      Get_Idle(1:3) = ' '
	    end if
	Else
	    If ( Get_Idle(4:4) .eq. ' ' ) Get_Idle(4:4) = '0'
	End if
300	Return

1000	Format(I2,':',I2)

	End

c-----------------------------------------------------------------------------
	Character*8	Function Get_jnet_Node(Terminal)

c	This routine finds the jnet node name using a /SYSTEM
c	Logical name of the form JNET_PTYxxxx

	Integer		TRN$_String /Z00000002/
	Integer		TRN_ItemList(4)
	Integer*2	TRN_ItemList2(8)
	Equivalence	(TRN_ItemList,TRN_ItemList2)

	Character	Terminal*8

	Get_jnet_Node = '?'	! default
	If ( Index(Terminal,'PT') .eq. 0 ) Return	! Wrong terminal type
	ii = Index(Terminal,':') - 1

	TRN_ItemList2(1) = 8
	TRN_ItemList2(2) = TRN$_String
	TRN_ItemList(2) = %Loc(Get_jnet_Node)
	TRN_ItemList(3) = %Loc(L_node)
	TRN_ItemList2(7) = 0
	TRN_ItemList2(8) = 0

	SS$_Status = Sys$TrnLnm(,'LNM$SYSTEM_TABLE',
	1	'JNET_'//Terminal(:ii),,
	3	TRN_ItemList)

	Return
	End	
c---------------------------------------------------------------------------
	Character*20	Function Get_Image(Input_PID,LOGINTIM,CPUTIM)

c  This routine does an additional GETJPI to get the image name, the Login
c  time, and the CPU time.  This is not done in the main loop in Local_Finger 
c  because this Getjpi may take a long time for low priority or swapped out
c  processes and these processes are typically not listed by finger anyway.  

c  ! Site-specific note: Only images from "public" directories are identified 
c  by finger for reasons of privacy (basically so "Joe" won't complain that
c  "Harry" is running Adventure all day.)  The several site-specific public 
c  directories are set as parameters here and should be changed for your site.
c  You could also, for example, just check the disk and decide all images on
c  a certain disk are public etc.  Or just eliminate the check altogether 
c  and all images, public or private, will be identified.
c					- Rg
c	Parameter	PublicDirectory1 = 'SYS$SYSROOT:[SYSEXE]'! obviously.
c	Parameter	PublicDirectory2 = 'SYS$UTILITIES:'! These 2 for..
c	Parameter	PublicDirectory3 = 'SYS$SYSUTL:[VPW]'	! my site -Rg
c	Parameter	PublicDirectory4 = 'DUA0:'		! an example
c	Parameter	PublicDirectory5 = 'DRA1:[LOCAL]'	! an example
c
c  ! Site-specific: end of note

	Integer		Input_PID

C  Include all GETJPI data and definitions
	Include		'GETJPIDEF.FOR'
	integer		sys$getjpiw

	Get_Image = '<unavail>'

C  Set up item list for GETJPI
	I = 1
	II = 1
	ITEM_LIST2(II+IC) =	JPI$_IMAGNAME
	ITEM_LIST2(II+BL) =	L_IMAGNAME
	ITEM_LIST(I+BA)  =	%LOC(IMAGNAME)
	ITEM_LIST(I+RL)  =	%LOC(RL_IMAGNAME)
	I = I + 3
	II = II + 6
	ITEM_LIST2(II+IC) =	JPI$_LOGINTIM
	ITEM_LIST2(II+BL) =	L_LOGINTIM
	ITEM_LIST(I+BA)  =	%LOC(LOGINTIM)
	ITEM_LIST(I+RL)  =	%LOC(RL_LOGINTIM)
	I = I + 3
	II = II + 6
	ITEM_LIST2(II+IC) =	JPI$_CPUTIM
	ITEM_LIST2(II+BL) =	L_CPUTIM
	ITEM_LIST(I+BA)  =	%LOC(CPUTIM)
	ITEM_LIST(I+RL)  =	%LOC(RL_CPUTIM)

	ITEM_LIST(I+3) = 0		! End of list


c  Do Getjpi
	IStatus =  Sys$Getjpiw(,Input_PID,,Item_List,,,)
	If ( .not. IStatus ) Return

c  Check for no image (DCL)
	If ( Rl_Imagname .eq. 0 ) Then
	    Get_Image = '$'	! DCL
	    Return
	EndIf

c  Check for public directory
c  ! Site-specific: If you want all images printed, delete this whole block.
c	i_Dir1 = Index(Imagname,PublicDirectory1)	!
c	i_Dir2 = Index(Imagname,PublicDirectory2)	! to be set
c	i_Dir3 = Index(Imagname,PublicDirectory3)	! above for
cc	i_Dir4 = Index(Imagname,PublicDirectory4)	! each site. 
cc	i_Dir5 = Index(Imagname,PublicDirectory5)	! 
c	If ( 
c	1		i_Dir1 .eq. 0 	! one of 
c	2	.and. 	i_Dir2 .eq. 0 	! these for 
c	3	.and. 	i_Dir3 .eq. 0 	! each public 
cc	4	.and. 	i_Dir4 .eq. 0 	! directory
cc	5	.and. 	i_Dir5 .eq. 0 	! at your site.
c	6   ) Then
c	    Get_Image = '<user>' ! default for image in private directory
c	    Return		 ! (for privacy)
c	EndIf
c  ! Site-specific - end of block

c  Image good.  Just get file name.

	Do i = Rl_Imagname,0,-1
	    If ( Imagname(i:i) .eq. ']' ) Goto 101
	    If ( Imagname(i:i) .eq. '>' ) Goto 101
	    If ( Imagname(i:i) .eq. ':' ) Goto 101
	End do

101	ii = i + 1
	iii = Index(Imagname(ii:Rl_Imagname),'.') + ii - 2
	Get_Image = Imagname(ii:iii)

	Return
	End

c---------------------------------------------------------------------------
	Character*31	Function Get_PersonalName(Username)

	Include		'FingerCom.For'

	Character*12	UserName		! User's login name
	Character*31	Owner, Fix_Name*31

	Call NULToSP(Username,12)

c  search for Userame in shared common database
	Do ii = 1,Usr$I_Last
	    If ( Usr$C_Username(ii) .eq. Username ) then
		Owner = Usr$C_PersonalName(ii)
		Go to 122
	    End if
	End do
	Get_PersonalName = ' '	!default if name not found
	Return

122	Continue
	Get_PersonalName = Fix_Name(Owner)

	Return
	End

c---------------------------------------------------------------------------
	Character*12	Function Get_Username(PersonalName,
	1			NMatches,OutFlag,Out_Routine)
c
c  This routine searches the username <--> Personalname database
c  for a match in part (or all) with the personal name and returns
c  the Username.  If there is more than 1 match the last match is
c  returned.  "minimum_match_length" requires at least that many
c  characters for the compare (to avoid matching all kinds of small
c  strings).  The routine also returns the number of matches and will
c  output the match on option.
c
c Note: If "minimum match" is omitted, Finger can be easily used to
c obtain lists of users at a site by searching for all names containing
c a few common letter combinarions (e.g., vowels). The minimum match
c effectively prevents this.
c
c  ! site-specific:	set minimum match length or omit. (see below)
	Parameter	minimum_match_length = 3

	Include		'FingerCom.For'

	Integer		NMatches, Btrim
	Logical		OutFlag, ExactMatch, Match
	Logical		Wild, Wild_Match
	External	Out_Routine
	Character	C_Temp*31, Str$UpCase*31
	Character	Fix_Name*31, Make_Pretty*31
	Character*(*)	PersonalName
	Character*1	LF/10/, CR/13/

	Get_Username = ' '
	NMatches = 0
c  ! site-specific: use following code for minimum match length
	If ( Len(PersonalName) .lt. minimum_match_length ) then
	    ExactMatch = .true.
	Else
	    ExactMatch = .false.
	End if
c  check if wildcards (a bit useless considering...)
	If ((Index(PersonalName,'*') + Index(PersonalName,'%')).gt.0)
	1	Wild = .true.
c  search for PersonalName in shared common database
	Do ii = 1,Usr$I_Last
	    Match = .false.
	    If ( ExactMatch ) then
		If ( Str$UpCase(Usr$C_Personalname(ii))
	1		 .eq. Personalname ) Match = .true.
	    Else if ( Wild ) then
		iii = Btrim(Usr$C_Personalname(ii))
		C_Temp = Str$Upcase(Usr$C_Personalname(ii))
		Match = Wild_Match('*'//PersonalName//'*',	! add wild
	1		C_Temp(:iii))				! front & back
	    Else
		If ( Index(Str$UpCase(Usr$C_PersonalName(ii)),
	1	    PersonalName) .ne. 0 ) Match = .true.
	    End if
	    If ( Match ) then
		NMatches = NMatches + 1
		Get_Username = Usr$C_Username(ii)
		If ( OutFlag ) then
		    Call Out_Routine(LF//Usr$C_Username(ii)//' - '//
c ! site-specific: Choose one of the following two lines
	1		Fix_Name(Usr$C_PersonalName(ii))
c	1		Make_Pretty(Fix_Name(Usr$C_PersonalName(ii)))
	2		//CR)
		End if
	    End if
	End do

	Return
	End

c---------------------------------------------------------------------------
	Character*9	Function Day_OfTheWeek(BinTime)

	Character*9	Day(7) /
	1		'Monday',
	2		'Tuesday',
	3		'Wednesday',
	4		'Thursday',
	5		'Friday',
	6		'Saturday',
	7		'Sunday'/

	Integer		BinTime(2), DayNumber

	Call Lib$Day_of_Week(BinTime,DayNumber)
	Day_OfTheWeek = Day(DayNumber)

	Return
	End

c---------------------------------------------------------------------------
	Subroutine	NULToSP(String,Length)

	Character	String*(*)
	Character	NUL/0/, SP/' '/

	Do ii=1,Length
	    If ( String(ii:ii) .eq. NUL ) String(ii:ii) = SP
	EndDo

	Return
	End

c------------------------------------------------------------------------
	Character*31 Function Fix_Name(Name)

	Character	Name*31, First_Name*31, Last_Name*31
	Character	SP /' '/

	Fix_Name = Name

	If ( Name .eq. ' ' ) Return

	If ( Name(1:1) .eq. '(' ) GoTo 200
	i_Comma = Index(Name,',')
	If ( i_Comma .eq. 0 ) GoTo 200

	i_Last = i_Comma-1
	If ( i_Last .le. 0 ) Then
	    Last_Name = ' '
	    i_Last = 1
	EndIf
	Last_Name = Name(:i_Last)

	First_Name = Name(i_Comma+1:)
	i_First = 31 - i_Comma
	Do ii=i_First,2,-1
	    If ( First_Name(ii:ii) .ne. SP ) GoTo 110
	EndDo

110	i_First = ii
	Do ii = 1,i_First
	    If ( First_Name(ii:ii) .ne. SP ) GoTo 120
	EndDo

120	First_Name = First_Name(ii:i_First)
	i_First = i_First - ii + 1

c ! site-specific: Uncomment next line if your usernames are stored as
c lastname, firstname.
c	Fix_Name = First_name(:i_First)//SP//Last_name(:i_Last)

200	Return

	END


c------------------------------------------------------------
	Character*(*) Function Make_Pretty(String)

c	! Site-specific note
c  This implements one person's idea of what constitutes "pretty"
c  text: all words capitalized, with other letters lower case.  If
c  you like all UPPER-CASE (like VMS) or all lower-case (like unix)
c  feel free to change this as per comments below.		- Rg

	Character*(*)	String
	Character	Item
	Character	Down_Case, Str$UpCase	! May have to specify length
	Logical		NewWord, Alpha

	NewWord = .true.
	Make_Pretty = ' '

	Do i = 1, Len(String)
	    Item = String(i:i)
	    Alpha = (Item .ge. 'A' .and. Item .le. 'Z') .or.
	1	    (Item .ge. 'a' .and. Item .le. 'z')
	    Item = Down_Case(Item)
	    If ( NewWord ) Item = Str$UpCase(Item)
	    NewWord = .not. Alpha
	    Make_Pretty(i:i) = Item
	EndDo

c  Following are alternate possibilities.	! Site-specific
c  Must give "Down_Case" and "Str$UpCase" correct length specification above.
c	Make_Pretty = Down_Case(String)		! For all lower case
c	Make_Pretty = Str$UpCase(String)	! For all UPPER CASE

	Return
	End

c------------------------------------------------------------
	Character*(*) Function Filter_Control_Chars(String)

c	This routine can be used to filter control characters
c	from the output stream and put a period (".") in their
c	place to prevent wierd process names etc. from messing 
c	up the terminal screen.

	Character*(*)	String

	Character*256	FilterTable 

	    Parameter ( FilterTable =
	1	'................................' //
	2	' !"#$%&''()*+,-./0123456789:;<=>?'//
	3	'@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_' //
	4	'`abcdefghijklmnopqrstuvwxyz{|}~.' //
	5	'................................' //
	6	'................................' //
	7	'................................' //
	8	'................................' )

	Call Lib$Movtc(String,' ',FilterTable,Filter_Control_Chars)

	Return
	End

c------------------------------------------------------------
	Character*(*) Function Down_Case(Item)

	Character*(*)	Item

	Do i = 1,Len(Item)
	    Down_Case(i:i) = Item(i:i)
	    If ( Item(i:i) .ge. 'A' .and. Item(i:i) .le. 'Z' ) 
	1	Down_case(i:i) = Char(Ichar(Item(i:i)) + 32)
	EndDo

	Return
	End

c------------------------------------------------------------
	Integer Function OutLink_UserOpen(FAB,RAB,Unit)

	Integer		FAB(30), RAB(30)
	Integer		Rab$L_Rop/2/, Rab$M_Loc/Z00010000/
	Integer		Sys$Create, Sys$Connect
	Integer		Unit, OutLinkOpenStatus, OutLinkRMSStatus

	Common	/OutLinkOpen_Common/ OutLinkOpenStatus, OutLinkRMSStatus

	iii = Sys$Create(FAB)
	OutLinkRMSStatus = iii		! RMS Status
	OutLinkOpenStatus = FAB(4)	! This is the Fab$l_STS field: status

	If ( .not. iii ) Then
	    IF ( OutLinkOpenStatus .eq. 0 ) OutLinkOpenStatus = iii
	    OutLink_UserOpen = iii
	    Return
	EndIf

	RAB(Rab$L_Rop) = RAB(Rab$L_Rop) .or. Rab$M_Loc	! Locate option
	OutLink_UserOpen = Sys$Connect(RAB)

	Return
	End

c--------------------------------------------------------------------------
	integer function btrim (string)

c   Integer function to determine the length of a character string with
c   trailing blanks and tabs removed.
c   Routine written at CMU PSYA::

	implicit integer*4 (a-z)
	integer countr
	character*(*) string
	character*1 tab, NUL, space
	
	NUL = char(0)
	tab = char(9)
	space = char(32)

	do 10 countr = len (string), 1, -1
		if (string (countr : countr) .ne. NUL .and.
     *			string (countr:countr) .ne. space .and.
     *			string (countr:countr) .ne. tab) then
			btrim = countr
			return
		endif
10	continue

	btrim = 1
	return
	end


c------------------------------------------------------------
	Integer Function Priv_UserOpen(FAB,RAB,Unit)

c  open a system file with privilege.

c  set bits in the FAB to require EXEC mode logical name
c  translation to be used when opening the file and turn
c  SYSPRV on for the open.

	Include		'Fingerdef.inc'
	Include '($RMSDEF)/nolist'
	Include '($SYSSRVNAM)/nolist'
	Include '($FABDEF)/nolist'
	Include '($RABDEF)/nolist'
	Include '($xabDEF)'
	Include	'XABPRODEF.INC'
	Record /FABDEF/Fab, /RABDEF/ rab
	Record /XABPRODEF1/ xabpro
	Integer*4 LUIC
	Common /xab_uic/ LUIC
	External XABSET, XABGET
	Integer		Privilege(2) /0,0/
c	Byte		FAB$B(0:119)
c	Integer		RAB(30)
c	Integer*4	Sys$Open, Sys$Connect		![rph] 01-06-88
	Integer		Unit
	Integer*4       UserUIC,FlgUIC,ownUIC
	Common/UseUIC/UserUIC,FlgUIC

c  set Logical name access to EXEC mode
	FAB.FAB$B_ACMODES = FAB.FAB$B_ACMODES .or.
     1   1
c	1	( (1) * 2**FAB$V_LNM_MODE)		! require EXEC mode
c  fab$V_lnm_mode = 0 so omit ref since define includes double def it
c set up xab
	If (FlgUIC .ne. 0 ) then
	Call XABSET( %VAL (fab.FAB$L_XAB))
	EndIf

c  Turn on SYSPRV privilege
	Privilege(1) =  Prv$M_Sysprv
	Call Sys$Setprv(%Val(1),Privilege,,)

c  open file
	iii = Sys$Open(FAB)
	If (FlgUIC .ne. 0) then
	If (iii .eq. rms$_NORMAL) then
	  iii= SYS$DISPLAY(fab)
	  Call XABGET (%VAL ( fab.FAB$L_XAB))
	  OwnUIC=LUIC
d	Write(6,4555)userUIC, ownUIC
d4555	Format(' user UIC=', i12,' FileOwner UIC=',i12)
	  if (ownUIC.ne.userUIC) then
		iii=sys$close(FAB)
	  End IF
	End if
	End If
c  Turn off SYSPRV privilege
	Call Sys$Setprv(,Privilege,,)
	If (FlgUIC .ne.0) then
	FlgUIC=0
c If flagged for nonzero UIC check, compare file owner UIC
c here with userUIC longword and if non equal close the file
c and forget it. One pass, to avoid possible problems, since
c this is only for FINGER.PLN files.
c need $xabpro to get UIC.
	  if (ownUIC.ne.userUIC) then
		iii= sys$open(FAB)
c try nonpriv'd open if wrong UIC, in case file IS world readable
c but owned by, e.g., some identifier on behalf of the user we're
c fingering.
	  endif
	EndIF

	If ( .not. iii ) Then
	    Priv_UserOpen = iii
	    Return
	EndIf

c  connect
	Priv_UserOpen = Sys$Connect(RAB)

	Return
	End

c------------------------------------------------------------
	Integer Function Priv_Close(Unit)

c  Close a system file with privilege.  Needed for Files opened with
c  privilege in VMS V4.2 (it is rumored)

	Include		'Fingerdef.inc'
	Integer		Privilege(2) /0,0/
	Integer		Unit

c  Turn on SYSPRV privilege
	Privilege(1) =  Prv$M_Sysprv
	Call Sys$Setprv(%Val(1),Privilege,,)

c  Close file
	Close( Unit = Unit )

c  Turn off SYSPRV privilege
	Call Sys$Setprv(,Privilege,,)
	priv_close=1
	Return
	End

c-------------------------------------------------------------
	Integer*2 Function Get_w_Val(I2)

	Integer*2	I2

	Get_w_Val = I2

	Return

	End

c-----------------------------------------------------------------------------
	Subroutine Make_Info(PID,STS,Prcnam,Username,Terminal,
	1	State, PgCnt, HeaderWritten, TestOutput, FlagProcess)

c  This routine and subroutine Show_Info are used together to provide
c  a sorted output display.  If the command option SORT is turned on,
c  user information is written into an array in this subroutine.  Then,
c  the array is sorted, and written to the output.
c
c  Added by  Art Greenberg, RCA Laboratories

	Include		'GETJPIDEF'
	Include		'FingerFlg'
	Include		'Fingerdef.inc'

	Integer		PID_array, STS_array, State_array,
	1		PgCnt_array, HeaderWritten, TestOutput,
	2		FlagProcess, FP_array

	Character	Prcnam_array*15, Username_array*12,
	1		Terminal_array*8

	Dimension	PID_array(200), STS_array(200),
	1		State_array(200), PgCnt_array(200),
	2		Prcnam_array(200), Username_array(200),
	3		Terminal_array(200), FP_array(200)

	Common	/Info/	PID_array, STS_array, State_array,
	1		PgCnt_array, Prcnam_array, Username_array,
	2		Terminal_array, Last_Number, FP_array

	Integer		PgCnt
	Integer		Index

	Data		Index /0/

c  Initialize the info array if first time thru here.

	If (PID .eq. 0) then
	    Index = 0
	    Return
	EndIf

	If (Index .eq. 0) then
	    Index = 1
	EndIf

c  Enter one user's information into the info arrays.

	PID_array(Index)	= PID
	STS_array(Index)	= STS
	Prcnam_array(Index)	= Prcnam
	Username_array(Index)	= Username
	Terminal_array(Index)	= Terminal
	State_array(Index)	= State
	PgCnt_array(Index)	= PgCnt
	FP_array(Index)		= FlagProcess

	Last_Number		= Index
	Index			= Index + 1

c  Done!

	Return

	End


c------------------------------------------------------------------
	Character*20	Function Get_LastName(Username)

	Include		'GETJPIDEF'
	Include		'FingerFlg'
	Include		'Fingerdef.inc'

	Logical		IsPrint

	Character	ToUpper
	Character*31	Get_PersonalName, PersonalName, LastName
	Integer		Length, Pointer, Btrim, Index, End

	PersonalName	= Get_PersonalName(Username)
	Length		= Btrim(PersonalName)

	if (Length .eq. 1) Then
	    Get_LastName = ' '
	    return
	endif

c  Have to make sure the name is uppercase for sorting purposes.

	Index = 1
	DoWhile (Index .le. Length)
	    PersonalName(Index:Index) = ToUpper(PersonalName(Index:Index))
	    Index = Index + 1
	EndDo

c  Scan backward from the end of the name string to isolate the last
c  name.

	Pointer = Length
	DoWhile ( IsPrint(PersonalName(Pointer:Pointer)) .and.
	1        (Pointer .gt. 0) )
	    Pointer = Pointer - 1
	EndDo
	Pointer = Pointer + 1

c  Copy the last name into the returned string.

	LastName = ' '			! 20 spaces
	Index = 1
	End = Length - Pointer + 1
	DoWhile (Index .le. End)
	    Position = Index + Pointer - 1
	    LastName(Index:Index) = PersonalName(Position:Position)
	    Index = Index + 1
	EndDo

c  Now concat the balance of the personal name to the last name.  This
c  will cause sorting to reconcile people with the same last name.

	If (Pointer .gt. 1) then
	    Get_LastName = LastName(:End) // PersonalName(1:Pointer-1)
	Else
	    Get_LastName = LastName(:End)
	EndIf

	Return

	End



c-------------------------------------------------------------
	Integer Function Get_l_Val(I)

	Integer	I

	Get_l_Val = I

	Return

	End

c------------------------------------------------------------------
	Logical		Function IsPrint(Candidate)

	Character	Str$UpCase, Candidate, Temp

	Temp = Str$UpCase (Candidate)

	If ( (Temp .gt. ' ') .and. (Temp .lt. 'a') ) then
	    IsPrint = .true.
	Else
	    IsPrint = .false.
	EndIf

	Return

	End


c------------------------------------------------------------------
	Character	Function ToUpper (Candidate)

	Character	Candidate
	Character*26	UCase_Alphas, LCase_Alphas
	Integer		Place

	Data		UCase_Alphas /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
	Data		LCase_Alphas /'abcdefghijklmnopqrstuvwxyz'/

	Place = Index(LCase_Alphas, Candidate)
	If (Place .ne. 0) then
	    ToUpper = UCase_Alphas(Place:Place)
	Else
	    ToUpper = Candidate
	EndIf

	Return

	End


	Logical Function Wild_Parse( Name, NonWild)			!FJN

	Character*(*) Name						!FJN
	Integer NonWild							!FJN

	Wild_Parse = .false.						!FJN
	NonWild = 0							!FJN

c Scan for wild card characters "*" and "%", count non-wild characters	!FJN

	Do i = 1,LEN(Name)						!FJN
	    If ( Name(i:i) .eq. '*' ) Then				!FJN
		Wild_Parse = .true.					!FJN
	    Else If ( Name(i:i) .eq. '%' ) Then				!FJN
		Wild_Parse = .true.					!FJN
	    Else If ( Name(i:i) .ne. ' ' ) Then				!FJN
		NonWild = NonWild + 1					!FJN
	    End If							!FJN
	Enddo								!FJN

	Return								!FJN
	End								!FJN

c------------------------------------------------------------------
	SUBROUTINE XABSET ( xabpro )
C
	INCLUDE 'XABPRODEF.INC'
C
	RECORD	/XABPRODEF1/ xabpro
C
	INTEGER*4	l_uic
C
	COMMON	/XAB_UIC/   l_uic
C
	xabpro.XABPRODEF$$_FILL_1 = XAB$C_PRO	    ! Type of XAB block.
	xabpro.XABPRODEF$$_FILL_2 = XAB$C_PROLEN     ! Length of PRO XAB.
C	xabpro.XABPRODEF$$_FILL_4 = 0		    ! Next XAB address.
	RETURN
	END
C
	SUBROUTINE XABGET ( xabpro )
C
	INCLUDE 'XABPRODEF.INC'
C
	RECORD	/XABPRODEF1/ xabpro
C
	INTEGER*4	l_uic
C
	COMMON	/XAB_UIC/   l_uic
C
	l_uic = xabpro.XAB$L_UIC
	RETURN
	END


c------------------------------------------------------------------
c	Update history / implementation notes -
c
C	V1.00	Base version Working with DEC-20	June 1982
C	V1.01	Index of nodes with routing		June 1982
C	V1.02	Return open error message on failure
C		to establish link to next node		July 1982
C	V1.03	Slight change in task spec for VMS V3.0	July 1982
C	V1.04	Add image name information		July 1982
C
C	V2.00	Start looking for individuals		July 1982
C	V2.01	Clean up IO units			July 1982
C	V2.02	Clean up LOCATION, NAME & IMAGE		July 1982
C	V2.03	Fix individual finger w. wildcards	Aug. 1982
C	V2.04	Put GETJPI stuff in include file	Aug. 1982
C
C	V3.00	Combine local and network invocation	Aug. 1982
C	V3.01	Consolidate IO units into COMMON	Aug. 1982
C	unspec	Added terminal display -- PSYA::LUCAS	Sep. 1982
C	V3.02	Added typing of <username>.PLN files	
C		when fingering a specific user, as well
C		as telling if user has any new mail
C		messages. -- PSYA::OHLUND		Sep. 1982
C	V3.03	Change <username>.PLN to FINGER.PLN Rg	Sep. 1982
C	V3.04	Fix a few bugs. Rg			Sep. 1982
C	V3.10	Get personal name from UAF		Nov. 1982
C	V3.20	Get load averages			Nov. 1982
C	V3.25	Get node name from SYS$NODE		Nov. 1982
C	V3.30	Get current Mail messages		Nov. 1982
C	V3.35	Get day of the week			Nov. 1982
C	V4.00	Complete cleanup and rationalization		15-Nov-1982
c	V4.01	Fix bug in Get_Image scanning for image name	16-Nov-1982
c	V4.02	"Make_Pretty" the image name. Put all "Make_Pretty"'s
c		in Output routines.				18-Nov-1982
c	V4.03	Remove all Str$UpCase calls but the 1st
c		in routine Finger and in Make_Pretty.		18-Nov-1982
c	V4.04	Make load device a parameter			22-Nov-1982
c	V4.05	Fix mail-messages > 99 bug.			23-Nov-1982
c	V4.06	Put in handler to catch signalled errors
c		and route messages back to requesting node	17-Dec-1982
c	V4.07	Fix bug in MailTextInfo "From:" message.	 6-Jan-1983
c	V4.08	Slight mod in load average output statement.	17-Mar-1983
c	V4.09	Put in BITnet for location for PTys		24-Apr-1983
c
c	V5.00	Restructure program to use callable output
c		routine.  This is in anticipation of other
c		network support.				19-May-1983
c	V5.01	Allow terminal names to 6 char (7 including the
c		":"). This allows 3 digit numbers, e.g. TTC123	19-May-1983
c	V5.02	Put in limits to the number of messages output
c		by the signal_handlers to catch runaway error
c		loops						19-May-1983
c	V5.03	Add CPU type and VMS version to header.		20-May-1983
c	V5.04	Add display qualifiers to .CLD file		4-Jun-1983
c		In anticipation of having all display options
c		selectable by the user.
c	V5.05	add "no such jobs." message.			4-Jun-1983
c	V5.06	Change Flag integers to parameters		6-Jun-1983
c	V5.06	Check for NET, SUBPROCESS, and SYSTEM jobs	6-Jun-1983
c	V5.07	Move flag definitions to include file.		7-Jun-1983
c	V5.08	Fix wrong mask PCB$M_NETWRK			9-Jun-1983
c	V5.09	Change OPEN statement for load average due
c		to aparent VMS change in V3.2			18-Aug-1983
c	V5.10	Use Fortran IO instead of LIB$PUT_SCREEN locally
c		to avoid screw ups on hard copy devices. Consolidate
c		DECnet and local output routine: RMS_Out_Routine.
c		Similarly consolidate Signal handlers.		3-Sep-1983
c	V5.11	Add [NO]Message qualifier to suppress message
c		of the day.					3-Sep-1983
c	V5.12	Get LOGIN time and CPU time for processes.	22-Sep-1983
c	V5.13	Change NAME qualifier to PERSONALNAME,
c		change TTNAME qualifier to TERMINAL,
c		change PRCNAME qualifier to PROCESSNAME.	22-Sep-1983
c	V5.14	Break User_Info according to qualifiers		21-Sep-1983
c	V5.15	Take out space in front of PLAN lines.		22-Sep-1983
c	V5.16	Map "." into self.				22-Sep-1983
c	V5.17	Put "- Subprocess -" into Location		22-Sep-1983
c	V5.18	Move Username <--> Name to Shared COMMON	5-Oct-1983
c	V5.19	Put in personal name matching			6-Oct-1983
c	V5.20	Implement Idle time				6-Oct-1983
c	V5.21	Put terminal data-base into common section	7-Oct-1983
c	V5.22	Put node data into shared common section	10-Oct-1983
c	V5.23	Change idle-time from mm:ss to hh:mm		15-Oct-1983
c	V5.24	change local output open to type='NEW' to fix
c		bug when assigning sys$output to a file.	15-Oct-1983
c	V5.25	Fix typo in JPI item list for OWNER		17-Oct-1983
c	V5.26	Add /FULL (all display qualifiers on)		18-Oct-1983
c	V5.27	Fix load average output bug.			18-Oct-1983
c	V5.28	Fix MailTextInfo multiple message bug (CRW)	29-Oct-1983
c	V5.29	Use Wild_Match routine in Check_Name		4-Nov-1983
c	V5.30	Put in wild cards for node names		4-Nov-1983
c	V5.31	Put in wild cards for personalname match	5-Nov-1983
c	V5.32	Separate the FingerMain file from Finger	5-Nov-1983
c	V5.33	Fix personalname wild cards a bit		7-Nov-1983
c	V5.34	Add STATE & SIZE from BJJ@PSUVMS1		25-Nov-1983
c	V5.35	Include outgoing BITnet linking			25-Nov-1983
c	V5.36	Put in checks for reentrant BITnet call		28-Nov-1983
c	V5.37	Fix several bugs in BITnet stuff		29-Nov-1983
c	V5.38	Put FAO arguments for signal handler		1-Dec-1983
c	V5.39	Close channels (Out-link, and Mail)		2-Dec-1983
c	V5.40	Signal (rather than Exit) on Help error		3-Dec-1983
c	V5.41	Have Finger and subFingers return status. -1
c		means abort.  					5-Dec-1983
c	V5.42	Put in messages and return codes for exits.	7-Dec-1983
c	V5.43	Take out "ERR=" in DECnet read			13-Dec-1983
c	V5.44	Put in error return for Node wild card failure	15-Dec-1983
c	V5.45	Allow "<>" as directory delimitors in Get_Image	15-Dec-1983
c	V5.46	Fix CPU time for overflow.			22-May-1984
c	V5.47	clear a flag before first timeout so wild card
c		node timeouts won't give spurious timeouts	22-Jun-1984
c	V5.48	Change "BITnet" to "jnet" throughout.		17-Jul-1984
c	V5.49	Add network names in Fingershr and on output	17-Jul-1984
c	V5.50	Put Que name in for Batch jobs			19-Jul-1984
c	V5.51	Avoid doing extra GETJPI on outswapped procs.
c		and fix output for same (Ed Miller @SLAC)	9-Aug-1984
c	V5.52	Get remote DECnet node for location		10-Aug-1984
c	V5.53	Work on multile jnet link situation		31-Aug-1984
c	V5.54	Send to IBM nodes a'la Vace (MSG vs CMD)	31-Aug-1984
c	V5.55	Make "Command complete" check case-insensitive	19-Sep-1984
c	V5.56	Buffer RMS output line at a time		19-Sep-1984
c	V5.57	Supply the command "FINGER" if missing on
c		jnet invocations.				20-Sep-1984
c	V5.58	put in ' MSG' at end of command to IBM hosts	26-Sep-1984
c	V5.59	change definition of "system" process slightly	19-Oct-1984
c	V5.60	Fix bug in clearing DECnet site name		23-Oct-1984
c	V5.61	Deassign NET: channel after use:Get_DECnet_Node	24-Oct-1984
c	V5.62	Add routine to get jnet node: Get_jnet_Node	27-Oct-1984
c	V5.63	Adapt for uVAX. (VMS V4.0 changes)		5-Nov-1984
c			CPU type: add uVAX I
c			Imagename: multiple brakets [ ][ ] etc.
c			Default Dir from SYSUAF
c			PID format
c	V5.64	real V4.0 came					12-Jan-1985
c			Get DCL parse kludge from BJJ @ PSUVMS1
c			GET_ID from CRW @PSUVMS1 (Mail stuff)
c			New IDLE.MAR (BJJ @ PSUVMS1) to use EPIDs
c
c	New version format: Vx.y.z - 	x = VMS version
c					y = major finger version
c					z = finger revision
c	V5.64 => V40.0.7					12-Jan-1984
c	V40.0.8	-	new V4.0 QUENAME (PJO @ PSUVMS1)	14-Jan-1985
c	V40.0.9	-	disable DECNET node name for now	14-Jan-1985
c	V40.0.10 -	Use LIB$DAY_OF_WEEK			17-Jan-1985
c	V40.0.11 -	Put in new CPU types			17-Jan-1985
c	V40.0.12 -	Put in last login time			17-Jan-1985
c	V40.0.13 -	Integrate Mark London (MIT) changes 
c			into IDLE.MAR				24-Jan-1985
c	V40.0.13	Add filter for printing control chars.	29-Jan-1985
c	V40.0.14	Rewrite and rename Idle --> TT_UCB.  Now it
c			also gets physcial terminal name.	31-Jan-1985
c	V40.0.15	Transform VT's into TT's in Get_Location 31-Jan-1985
c	V40.0.16	Allow local host name to be set other than
c			DECnet node name			6-Feb-1985
c	V40.0.17	Add "Organization name" to heading	7-Feb-1985
c	V40.0.18	Include Peter Lucas's TCP code untested	12-Feb-1985
c	V40.0.19	Search multiple nets for a node (ala PAL) 12-Feb-1985
c	V40.0.20	Default "router" stuff (ala PAL)	15-Feb-1985
c	This was sent out to some sites as a "beta test"	15-Feb-1985
c	----------------
c	V40.0.21	minor fixes to above			19-Feb-1985
c	V40.0.22	more of same				20-Feb-1985
c	V40.0.23	enable privs only when needed		25-Feb-1985
c	V40.0.24	require EXEC mode log name translation	27-Feb-1985
c	V40.0.25	jnet_Finger using global sec after getting
c			status that there wasn't one.		28-Feb-1985
c	V40.0.26	Fix TTUCB and Finger for RT DECnet nodes 8-Mar-1985
c	V40.0.26	Take EXEC mode out for FINGER$MESSAGE	25-Mar-1985
c	V40.0.27	Change Open of SYSUAF for VMS 4.1	25-Mar-1985
c	V40.0.28	make singular "user" in header		25-Mar-1985
c	V40.1.00	Call this VMS 4.0 "release version"	25-Mar-1985
c	----------------
c	V40.1.01	Put "%Val( )" in SYS$DASSGN: Get_DECnet_Node
c			turn off CMKRNL: Get_Idle_Times		3-Apr-1985
c	V40.1.02	Trim trailing space off ORGANIZATION	5-Apr-1985
c	V40.1.03	Make 7 chars default for Terminal names
c			to accomodate VTA's			16-Apr-1985
c	V40.1.04	Assign channel each time: Get_DEC_Node	17-Apr-1985
c	V40.1.05	fix for jnet V2X2 add SYS$CANEXH	21-Apr-1985
c	V40.1.06	Fix by Mike Cochran <Mike@Mecan1.BITnet>
c			for last users in UAF problem		22-Apr-1985
c	V41.1.07	Close with privilege files so opened	20-May-1985
c	V41.1.08	Move open of UAF inline. kill OPEN_UNITS 20-May-1985
c	V41.1.09	Change $TRNLOG to $TRNLNM 		20-May-1985
c	V41.1.10	Look for "::" if no "@" in command.	21-May-1985
c			above 3 changes from Dan Cottler of RCA
c	V41.1.11	Don't cut "_" in Node if there isn't one 5-Jul-1985
c	V41.1.12	List "From: so-and-so" mail messages	19-Jul-1985
c	V41.1.13	Incorporate GET_ID into PERSONAL_INFO,
c			get correct mail subdirectory		21-Jul-1985
c	V41.1.14	Fix PERSONAL_INFO to deal with mail
c			subdirectories				23-Jul-1985
c	V41.1.15	Fix bug in GET_LOCATION for VTA's	23-Jul-1985
c	V41.1.16	Compile time option for latest message
c			only - Personal_info			3-Aug-1985
c	V41.1.17	Use new JANLIB routines in jnet_FINGER	5-Sep-1985
c	V41.1.18	Merge in R. Greenberg's sort routines	22-Sep-1987
c			and other RCA and GE changes.
c	V45.1.01	Add in code to check UIC of individual 
c			fingered against owner UIC of FINGER.PLN
c			to thwart spoofs vis SET FILE/ENTER	28-Sep-1987
c	V46.1.01	Eliminate dual definitions of system
c			services in function Priv_UserOpen. By
c			Rand P. Hall <rand@merrimack.edu>	22-Oct-1987
c	V46.1.02	Changed all references to terminals to
c			Character*8 instead of *7 (ie, can now
c			handle VTA1234:). By Rand P. Hall	06-Jan-1988
c	V46.1.03	Made LAT terminal identification code
c			functional. Added a couple more cpus.
c			By Rand P. Hall				06-Jan-1988
c	V46.1.04	Made display of unread mail more realistic.
c			You now have the option of displaying only
c			mail from you. Fixed a few .02 bugs. Tested
c			with the LTDRIVER from the VMS 4.7 kit.
c			By Rand P. Hall				29-Jan-1988
c	V47.1.00	Works w/ 4.7. Fingering someone NOT in the 
c			Finger Common Block works, again. Mail file
c			processing now has two options: A) Display
c			only # of new mail messages, or B) Display
c			A plus DATE and SUBJECT of unread messages
c			sent to the Fingeree from the Fingerer.
c			Sort routine loads indices more efficiently.
c			All cpu types now handled. By Rand Hall 04-Apr-1988

