C P A S S 2 . F T N C C THIS PROGRAM IS USED TO PRINT A LIST OF ALL THE CURRENT UIC'S AND C THEIR ASSOCIATED PASSWORDS ON AN RSX-11D SYSTEM. C C C WRITTEN BY: ALAN E. FRISBIE C 3786 E. MOUNTAIN VIEW C PASADENA, CA 91107 C C C THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT C NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY C ALAN E. FRISBIE. PLEASE DIRECT ANY COMMENTS AND QUESTIONS TO C THE AUTHOR. C C C C FIRST, [0,0]000000.DIR IS READ TO GET A LIST OF UIC'S. C C SECOND, THIS LIST IS SORTED BY UIC NUMBER. C C THIRD, THE HEADER BLOCK FOR EACH ".DIR" FILE IS READ FROM C [0,0]INDEXF.SYS AND THE PASSWORD EXTRACTED. C LOGICAL*1 UIC(9),UIC2(3),UIC6(3),IUIC0(9),INNAME(11),IDATE(9), + ITIME(8),NAME(23),PAS(8),RES(8) C EQUIVALENCE (UIC(2),UIC2),(UIC(6),UIC6) C INTEGER*2 INBUF(8),IHEADR(256),IDTABL(200,3) C DATA IDIR/3RDIR/ DATA UIC/'[',3*'9',',',3*'9',']'/ DATA IUIC0/'[',3*'0',',',3*'0',']'/ DATA INNAME/'I','N','D','E','X','F','.','S','Y','S',0/ DATA PAS/'P','A','S','S','W','O','R','D'/ C C I/O UNIT ASSIGNMENTS C IN1 = 1 INDEXF = 2 LIST = 4 ITTY = 5 C WRITE (ITTY,90000) READ (ITTY,90001) NC,(RES(I),I=1,NC) C DO 100 I = 1,8 IF (RES(I) .NE. PAS(I)) GO TO 60000 100 CONTINUE C C REQUEST OUTPUT FILENAME C 10 WRITE (ITTY,90005) READ (ITTY,90001,END=60000) NC,(NAME(I),I=1,NC) IF (NC .LE. 0) GO TO 10 C C ASSIGN LOGICAL UNIT "LIST" TO FILENAME C CALL ASSIGN(LIST,NAME,NC) C C GET PAGE LENGTH C WRITE (ITTY,90007) READ (ITTY,90008) SIZE C NLP = (SIZE*6.0) - 8.0 C C GET THE CURRENT DATE AND TIME AND PRINT A HEADER. C CALL DATE(IDATE) CALL TIME(ITIME) WRITE (LIST,90004) IDATE,ITIME C C ILEN = 0 C C OPEN THE DIRECTORY OF DIRECTORIES C CALL ASSIGN(IN1,'[0,0]000000.DIR') CALL FDBSET(IN1,'READONLY','SHARE') DEFINE FILE IN1(300,8,U,NREC) C C START READING WITH RECORD #1. THIS WILL AUTOMATICALLY BE INCREMENTED C NREC = 1 C C READ ENTRY FROM [0,0]000000.DIR C 1000 READ (IN1'NREC,ERR=50200) INBUF C C !!!! NOTE !!!! IF THE LAST RECORD IN THE FILE IS ALSO THE LAST C RECORD OF A BLOCK, THE NEXT READ ATTEMPT WILL FAIL C WITH AN ERROR CODE OF -16 (PRIVILEGE VIOLATION). C SINCE DIRECT ACCESS HAS NO "END=" FUNCTION, THE C ONLY WAY TO HANDLE THIS IS TO SIMPLY ADD ANOTHER C UIC (WITH THE "UFD" COMMAND). THIS ENSURES THAT C AN ALL-ZEROS RECORD IS IN THE FILE. (AT LEAST UNTIL C SOMEONE ADDS ANOTHER 15 UIC'S. C C TEST FOR ALL ZERO'S RECORD (EOF) C DO 1010 I = 1,8 C C IF NON-ZERO WORD, THIS MAY BE A VALID ENTRY -- PROCESS IT C IF (INBUF(I) .NE. 0) GO TO 1020 1010 CONTINUE C C END-OF-FILE, CLOSE [0,0]000000.DIR C 1015 CALL CLOSE(IN1) C C REPORT NUMBER OF DIRECTORY ENTRIES FOUND. IF NONE, QUIT. C WRITE (LIST,90002) ILEN IF (ILEN .GT. 0) GO TO 2000 C STOP 1 C C C********************************************************************** C C INSERT THE DIRECTORY ENTRY INTO THE TABLE ALONG WITH C THE FILE NUMBER OF THE ".DIR" FILE. C C IF WORD 1 IS ZERO, THIS IS A DELETED ENTRY C 1020 IF (INBUF(1) .EQ. 0) GO TO 1000 C C IF NOT A ".DIR" ENTRY, TRY READING ANOTHER ONE C IF (INBUF(7) .NE. IDIR) GO TO 1000 C ILEN = ILEN + 1 IDTABL(ILEN,1) = INBUF(4) IDTABL(ILEN,2) = INBUF(5) IDTABL(ILEN,3) = INBUF(1) C C GO BACK AND READ ANOTHER ENTRY C GO TO 1000 C C********************************************************************** C C SORT THE CONTENTS OF IDTABL BY UIC C C C I0 = FIRST POSITION OF SORT FIELD C I1 = LAST POSITION OF SORT FIELD C I2 = LENGTH OF TOTAL FIELD C 2000 I0 = 1 I1 = 2 I2 = 3 C K = 1 2123 K = K * 2 IF (K .LE. ILEN) GO TO 2123 2125 K = (K-1)/2 IF (K .EQ. 0) GO TO 2200 M = ILEN - K DO 2145 L=1,M J = L 2130 I = J + K DO 2140 N = I0,I1 IF (IDTABL(I,N) .EQ. IDTABL(J,N)) GO TO 2140 IF (IDTABL(I,N) .GT. IDTABL(J,N)) GO TO 2145 DO 2135 NO = 1,I2 ITEMP = IDTABL(I,NO) IDTABL(I,NO) = IDTABL(J,NO) IDTABL(J,NO) = ITEMP 2135 CONTINUE J = J - K IF (J .GT. 0) GO TO 2130 GO TO 2145 2140 CONTINUE 2145 CONTINUE GO TO 2125 C C END OF SORT ROUTINE C 2200 CONTINUE C C NOW THAT WE HAVE A SORTED LIST OF UIC'S, LET'S READ C THE HEADER BLOCK FOR THAT ".DIR" FILE FROM "INDEXF.SYS". C THIS ALLOWS US TO READ THE HEADER INFORMATION EVEN IF THE C ".DIR" FILE HAS BEEN SET TO NOT ALLOW US READ ACCESS. C CALL OPENI(INDEXF,IUIC0,INNAME,ISTAT) IF (ISTAT .LT. 0) GO TO 50300 C C NOW WE MUST READ THE LENGTH OF THE BITMAP FROM THE HOME BLOCK C TO SEE WHAT OFFSET WE MUST ADD TO THE FILE NUMBER. C IPOINT = 2 CALL READI(INDEXF,IHEADR,IPOINT,NBYTES,ISTAT) IF (ISTAT .LT. 0) GO TO 50400 IOFFST = 2 + IHEADR(1) C C NOW READ THE INDEX BLOCK FOR EACH ".DIR" FILE AND GET THE PASSWORD C LINES = 4 C DO 3100 I = 1,ILEN C C SET THE POINTER INTO "INDEXF.SYS" FROM THE FILE NUMBER C IPOINT = IDTABL(I,3) + IOFFST CALL READI(INDEXF,IHEADR,IPOINT,NBYTES,ISTAT) IF (ISTAT .LT. 0) GO TO 50400 C C CONVERT THE RAD50 UIC TO ASCII IN A PRE-FORMATTED CHARACTER STRING C CALL R50ASC(3,IDTABL(I,1),UIC(2)) CALL R50ASC(3,IDTABL(I,2),UIC(6)) C C NOW SUPPRESS LEADING ZEROS BY DOING A DECODE FOLLOWED BY AN ENCODE C DECODE (3,90006,UIC2) IU ENCODE (3,90006,UIC2) IU C DECODE (3,90006,UIC6) IU ENCODE (3,90006,UIC6) IU C C C LIST THE UIC AND THE PASSWORD C C C IF THE PASSWORD IS NULLS, GO PRINT JUST THE UIC C IF (IHEADR(21) .EQ. 0) GO TO 3040 WRITE (LIST,90003) UIC,(IHEADR(K),K=21,23) GO TO 3050 C 3040 WRITE (LIST,90010) UIC C 3050 LINES = LINES + 1 IF (LINES .LT. NLP) GO TO 3100 WRITE (LIST,90009) LINES = 0 3100 CONTINUE C C WHEN DONE, CLOSE "INDEXF.SYS" C CALL CLOSEI IF (ILEN .EQ. 0) STOP 2 C STOP C 50200 WRITE (ITTY,90502) C C TRY AND LIST THE UIC'S ANYWAY (SEE COMMENTS AFTER STATEMENT 1000) C GO TO 1015 C 50300 WRITE (ITTY,90503) ISTAT STOP 5 C 50400 WRITE (ITTY,90504) ISTAT STOP 5 C 60000 STOP 6 C C 90000 FORMAT($,' PLEASE ENTER PASSWORD: ') 90001 FORMAT(Q,80A1) 90002 FORMAT('0',I4,' ".DIR" ENTRIES FOUND.'/) 90003 FORMAT(' ',9A1,3X,3A2) 90004 FORMAT('0','UIC/PASSWORD LIST AS OF ',9A1,2X,8A1) 90005 FORMAT($,' ENTER OUTPUT FILE NAME: ') 90006 FORMAT(I3) 90007 FORMAT($,' ENTER PAGE LENGTH IN INCHES: ') 90008 FORMAT(F6.0) 90009 FORMAT(///////) 90010 FORMAT(' ',9A1) 90502 FORMAT('0','ERROR READING [0,0]000000.DIR') 90503 FORMAT('0','ERROR OPENING INDEX FILE. STATUS = ',I4) 90504 FORMAT('0','ERROR READING INDEX FILE. STATUS = ',I4) END