From:	CSBVAX::CSBVAX::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 11-DEC-1988 02:20
To:	MRGATE::"ARISIA::EVERHART"
Subj:	UNDEL.1_OF_2


Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Tue, 29 NOV 88 00:37:36 PDT
Received: from Xerox.COM by KL.SRI.COM with TCP; Tue, 29 Nov 88 00:13:44 PST
Received: from Burger.ms by ArpaGateway.ms ; 29 NOV 88 00:04:51 PST
Sender: "James_A._Gray.OsbuSouth"@Xerox.COM
Date: 29 Nov 88 00:04:23 PST (Tuesday)
Subject: UNDEL.1_OF_2
From: "James_A._Gray.OsbuSouth"@Xerox.COM
To: info-vax@kl.sri.COM
Reply-to: "Gray:OSBUSouth@Xerox.COM:Xerox.ns"@Xerox.COM
Message-ID: <881129-000451-4498@Xerox>

$! ...................... Cut between dotted lines and save. .....................
$!.............................................................................
$! VAX/VMS archive file created by VMS_SHARE V06.03 20-Oct-1988.
$!
$! VMS_SHARE was written by James Gray (Gray:OSBUSouth@Xerox.COM) from
$! VMS_SHAR by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au).
$!
$! To unpack, simply save, concatinate all parts into one file and
$! execute (@) that file.
$!
$! This archive was created by user GRAY
$! on 28-NOV-1988 23:36:18.09.
$!
$! ATTENTION: To keep each article below 31 blocks (15872 bytes), this
$!            program has been transmitted in 2 parts.  You should
$!            concatenate ALL parts to ONE file and execute (@) that file.
$!
$! It contains the following 2 files:
$!        UNDEL.FOR
$!        CHECKSUM.MAR
$!
$!==============================================================================
$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )
$ VERSION = F$GETSYI( "VERSION" )
$ IF VERSION .GES "V4.4" THEN GOTO VERSION_OK
$ WRITE SYS$OUTPUT "You are running VMS ''VERSION'; ", -
    "VMS_SHARE V06.03 20-Oct-1988 requires VMS V4.4 or higher."
$ EXIT 44 
$VERSION_OK:
$ GOTO START
$
$UNPACK_FILE:
$ WRITE SYS$OUTPUT "Creating ''FILE_IS'"
$ DEFINE/USER_MODE SYS$OUTPUT NL:
$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSECTION -
    VMS_SHARE_DUMMY.DUMMY

b_part := CREATE_BUFFER( "{Part}", GET_INFO( COMMAND_LINE, "file_name" ) );
s_file_spec := GET_INFO( COMMAND_LINE, "output_file" );SET( OUTPUT_FILE, b_part
, s_file_spec ); 
b_errors := CREATE_BUFFER( "{Errors}" );i_errors := 0; 
pat_beg_1 := ANCHOR & "-+-+-+ Beginning";
pat_beg_2 := LINE_BEGIN & "+-+-+-+ Beginning";
pat_end := ANCHOR & "+-+-+-+-+ End";
pat_trail := " " & LINE_END;POSITION( BEGINNING_OF( b_part ) ); LOOP b 
:= SEARCH( pat_trail, FORWARD); EXITIF b=0; POSITION( END_OF( b ) )
; LOOP MOVE_HORIZONTAL( -1 ); EXITIF CURRENT_CHARACTER <> ' '; ERASE_CHARACTER
( 1 ); EXITIF CURRENT_OFFSET=0; ENDLOOP; ENDLOOP; POSITION( BEGINNING_OF
( b_part ) ); i_append_line := 0; LOOP EXITIF MARK( NONE ) = END_OF( b_part )
; s_x := ERASE_CHARACTER( 1 ); 
  IF s_x = "+" THEN r_skip := SEARCH( pat_beg_1, FORWARD, EXACT ); IF r_skip <
> 0 THEN 
      s_x := ""; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE; ENDIF; ENDIF; 
  IF s_x = "-" THEN r_skip := SEARCH( pat_end, FORWARD, EXACT ); IF r_skip <
> 0 THEN 
      s_x := ""; MOVE_HORIZONTAL( -CURRENT_OFFSET ); m_skip := MARK( NONE )
; r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF r_skip <> 0 THEN POSITION
( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET ); MOVE_VERTICAL( 1 )
; MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF( b_part ) ); ENDIF; ERASE
( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF; ENDIF; 
  IF s_x = "V" THEN 
    s_x := ""; IF i_append_line <> 0 THEN APPEND_LINE; MOVE_HORIZONTAL
( -CURRENT_OFFSET ); ENDIF; i_append_line := 1; MOVE_VERTICAL( 1 ); ENDIF; 
  IF s_x = "X" THEN 
    s_x := ""; IF i_append_line <> 0 THEN APPEND_LINE; MOVE_HORIZONTAL
( -CURRENT_OFFSET ); ENDIF; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF; 
  IF s_x <> "" THEN i_errors := i_errors + 1; s_text := CURRENT_LINE; POSITION
( b_errors ); 
    COPY_TEXT( "The following line could not be unpacked properly:" )
; SPLIT_LINE; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part )
; MOVE_VERTICAL( 1 ); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP 
  r_x := SEARCH( "`", FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x )
