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