	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

	IMPLICIT INTEGER (A-Z)
     
	Character*25	Fingerdae_Version /'V41.1.01 of 11-Sep-1985'/
	Character	CMode
	CHARACTER*99	MSG_LINE
	CHARACTER*8	FROM_USER, FROM_NODE
     
	Logical		Parse_jnet
     
	Character VersionMsg*50
	Common	/Version_Common/ VersionMsg

	COMMON /INFO/ FROM_NODE, FROM_USER
     
	EXTERNAL	LOG

	STATUS = JAN_HOOK_INIT (4, 'FINGER')
	IF (.NOT.STATUS) CALL LIB$STOP(%VAL(STATUS))
     
	CALL LOG('Starting FINGER jnet daemon')
	Call Log(VersionMsg)
	Call Log('FINGERDAE version: '//Fingerdae_version)
	CALL JAN_VERSION_DSP(LOG)		! 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 Log (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 LOG(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 /INFO/ 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	Str$UpCase*132

	Character	Buffer*132
	Character	RMSstring*22
	Character	Msg*255
	Integer		MsgLen
	Integer		BufferPointer
	Integer		MaxPointer/80/, CRLast
	Integer		Finger,
	1		OutboundLinkUnit /11/,
	2		UafUnit /12/,
	3		ScratchUnit /13/

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

	Common		/jnet_Daemon/ IDaemon

	Integer		Lib$Establish
	External	jnet_Out_Routine
	External	jnet_Signal_Handler
	Character	C$Temp*80
	
c  initialize things
	BufferPointer = 0
	CRLast = .true.
	l_Com = Len(Command)
	Command = Str$Upcase(Command)
	IDaemon = .true.

c  turn off message
	Call Lib$Set_Logical('FINGER$MESSAGE','NL:')
c  Establish handler and call finger
	Call Lib$Establish(jnet_Signal_Handler)
	ii = Finger(
	1   Command(:l_Com),jnet_Out_Routine)
	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
	Call Sys$Getmsg(%Val(ii),MsgLen,Msg,%VAL(1),)
	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/
	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: '//Msg2(:MsgLen2)//CR)
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/, Save, Flush/255/

	Character	Buffer*132
	Integer		BufferPointer, MaxPointer, CRLast

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

	TextLen = Len(Text)

	If ( TextLen .eq. 0 ) Return

	Do ii = 1, TextLen
	    If ( Text(ii:ii) .eq. CR ) then
		Call ReturnMail(Buffer(:BufferPointer))
		BufferPointer = 0
		CRLast = .true.
	    Else if ( Text(ii:ii) .eq. LF ) then
		If ( .not. CRLAST ) then
		    Call ReturnMail(Buffer(:BufferPointer))
		    BufferPointer = 0
		End if
		CRLast = .false.
	    Else if ( Text(ii:ii) .eq. Flush ) then
	    Else
		If ( BufferPointer .eq. MaxPointer ) then
		    Save = Buffer(MaxPointer:MaxPointer)
		    Buffer(MaxPointer:MaxPointer) = '-'
		    Call ReturnMail(Buffer)
		    Buffer(1:2) = '-'//Save
		    BufferPointer = 2
		End if
		BufferPointer = BufferPointer + 1
		Buffer(BufferPointer:BufferPointer) = Text(ii:ii)
		CRLast = .false.
	    End if
	End do

	Return

	End