; ERASE_CHARACTER( 1 ); 
  IF CURRENT_CHARACTER = "`" THEN MOVE_HORIZONTAL( 1 ); ELSE COPY_TEXT( ASCII
( INT( ERASE_CHARACTER( 3 ) ) ) ); ENDIF; ENDLOOP; IF i_errors = 0 THEN SET
( NO_WRITE, b_errors, ON ); ELSE POSITION( BEGINNING_OF( b_errors ) ); 
  COPY_TEXT( FAO( "The following !UL errors were detected while unpacking !AS"
, i_errors, s_file_spec ) ); SPLIT_LINE; 
  SET( OUTPUT_FILE, b_errors, "SYS$COMMAND" );ENDIF; EXIT; 
$ DELETE VMS_SHARE_DUMMY.DUMMY;*
$ CHECKSUM 'FILE_IS
$ WRITE SYS$OUTPUT " CHECKSUM ", -
  F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, ",", "failed!,passed." )
$ RETURN
$
$START:
$ FILE_IS = "UNDEL.FOR"
$ CHECKSUM_IS = 442361245
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X      program UNDEL
Xc             -----
Xc
Xc  Undelete a file on a FILES-11 disk
Xc
Xc  --------------------------------------------------------------------------
Xc
Xc  Handles disks with any cluster size, and files with any number of
Xc  extension headers. Use with caution only when you REALLY need it;
Xc  a backup copy is always preferable if you have one. If the file
Xc  is really vital, back the disk up before using UNDEL on it.
Xc
Xc  Define $ UNDEL=="$disk:[directory]UNDEL.EXE" in SYSLOGIN etc.
Xc
Xc  Use:   $ UNDEL disk:filename             ! puts it into original directory
Xc         $ UNDEL disk:[dir]filename        ! puts it in [dir] if it exists
Xc  Disk must be mounted Files-11.
Xc
Xc  IF THIS PROGRAM SHOULD FALL OVER:
Xc
Xc  $ ANALYZE/DISK/REPAIR the disk afterwards if this program does not
Xc  recover the file or crashes for any reason without finishing normally.
Xc  You will probably get the file you wanted in the [SYSLOST] directory,
Xc  with possible multiply allocated blocks. If there are multiply allocated
Xc  blocks, copy the file to another disk and delete it, then
Xc  ANALYZE/DISK/REPAIR the disk again to clean it up. You will have to edit
Xc  or otherwise claen up the junk in the file in this case. If not, then
Xc  the file and disk are OK.
Xc
Xc  ------------------------------------------------------------------------
Xc
Xc  Bitmap holds 220 blocks, enough for an RA81 with cluster=1
Xc
X      parameter (maxbitblk=220)
Xc
X      character name*86,file*86,device*10,dir*60,ans*1,result*86
X      integer*4 rslen,bitmap(128,maxbitblk),dirty,blocks
X      logical*1 done(maxbitblk)
X      byte record(512)
Xc
Xc  Home block definitions
Xc
X      integer*4 dum3(3),dum,headers,maxfiles
X      integer*2 i2dum3(3),cluster,mapvbn,mapsize
X      byte struc(2)
Xc
Xc  File header definitions
Xc
X      integer*2 check,fid(3),extfid(3),bakfid(3)
X      integer*4 filechar,idoff,resoff,acloff
X      equivalence (fid(1),record(9)),
X     &            (extfid(1),record(15)),
X     &            (filechar,record(53)),
X     &            (bakfid(1),record(67)),
X     &            (check,record(511))
Xc
Xc
Xc  Open INDEXF.SYS and BITMAP.SYS on the afflicted disk
Xc
X      call LIB$GET_FOREIGN(file)
X      lendev=INDEX(file,':')
X      if(lendev.eq.0) stop 'No device specified, no risks taken'
X      device=file(1:lendev)
X      print*,'Opening index file and bitmap on ',device
X      jpos=INDEX(file,']')
X      if(jpos.gt.lendev) then
X         dir=file(lendev+1:jpos)
X         lend=LENBL(dir)
X         file=file(jpos+1:)
X         print*,'Attempting to recover ',file(1:LENBL(file)),
X     &          ' and place it in directory ',dir(1:LENBL(dir))
X      else
X         dir=' '
X         file=file(lendev+1:)
X         print*,'Attempting to recover ',file(1:LENBL(file)),
X     &          ' and place it in its original directory'
X      endif
X      write(6,'(1x,a,$)') 'Continue? (Y/N) '
X      read(5,'(a)',end=800) ans
X      if(ans.ne.'y') go to 800
X      iver=INDEX(file,';')
Xc
X      open(1,file=device(1:lendev)//'[000000]INDEXF.SYS',shared,
X     &     form='unformatted',recordtype='fixed',status='old')
X      open(2,file=device(1:lendev)//'[000000]BITMAP.SYS',shared,
X     &     form='unformatted',recordtype='fixed',status='old')
Xc
Xc  Read in the storage bitmap, skipping over the SCB (block 1)
Xc
X      read(2)
X      i=1
X    5 read(2,end=6) (bitmap(j,i),j=1,128)
X      i=i+1
X      go to 5
Xc
X    6 nblocks=i
X      print*,nblocks,' blocks read from storage bitmap'
X      do i=1,nblocks
X         done(i)=.false.
X      enddo
Xc
Xc  Read the home block (record 2) from INDEXF.SYS
Xc
X      print*,'Reading home block on ',device
X      read(1)
X      read(1) dum3,struc,cluster,i2dum3,mapvbn,dum,maxfiles,mapsize
X      if(struc(2).ne.2) stop 'Disk is not a FILES-11 ODS-2 disk.'
X      print*,'Disk is Files-1 ODS-2 version',struc(1)
X      print*,'Cluster size is',cluster
X      print*,'Maximum number of files is',maxfiles
X      print*,'Index file bitmap starts at VBN',mapvbn,
X     &       ' and goes on for',mapsize,' blocks'
X      headers=mapvbn+mapsize
X      print*,'File headers start at VBN',headers
Xc
Xc  Skip over the alternate home block, index bitmap etc. and start reading
Xc  headers for the file
Xc
X      do i=3,headers-1
X         read(1,end=150)
X      enddo
X      ivbn=headers-1
X      blocks=0
X      dirty=0
X      iseek=0
X      lastblock=0
X      do 100 i=1,maxfiles
X         ivbn=ivbn+1
X         read(1,end=150) record
Xc
Xc  Get the name from the ID offset; the first 20 chars are at the ID offset
Xc  The remaining 66, if they exist, are later on in the ident area
Xc
X   30    idoff=record(1)
X         idoff=idoff*2
X         mpoff=record(2)
X         mpoff=mpoff*2
X         if(idoff.le.0.or.idoff.gt.512) go to 100
X         k=1
X         name=' '
X         do j=1,20
X            name(j:j)=CHAR(record(idoff+k))
X            k=k+1
X            if(idoff+k.gt.mpoff) go to 35
X         enddo
X         k=55
X         do j=21,86
X            name(j:j)=CHAR(record(idoff+k))
X            k=k+1
X            if(idoff+k.gt.mpoff) go to 35
X         enddo
X   35    lenl=INDEX(name,';')-1
X         if(iver.gt.0.or.lenl.le.0) lenl=86
X         if(iseek.eq.0.and.name(1:lenl).ne.file) go to 100
Xc
Xc  The name compared (up to the ';' if a version was not specified)
Xc
X         lenl=LENBL(name)
X         print*,'Filename: ',name(1:lenl)
X         write(6,1000) ivbn,fid,extfid,filechar,check
Xc
Xc  If we are looking for extension headers, scream loudly if all not OK here
Xc
X         if(iseek.gt.0) then
X            k=INDEX(name,';')-1
X            if(name(1:k).ne.file) stop
X     &         'Index file corrupt; bad filename in extension header'
X            if(check.ne.0.and.fid(1).ne.0) stop
X     &         'Index file corrupt; extension header not deleted'
Xc
Xc  See if the file was deleted
Xc
X         else
X            if(check.ne.0.and.fid(1).ne.0) then
X               print*,'This file is not deleted'
X               go to 100
X            endif
X            write(6,'(1x,a,$)') 'Recover this file? (Y/N) '
X            read(5,'(a)',end=100) ans
X            if(ans.ne.'y') go to 100
X         endif
Xc
Xc  Found a deleted file we want to restore - replace the fid and checksum,
Xc  and clear the delete bit in filechar
Xc
X         fid(1)=ivbn-4*cluster-mapsize
X         filechar=filechar.and.'FFFF7FFF'x
Xc
Xc  If we are doing the original header (not an extension):
Xc  The original directory is pointed to by bakfid; if a directory was specified
Xc  we need to find out its fid first and put it in the backlink fid
Xc  Leave extension bakfid alone as it points to the previous file header
Xc
X         if(dir.ne.' '.and.iseek.eq.0)
X     &      call PARSE (device(1:lendev)//dir(1:lend)//'*.*',bakfid)
Xc
Xc  Checksum the record and write it back into the current record
Xc
X         call CHECKSUM(record)
X         print*,'Rewriting file header for ',name(1:lenl)
X         write(6,1000) ivbn,fid,extfid,filechar,check
X         call UPD(1,record,512)
Xc
Xc  If we are doing the original header (not an extension):
Xc  Enter file into the directory specified or into its original directory
Xc
X         if(iseek.eq.0) then
X            write(6,1020) bakfid
X            call ENTER(name(1:lenl),fid,bakfid,device(1:lendev),
X     &                 result,rslen)
X            if(rslen.gt.0) print*,'Created '//result(1:rslen)
X         endif
Xc
Xc  Go through the bitmap and see if all the blocks in this file are still free
Xc  If so, the file is OK; mark the blocks as used and we are done
Xc  If not, we need to copy this file OFF the disk and ANAL/DISK/REPAIR ASAP
Xc
Xc  Record still contains the file header; go through the map area
Xc  Each bit in the bitmap represents 1 cluster of blocks
Xc  Clear the bit in the bitmap memory image so we can write it back later
Xc
X         mpend=511
X         resoff=record(3)
X         if(resoff.gt.0.and.resoff*2+1.lt.mpend) mpend=resoff*2+1
X         acloff=record(4)
X         if(acloff.gt.0.and.acloff*2+1.lt.mpend) mpend=acloff*2+1
X         m=mpoff+1
X         print*
X         print*,'Checking bitmap for allocation of blocks...'
X         print*
X         print*,'Count Start Retrieval pointer'
X   80    call RPOINTER(record(m),lbncount,lbnstart,m)
X         if(m.ge.mpend) go to 85
X         if(lbncount.eq.0) go to 80
X         lbnstart=lbnstart/cluster
X         lbncount=lbncount/cluster
X         do j=lbnstart,lbnstart+lbncount-1
X            iblock=j/4096+1
X            if(iblock.le.0.or.iblock.gt.nblocks) stop 'Silly block #'
X            ibit=MOD(j,4096)
X            iword=ibit/32+1
X            ibit=MOD(ibit,32)
X            blocks=blocks+1
X            if(.not.LIB$EXTZV(ibit,1,bitmap(iword,iblock)))
X     &         dirty=dirty+1
X            call LIB$INSV(0,ibit,1,bitmap(iword,iblock))
X            done(iblock)=.true.
X            lastblock=MAX0(lastblock,iblock)
X         enddo
X         go to 80
Xc
Xc  If the file has extension headers, continue reading these and looking
Xc  for more retrieval pointers; if not, we are done
Xc
X   85    if(extfid(1).eq.0) then
X            if(dirty.gt.0) go to 190
X            go to 185
X         else
X            iseek=extfid(1)
X            do j=1,iseek-fid(1)
X               ivbn=ivbn+1
X               read(1) record
X            enddo
X            go to 30
X         endif
X  100 continue
Xc
Xc  Whole index file has been scanned, stop
Xc
X  150 print*,'EOF on INDEXF.SYS'
X  160 close(1)
X      close(2)
X      call EXIT
Xc
Xc  Here all the storage bits are free - the file is intact, and we have marked
Xc  them as allocated again. Rewrite the affected bitmap blocks back to
Xc  BITMAP.SYS
Xc
X  185 print*,'Rewriting affected blocks in BITMAP.SYS: 1 to',
X     &       lastblock
X      rewind 2
X      read(2)
X      do j=1,lastblock
X         read(2)
X         if(done(j)) call UPD(2,bitmap(1,j),512)
X      enddo
X      print*
X      print*,'Recovered',blocks,' blocks'
X      print*,'FILE AND DISK HAVE BEEN RECOVERED INTACT'
X      go to 160
Xc
Xc  Error message for multiply allocated blocks
Xc
X  190 print*,dirty,' out of',blocks,' blocks have been allocated'//
X     &       ' to another file!'
X      print*,'Do the following in DCL:'
X      print*
X      print*,'   $ COPY ',result(1:rslen),' another_disk:[directory]'
X      print*,'   $ DELETE ',result(1:rslen)
X      print*,'   $ ANALYZE/DISK/REPAIR '//device
X      print*
X      print*,'This will clean up the disk'
X      go to 160
Xc
X  800 stop 'UNDEL aborted - no action taken'
Xc
X 1000 format(' VBN',i5,': FID(',i5,2i3,') EXT(',i5,2i3,') CHAR ',z8.8,
X     &       ' CHECK ',z4.4)
X 1020 format(' Entering file into directory FID (',i5,2i3,')')
X      end
X      subroutine UPD(iunit,record,length)
Xc
X      byte record(length)
X      integer FOR$RAB
Xc
Xc  $UPDATE a record back into the file on unit
Xc
X      irab=FOR$RAB(iunit)
-+-+-+-+-+ End of part 1 +-+-+-+-+-

