C..FingMain.For				VAX/VMS Finger main program
C..					R. Garland / C.U. Chemistry / Oct-1983
	Program	Finger$Main

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 V3.0 or later
C		Must be installed with CMKRNL,SYSPRV, and WORLD 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
C	Routines required-
C		FINGER callable routine for Finger.
C		FINGERSHR (shared common section) in this submission.
C			Note:  This shared section is maintained by
C				the SHR program in this submission.
C		IDLE,WILD (.MAR) in this submission.
C		FINGERCLD (.CLD table) in this submission
c
C		All other routines other than VMS system services and
C		VMS library routines are contained in this source.
C
C	Include files-
C		GETJPIDEF.FOR: (in this submission) contains
C		    definitions and data declarartions for the $GETJPI
C		    system service.
c		FINGERCOM.FOR: (in this submission) definitions of the
C		    shared common sections.
c		FINGERFLG.FOR (part of this submission) contains
C		    Bit definitions used in parsing the command qualifiers.
c
C	Implementation and installation notes-
C		See separate document in this submission.
C
	Include		'Fingerdef.inc'

	Character	Command*132
	Character	Lib$Get_Foreign*132, Str$UpCase*132
	Character	Net$Lognam*7	/'SYS$NET'/
	Character	Out$Lognam*10	/'SYS$OUTPUT'/
	Character	Rslbuf*132
	Integer		Sys$Trnlnm, SS$_Status,	SS$_NoLog/Z000001BC/
	Integer		SS$_Normal/1/,	Btrim
	Integer		LAccess/1/, DAccess/3/
	External	RMS_Signal_Handler, RMS_Out_Routine
	External	Fing_NoNode
	Integer		Finger

	Parameter	InboundLinkUnit	= 10

	Character	LF/10/, CR/13/, Flush/255/

	Character	Buffer*255
	Integer		BufferPointer, MaxPointer/255/, CRLast
	Integer		Privilege(2) /0,0/

	Common	/RMS_Buffer/ BufferPointer, MaxPointer,
	1		CRLast, Buffer

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

c  initialize things for output routine
	BufferPointer = 0
	CRLast = .true.

C Find the type of invocation, and call Finger appropriately.
c
c  Note:  For the particular invocation one must do 3 things:
c	o Get the Finger command from the invoker.
c	o Establish a channel and an appropriate output
c	  routine to send the output of finger to the invoker.
c	o Establish a signal handler to route error messages back
c	  to the invoker.
c
c	The current version supports Local invocation and DECnet invocation.

C  Check if SYS$NET is defined, if so we are a DECnet invocation

	SS$_Status = Sys$Trnlnm(,'LNM$PROCESS_TABLE',Net$Lognam,,)

	If ( SS$_Status .eq. SS$_Normal ) then		! DECnet invocation
C	    Network object finger.  It differs from the local 
C	    version only in unit assignment, and in where it gets
C	    the finger command.
C	  Get command 
	    Open( Unit=InboundLinkUnit,
	1	Name=Net$Lognam,
	2	Type='OLD',
	3	Record size = 255,
	4	Block size = 255,
	5	CarriageControl='NONE')
	    Read (InboundLinkUnit,1001) l_Com, Command
	    Command = Str$UpCase(Command)
C	  Establish handler for error messages, call finger routine
	    Call Lib$Establish(RMS_Signal_Handler)
	    ii = Finger(Command(:l_Com),RMS_Out_Routine,DAccess)

	ElseIf ( SS$_Status .eq. SS$_NoLog ) Then	! Local invocation
C	    Local invocation.  It differs from the network object version 
C	    only in unit assignment, and in where it gets the finger 
C	    command.
C	  Get command 
	    Command = 'FINGER '//Lib$Get_Foreign(,l_Com)
	    l_Com = l_Com + 7
	    Command = Str$UpCase(Command)
	    Open( Unit=InboundLinkUnit,
	1	Name=Out$Lognam,
	2	Type='NEW',
	3	Record size = 255,
	4	Block size = 255,
	5	CarriageControl='NONE')
C  	  Establish handler for error messages, call finger routine
c..uVAX dbug	    Call Lib$Establish(RMS_Signal_Handler)
	    ii = Finger(Command(:l_Com),RMS_Out_Routine,LAccess)

	EndIf
c  Flush buffer
	Call RMS_Out_Routine(Flush)
C  Done
	If (ii .eq. %Loc(Fing_NoNode)) Then
	    Call Exit(SS$_Normal)
	Else
	    Call Exit(ii)
	EndIf

1001	Format(Q,A)

	End
