?saveabend -- Mods by Greg Lehey, 31 July 1989 -- print more intelligible error messages -- Mods by Greg Lehey,17 June 1987 -- Suppress first bit of file type on header check, so that we can -- recover directories to key-sequenced files -- Modified by Greg Lehey, 30 August 1986, to recover DP1 or DP2 files !**************************************************************** !! JHS011585! ! modified by John Schwarz, Kansas City on 1/15/1985!! JHS011585! ! to fix handling of partitioned files !! JHS011585! !**************************************************************** !! JHS011585! ?pep = 40 ?abslist define say (x) = begin buffers ':=' x -> @char^point; call output (listfile, buffer, @char^point '-' @buffers); end#; define sayit = call output (listfile, buffer, @char^point '-' @buffers)#; define startbuf (x) = -- Start off text in buffer buffers ':=' x -> @char^point#; define inbuf (x) = -- Insert x into implicit buffer at char^point char^point ':=' x -> @char^point#; define numinbuf (x) = -- Insert x as number into implicit buffer at char^point @char^point := num^out (char^point, x)#; define prompt (x) = do begin buffers ':=' x -> @char^point; call writeread (listfile, buffer, @char^point '-' @buffers, 80, in^count); call fileinfo (listfile, error); if error > 109 and error < 123 then call delay (100D) else if error = 1 then call stop end until not error and in^count#; define prompt0 (x) = do begin buffers ':=' x -> @char^point; call writeread (listfile, buffer, @char^point '-' @buffers, 80, in^count); call fileinfo (listfile, error); if error > 109 and error < 123 then call delay (100D) else if error = 1 then call stop end until not error#; define errcheck (file) = if <> then begin call fehler^meldung (,, file); call abend end#; define stderr (file) = -- same as before, but don't die if <> then begin call fehler^meldung (,, file) end#; define openerr (file) = if <> then begin call fehler^meldung (,,, file); -- Note the fine difference call abend end#; define skipblanks = scan char^point while " " -> @char^point#; define skipnoise (x) = begin scan x while " " -> @x; if x = "," then scan x [1] while " " -> @x; end#; literal eyecatcher = ">", -- eye catcher for DP2 no^message = -1, -- no exception record message not^block^header = 0, -- exception record headers bad^initial^offset, bad^record^length, sequence^error, not^in^partition, duplicate^record; int (32) relkey, rpb; int dd, badfile, ! the file being recovered goodfile, ! the recovery file listfile, ! the summary report file ! defaults to the home terminal exceptionfile, ! file where any exception records ! are written defaults to ! $default.default.exceptn receive, ! receive file term, ! home terminal error, ! for result conditionals goodfileerrors, ! count of errors on recovery file countread, ! count of characters read eof, ! end of file flag maxlistreclen, ! maximum list file record length maxexceptreclen, ! maximum exception file record size maxreclen, ! the maximum record length datablocklen, ! the length of a data block devtype, ! the device type (file type) reclen, ! the record length of input file ksparms [0:2], ! key sequence file parameters prikeylen = ksparms, ! primary key length prikeyoff = ksparms [1], ! the keyoffset indexblocklen = ksparms [2], ! the length of an index block thisrecordlen, ! the length of the current record thiskeylen, ! the length of the key for the curr rec thisrecordoffset, ! current record offset into the block filetype, ! used to get the type of file maxreadlen, ! maximum of datablocklen, indexblocklen numlevels, ! number of levels in index structure i, ! utility (record loop variable) j, ! utility .endblock, ! used to point to end of block for offsets .defaultvol [0:7], ! default volume and subvolume .listbuff [0:1023], ! listfile buffer and utility .input^buffer [0:2047], ! input buffer .startup^message [0:65], -- startup message .buffer [0:39], -- for message output .outbuff [0:1023]; ! output buffer ! ! this group of pointers is used to describe the enscribe block ! int (32) dumpedblocks := 0d, ! number of bad blocks dumped recordsrecovered := 0d, ! number of records recovered .nextblock := @input^buffer, ! next block at same level .freelist := @input^buffer [2]; ! next block on free list int .records := @input^buffer [4], ! number of records in this block .level := @input^buffer [5], ! level number (level 0 = data block) .checksum := @input^buffer [6], ! checksum word .unused := @input^buffer [7], ! should be three words of zero here dp2, -- disc process type of in file out^dp; -- and of out file (must be the same) ! ! ! string .listbuffs := @listbuff '<<' 1, ! string equivalent of listbuff .input^buffers := @input^buffer'<<' 1, ! string equivalent of buffer .buffers := @buffer '<<' 1, -- message output buffer .startup^messages := @startup^message '<<' 1, .char^point, -- handy pointers .end^string, .outbuffs := @outbuff '<<' 1, ! string equivalent of outbuff .priorkey [0:255], ! holds key of prior record in block .first, ! utility .last, ! utility .comma; ! utiltiy ! ! ! int (32) numblocks [0:9] := [10 * [0d]], ! number of blocks at each level numrecs [0:9] := [10 * [0d]], ! number of records at each level exceptioncount := 0d, ! number of records not recovered diskaddr; ! disk address of the block ! ! ! int diskaddr1 = diskaddr, ! the first word of the diskaddress diskaddr2 = diskaddr + 1; ! the second word of the diskaddress ! STRING .PREV^DATA^KEY [0:255], .CKEY [0:255]; INT DATA^COMP, ! flag for data compression allflag := 0, ! flag for partitioned files partonly := 0, ! flag for specified partition thispart := 0, ! current partition .partparms [0:4172], ! partition parameters !! JHS011585! thisoffset:=0, ! offset of current partition!! JHS011585! nextoffset:=0, ! offset of next partition !! JHS011585! partkeylen, ! partition key size .savname [0:11]; ! bad file name ! string ! JHS011585! .spartparms := @partparms '<<' 1;! partition parms string !! JHS011585! ! !struct partkey; !!JHS011585! ! begin !!JHS011585! ! int thispartkey; !!JHS011585! ! struct thispartkeys = thispartkey; !!JHS011585! ! begin !!JHS011585! ! string byte [0:255]; !!JHS011585! ! end; !!JHS011585! ! int nextpartkey; !!JHS011585! ! struct nextpartkeys = nextpartkey; !!JHS011585! ! begin !!JHS011585! ! string byte [0:255]; !!JHS011585! ! end; !!JHS011585! ! end; !!JHS011585! ! ! struct .dp2block; begin string ec, -- 0: eye catcher rsn [0:2], -- 1: relative sector number flags, -- 4: level, -- 5: index level vsn [0:5]; -- 6: volume sequence number int checksum, -- 12: checksum rec^count, -- 14: for all except bitmaps recs^there; -- 16: recs present for relatives string bitmap^start [0:1], -- 18: bit map starts here es^records [0:3], -- 20: entry sequence record starts here ks^next^rsn [0:2], -- 24: Key sequence next data block ks^prev^rsn [0:2], -- 27: Key sequence previous data block ks^data^record; -- 30: (finally) key sequence data record end; define incrementdiskaddr = diskaddr := diskaddr + (if level then $dbl (indexblocklen) else $dbl (datablocklen))#; define unstructured = filetype.<13:15> = 0#; define relative = filetype.<13:15> = 1#; define entrysequenced = filetype.<13:15> = 2#; define keysequenced = filetype.<14:15> = 3#; ! ! ! ?nolist ?source sources -- Greg's defines and proc definitions ?page "DOUBLE WORD TO ASCII CONVERSION" INT PROC DASCII (NUM, BASE, STR); INT (32) NUM; ! NUMBER TO BE FORMATTED INT BASE; ! IF POSITIVE (I.E. 10) THEN LEFT JUSTIFIED STARTING AT STR ! IF NEGATIVE (1.E. -10) THEN RIGHT JUSTIFIED WITH STR BEING THE RIGHTMOST CHAR STRING .STR; ! OUTPUT AREA BEGIN ! DASCII STRING TEMP [0:15], LOWNUM = 'P' := "-2147483648"; INT INDEX := 15, MINUS := 0; IF NUM=%20000000000D THEN BEGIN !*0*! IF BASE<0 THEN STR '=:' LOWNUM FOR 11 ELSE STR ':=' LOWNUM FOR 11; RETURN 11; END; !*0*! IF NUM=0D THEN BEGIN !*1*! STR := "0"; RETURN 1; END; !*1*! IF NUM<0D THEN BEGIN !*2*! MINUS := -1; NUM := -NUM; END; !*2*! DO BEGIN !*3*! TEMP [INDEX] := $INT (NUM - $FIXD ($DFIX (NUM, 0)/10F*10F)) + "0"; INDEX := INDEX - 1; END !*3*! UNTIL (NUM:=$FIXD ($DFIX (NUM, 0)/10F))=0D; IF MINUS THEN BEGIN !*4*! TEMP [INDEX] := "-"; INDEX := INDEX - 1; END; !*4*! IF BASE<0 THEN STR '=:' TEMP [15] FOR 15-INDEX ELSE STR ':=' TEMP [INDEX+1] FOR 15-INDEX; RETURN 15-INDEX; END; ! DASCII ?LIST ?page "Recover: proc create^output^file" proc create^output^file (name, like); int .name; -- name of file int like; -- number of file to make it like begin int extentsize, filecode, secondary^extent, file^type, maxextents, reclen, blocklen, ksparm [0:2], .my^fup [0:11], .fup [0:11] := "$SYSTEM SYSTEM FUP ", .startfup [0:65]; string .startfups := @startfup '<<' 1; startbuf ("Creating output file "); @char^point := filenamecompress (char^point, name); sayit; call fileinfo (like,,, ,, extentsize,,,, filecode, secondary^extent,,, ,,, ,,, ,, maxextents); call filerecinfo (like,,, ,,, ,, file^type, reclen, blocklen, ksparm); file^type .<2> := 0; -- reset audit call create (name, extentsize, filecode, secondary^extent, file^type, reclen, blocklen, ksparm,,, maxextents); if <> then begin call fehler^meldung (,,, name); call abend end; call open (name, goodfile, %60); if <> then begin startbuf ("Unable to open "); @char^point := filenamecompress (char^point, name); inbuf (", error "); numinbuf (error); inbuf (":"); sayit; @char^point := fehler^text (error, buffers, 80); sayit; call abend; end; startfup ':=' startup^message for 9; -- -1 and default call fileinfo (listfile,, startfup [9]); call fileinfo (listfile,, startfup [21]); startfups [66] ':=' "info " -> @char^point; @char^point := filenamecompress (char^point, name); inbuf (", detail"); inbuf (0); -- to delimit if error := start^process (fup, startfup, @char^point '-' @startfups,, my^fup) then begin startbuf ("Unable to start FUP process, error "); numinbuf (error); sayit; @char^point := fehler^text (error, buffers, 80); sayit; end else begin do call read (receive, buffer, 128) until (buffer = -5 or buffer = -6) and buffer [1] = my^fup for 3; end; end; ?page "MAIN PROCEDURE" PROC MAINPROC MAIN; begin int rb, iskeyseq, -- TRUE if we are processing a DP2 key sequenced file duplicates := 0, -- number of duplicates in this block screwed; -- true if this block screwed up ! ! ! subproc print^rba; -- print the current RBA of BADFILE to the list file begin buffers ':=' "Input file RBA " -> @char^point; call numout (char^point, diskaddr1, 8, 6); char^point [6] ':=' "." -> @char^point; call numout (char^point, diskaddr2, 8, 6); call output (listfile, buffer, @char^point [6] '-' @buffers); end; ?page "Recovery: Subproc writeexceptionrecord" subproc writeexceptionrecord (recnum, reason); int recnum, -- record number we are doing reason; -- and why -- write an exception record and note the fact in the list file begin listbuffs ':=' input^buffers [thisrecordoffset] for $min (thisrecordlen, maxexceptreclen); call output (exceptionfile, listbuff, $min (maxexceptreclen, thisrecordlen)); if < then call fehler^meldung (,,exceptionfile); listbuffs ':=' "Record " -> @char^point; @char^point := num^out (char^point, recnum); char^point ':=' " at RBA " -> @char^point; call numout (char^point, diskaddr1, 8, 6); char^point [6] ':=' "." -> @char^point; call numout (char^point, diskaddr2, 8, 6); char^point [6] ':=' " written to exception file - " -> @char^point; if reason >= 0 then -- tell why begin case reason of begin char^point ':=' " block header invalid: block skipped" -> @char^point; char^point ':=' " record 0 offset incorrect for file type: block skipped" -> @char^point; char^point ':=' " record length does not match file definition" -> @char^point; char^point ':=' " record is not in sequence" -> @char^point; char^point ':=' " record key does not belong to this partition" -> @char^point; char^point ':=' " record already exists in recovered file" -> @char^point; end; call output (listfile, listbuff, @char^point '-' @listbuffs); end; exceptioncount := exceptioncount + 1d; return; end; ! of the write exception subprocedure ?page "Recovery main procedure: Print summary" subproc printsummary; begin int filename [0:11]; call fileinfo (badfile,, filename); startbuf ("Summary of file recovery for "); @char^point := filenamecompress (char^point, filename); sayit; startbuf ("Levels: "); numinbuf (numlevels); sayit; for i := numlevels downto 0 by 1 do begin startbuf ("Level "); numinbuf (i); inbuf (" has "); @char^point := $int (d^num^out (char^point, numblocks [i])); inbuf (" blocks and "); @char^point := $int (d^num^out (char^point, numrecs [i])); inbuf (" records."); sayit; end; startbuf ("Total of "); @char^point := $int (d^num^out (char^point, recordsrecovered)); inbuf (" records recovered"); sayit; @char^point := $int (d^num^out (buffers, exceptioncount)); inbuf (" records written to exception file"); sayit; @char^point := $int (d^num^out (buffers, dumpedblocks)); inbuf (" blocks dumped"); sayit; for i := 0 to numlevels do begin numblocks [i] := numrecs [i] := 0d; end; recordsrecovered := exceptioncount := dumpedblocks := 0d; numlevels := 0; return; end; ?page "Recovery main procedure: Subproc getbackinstep" int subproc getbackinstep; begin ! ! this subprocedure is invoked whenever the program gets lost ! and does not recognize the beginning of an ENSCRIBE block where ! we think it should be. This could be because ! 1. the block is messed up ! 2. our pointer is messed up ! 3. our logic is messed up ! ! The recovery procedure invoked is to insure the position pointer ! references a sector boundary (a multiple of 512), and step thru ! sectors until we find a good block. Those sectors stepped over will ! be written to the exception file. ! int blockend, numsectors, .sectorboundary; ! ! make sure that the position pointer is a multiple of 512 ! diskaddr2.<13:15> := 0; ! ! set flag for iterative loop to false ! while 1 do begin call position (badfile, diskaddr); if <> then begin call fehler^meldung (,, badfile); -- how can this happen? call abend; end; ! ! we now are positioned in the file so read 2 blocks or 4096 ! and begin looking for a good block ! call read (badfile, input^buffer, $min (4096, 2 * $max (datablocklen, indexblocklen)) , countread); if > then begin call fileinfo (badfile, error); if error = 1 then ! end of file begin call printsummary; call stop end else begin call print^rba; call fehler^meldung (,, badfile) end end; if < then begin call print^rba; call fehler^meldung (,, badfile); call GETBACKINSTEP; return 0; end; numsectors := countread / 512 - 1; for j := 0 to numsectors do begin @sectorboundary := @input^buffer + 256 * j; ! points to a sector boundary if sectorboundary [5] then blockend := indexblocklen '>>' 1 else blockend := datablocklen '>>' 1; blockend := blockend - 1; ! ! check to see if we have a block header ! if dp2 then -- do DP2 checks begin if screwed := (dp2block.ec <> eyecatcher) then say ("Invalid eyecatcher: " & dp2block.ec for 1) else if screwed := (dp2block.flags .<12:13> <> filetype .<14:15>) then -- wrong kind of block begin startbuf ("Invalid block type: "); numinbuf (dp2block.flags .<12:13>); sayit; end else if screwed := numlevels -- we know how many index levels we have and (dp2block.level < 0 or dp2block.level > numlevels + 2) then -- but this block doesn't begin startbuf ("Invalid block level: "); numinbuf (dp2block.level); sayit; end end else screwed := (sectorboundary [5] < 0 ! level or sectorboundary [5] > numlevels ! level or sectorboundary [7] <> 0 ! first not used or sectorboundary [8] <> 0 ! second not used or sectorboundary [9] <> 0 ! third not used or sectorboundary [blockend] <> 20); ! offset for first record if screwed then -- this block screwed up begin ! not a block header thisrecordoffset := j * 512; thisrecordlen := 512; call writeexceptionrecord (0, not^block^header); dumpedblocks := dumpedblocks + 1d; diskaddr := diskaddr + 512d; end else ! we have a block header begin call position (badfile, diskaddr); call fileinfo (badfile, error); if error = 1 then -- EOF begin call printsummary; call stop; end else if error then begin call print^rba; call fehler^meldung (,, badfile); end; call read (badfile, input^buffer, if sectorboundary [5] then indexblocklen else datablocklen, countread); if < then begin call print^rba; call fehler^meldung (,, badfile); call getbackinstep; return 0; end; return -1; end; ! of the if statement to determine if good block end; ! of the loop on sectors end; ! of the do forever end; ! of the subprocedure ?page "Recovery main procedure: Subrproc defaultexceptionfile" subproc defaultexceptionfile; begin int filetype; ! ! there is no exception file name given. set up the defaults ! listbuff ':=' defaultvol for 8; listbuff [8] ':=' "exceptn "; call open (listbuff, exceptionfile); if < then begin call fileinfo (-1, error); if error <> 11 then begin call fehler^meldung (error,,, listbuff); call abend; end; end ! no problem, the file is not there so continue else begin call deviceinfo (listbuff, devtype, reclen); if devtype.<4:9> = 3 then ! a disk file begin call filerecinfo (exceptionfile,, ,, ,, ,, filetype, maxexceptreclen); if unstructured then maxexceptreclen := 4096; end else maxexceptreclen := reclen; return; ! file is there so return end; call create (listbuff, 32,, 32, 2, 4072, 4096); ! ! primary extent size 32 ! secondary extent size 32 ! entry sequenced ! maximum record length 4072 ! data block length 4096 ! if < then begin call fileinfo (-1, error); listbuff := " "; listbuff [1] ':=' listbuff for 39; listbuff ':=' "CREATE ERROR NUMBER: "; call numout (listbuffs [21], error, 10, 3); listbuffs [25] ':=' "LISTFILE SUBSTITUTED"; call output (listfile, listbuff, 45); exceptionfile := listfile; return; end else begin call open (listbuff, exceptionfile); if < then begin call fileinfo (-1, error); call fehler^meldung (error,,, listbuff); call abend; end; maxexceptreclen := 4072; return; end; end; ! of the default exception subprocedure ?page "Recovery: Subproc processoptions" subproc processoptions; begin int devtype, ! file device type reclen, ! record length filetype, ! type of file namelen; ! length of the filename ! ! At this point the input, output, and home terminal files have ! been opened successfully. We must pick up the partition to recover ! optional, otherwise all partitions are recovered), the list file name, ! and the exception file name in that order separated by a comma. ! Both files are optional. If the list file is not given it will ! default to the home terminal. If the exception file is not given ! we will first try to create an entry sequenced file on the default ! volume and subvolume by the name of "exceptn". Failing this we will ! use the listfile. The exception file defaults to 4072 record length ! 4096 block length, 32 page primary and secondary extent size. If ! the exception file name is given and the listfile name is not then ! the comma must be included as delimeter. ! scan startup^messages [66] while " " -> @first; if $carry then ! no options given begin call defaultexceptionfile; partonly := 0; thispart := 0; return; end; if first = "," then ! no part option begin partonly := 0; thispart := 0; scan first [1] while " " -> @first; end else begin scan first until " " -> @last; for i := 0 to 3 do if $alpha (first [i]) then first [i] := first [i] land %337; if first <> "PART" then goto parterror; scan last [1] while " " -> @first; call numin (first, thispart, 10, error); if error or thispart < 0 or thispart > 15 then parterror: begin listbuff := " "; listbuff [1] ':=' listbuff for 40; listbuff ':=' "PARTITION OPTION ERROR"; call output (listfile, listbuff, 24); call stop; end; partonly := -1; scan first until "," -> @first; if $carry then begin listfile := term; call defaultexceptionfile; return; end; scan first [1] while " " -> @first; end; if first = "," then ! ! if first = comma then no listdev was given so default to home term ! begin listfile := term end else begin ! -- we have a listfile name so process it ! scan first until "," -> @comma; rscan comma [-1] while " " -> @last; namelen := @last '-' @first + 1; ! ! loop on filename expand until successful. If not successful ! then reprompt for the name ! do begin error := fnameexpand (first, listbuff, defaultvol); if not error then ! filenameexpand failed begin say ("Invalid list file name - please reenter -> "); listbuff := " "; listbuff [1] ':=' listbuff for 39; listbuff ':=' " [<$volname>.] [.] "; call writeread (term, listbuff, 40, 60, countread); listbuffs [countread] := 0; first ':=' listbuffs for countread + 1; end; end until error; ! ! At this point we have a valid file name for the listfile ! so let's open it ! call open (listbuff, listfile); if < then begin call fehler^meldung (,, , listbuff); call abend end; end; ! ! the list file is now open. Get the record size for it ! call deviceinfo (listfile, devtype, reclen); if devtype.<4:9> = 3 then ! a disk file call filerecinfo (listfile,, ,, ,, , filetype, maxlistreclen) else maxlistreclen := reclen; ! ! now we must take care of the exception file ! if comma <> "," then ! default exception file begin call defaultexceptionfile; return; end; scan comma [1] while " " -> @first; if $carry then ! user put comma but no file name begin call defaultexceptionfile; return; end; scan first until "," -> @last; @last := @last - 1; error := fnameexpand (first, listbuff, defaultvol); if error then ! successful expansion begin call open (listbuff, exceptionfile); if < then exceptionfile := listfile; end else exceptionfile := listfile; call deviceinfo (exceptionfile, devtype, reclen); if devtype.<4:9> = 3 then ! a disk file call filerecinfo (exceptionfile,, ,, ,, ,, filetype, maxexceptreclen) else maxexceptreclen := reclen; end; ! of the process option subroutine ! ! ! subproc printtime; begin string months [0:35] := ["JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC"]; call time (outbuff); listbuff := " "; listbuff [1] ':=' listbuff for 20; listbuff ':=' "CURRENT DATE AND TIME IS: "; call numout (listbuffs [26], outbuff [2], 10, 2); listbuffs [29] ':=' months [ (outbuff [1] - 1) * 3] for 3; call numout (listbuffs [33], outbuff, 10, 4); listbuffs [38] ':=' "- : :"; call numout (listbuffs [40], outbuff [3], 10, 2); call numout (listbuffs [43], outbuff [4], 10, 2); call numout (listbuffs [46], outbuff [5], 10, 2); call output (listfile, listbuff, 50); return; end; ! of the print time subroutine ! SUBPROC KEY^EXPAND (IN^KEY, OUT^KEY, IN^LEN); STRING .IN^KEY, .OUT^KEY; INT .IN^LEN; BEGIN INT NUM^CHAR, len; NUM^CHAR := IN^KEY [0]; len := in^len '-' 1; OUT^KEY [0] ':=' 0; OUT^KEY [1] ':=' OUT^KEY [0] FOR 255; IF LEN <> 0 THEN BEGIN OUT^KEY [NUM^CHAR] ':=' IN^KEY [1] FOR $min (len, prikeylen - num^char); OUT^KEY [0] ':=' PREV^DATA^KEY FOR NUM^CHAR ; END; PREV^DATA^KEY ':=' OUT^KEY FOR PRIKEYLEN; IN^LEN := PRIKEYLEN; END; ! SUBPROC REC^EXPAND (IN^REC, OUT^REC, IN^LEN); STRING .IN^REC, .OUT^REC; INT .IN^LEN; BEGIN INT NUM^CHAR; NUM^CHAR := IN^REC [0]; OUT^REC [0] ':=' PRIORKEY FOR num^char; OUT^REC [num^char] ':=' IN^REC [1] FOR IN^LEN - 1; IN^LEN := IN^LEN + num^char -1; END; ?page "Recovery: Main procedure" ! !****************************************************************************** ! * ! S T A R T O F T H E M A I N P R O C E D U R E * ! * !****************************************************************************** ! ! @dp2block := @input^buffer; -- use this for pointing to DP2 blocks call myterm (buffer); -- sad as it may be, we need MYTERM open call open (buffer, term); if < then begin call fehler^meldung (,, , buffer); -- print an error message call abend end; listfile := term; -- until proven otherwise -- Now read in the startup message and open in and out files call startup (startup^message, receive,, badfile, %2060); defaultvol ':=' startup^message [1] for 8; call deviceinfo2 (startup^message [9], devtype, reclen, dp2); if devtype .<4:9> <> 3 then -- in file not a disc begin buffers ':=' "The input file " -> @char^point; @char^point := filenamecompress (char^point, startup^message [9]); char^point ':=' " is not on a disc. This is a disc recovery program." -> @char^point; call output (term, buffer, @char^point '-' @buffers); call abend; end; call deviceinfo2 (startup^message [21], devtype, reclen, out^dp); if devtype .<4:9> <> 3 then -- in file not a disc begin buffers ':=' "The output file " -> @char^point; @char^point := filenamecompress (char^point, startup^message [21]); char^point ':=' " is not on a disc. This is a disc recovery program." -> @char^point; call output (term, buffer, @char^point '-' @buffers); call abend; end; if out^dp <> dp2 then -- still can't do it begin say ("I can't change disc processes in mid-recovery."); call abend end; call filerecinfo (badfile,, ,, ,, ,, filetype, maxreclen, datablocklen, ksparms ,, partparms); if < then begin call fehler^meldung (,, badfile); call abend end; DATA^COMP := FILETYPE.<12>; -- check whether file has data compression input^buffer ':=' startup^message [9] for 4 & " " & input^buffer [4] for 7; -- get volume name if unstructured then ! not a structured file begin say ("Recovery only works on structured files"); @char^point := filenamecompress (buffers, startup^message [9]); char^point ':=' " is unstructured." -> @char^point; call output (term, buffer, @char^point '-' @buffers); call abend; end; if relative then begin rb := $dbl (datablocklen - %24 -2) '/' (maxreclen + 2); rpb := $dbl (rb); end; call processoptions; call open (startup^message [21], goodfile, %60); if <> then -- couldn't open output file begin call fileinfo (-1, error); if error = 11 then -- not there, we can make it call create^output^file (startup^message [21], badfile) else -- something strange here begin startbuf ("Unable to open "); @char^point := filenamecompress (char^point, startup^message [21]); inbuf (", error "); numinbuf (error); inbuf (":"); sayit; @char^point := fehler^text (error, buffers, 80); sayit; call abend; end end; call close (badfile); -- reopen partition for partition allflag := partparms [0]; -- are we recovering all of a file? partkeylen := partparms [partparms [0] * 6 + 1]; ! Note that thisoffset is being used temporarily as word offset !!JHS011585! thisoffset:=partparms [0]* ( (partkeylen+1)/2+6)+2;!offset last !!JHS011585! partparms [thisoffset]':=' [-1] & partparms [thisoffset] !JHS011585! for (partkeylen+1)/2; !high value!!JHS011585! ! Note that thisoffset and nextoffset are byte counts now ! !JHS011585! thisoffset:=2* (partparms [0]*6+2+ (thispart-1)* (partkeylen+1)/2);!JHS011585! nextoffset:=thisoffset+2* ( (partkeylen+1)/2); !JHS011585! !JHS011585! ! partparms [partparms [0] * 7 + 2] := %77577; delete !!JHS011585! ! if thispart then partkey.thispartkey := partparms [partparms [0] * 6!!JHS0115 ! + 2 + thispart] !!JHS011585! ! else partkey.thispartkey := 0; !!JHS011585! ! partkey.nextpartkey := partparms [partparms [0] * 6 + 2]; !!JHS011585! if partonly and thispart > allflag then begin say ("This partition does not exist"); call abend end; if thispart then startup^message [9] ':=' partparms [ (thispart - 1) * 4 + 1] for 4; ! ! process the rest of the startup message. The valid options are ! [] [, ] ! call printtime; savname ':=' startup^message [9] for 12; open^unstructured: ! write the name of the file to the listfile ! listbuff := " "; listbuff [1] ':=' listbuff for 40; call output (listfile, listbuff, 10); call output (listfile, listbuff, 10); listbuff ':=' "FILE RECOVERY FOR FILE: "; call fnamecollapse (savname, listbuff [12]); if allflag then begin listbuff [30] ':=' "PARTITION #"; call numout (listbuff [37], thispart, 10, 2); end; call output (listfile, listbuff, 80); if relative then begin listbuff := " "; listbuff [1] ':=' listbuff for 40; listbuff ':=' "RECORDS/BLOCK = "; call numout (listbuffs [17], $int (rpb), 10, 4); call output (listfile, listbuff, 22); end; ! ! open THE FILE unstructured and play enscribe ! call open (savname, badfile, %22060); ! ! UNSTRUCTURED ACCESS ! protected access ! ! IF < THEN BEGIN call Fehler^meldung (,,, savname); call abend; END; diskaddr := 0d; relkey := 0d; call position (badfile, 0d); numlevels := 0; maxreadlen := datablocklen; if keysequenced then begin ! ! if key-sequenced get the root level index block and the number of levels ! IF DATA^COMP THEN MAXRECLEN := MAXRECLEN + 1; call read (badfile, input^buffer, indexblocklen); if < then begin call print^rba; call fehler^meldung (,, badfile); end else if > then begin call fileinfo (badfile, error); if error <> 1 then begin call print^rba; call fehler^meldung (error,, badfile); end else begin buffers ':=' "Partition " -> @char^point; @char^point := num^out (char^point, thispart); char^point ':=' " is empty" -> @char^point; call output (listfile, buffer, @char^point '-' @buffers); end; if partonly or thispart = partparms [0] then call stop else begin thispart := thispart + 1; savname ':=' partparms [ (thispart - 1) * 4 +1] for 4; ! partkey.thispartkey := partkey.nextpartkey; !!JHS011585! ! partkey.nextpartkey := partparms [partparms [0] * 6 !!JHS011585! ! + 2 + thispart]; !!JHS011585! thisoffset:=nextoffset; !JHS011585! nextoffset:=thisoffset+2* ( (partkeylen+1)/2); !JHS011585! !JHS011585! goto open^unstructured; end; end else -- got the index block begin if dp2 then -- handle DP2 information begin if dp2block.flags .<14:15> -- not an index block or not dp2block.level then -- or a data block begin buffers ':=' "First block in file not an index block: flags %" -> @char^point; @char^point := num^out (char^point, dp2block.flags, 8); char^point ':=' ", block level " -> @char^point; @char^point := num^out (char^point, dp2block.level); end else -- it's an index block, do it begin numlevels := dp2block.level; -- number of file levels? numblocks [dp2block.level] := numblocks [dp2block.level] + 1D; numrecs [dp2block.level] := numrecs [dp2block.level] + $dbl (dp2block.rec^count); end end else -- DP1 index block begin numlevels := level; numblocks [level] := numblocks [level] + 1d; numrecs [level] := numrecs [level] + $dbl (records); end; diskaddr := diskaddr + $dbl (indexblocklen); maxreadlen := $max (indexblocklen, datablocklen); end end; ?Page "Recovery main procedure: Main loop" while not eof do begin getnextrecord: relkey := $int (diskaddr / $dbl (maxreadlen)) '*' rb; -- relkey := (diskaddr '/' maxreadlen) '*' rb; call position (badfile, diskaddr); call read (badfile, input^buffer, maxreadlen, countread); if < then begin call fileinfo (badfile, error); call print^rba; call fehler^meldung (error,, badfile); call getbackinstep; goto getnextrecord; end else if > then begin call printsummary; if partonly or thispart = partparms [0] then begin say (" "); say ("This program could have saved your life."); say ("A nice way to show your appreciation would be to send a bottle of"); say ("the best single malt scotch whisky or perfect French Cognac to"); say ("Greg Lehey at ESSG in Frankfurt."); say (" "); say ("Thank you and good luck!"); call stop end else begin thispart := thispart + 1; savname ':=' partparms [ (thispart - 1) * 4 +1] for 4; ! partkey.thispartkey := partkey.nextpartkey; !!JHS011585! ! partkey.nextpartkey := partparms [partparms [0] * 6 !!JHS011585! ! + 2 + thispart]; !!JHS011585! thisoffset:=nextoffset; !JHS011585! nextoffset:=thisoffset+2* ( (partkeylen+1)/2); !JHS011585! !JHS011585! goto open^unstructured; end; end; ! ! at this point we have successfully read a block. -- Now is a good time to decide what kind of block we are looking for. -- Determining the block beginning is easier in DP2. -- Make some checks to insure that it is probably a block beginning if dp2 = 1 then -- DP2 begin if dp2block.ec <> eyecatcher -- can't find an eyecatcher or dp2block.level < 0 -- unlikely level number or (numlevels and (dp2block.level > numlevels + 2)) -- (if levels are screwed up, this could help) or dp2block.flags .<12:13> <> filetype .<14:15> -- not this type of file -- NOTE: Bit 3 of the flags may specify a directory. This is still a key-sequenced file, -- and omitting bit 3 from the comparison might therefore be of use. then -- doesn't look like a block to me begin call getbackinstep; -- get back in step goto getnextrecord; -- UGH end; -- See if there is anything in the block if dp2block.flags .<14:15> -- bit map or free, ignore -- *** Should we include an option to recover free blocks? or not dp2block.rec^count then -- nothing there begin diskaddr := diskaddr + $dbl (datablocklen); -- point to next block goto getnextrecord; -- UGH end; -- Now we have an index or a data block. If it is an index block, just count -- it. Do real things with data blocks. numrecs [dp2block.level] := numrecs [dp2block.level] + $dbl (records); -- add record count at this level numblocks [dp2block.level] := numblocks [dp2block.level] + 1d; if dp2block.level then -- it's an index block begin diskaddr := diskaddr + $dbl (datablocklen); -- point to next block goto getnextrecord; end; -- If we get here, we have a data block with something in it. First check to see -- if the stuff is any good, then recover it @endblock := @input^buffer [(datablocklen '>>' 1) - 1]; -- point to the end of the block -- Check if the first offset is what we expect it to be. For relative and entry sequenced -- files, this will be 20, for key sequenced it will be 30. if endblock <> (if (iskeyseq := (dp2block.flags .<12:13> = 3)) then 30 else 20) then -- no go begin call writeexceptionrecord (0, bad^initial^offset); -- *** Would be nice to allow manual intervention here diskaddr := diskaddr + $dbl (datablocklen); -- point to next block goto getnextrecord; end; for i := 0 to dp2block.rec^count - 1 do -- look at each record begin thisrecordoffset := endblock [-i]; -- offset thisrecordlen := endblock [- (i + 1)] - endblock [-i]; -- length if iskeyseq then -- key sequenced thiskeylen := $min (prikeylen, thisrecordlen - prikeyoff + 1); -- get primary key length if thisrecordlen < 0 or thisrecordlen > maxreclen then -- bad key length begin call writeexceptionrecord (i, bad^record^length); -- write to exception file relkey := relkey + 1d; -- increment relative key goto dp2forloop; -- God, what blasphemy end; if iskeyseq then -- check for sequence errors begin if data^comp then -- data compression, expand it call key^expand (input^buffers [thisrecordoffset + prikeyoff], ckey, thiskeylen) else -- just move it across ckey ':=' input^buffers [thisrecordoffset + prikeyoff] for thiskeylen; if i and priorkey >= ckey for thiskeylen then -- sequence error begin call writeexceptionrecord (i, sequence^error); -- single this one out goto dp2forloop; end; priorkey ':=' ckey for thiskeylen; -- save this one end; -- check for fit within the partition, if not write to exception file if allflag then -- partitioned file if (thispart and ckey < spartparms [thisoffset] for partkeylen) -- secondary partition, -- we're below it or ckey > spartparms [nextoffset] for partkeylen then -- or above the next partition boundary begin call writeexceptionrecord (i, not^in^partition); -- single this one out relkey := relkey + 1d; -- forget it goto dp2forloop; end; -- OK, we've done our checks, write this record to the new file if data^comp then -- turn it off to write it again call rec^expand (input^buffers [thisrecordoffset], listbuffs, thisrecordlen) else listbuffs ':=' input^buffers [thisrecordoffset] for thisrecordlen; -- copy it across if relative then -- position it call position (goodfile, relkey); call write (goodfile, listbuff, thisrecordlen); if <> then -- screwed up begin call fileinfo (goodfile,error); -- what kind of error was it? if error = 10 then -- already there begin call writeexceptionrecord (i, no^message); -- write to exception file duplicates := duplicates + 1; -- count number on this block end else begin call fehler^meldung (error,, goodfile); -- report it anyway goodfileerrors := goodfileerrors + 1; -- another error on goodfile end; if goodfileerrors > 100 then -- at least tell him why begin say ("More than 100 errors on recoverd file. Recovery is probably impossible."); call abend end; end else if = then -- got it across recordsrecovered := recordsrecovered + 1D; relkey := relkey + 1D; -- up relative key dp2forloop: end; if duplicates then -- say so begin @char^point := num^out (buffers, duplicates); inbuf (" duplicate records found in block at "); call numout (char^point, diskaddr1, 8, 6); char^point [6] ':=' "." -> @char^point; call numout (char^point, diskaddr2, 8, 6); call output (listfile, buffer, @char^point '-' @buffers '+' 6); duplicates := 0; end; diskaddr := diskaddr + $dbl (datablocklen); -- point to next block end else -- must be a DP1 file begin if (level < 0 or level > numlevels) or (unused <> 0 or unused [1] <> 0 or unused [2] <> 0) then begin call getbackinstep; goto getnextrecord; end; ! ! check to see if the block is in use ! if not records then ! block not in use begin incrementdiskaddr; goto getnextrecord; end; ! ! at this point we have a block that is being used. If it ! is an index block, gather the stats and go to read the next ! block ! numrecs [level] := numrecs [level] + $dbl (records); numblocks [level] := numblocks [level] + 1d; if level then begin incrementdiskaddr; goto getnextrecord; end; ! ! this is what we have all been waiting for, an honest to ! goodness data block waiting to be recovered. Loop on the ! records and make the necessary integrity checks ! @endblock := @input^buffer [ (datablocklen '>>' 1) - 1]; ! ! before we start extracting records, check to make sure that ! the first offset is %24. If not, then we may have blocks of ! a length different from the file. This could happen when ! trying to recover a file which has been accidently purged. ! If this is so, try to get back in step and write this information ! to the exception file. ! if endblock <> 20 then begin call writeexceptionrecord (0, bad^initial^offset); incrementdiskaddr; goto getnextrecord; end; ! ! ! for i := 0 to records - 1 do begin ! ! compute the record length, key length etc. ! thisrecordoffset := endblock [-i]; thisrecordlen := endblock [-i - 1] - endblock [-i]; if keysequenced then thiskeylen := $min (prikeylen, thisrecordlen - prikeyoff + 1); ! ! check that the record length is valid ! if thisrecordlen < 0 or thisrecordlen > maxreclen then begin call writeexceptionrecord (i, bad^record^length); relkey := relkey + 1d; goto forloop; end; if keysequenced then begin ! ! check that there are no sequence errors ! IF DATA^COMP THEN call KEY^EXPAND (input^buffers [THISRECORDOFFSET + PRIKEYOFF], CKEY, THISKEYLEN) ELSE CKEY ':=' input^buffers [THISRECORDOFFSET + PRIKEYOFF] FOR THISKEYLEN; if i and priorkey >= CKEY for thiskeylen then begin call writeexceptionrecord (i, sequence^error); goto forloop; end; priorkey ':=' CKEY for thiskeylen; end; ! ! now check for fit within the partition. If not write to the exception file ! !delete if allflag then if ckey < partkey.thispartkeys.byte for partkeylen !!JHS011585! !delete or ckey > partkey.nextpartkeys.byte for partkeylen then !!JHS011585! if allflag then if (ckey '<' spartparms [thisoffset]for partkeylen !JHS011585! and thispart ) ! Don't check lower bound for part 0 !!JHS011585! or ckey '>' spartparms [nextoffset] for partkeylen then !JHS011585! begin call writeexceptionrecord (i, not^in^partition); relkey := relkey + 1d; goto forloop; end; ! ! that is all the checks for now. recover the record ! IF DATA^COMP THEN call REC^EXPAND (input^buffers [THISRECORDOFFSET], LISTBUFFS, THISRECORDLEN) ELSE listbuffs ':=' input^buffers [thisrecordoffset] for thisrecordlen; if relative then call position (goodfile, relkey); call write (goodfile, listbuff, thisrecordlen); if < then begin call fileinfo (goodfile, error); call fehler^meldung (error,, goodfile); if error = 10 then call writeexceptionrecord (i, duplicate^record); goodfileerrors := goodfileerrors + 1; if goodfileerrors > 100 then call stop; end else if = then -- no error recordsrecovered := recordsrecovered + 1d; relkey := relkey + 1d; forloop: end; ! of the loop on records if duplicates then -- say so begin @char^point := num^out (buffers, duplicates); inbuf (" duplicate records found in block at "); call numout (char^point, diskaddr1, 8, 6); char^point [6] ':=' "." -> @char^point; call numout (char^point, diskaddr2, 8, 6); call output (listfile, buffer, @char^point '-' @buffers '+' 6); duplicates := 0; end; incrementdiskaddr; end; ! of the while not eof loop end; -- of DP1/DP2 selection call printsummary; -- surely somebody must have noticed that this was missing? say (" "); say ("This program could have saved your life."); say ("A nice way to show your appreciation would be to send a bottle of"); say ("the best single malt scotch whisky or perfect French Cognac to"); say ("Greg Lehey at ESSG in Frankfurt."); say (" "); say ("Thank you and good luck!"); call stop; -- how about a report of what we have done? end; ! of the recovery program