SUBROUTINE FINLCL C+ C Title: FINGERLCL.FTN C Author: T. R. Wyant C Date: 18-Aug-1987 C Modified: C Remarks: C This is the local information gatherer for FINGER. C- INCLUDE 'FINGERCOM/NOLIST' INCLUDE 'IPCOMM/NOLIST' PARAMETER USRSIZ = 50 ! Size of UAB in words. PARAMETER NAMSIZ = 14 ! Size of user name. INTEGER*2 ACNBFW (256) ! Account file buffer. LOGICAL*1 ACNBFB (128, 4) ! Account file buffer. INTEGER*2 ACNENT ! Account entry number. LOGICAL*1 BLK ! Trailing character to ignore. LOGICAL*1 BUG ! Multicharacter wildcard. LOGICAL*1 BYTBUF (USRSIZ*2) ! UAB buffer, in bytes. INTEGER*2 CURTIM (8) ! Current time. INTEGER*2 DEVINX ! Device name index. INTEGER*2 DEVUNT ! Device unit number. INTEGER*2 EXACT ! .TRUE. if want exact match. INTEGER*2 IDSW ! Exec directive status. INTEGER*2 ITER8 ! Iteration. INTEGER*2 LUNBUF(6) ! LUN data. INTEGER*2 MACHES ! Matches found. INTEGER*2 NAMMSK(8) ! Mask of legal characters in name INTEGER*2 PATMAT ! Pattern match subroutine. LOGICAL*1 PCT ! Single character wildcard. LOGICAL*1 UABINI ! UAB buffer initials. LOGICAL*1 UABNAM (NAMSIZ) ! UAB buffer user name. LOGICAL*1 UABTIM (6) ! Login time. LOGICAL*1 UNAMBF (NAMSIZ+1) ! User name buffer. INTEGER*2 UNAMSZ ! User name size. INTEGER*2 USIZE ! Size of unit number. INTEGER*2 USRBUF (USRSIZ) ! UAB buffer. EQUIVALENCE (ACNBFW, ACNBFB) EQUIVALENCE (USRBUF, BYTBUF) EQUIVALENCE (BYTBUF (41), UABTIM) EQUIVALENCE (BYTBUF (75), UABNAM) EQUIVALENCE (BYTBUF (89), UABINI) DATA BLK /' '/ DATA BUG /'*'/ DATA NAMMSK /0, 0, -1, -1025, -2, -1, -1, 32767/ DATA PCT /'%'/ C C======================================================================= C C Code. C C....................................................................... C C Parse the command. C C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Pick off the command name. C CALL CMDCMP ! Compress the command. IPSKFG = .TRUE. ! Blanks and tabs are separators IF (.NOT. IPSTR (6, 'FINGER', 1)) ! If command is not "Finger" 1 GO TO 9000 ! Error out. IPSKFG = .FALSE. ! Blanks and tabs are syntax. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Parse the switches. Unrecognized switches are ignored. C Currently, this includes all switches. C 3000 IF (IPCHAR(' ') .OR. IPEOS()) ! If at end of switches, 1 GO TO 3090 ! branch out. CALL IPANY () ! Gobble the next character. GO TO 3000 ! Next character. 3090 CONTINUE C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Parse the username. C IPSKFG = .TRUE. ! Blanks and tabs are separators UNAMSZ = 0 IF (IPEOS()) GO TO 3290 ! If at end of string, no user. IF (IPCHAR('.') .AND. IPEOS()) THEN ! If fingering self, CALL GETLUN (LUNOUT, LUNBUF) ! Find out terminal. LUNBUF(2) = LUNBUF(2) .AND. '377'O ! Mask status bits. CALL GINUSR (USRBUF, USRSIZ, ! Call the GIN$ directive 1 LUNBUF(1), LUNBUF(2), ! to find out who is 2 IDSW) ! logged on. IF (IDSW .LT. 0) GO TO 9020 ! If it failed, too bad. IPSLOC = 1 ! Move name from UAB IPSLEN = 0 ! to the CALL LODSTR (NAMSIZ, UABNAM) ! command buffer. CALL TRMSTR (0) ! truncate the name. IPLOC = IPSLOC ! Report name's location IPLEN = IPSLEN ! and length. GO TO 3270 ! Go record it. END IF IF (.NOT. IPMSET(0, NAMMSK)) GO TO 9010 ! Bad user name. 3270 CALL MOVSTR(IPLEN,IPBUF(IPLOC), ! Copy the user name into the 1 UNAMBF) ! designated cell. EXACT = .TRUE. ! Assume want exact match. DO 3280 ITER8 = 1, IPLEN ! Loop thru string. IF (UNAMBF(ITER8) .EQ. BUG ! If this is a 1 .OR. UNAMBF(ITER8) .EQ. ! wildcard, then 2 PCT) ! no exact 3 EXACT = .FALSE. ! match. 3280 CONTINUE UNAMSZ = IPLEN + 1 ! Add in a trailing UNAMBF(UNAMSZ) = BUG ! wildcard. 3290 CONTINUE ! Got the username. MACHES = 0 ! Init. match counter. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Display blank line. C IPSLOC = 1 IPSLEN = 0 CALL LODSTR (1, ' ') CALL FINOUT C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Display our node name and identification. C IPSLOC = 1 IPSLEN = 0 CALL LODSTR (1, ' ') CALL LODSTR (6, OURNAM) CALL TRMSTR (2) CALL TRALON (0, 0, , 'FINGER$SYSTEM_ID', 16, IPBUF(IPSLEN+1), 1 IPBLEN - IPSLEN, IPLEN, , IDSW) IF (IDSW .GE. 0) IPSLEN = IPSLEN + IPLEN IF (IDSW .LT. 0) CALL LODSTR (10, 'PDP-11/RSX') CALL TRMSTR (2) CALL GETTIM (CURTIM, IDSW) CALL LODTIM (CURTIM(1), CURTIM(2), CURTIM(3), 1 CURTIM(4), CURTIM(5), CURTIM(6)) CALL FINOUT C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C If name too short, croak now. C IF (UNAMSZ .GT. 0 .AND. UNAMSZ .LT. MINMAT) GO TO 9020 C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Loop through all legal terminals, looking for user. C DO 4290 DEVINX = 1, DEVTYP ! For each device type desired, DO 4280 DEVUNT = 0, DEVUTS (DEVINX) ! For each unit, CALL GINUSR (USRBUF, USRSIZ, ! Call the GIN$ directive 1 DEVNMS (DEVINX), DEVUNT, ! to find out who is 2 IDSW) ! logged on. IF (IDSW .LT. 0) GO TO 4280 ! If it failed, too bad. IF (UNAMSZ .LE. 0) GO TO 4250 ! If no username, displa IF (.NOT. PATMAT (NAMSIZ, ! If this user's name 1 UABNAM, UNAMSZ, UNAMBF, ! does not match the 2 BUG, PCT, BLK)) ! one passed, 3 GO TO 4280 ! don't display. 4250 USIZE = 3 IF (DEVUNT .LT. 64) USIZE = 2 IF (DEVUNT .LT. 8) USIZE = 1 IF (MACHES .GT. 0) GO TO 4260 IPSLOC = 1 IPSLEN = 0 CALL LODSTR (1, ' ') CALL FINOUT IPSLOC = 1 IPSLEN = 72 ENCODE (IPSLEN, 94250, IPBUF (IPSLOC)) 94250 FORMAT (' Term', T10, 'User name', T32, 'Logged in') CALL FINOUT 4260 MACHES = MACHES + 1 IPSLOC = 1 IPSLEN = 31 ENCODE (IPSLEN, 94260, IPBUF(IPSLOC)) ! Create buffer showing 1 DEVNMS (DEVINX), ! the device name and 2 DEVUNT, UABINI, ! user name, 3 UABNAM 94260 FORMAT (X, A2, O, ':', T10, A1, '. ', A1) CALL LODTIM (UABTIM(1), UABTIM(2), UABTIM(3), 1 UABTIM(4), UABTIM(5), UABTIM(6)) CALL FINOUT 4280 CONTINUE 4290 CONTINUE IF (UNAMSZ .LE. 0) GO TO 4900 C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Open account file. C OPEN (UNIT=LUNDSK, NAME='LB0:[0,0]RSX11.SYS', TYPE='OLD', 1 READONLY, SHARED, ERR=4900) C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Look for account in account file. C 4400 READ (LUNDSK, 94400, END=4800) ACNBFB ! Read the next record. 94400 FORMAT (4(128A1)) DO 4490 ACNENT = 1, 4 ! For each entry, IF (PATMAT (NAMSIZ, ! If the user name 1 ACNBFB(13,ACNENT), 1, 0, BUG, ! is null, 2 PCT, 0)) ! then 3 GO TO 4490 ! ignore it. IF (.NOT. PATMAT (NAMSIZ, ! If it's not a 1 ACNBFB(13,ACNENT), UNAMSZ, ! match, 2 UNAMBF, BUG, PCT, BLK)) ! then 3 GO TO 4490 ! ignore it. MACHES = MACHES + 1 C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Display blank line. C IPSLOC = 1 IPSLEN = 0 CALL LODSTR (1, ' ') CALL FINOUT C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Display user's name, and time last logged in. C IPSLOC = 1 IPSLEN = 0 CALL LODSTR (1, ' ') CALL LODSTR (12, ACNBFB (27,ACNENT)) CALL TRMSTR (1) CALL LODSTR (14, ACNBFB (13,ACNENT)) CALL TRMSTR (1) CALL LODSTR (15, 'last logged in ') CALL LODTIM (ACNBFB (41, ACNENT), ACNBFB (40, ACNENT), 1 ACNBFB (39, ACNENT), ACNBFB (42, ACNENT), 2 ACNBFB (43, ACNENT), ACNBFB (44, ACNENT)) CALL FINOUT IF (.NOT. EXACT) GO TO 4490 ! If wildcard, skip. IF (.NOT. PATMAT (NAMSIZ, ACNBFB(13,ACNENT),! If not exact 1 UNAMSZ-1, UNAMBF, BUG, PCT, BLK)) ! match, no 2 GO TO 4490 ! FINGER.PLN C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Found an exact match. Build name of finger plan. C IPSLOC = 1 IPSLEN = 0 CALL LODSTR (4, ACNBFB(47,ACNENT)) CALL LODSTR (1, ':') IF (ACNBFB (65,ACNENT) .NE. '[' .OR. 1 ACNBFB(66,ACNENT) .EQ. ']') GO TO 4440 CALL LODSTR (11, ACNBFB(65,ACNENT)) CALL TRMSTR (0) GO TO 4460 4440 CALL LODSTR (1, '[') CALL LODSTR (3, ACNBFB(1,ACNENT)) CALL LODSTR (1, ',') CALL LODSTR (3, ACNBFB(4,ACNENT)) CALL LODSTR (1, ']') 4460 CALL LODSTR (10, 'FINGER.PLN') CALL LODSTR (1, 0) C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Open the Finger Plan file. C OPEN (UNIT=LUNPLN, NAME=IPBUF, TYPE='OLD', 1 READONLY, SHARED, ERR=4490) C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Display blank line. C IPSLOC = 1 IPSLEN = 0 CALL LODSTR (1, ' ') CALL FINOUT C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Display user's name. C IPSLOC = 1 IPSLEN = 0 CALL LODSTR (1, ' ') CALL LODSTR (12, ACNBFB (27,ACNENT)) CALL TRMSTR (1) CALL LODSTR (14, ACNBFB (13,ACNENT)) CALL TRMSTR (0) CALL LODSTR (8, '''s Plan:') CALL FINOUT C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Display the FINGER.PLN C 4470 READ (LUNPLN, 94470, END=4480) IPSLEN, ! Read fingerpln 1 (IPBUF(ITER8), ITER8=2,132) 94470 FORMAT (Q, 2(128A1)) IPBUF (1) = ' ' ! Carriage ctrl IPSLOC = 1 ! Location in IPSLEN = IPSLEN + 1 ! buffer. CALL FINOUT ! Display line. GO TO 4470 ! Loop. 4480 CLOSE (UNIT=LUNPLN) ! Close. 4490 CONTINUE ! Try next user. GO TO 4400 ! Read nxt rec. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Close the account file. C 4800 CLOSE (UNIT=LUNDSK) C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Local node information display complete. C 4900 IF (MACHES .LE. 0) GO TO 9020 GO TO 9900 C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Error - Unrecognised command. C 9000 IPSLOC = 1 IPSLEN = 36 CALL MOVSTR (IPSLEN, ' %FIN-E-UNKCOMAND - Unknown command.', 1 IPBUF(IPSLOC)) CALL FINOUT GO TO 9900 C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Error - illegal username. C 9010 IPSLOC = 1 IPSLEN = 38 CALL MOVSTR (IPSLEN, ' %FIN-E-ILLUSRNAM - Illegal user name.', 1 IPBUF(IPSLOC)) CALL FINOUT GO TO 9900 C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Error - User name not found. C 9020 IPSLOC = 1 IPSLEN = 33 CALL MOVSTR (IPSLEN, ' %FIN-E-NOSUCHUSR - No such user.', 1 IPBUF(IPSLOC)) CALL FINOUT GO TO 9900 C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Local node information display complete. C 9900 RETURN END