Program Finger_Dae

c	This is the main program for the jnet Finger Daemon.
c	It utilizes calls to jnet (tm) software which provides
c	VAX/VMS the ability to emulate an IBM RSCS node.  This
c	daemon provides incoming jnet access to the Finger command.
c
c	Top level routine written by Craig Watkins.  Integrated into
c	routine to call Finger by Richard Garland.
c
c	jnet is a trademark of Joiner Associates.
c
c	Mods to jnet interface routines to call new JANLIB interface
c	instead of doing everything with low level jnet routines.
c	C. R. Watkins 3-Aug-1985
c		V41.1.00	CRW version		3-Aug-1985
c		V41.1.01	fix wake problem	11-Sep-1985
c		V51.1.06	Replace Jnet_Out_Routine completely,
c				add hooks for getting help via jnet,
c				general cleanup		18-Mar-1989
c		V51.1.09	Fix common INFO being used for two
c				seperate things w/ different contents
c				Way to go!!!		15-Apr-1989	
c		V51.1.11	Add /IAM="user~node" qualifier to end
c				of finger command for mail checking.
c							25-Apr-1989
c		V51.1.12	More /IAM stuff.	27-Apr-1989
c		V51.1.19	More fix for status msg 01-Jul-1989
c		V51.1.21	Update version info     07-Aug-1989
c		V51.1.22	Update version info	26-Aug-1989
c		V51.1.23	Fix confusion w/ Fortran's LOG function.
c							15-Sep-1991

	IMPLICIT INTEGER (A-Z)
     
	Character*25	Fingerdae_Version /'V51.1.35 of 24-Jul-2000'/
	Character	CMode
	CHARACTER*99	MSG_LINE
	CHARACTER*8	FROM_USER, FROM_NODE
     
	Logical		Parse_jnet
     
	Character VersionMsg*50
	Common	/Version_Common/ VersionMsg

	COMMON /JINFO/ FROM_NODE, FROM_USER
     
	EXTERNAL	jfLOG

	STATUS = JAN_HOOK_INIT (4, 'FINGER')
	IF (.NOT.STATUS) CALL LIB$STOP(%VAL(STATUS))
     
	CALL jfLOG('Starting FINGER jnet daemon')
	Call jfLog(VersionMsg)
	Call jfLog('FINGERDAE version: '//Fingerdae_version)
	CALL JAN_VERSION_DSP(jfLOG)		! Log JANLIB version

1000	Continue

	STATUS = JAN_RECEIVE_MSG (MODE, FROM_NODE, FROM_USER,
	1					MSG_LINE, MSG_LEN)
	IF (.NOT.STATUS) GOTO 1200
	Write(CMode,2001) Mode
	Call jfLog (CMode//' - '//From_User//'@'//From_Node//' - '//
	1	Msg_Line(:Msg_Len))
	If ( Parse_jnet(Msg_Line(:Msg_Len)) ) then
	    CALL FINGER_jnet(MSG_LINE(:MSG_LEN))
	Else
	    CALL FINGER_jnet('FINGER '//MSG_LINE(:MSG_LEN))
	End if
     
	GOTO 1000

1200 	STATUS = SYS$HIBER()
	IF (.NOT.STATUS) CALL LIB$STOP(%VAL(STATUS))
     
	GOTO 1000
2001	Format(I1)
	END

	SUBROUTINE jfLOG(STRING)
	IMPLICIT  INTEGER*4(A-Z)
	CHARACTER*(*)     STRING
	INTEGER*4 NOW_TIME(2)
	CHARACTER*23      TIME_DATE
     

	CALL SYS$ASCTIM(,TIME_DATE, , %VAL(0))
     
	OPEN (UNIT=12, DEFAULT FILE='JAN_SYS:.LOG', FILE='FINGER',
	1  STATUS='UNKNOWN',
	1  CARRIAGECONTROL='LIST',
	1  ACCESS='APPEND',
	1  ERR = 10,
	1  RECORDSIZE=200)
     
	WRITE(12,1) TIME_DATE,STRING
1	FORMAT(A23,' ',A)
	CLOSE(UNIT=12)
     
10	RETURN
	END
     
	INTEGER FUNCTION RETURN MAIL(LINE)
	IMPLICIT INTEGER (A-Z)
     
	CHARACTER*(*)	LINE
	CHARACTER*8	FROM_NODE, FROM_USER
     
	COMMON /JINFO/ FROM_NODE, FROM_USER
     
	RETURN MAIL = JAN_SEND_MSG (2, FROM_NODE, FROM_USER, LINE)

	RETURN
	END
     

c------------------------------------------------------------------------------
	Logical Function Parse_jnet(Command)

c	check to see if the keyword "FINGER" is the first element
c	on the command line

	Character Command*(*), Str$UpCase*80, UpCommand*80

	UpCommand = Str$UpCase(Command)
	Parse_jnet = .false.
	ll = len(Command)

	If ( Index(UpCommand(:ll),'FINGER') .ne. 0 ) Parse_jnet = .true.

	Return
	End


c------------------------------------------------------------------------------
C..Finger_jnet				Call Finger from jnet (DAE)
C..					R. Garland / CUCHEM /28-Nov-1983

	Integer	Function Finger_jnet(Command)

c	This routine is called from the command parser of the jnet
c	daemon DAE.  It sets up the appropriate output routine and
c	signal handler and then calls Finger.  It passes the complete
c	command line from DAE to Finger.

	Character	Command*(*)
	Character	LocalCommand*132, LocalQualifier*32, LocalUser*9
	Character	Str$UpCase*132

	Character	Buffer*132
	Character	RMSstring*22
	Character	Msg*255

	Integer		MsgLen
	Integer		BufferPointer
	Integer		MaxPointer/80/
	Integer		Access/2/
	Integer		Finger,
	1		OutboundLinkUnit /11/,
	2		UafUnit /12/,
	3		ScratchUnit /13/

	Common	/jnet_Buffer/ BufferPointer, MaxPointer,
	1		Buffer

	Common		/jnet_Daemon/ IDaemon

	Integer		Lib$Establish
	Integer		Btrim
	External	jnet_Out_Routine
	External	jnet_Signal_Handler
	External	Fing_Complete

	Character*8	From_User, From_Node

	Common		/JINFO/	From_Node, From_User

	Integer		FirstTime
	Common		/zip/ FirstTime

	Character	C$Temp*80
	
c  initialize things
	BufferPointer = 0
	l_Com = Len(Command)
	Command = Str$Upcase(Command)
	IDaemon = .true.

c  tack on user, node info
	LocalUser = From_User
	If (Btrim(LocalUser) .eq. 8) Then
	    LocalUser = LocalUser(:Btrim(LocalUser))//'*'
	EndIf
	LocalQualifier = '/IAM="'//LocalUser(:Btrim(LocalUser))
	1 //'~'//From_Node(:Btrim(From_Node))//'"'
	LocalCommand = Command//LocalQualifier(:Btrim(LocalQualifier))
	l_Com = l_Com+Btrim(LocalQualifier)
c  turn off message
c !! Site-specific - uncomment the following line if you don't want to show
c		     the message-of-the-day to other jnet sites.
c	Call Lib$Set_Logical('FINGER$MESSAGE','NL:')
c  Establish handler and call finger
	Call Lib$Establish(jnet_Signal_Handler)
	FirstTime = 1
	ii = Finger(
	1   LocalCommand(:l_Com),jnet_Out_Routine, Access)
	If ( .not. ii ) then
c  Here if an abort occured.
c  Close any units left hanging
	    Close(OutboundLinkUnit,	Err=1011)
1011	    Close(UafUnit,		Err=1012)
1012	    Close(ScratchUnit,	Err=1013)
1013	    Continue
	    BufferPointer = 0
c  may have to unmap mail file
	End if

c  Check for anything left in buffer
	If (BufferPointer .ne. 0 )
	1   Call ReturnMail(Buffer(:BufferPointer))
c  Get exit message from Finger
	If (ii .eq. %loc(Fing_Complete)) Then
	    Call Sys$Getmsg(%val(ii),MsgLen,Msg,%VAL(1),)
	Else
	    Call Sys$Getmsg(%Val(ii),MsgLen,Msg,%VAL(15),)
	EndIf
	Call ReturnMail(Msg(:MsgLen))

c  exit with normal status
	Finger_jnet = 1
	Return

	End

c-------------------------------------------------------------------------
	Integer Function jnet_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 ReturnMail to transmit the message back to the
c  jnet invoker.  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		SS$_Status, 		SS$_Normal/1/
	Integer		SignalVector(8),	MechanismVector(5)
	Integer		Message_Limit/10/,	Message_Count/0/
	Integer		Depth
	Integer		MsgLen,		MsgLen2
	Character	Msg*255,	Msg2*132
	Character	LF/10/,		CR/13/
	Character	FLUSH/255/
	External	Fing_Abort

	jnet_Signal_Handler = SS$_Normal
	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 jnet_Out_Routine(LF//'%FINGER-E-OOPS, '
	1	//Msg2(:MsgLen2)//CR//FLUSH)
c  unwind to the calling routine (Finger_jnet)
	Depth = MechanismVector(3)
	MechanismVector(4) = %Loc(Fing_Abort)	! Set return code
	Call Sys$Unwind(Depth,%Val(0))

	Return

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

c	This routine sends a message back over jnet
c	It must buffer input and form records out of stream type
c	data, stripping CR, LF etc. in the process.

	Character	Text*(*)
	Integer		TextLen
	Character	LF/10/,	CR/13/, Flush/255/

	Character	Buffer*132
	Integer		BufferPointer, MaxPointer

	Integer		FirstTime
	Common		/zip/ FirstTime

	Common	/jnet_Buffer/ BufferPointer, MaxPointer,
	1		Buffer

	TextLen = Len(Text)

d	call returnmail(text(:textlen))
d	return

	If (TextLen .eq. 0) Return

	Do ii = 1, TextLen
	    If (Text(ii:ii) .ne. CR) then
		If (Text(ii:ii) .ne. LF) then
		    If (Text(ii:ii) .ne. flush) then
			BufferPointer = BufferPointer + 1
			Buffer(BufferPointer:BufferPointer) = Text(ii:ii)
		    Endif
		Endif
	    Endif
	    If (Text(ii:ii) .eq. LF) then
		If (BufferPointer .ne. 0) then
		    Call ReturnMail(Buffer(:BufferPointer))
		    BufferPointer = 0
		Else
		    If (FirstTime .ne. 1) then
			Call ReturnMail(' ')
		    Else
			FirstTime = 0
		    Endif
		Endif
	    Endif
	    If (Text(ii:ii) .eq. flush) then
		If (BufferPointer .ne. 0) then
		    Call ReturnMail(Buffer(:BufferPointer))
		    BufferPointer = 0
		Endif
	    Endif
	    If (BufferPointer .gt. MaxPointer-1) then
		Call ReturnMail(Buffer(:BufferPointer))
		BufferPointer = 0
	    Endif
	End do
	Return
	End