c-------------------------------------------------------------------------
	Integer Function RMS_Signal_Handler(
	1	SignalVector,MechanismVector)

c  The point of this handler is really error message routing rather
c  than actually responding to a particular condition.  The routine
c  convert all signals into messages for transmission to the invoker.
c  This routine uses RMS_Out_Routine so it should work for local
c  or DECnet invocations. The routine exits with a CONTINUE flag.  If
c  there are errors that should actually be handled (arithmetic or
c  whatever) by some system handler,  they will not be.

	Integer		SignalVector(20),	MechanismVector(20)
	Integer		Message_Limit/10/,	Message_Count/0/
	Integer		SS$_Status,	SS$_Normal/1/
	Integer		MsgLen		MsgLen2
	Character	Msg*255,	Msg2*132
	Character	CR /13/,	LF /10/,	SP /' '/

	Integer		RMS_CRLF_Out_Routine
	External	RMS_CRLF_Out_Routine

	RMS_Signal_Handler = SS$_Normal	! Continue after condition
	SS$_Status = SignalVector(2)
	If ( SS$_Status .eq. SS$_Normal ) Return

	Call Sys$Getmsg(%Val(SS$_Status),Msglen,Msg,%VAL(1),)
	Call Sys$Fao(Msg(:MsgLen),MsgLen2,Msg2,
	1	%Val(SignalVector(4)),
	2	%Val(SignalVector(5)),
	3	%Val(SignalVector(6)),
	4	%Val(SignalVector(7)))
	Call RMS_Out_Routine(LF//'%FINGER-E-OOPS, '//
	1    Msg2(:Msglen2)//CR//LF)

d	jj = SignalVector(1) + 1
d	SignalVector(1) = SignalVector(1) .or. 15 * 2**16 !Turn on message flags
d	Write(6,2001) (SignalVector(ii),ii=1,jj)
d2001	Format((1X,Z8))

d	RMS_Signal_Handler = Sys$Putmsg(
d	1	SignalVector,
d	2	RMS_CRLF_Out_Routine,
d	3	'Finger',
d	4	null)

	Message_Count = Message_Count + 1
	If ( Message_Count .ge. Message_Limit ) then
	    Call RMS_CRLF_Out_Routine('%FINGER-E-EXLIMIT, '//
	1	'Message limit exceeded, aborting.'//LF)
	    Call Sys$Unwind
	EndIf

d	Call RMS_CRLF_Out_Routine(' ')
	Return

1001	Format(A)
	End

c-------------------------------------------------------------------------
	Subroutine RMS_Out_Routine(Text)

c	This routine types output locally or over DECnet

	Character	Text*(*)

	Parameter	InboundLinkUnit = 10

	Character	LF/10/, CR/13/, Flush/255/

	Character	Buffer*255
	Integer		BufferPointer, MaxPointer, CRLast

	Common	/RMS_Buffer/ BufferPointer, MaxPointer,
	1		CRLast, Buffer

	TextLen = Len(Text)

	If ( TextLen .eq. 0 ) Return

	Do ii = 1, TextLen
	    BufferPointer = BufferPointer + 1
	    Buffer(BufferPointer:BufferPointer) = Text(ii:ii)
	    CRLast = .false.
	    If ( Text(ii:ii) .eq. CR ) then
		Write(InboundLinkUnit,1000) Buffer(:BufferPointer)
		BufferPointer = 0
		CRLast = .true.
	    Else if ( Text(ii:ii) .eq. LF ) then
		If ( .not. CRLAST ) then
		    Write(InboundLinkUnit,1000) Buffer(:BufferPointer)
		    BufferPointer = 0
		End if
		CRLast = .false.
	    Else If ( Text(ii:ii) .eq. Flush ) then
		If ( BufferPointer .gt. 1 )
	1	    Write(InboundLinkUnit,1000) Buffer(:BufferPointer-1)
		BufferPointer = 0
	    Else
		If ( BufferPointer .eq. MaxPointer ) then
		    Write(InboundLinkUnit,1000) Buffer(:BufferPointer)
		    BufferPointer = 0
		End if
	    End if
	End do

	Return

1000	Format(A)
	End


c-------------------------------------------------------------------------
	Logical Function RMS_CRLF_Out_Routine(Text,null)

c	This routine types output locally or over DECnet with leading LF
c	and trailing CR.  It calls RMS_OUT_Routine.

	Character	Text*(*), CR/13/, LF/10/
	Call RMS_Out_Routine(LF//Text//CR)

	RMS_CRLF_Out_Routine = .false.

	Return

1000	Format(A)
	End