PROGRAM UNDELETE C C+ C C UNDELETE - F4P program to undelete files from a disk. There must be no C other activity on the disk and it must be MOUnted/UNL. C Naturally, this should only be run from a privileged terminal. C (F4P is required to perform 32-bit integer arithmetic.) C C This is not a privileged program! It should only be run C by someone knowledgeable about the system and FILES-11 C structures, and should normally NOT be INStalled for C general use. C C Search patterns for recovery are specified in a form C similar to the SRD /SElect_entry option: ? and * are C single character wild cards and a stem search is C automatically performed. Any unspecified fields C default to wild cards. Note that the special version C numbers, 0 and -1, are NOT supported. C C For example: C C To recover all the .FTN files owned by [100,2], C specify the search pattern [100,2]*.FTN. C C To recover all files beginning with BP2 owned C by any account, you may specify simply BP2. C C See the comments in the code for possible modifications ('NOTE'). C There should not be any required to run on a V3.1 system. C C To compile: C C >F4P UNDELETE,UNDELETE/-SP=UNDELETE C C To task build, include a reference to USERLIB/LB for UPSTR, UPPER, C and STDIO: C C >TKB C TKB>UNDELETE,UNDELETE/-SP=UNDELETE C TKB>LB:[1,1]SYSLIB/LB:$SHORT,[2,24]USERLIB/LB C TKB>/ C ENTER OPTIONS: C TKB>UNITS=5 C TKB>ACTFIL=1 C TKB>EXTSCT=$$FSR1:230 C TKB>UIC=[1,1] C TKB>// C C Larry Baker C U. S. Geological Survey C 345 Middlefield Road M/S 77 C Menlo Park, CA 94025 C (415) 323-8111 C RSX-11M V3.1 21-JAN-80 C C Warning -- as of this writing UNDELETE has been used exactly once in a C real live situation (it worked). It was written for this C emergency and has been used successfully on floppy disks C and RP03s. I recommend using any other source of a backup C copy of a file before attempting to UNDELETE it, since it C is always risky to mess with the volume structure. However, C when it was actually applied in a real disaster, UNDELETE C worked great, and I have confidence in its ability to correctly C manipulate the index file structure. C C- C IMPLICIT INTEGER (A-Z) C INTEGER*4 HFMAX, HEDRNO, IVBN, LONG2, MAPNO, KOUNT INTEGER HEADER(256), IDXBLK(256), LUNDAT(6) LOGICAL ISUSED, MATCH LOGICAL*1 REPLY(40), PATRN(24), COLON, INDEXF(23), LDEV(2) C EQUIVALENCE (HEDRNO, HEDR16) EQUIVALENCE (LUNDAT, LDEV) C DATA LONG2/2/, COLON/':'/, IEEOF/-10/, ISSUC/1/ C... NOTE: The mask ISDISK contains all the bit settings that a disk device C... might have set in the first device characteristics word, LUNDAT(3). DATA ISDISK/"140730/ C... File spec for index file on specified disk. DATA INDEXF/'D','D','N','N',':','[','0',',','0',']', 1 'I','N','D','E','X','F','.','S','Y','S', 2 ';','1',0/ C KOUNT = -1 C WRITE(5,501) 501 FORMAT (/'$Enter disk name (ddnn:) ') READ(5,502,END=9940) NCHARS, REPLY 502 FORMAT (Q, 40A1) C... Do a little syntax checking. IF (NCHARS .LE. 0) GOTO 1050 IF (NCHARS .GT. 5) GOTO 1050 IF (REPLY(NCHARS) .NE. COLON) GOTO 1050 CALL ERRSNS CALL ASSIGN(1,REPLY,NCHARS) CALL ERRSNS(IERR) IF (IERR .EQ. 0) GOTO 1100 1050 WRITE(5,503) (REPLY(J), J = 1,NCHARS) 503 FORMAT (/' Unable to assign ', 40A1/) GOTO 9900 C C... Make sure this is really a disk. C C... NOTE: In order to run UNDELETE on an RSX-11M V3.0 system using C... RP03s, it was necessary to ZAP the value of ISDISK to "177777. C... While the I/O Drivers Manual indicates this should have C... worked, we found this test had to be bypassed. To find C... ISDISK in the map file, locate the contribution to PSECT C... $VARS from .MAIN., and add the offset to ISDISK found in C... the compiler listing. ZAP may then be used to open the C... location and change it to always pass this test. C 1100 CALL GETLUN(1,LUNDAT) LUNDAT(2) = IAND(LUNDAT(2),"377) INDEXF(1) = LDEV(1) INDEXF(2) = LDEV(2) INDEXF(3) = '0' + (LUNDAT(2)/8) INDEXF(4) = '0' + MOD(LUNDAT(2),8) IF (IAND(LUNDAT(3),NOT(ISDISK)) .EQ. 0) GOTO 1150 WRITE(5,505) (INDEXF(J), J = 1,5) 505 FORMAT (/1X, 5A1, ' is not a disk.'/) GOTO 9000 C 1150 CLOSE(UNIT=1) C C... BUFFERCOUNT=-1 disables all FCS access to the file. C... All I/O to the index file is done using F11ACP QIOs directly. C OPEN(UNIT=1,NAME=INDEXF,TYPE='OLD',BUFFERCOUNT=-1,ERR=1200) GOTO 1300 1200 WRITE(5,504) 504 FORMAT (/' Unable to access index file'/) GOTO 9900 C C... Read HOME block. 1300 IF (GETBLK(1,LONG2,IDXBLK,IERR) .EQ. ISSUC) GOTO 1400 WRITE(5,506) 506 FORMAT (/' Home block read error'/) GOTO 9000 C C... Get offset to start of file headers and maximum number of files. C... Note: H.FMAX is a 16-bit unsigned binary number. 1400 HIBSZ = IDXBLK(1) HEDRNO = 0 HEDR16 = IDXBLK(4) HFMAX = HEDRNO D WRITE(5,509) HIBSZ, HFMAX D 509 FORMAT (/' Index file bitmap size (H.IBSZ): ', I6, '.'/ D 1 ' Maximum number of files (H.FMAX): ', I6, '.'/) C C... Make data pattern to match for header search (same as used by SRD). CALL MAKPAT(PATRN,IERR) IF (IERR .NE. 0) GOTO 9000 C C... There will be a maximum of HFMAX headers starting at VBN HIBSZ+3. IVBN = HIBSZ + 2 KOUNT = 0 DO 3000 HEDRNO = 1,HFMAX IVBN = 1 + IVBN C C... Is this file header marked available? IF (ISUSED(1,HEDRNO,IDXBLK,MAPNO,WORDNO,MASK)) GOTO 3000 C... No, see if it qualifies for resurrection IF (GETBLK(1,IVBN,HEADER,IERR) .NE. ISSUC) GOTO 4000 IF (.NOT. MATCH(HEDRNO,PATRN,HEADER)) GOTO 3000 C... See if it looks like it might be saved (027027 in first C... field and zeroed out file number and checksum) IF (HEADER(1) .NE. "027027) GOTO 1700 IF (HEADER(2) .NE. 0) GOTO 1700 IF (HEADER(256) .EQ. 0) GOTO 1800 C... Header possibly corrupted C C... NOTE: You may choose to let this recovery procede, but it is not C... advised. The one time I tried letting an unused header C... through (before the checks in MATCH were added), I ended C... up throwing VFY into a tizzy and made my test disk unusable. C 1700 WRITE(5,511) 511 FORMAT (' Warning: File header corrupted;', 1 ' recovery not attempted.') GOTO 3000 C C... Perform recovery for this file header C C... Set bitmap in index file (ISUSED told us where). 1800 IDXBLK(WORDNO) = IOR(IDXBLK(WORDNO),MASK) IF (PUTBLK(1,MAPNO,IDXBLK,IERR) .NE. ISSUC) GOTO 4100 C... Set file number in file ID (16-bit unsigned binary). HEADER(2) = HEDR16 C... Reset the marked for delete characteristic HEADER(7) = IAND(HEADER(7),"77777) C... Set checksum in header CKSUM = 0 DO 2200 J = 1,255 2200 CKSUM = CKSUM + HEADER(J) HEADER(256) = CKSUM C... Re-write header IF (PUTBLK(1,IVBN,HEADER,IERR) .NE. ISSUC) GOTO 4200 C... Count this one in the total. KOUNT = 1 + KOUNT C 3000 CONTINUE GOTO 9000 C C... Recovery loop terminated prematurely -- index file probably shorter C... than HFMAX. 4000 IF (IERR .EQ. IEEOF) GOTO 9000 WRITE(5,510) HEDRNO, IERR 510 FORMAT (/' Fatal error reading file header no. ', I6, '.: ', I5/) GOTO 9000 C C... Error rewriting index file bitmap. 4100 WRITE(5,513) IERR 513 FORMAT (/' Fatal error rewriting index file bitmap: ', I5/) GOTO 9000 C C... Error rewriting file header to index file. 4200 WRITE(5,514) IERR 514 FORMAT (/' Fatal error rewriting file header to index file: ', 1 I5/) C C... Normal termination. 9000 CLOSE(UNIT=1) C C... Print message if any files recovered. 9900 IF (KOUNT) 9940, 9920, 9930 9920 WRITE(5,516) 516 FORMAT (/' No matching file headers found.'/) GOTO 9940 9930 WRITE(5,515) KOUNT 515 FORMAT (/' Total of ', I6, '. files recovered.'// 1 ' You must run the VFY utility to complete the', 2 ' recovery of the disk:'// 3 ' >VFY TI:,LB:=ddnn:/UP'/ 4 ' >VFY TI:,LB:=ddnn:/LO'/) C 9940 CALL EXIT C END INTEGER FUNCTION GETBLK (LUN, IBLK, IBUF, IERR) C C+ C C GETBLK - Reads a virtual block from the file currently associated with LUN. C PUTBLK - Writes a virtual block from the file currently associated with LUN. C C LUN - FORTRAN Logical Unit Number C IBLK - INTEGER*4 Virtual Block Number (from 1) C IBUF - Block buffer (256 words) C IERR - Error status (also returned as the function value): C C 1 = No errors (ISSUC) C ^0 = I/O Status Code C C- C IMPLICIT INTEGER (A-Z) INTEGER IBUF(256), IBLK(2) C IERR = IORVB(LUN,IBUF,512,IBLK,0,JUNK,IOSB2) GOTO 1000 C ENTRY PUTBLK (LUN, IBLK, IBUF, IERR) C IERR = IOWVB(LUN,IBUF,512,IBLK,0,JUNK,IOSB2) C 1000 PUTBLK = IERR RETURN C END SUBROUTINE MAKPAT (PATRN, IERR) C C+ C C MAKPAT - Make search pattern from user response. C C PATRN - 24 char search pattern (see MATCH) C IERR - Error flag C C- C IMPLICIT INTEGER (A-Z) LOGICAL*1 REPLY(40), PATRN(24) LOGICAL*1 CHAR, QMARK, STAR, PERIOD, SEMI, LBRAK, RBRAK, COMMA LOGICAL*1 CHARA, CHARZ, CHAR0, CHAR7, CHAR9 C DATA QMARK/'?'/, STAR/'*'/, PERIOD/'.'/, SEMI/';'/ DATA LBRAK/'['/, RBRAK/']'/, COMMA/','/ DATA CHARA/'A'/, CHARZ/'Z'/, CHAR0/'0'/, CHAR7/'7'/, CHAR9/'9'/ C IERR = 1 C 1000 WRITE(5,507) 507 FORMAT (/'$Enter search pattern ([grp,mem]name.typ;version', 1 ', CR=all) ') READ(5,502,END=9000) NCHARS, REPLY 502 FORMAT (Q, 40A1) WRITE(5,501) 501 FORMAT (1X) C... Fill pattern with wild cards DO 1010 J = 1,24 1010 PATRN(J) = QMARK IF (NCHARS .LE. 0) GOTO 1480 C... Convert to upper case characters CALL UPSTR(REPLY,NCHARS) C... Fill in owning UIC J = 0 IF (REPLY(1) .NE. LBRAK) GOTO 1400 J = 1 DO 1210 I = 1,3 J = 1 + J IF (J .GT. NCHARS) GOTO 1500 CHAR = REPLY(J) IF (CHAR .EQ. COMMA) GOTO 1215 1210 PATRN(I) = CHAR J = 1 + J IF (J .GT. NCHARS) GOTO 1500 IF (REPLY(J) .NE. COMMA) GOTO 1500 GOTO 1220 C... Right justify group number 1215 IF (I .EQ. 1) GOTO 1220 DO 1216 K = 3,1,-1 I = I - 1 CHAR = CHAR0 IF (I .GE. 1) CHAR = PATRN(I) 1216 PATRN(K) = CHAR 1220 DO 1230 I = 4,6 J = 1 + J IF (J .GT. NCHARS) GOTO 1500 CHAR = REPLY(J) IF (CHAR .EQ. RBRAK) GOTO 1240 1230 PATRN(I) = CHAR J = 1 + J IF (J .GT. NCHARS) GOTO 1500 IF (REPLY(J) .NE. RBRAK) GOTO 1500 GOTO 1400 C... Right justify member number. 1240 IF (I .EQ. 4) GOTO 1400 DO 1250 K = 6,4,-1 I = I - 1 CHAR = CHAR0 IF (I .GE. 4) CHAR = PATRN(I) 1250 PATRN(K) = CHAR C... Fill pattern with "name" part until period or 9 chars 1400 DO 1420 I = 7,15 J = 1 + J IF (J .GT. NCHARS) GOTO 1450 CHAR = REPLY(J) IF (CHAR .EQ. PERIOD) GOTO 1430 IF (CHAR .EQ. SEMI) GOTO 1445 1420 PATRN(I) = CHAR J = 1 + J IF (J .GT. NCHARS) GOTO 1450 CHAR = REPLY(J) IF ((CHAR .NE. PERIOD) .AND. (CHAR .NE. SEMI)) GOTO 1500 C... Fill "type" part with reply until 3 chars 1430 DO 1440 I = 16,18 J = 1 + J IF (J .GT. NCHARS) GOTO 1450 CHAR = REPLY(J) IF (CHAR .EQ. SEMI) GOTO 1445 1440 PATRN(I) = CHAR J = 1 + J IF (J .GT. NCHARS) GOTO 1450 IF (REPLY(J) .NE. SEMI) GOTO 1500 C... Fill "version" part with reply until 6 chars 1445 DO 1447 I = 19,24 J = 1 + J IF (J .GT. NCHARS) GOTO 1448 1447 PATRN(I) = REPLY(J) IF (NCHARS .GT. J) GOTO 1500 GOTO 1450 C... Shift version number specification to be FORTRAN O6 style 1448 IF (I .EQ. 19) GOTO 1450 DO 1449 J = 24,19,-1 I = I - 1 CHAR = CHAR0 IF (I .GE. 19) CHAR = PATRN(I) 1449 PATRN(J) = CHAR C C... Validate characters (must be RAD50, ?, or *) and convert * to ? 1450 CONTINUE D WRITE(5,511) PATRN D 511 FORMAT (' Search pattern: ', 24A1/) DO 1452 J = 1,6 CHAR = PATRN(J) IF (CHAR .NE. STAR) GOTO 1451 PATRN(J) = QMARK GOTO 1452 1451 IF (CHAR .EQ. QMARK) GOTO 1452 IF (CHAR .LT. CHAR0) GOTO 1520 IF (CHAR .GT. CHAR7) GOTO 1520 1452 CONTINUE DO 1460 J = 7,18 CHAR = PATRN(J) IF (CHAR .NE. STAR) GOTO 1455 PATRN(J) = QMARK GOTO 1460 1455 IF (CHAR .EQ. QMARK) GOTO 1460 IF (CHAR .LT. CHAR0) GOTO 1520 IF (CHAR .LE. CHAR9) GOTO 1460 IF (CHAR .LT. CHARA) GOTO 1520 IF (CHAR .GT. CHARZ) GOTO 1520 1460 CONTINUE DO 1470 J = 19,24 CHAR = PATRN(J) IF (CHAR .NE. STAR) GOTO 1461 PATRN(J) = QMARK GOTO 1470 1461 IF (CHAR .EQ. QMARK) GOTO 1470 IF (CHAR .LT. CHAR0) GOTO 1520 IF (CHAR .GT. CHAR7) GOTO 1520 1470 CONTINUE C C... Null search pattern comes here. 1480 IERR = 0 C 9000 RETURN C C... Pattern not of the form [grp,mem]name.typ;version 1500 WRITE(5,512) 512 FORMAT (/' Pattern not of the form [grp,mem],name.typ;version') GOTO 1000 C C... Illegal character in pattern 1520 WRITE(5,508) CHAR, (REPLY(J), J = 1,NCHARS) 508 FORMAT (/' Illegal character, ', A1, ', in ', 40A1) GOTO 1000 C END LOGICAL FUNCTION MATCH (HEDRNO, PATRN, HEADER) C C+ C C MATCH - Matches file headers selected for recovery. C C HEDRNO - Index file header number. C PATRN - 24 character match pattern ("?"=wild card): C C "gggmmmffffffffftttvvvvvv" C C g ( 1- 3) = Owner's group number C m ( 4- 6) = Owner's member number C f ( 7-15) = File name C t (16-18) = File type C v (19-24) = Version number C C All octal numbers not wild carded must have leading zeros. C C HEADER - Current file header (256 words). C C- C IMPLICIT INTEGER (A-Z) INTEGER*4 HEDRNO, USED, ALLOC INTEGER HEADER(256), IUSED(2), IALLOC(2) LOGICAL*1 NAME(24), PATRN(24), CHAR, QMARK LOGICAL*1 UIC(6), LUIC(2), LGROUP, LMEMBR, CRDATE(13) C EQUIVALENCE (USED, IUSED), (ALLOC, IALLOC), (UIC, NAME) EQUIVALENCE (IUIC, LUIC), (GROUP, LGROUP), (MEMBER, LMEMBR) C DATA QMARK/'?'/ C MATCH = .FALSE. C C... Insist on "027027 in first header word. IF (HEADER(1) .NE. "027027) GOTO 8100 C... If this header has never been used before, the creation date C... and modification date fields should be zeros. DO 1000 J = 30,42 1000 IF (HEADER(J) .NE. 0) GOTO 1100 GOTO 8100 C C... Convert UIC to two octal numbers 1100 IUIC = HEADER(5) GROUP = 0 LGROUP = LUIC(2) MEMBER = 0 LMEMBR = LUIC(1) DO 1150 J = 3,1,-1 UIC(J) = '0' + MOD(GROUP,8) GROUP = GROUP / 8 UIC(J+3) = '0' + MOD(MEMBER,8) 1150 MEMBER = MEMBER / 8 C C... Convert file name from RAD50 to ASCII CALL R50ASC(12,HEADER(24),NAME(7)) C... Convert version number to octal characters VERNO = HEADER(28) DO 1200 J = 24,19,-1 NAME(J) = '0' + MOD(VERNO,8) 1200 VERNO = VERNO / 8 C C... Attempt pattern match DO 2000 J = 1,24 CHAR = PATRN(J) IF (CHAR .EQ. QMARK) GOTO 2000 IF (CHAR .NE. NAME(J)) GOTO 8100 2000 CONTINUE C C... Successful pattern match, type PIP-style directory info for user C IUSED(1) = HEADER(13) IUSED(2) = HEADER(12) IALLOC(1) = HEADER(11) IALLOC(2) = HEADER(10) CALL MOVSTR(13,HEADER,72,CRDATE,1) WRITE(5,501) HEDRNO, HEADER(3), NAME, USED, 1 (CRDATE(J), J = 1,11) 501 FORMAT (' (', O6, ',', O6, '): [', 3A1, ',', 3A1, ']', 1 9A1, '.', 3A1, ';', 6A1, 3X, I6, '.', 3X, 2 2A1, '-', 3A1, '-', 2A1, 2X, 2A1, ':', 2A1) C C... NOTE: You may want to insert a query capability here as an option. C MATCH = .TRUE. C 8100 RETURN C END LOGICAL FUNCTION ISUSED (LUN, HEDRNO, BUFFER, BLKNO, 1 WORDNO, MASK) C C+ C C ISUSED - Returns setting of bit number HEDRNO (I*4) in index file bitmap. C C LUN - Index file logical unit number C HEDRNO - Header number in question C BUFFER - Buffer to hold the index file bitmap block for HEDRNO C BLKNO - I*4 VBN of the bitmap block C WORDNO - FORTRAN index within BUFFER for the word containing C HEDRNOs bitmap C MASK - Integer mask for HEDRNOs bit in BUFFER(WORDNO) C C- C IMPLICIT INTEGER (A-Z) INTEGER*4 HEDRNO, BITNO, BLKNO INTEGER BUFFER(256), MASKS(16) C DATA MASKS/"000001,"000002,"000004, 1 "000010,"000020,"000040, 2 "000100,"000200,"000400, 3 "001000,"002000,"004000, 4 "010000,"020000,"040000, 5 "100000/ DATA ISSUC/1/ C C... Header number 1 is bit 0 in the bitmap BITNO = HEDRNO - 1 C... 4096 bits to a disk block starting at VBN 3 BLKNO = 3 + (BITNO/4096) IF (GETBLK(LUN,BLKNO,BUFFER,IERR) .NE. ISSUC) GOTO 9900 BITNO = MOD(BITNO,4096) C... Word in BUFFER and bit in word (corrected for FORTRAN array indexing) WORDNO = (BITNO/16) + 1 BITNO = (MOD(BITNO,16)) + 1 C MASK = MASKS(BITNO) ISUSED = IAND(BUFFER(WORDNO),MASK) .NE. 0 C 9000 RETURN C 9900 WRITE(5,501) HEDRNO, IERR 501 FORMAT (/' Error reading index file bitmap for header no. ', 1 I6, '.: ', I5/ 2 ' Recovery not attempted'/) ISUSED = .FALSE. GOTO 9000 C END