From:	SMTP%"carl@SOL1.GPS.CALTECH.EDU" 24-SEP-1994 15:17:53.50
To:	EVERHART
CC:	
Subj:	Re: Any undelete programs out there?

From: carl@SOL1.GPS.CALTECH.EDU (Carl J Lydick)
X-Newsgroups: comp.os.vms
Subject: Re: Any undelete programs out there?
Date: 24 Sep 1994 09:53:40 GMT
Organization: HST Wide Field/Planetary Camera
Lines: 529
Distribution: world
Message-Id: <360sv4$8dd@gap.cco.caltech.edu>
Reply-To: carl@SOL1.GPS.CALTECH.EDU
Nntp-Posting-Host: sol1.gps.caltech.edu
To: Info-VAX@Mvb.Saic.Com
X-Gateway-Source-Info: USENET

In article <ddj.780353473@gradient>, ddj@gradient.gradient.com (Dave Johnson) writes:
=Does anyone know where I can look for a program to 
=undelete a file on VMS (AXP 6.1)?  I wanted to delete
=a .obj file, but typed .c;* by mistake.  I couldn't
=find any mention in the FAQ.
=
=(last time I did this was after an all-nighter 14 years ago,
=but it still was stupid).

First:  This is VMS, not DOS.  You're not the only user on the system (unless
you've got a VERY unusual system).  Chances are, by the time you get around to
using an UNDELETE program, somebody else has already allocated the blocks your
DELETE command freed.  So read (and take to heart) the disclaimer in the
following program).  Then try to program.  It *MIGHT* help you.  Probably
won't, but there's no harm in trying (*IF* you read and act on the comments):

$ COPY SYS$INPUT UNDEL.FOR
      program UNDEL
c             -----
c
c  Undelete a file on a FILES-11 disk
c
c  --------------------------------------------------------------------------
c
c  Handles disks with any cluster size, and files with any number of
c  extension headers. Use with caution only when you REALLY need it;
c  a backup copy is always preferable if you have one. If the file
c  is really vital, back the disk up before using UNDEL on it.
c
c  Define $ UNDEL=="$disk:[directory]UNDEL.EXE" in SYSLOGIN etc.
c
c  Use:   $ UNDEL disk:filename             ! puts it into original directory
c         $ UNDEL disk:[dir]filename        ! puts it in [dir] if it exists
c  Disk must be mounted Files-11.
c
c  IF THIS PROGRAM SHOULD FALL OVER:
c
c  $ ANALYZE/DISK/REPAIR the disk afterwards if this program does not
c  recover the file or crashes for any reason without finishing normally.
c  You will probably get the file you wanted in the [SYSLOST] directory,
c  with possible multiply allocated blocks. If there are multiply allocated
c  blocks, copy the file to another disk and delete it, then
c  ANALYZE/DISK/REPAIR the disk again to clean it up. You will have to edit
c  or otherwise claen up the junk in the file in this case. If not, then
c  the file and disk are OK.
c
c  ------------------------------------------------------------------------
c
c  Bitmap holds 220 blocks, enough for an RA81 with cluster=1
c
      parameter (maxbitblk=220)
c
      character name*86,file*86,device*10,dir*60,ans*1,result*86
      integer*4 rslen,bitmap(128,maxbitblk),dirty,blocks
      logical*1 done(maxbitblk)
      byte record(512)
c
c  Home block definitions
c
      integer*4 dum3(3),dum,headers,maxfiles
      integer*2 i2dum3(3),cluster,mapvbn,mapsize
      byte struc(2)
c
c  File header definitions
c
      integer*2 check,fid(3),extfid(3),bakfid(3)
      integer*4 filechar,idoff,resoff,acloff
      equivalence (fid(1),record(9)),
     &            (extfid(1),record(15)),
     &            (filechar,record(53)),
     &            (bakfid(1),record(67)),
     &            (check,record(511))
c
c
c  Open INDEXF.SYS and BITMAP.SYS on the afflicted disk
c
      call LIB$GET_FOREIGN(file)
      lendev=INDEX(file,':')
      if(lendev.eq.0) stop 'No device specified, no risks taken'
      device=file(1:lendev)
      print*,'Opening index file and bitmap on ',device
      jpos=INDEX(file,']')
      if(jpos.gt.lendev) then
         dir=file(lendev+1:jpos)
         lend=LENBL(dir)
         file=file(jpos+1:)
         print*,'Attempting to recover ',file(1:LENBL(file)),
     &          ' and place it in directory ',dir(1:LENBL(dir))
      else
         dir=' '
         file=file(lendev+1:)
         print*,'Attempting to recover ',file(1:LENBL(file)),
     &          ' and place it in its original directory'
      endif
      write(6,'(1x,a,$)') 'Continue? (Y/N) '
      read(5,'(a)',end=800) ans
      if(ans.ne.'y') go to 800
      iver=INDEX(file,';')
c
      open(1,file=device(1:lendev)//'[000000]INDEXF.SYS',shared,
     &     form='unformatted',recordtype='fixed',status='old')
      open(2,file=device(1:lendev)//'[000000]BITMAP.SYS',shared,
     &     form='unformatted',recordtype='fixed',status='old')
c
c  Read in the storage bitmap, skipping over the SCB (block 1)
c
      read(2)
      i=1
    5 read(2,end=6) (bitmap(j,i),j=1,128)
      i=i+1
      go to 5
c
    6 nblocks=i
      print*,nblocks,' blocks read from storage bitmap'
      do i=1,nblocks
         done(i)=.false.
      enddo
c
c  Read the home block (record 2) from INDEXF.SYS
c
      print*,'Reading home block on ',device
      read(1)
      read(1) dum3,struc,cluster,i2dum3,mapvbn,dum,maxfiles,mapsize
      if(struc(2).ne.2) stop 'Disk is not a FILES-11 ODS-2 disk.'
      print*,'Disk is Files-1 ODS-2 version',struc(1)
      print*,'Cluster size is',cluster
      print*,'Maximum number of files is',maxfiles
      print*,'Index file bitmap starts at VBN',mapvbn,
     &       ' and goes on for',mapsize,' blocks'
      headers=mapvbn+mapsize
      print*,'File headers start at VBN',headers
c
c  Skip over the alternate home block, index bitmap etc. and start reading
c  headers for the file
c
      do i=3,headers-1
         read(1,end=150)
      enddo
      ivbn=headers-1
      blocks=0
      dirty=0
      iseek=0
      lastblock=0
      do 100 i=1,maxfiles
         ivbn=ivbn+1
         read(1,end=150) record
c
c  Get the name from the ID offset; the first 20 chars are at the ID offset
c  The remaining 66, if they exist, are later on in the ident area
c
   30    idoff=record(1)
         idoff=idoff*2
         mpoff=record(2)
         mpoff=mpoff*2
         if(idoff.le.0.or.idoff.gt.512) go to 100
         k=1
         name=' '
         do j=1,20
            name(j:j)=CHAR(record(idoff+k))
            k=k+1
            if(idoff+k.gt.mpoff) go to 35
         enddo
         k=55
         do j=21,86
            name(j:j)=CHAR(record(idoff+k))
            k=k+1
            if(idoff+k.gt.mpoff) go to 35
         enddo
   35    lenl=INDEX(name,';')-1
         if(iver.gt.0.or.lenl.le.0) lenl=86
         if(iseek.eq.0.and.name(1:lenl).ne.file) go to 100
c
c  The name compared (up to the ';' if a version was not specified)
c
         lenl=LENBL(name)
         print*,'Filename: ',name(1:lenl)
         write(6,1000) ivbn,fid,extfid,filechar,check
c
c  If we are looking for extension headers, scream loudly if all not OK here
c
         if(iseek.gt.0) then
            k=INDEX(name,';')-1
            if(name(1:k).ne.file) stop
     &         'Index file corrupt; bad filename in extension header'
            if(check.ne.0.and.fid(1).ne.0) stop
     &         'Index file corrupt; extension header not deleted'
c
c  See if the file was deleted
c
         else
            if(check.ne.0.and.fid(1).ne.0) then
               print*,'This file is not deleted'
               go to 100
            endif
            write(6,'(1x,a,$)') 'Recover this file? (Y/N) '
            read(5,'(a)',end=100) ans
            if(ans.ne.'y') go to 100
         endif
c
c  Found a deleted file we want to restore - replace the fid and checksum,
c  and clear the delete bit in filechar
c
         fid(1)=ivbn-4*cluster-mapsize
         filechar=filechar.and.'FFFF7FFF'x
c
c  If we are doing the original header (not an extension):
c  The original directory is pointed to by bakfid; if a directory was specified
c  we need to find out its fid first and put it in the backlink fid
c  Leave extension bakfid alone as it points to the previous file header
c
         if(dir.ne.' '.and.iseek.eq.0)
     &      call PARSE (device(1:lendev)//dir(1:lend)//'*.*',bakfid)
c
c  Checksum the record and write it back into the current record
c
         call CHECKSUM(record)
         print*,'Rewriting file header for ',name(1:lenl)
         write(6,1000) ivbn,fid,extfid,filechar,check
         call UPD(1,record,512)
c
c  If we are doing the original header (not an extension):
c  Enter file into the directory specified or into its original directory
c
         if(iseek.eq.0) then
            write(6,1020) bakfid
            call ENTER(name(1:lenl),fid,bakfid,device(1:lendev),
     &                 result,rslen)
            if(rslen.gt.0) print*,'Created '//result(1:rslen)
         endif
c
c  Go through the bitmap and see if all the blocks in this file are still free
c  If so, the file is OK; mark the blocks as used and we are done
c  If not, we need to copy this file OFF the disk and ANAL/DISK/REPAIR ASAP
c
c  Record still contains the file header; go through the map area
c  Each bit in the bitmap represents 1 cluster of blocks
c  Clear the bit in the bitmap memory image so we can write it back later
c
         mpend=511
         resoff=record(3)
         if(resoff.gt.0.and.resoff*2+1.lt.mpend) mpend=resoff*2+1
         acloff=record(4)
         if(acloff.gt.0.and.acloff*2+1.lt.mpend) mpend=acloff*2+1
         m=mpoff+1
         print*
         print*,'Checking bitmap for allocation of blocks...'
         print*
         print*,'Count Start Retrieval pointer'
   80    call RPOINTER(record(m),lbncount,lbnstart,m)
         if(m.ge.mpend) go to 85
         if(lbncount.eq.0) go to 80
         lbnstart=lbnstart/cluster
         lbncount=lbncount/cluster
         do j=lbnstart,lbnstart+lbncount-1
            iblock=j/4096+1
            if(iblock.le.0.or.iblock.gt.nblocks) stop 'Silly block #'
            ibit=MOD(j,4096)
            iword=ibit/32+1
            ibit=MOD(ibit,32)
            blocks=blocks+1
            if(.not.LIB$EXTZV(ibit,1,bitmap(iword,iblock)))
     &         dirty=dirty+1
            call LIB$INSV(0,ibit,1,bitmap(iword,iblock))
            done(iblock)=.true.
            lastblock=MAX0(lastblock,iblock)
         enddo
         go to 80
c
c  If the file has extension headers, continue reading these and looking
c  for more retrieval pointers; if not, we are done
c
   85    if(extfid(1).eq.0) then
            if(dirty.gt.0) go to 190
            go to 185
         else
            iseek=extfid(1)
            do j=1,iseek-fid(1)
               ivbn=ivbn+1
               read(1) record
            enddo
            go to 30
         endif
  100 continue
c
c  Whole index file has been scanned, stop
c
  150 print*,'EOF on INDEXF.SYS'
  160 close(1)
      close(2)
      call EXIT
c
c  Here all the storage bits are free - the file is intact, and we have marked
c  them as allocated again. Rewrite the affected bitmap blocks back to
c  BITMAP.SYS
c
  185 print*,'Rewriting affected blocks in BITMAP.SYS: 1 to',
     &       lastblock
      rewind 2
      read(2)
      do j=1,lastblock
         read(2)
         if(done(j)) call UPD(2,bitmap(1,j),512)
      enddo
      print*
      print*,'Recovered',blocks,' blocks'
      print*,'FILE AND DISK HAVE BEEN RECOVERED INTACT'
      go to 160
c
c  Error message for multiply allocated blocks
c
  190 print*,dirty,' out of',blocks,' blocks have been allocated'//
     &       ' to another file!'
      print*,'Do the following in DCL:'
      print*
      print*,'   $ COPY ',result(1:rslen),' another_disk:[directory]'
      print*,'   $ DELETE ',result(1:rslen)
      print*,'   $ ANALYZE/DISK/REPAIR '//device
      print*
      print*,'This will clean up the disk'
      go to 160
c
  800 stop 'UNDEL aborted - no action taken'
c
 1000 format(' VBN',i5,': FID(',i5,2i3,') EXT(',i5,2i3,') CHAR ',z8.8,
     &       ' CHECK ',z4.4)
 1020 format(' Entering file into directory FID (',i5,2i3,')')
      end
      subroutine UPD(iunit,record,length)
c
      byte record(length)
      integer FOR$RAB
c
c  $UPDATE a record back into the file on unit
c
      irab=FOR$RAB(iunit)
      call UPD2(%VAL(irab),record,length)
      return
      end
      subroutine UPD2(rab,record,length)
c
      include '($rabdef)'
c
      integer SYS$UPDATE,SYS$FLUSH
      byte record(length)
      record /rabdef/ rab
c
c  $UPDATE then $FLUSH to RAB
c
      rab.rab$l_rbf=%LOC(record(1))
      rab.rab$w_rsz=length
      iret=SYS$UPDATE(rab)
      if(.not.iret) then
         write(6,1000) rab.rab$l_sts,rab.rab$l_stv
         go to 80
      endif
      iret=SYS$FLUSH(rab)
      if(.not.iret) then
         write(6,1000) rab.rab$l_sts,rab.rab$l_stv
         go to 80
      endif
      return
   80 print*,'Trouble writing the file header into the index file.'
      print*,'You may not have enough privileges. Error text follows:'
      call LIB$STOP(%VAL(iret))
      return
c
 1000 format(' RMS Status on $UPDATE: ',z8.8,' STV value: ',z8.8)
 1010 format(' RMS Status on $FLUSH: ',z8.8,' STV value: ',z8.8)
      end
      subroutine PARSE(string,did)
c
      include '($fabdef)'
      include '($namdef)'
c
      integer SYS$PARSE
      integer*2 did(3),savdid(3)
      character*(*) string
c
      record /fabdef/ fab
      record /namdef/ nam
c
c  Parse device//dir//'*.*' to get the directory id and device into
c  the NAM block
c
      call MOV3(did,savdid)
      fab.fab$b_bid=fab$c_bid
      fab.fab$b_bln=fab$c_bln
      nam.nam$b_bid=nam$c_bid
      nam.nam$b_bln=nam$c_bln
      fab.fab$l_nam=%LOC(nam)
      fab.fab$l_fna=%LOC(string)
      fab.fab$b_fns=LEN(string)
c
      iret=SYS$PARSE(fab)
      if(.not.iret) then
         write(6,1010) fab.fab$l_sts,fab.fab$l_stv
         print*,'Cannot find the directory you want.'
         print*,'File will be put back into its original directory'
         call MOV3(savdid,did)
         return
      endif
      call MOV3(nam.nam$w_did,did)
      return
c
 1010 format(' RMS Status on $PARSE: ',z8.8,' STV value: ',z8.8)
      end
      subroutine ENTER(file,fid,did,device,result,rslen)
c
      include '($iodef)'
      include '($fibdef)'
c
      integer SYS$ASSIGN,SYS$QIOW,fibdesc(2),iosb(2),rslen
      integer*2 channel,fid(3),did(3)
      character*(*) file,device,result
c
      record /fibdef/ fib
c
c  Invoke ACP function to create a directory entry
c  This will complain if the directory isn't there (but file will be found
c  later by ANAL/DISK/REPAIR and put into [SYSLOST])
c
c  Get a channel to the device
c
      iret=SYS$ASSIGN(device,channel,,)
      if(.not.iret) then
         write(6,1000) iret
         go to 80
      endif
c
c  Create the directory entry
c
      fibdesc(1)=22
      fibdesc(2)=%LOC(fib)
      call MOV3(did,fib.fib$w_did)
      call MOV3(fid,fib.fib$w_fid)
      fib.fib$w_nmctl=fib$m_newver
      iret=SYS$QIOW(,%VAL(channel),%VAL(io$_create),iosb,,,
     &              fibdesc,file,rslen,result,,)
      if(iret) iret=iosb(1)
      if(iret) return
c
c  Error entering the file in the directory
c
      write(6,1000) iret
   80 print*,'The file has not been entered in a directory.'
      print*,'ANALYZE/DISK/REPAIR is required to put it in [SYSLOST]'
      rslen=0
      return
 1000 format(' $ASSIGN status: ',z8.8)
 1010 format(' $QIOW status on CREATE: ',z8.8)
      end
      subroutine MOV3(fid,blkfid)
c
      integer*2 fid(3),blkfid(3)
c
c  Move a 3-word fid
c
      blkfid(1)=fid(1)
      blkfid(2)=fid(2)
      blkfid(3)=fid(3)
      return
      end
      subroutine RPOINTER(map,lbncount,lbnstart,m)
c
      integer*2 map(*)
c
c  Break the count and start fields out of a retrieval pointer
c  Handle the 3 formats of 'em that exist
c  Bump m by the # of bytes in the pointer found
c
      itype=LIB$EXTZV(14,2,map(1))
      if(itype.eq.0) then		! Placement word or junk
         lbncount=0
         lbnstart=0
      else if(itype.eq.1) then		! 4-byte short form
         lbncount=LIB$EXTZV(0,8,map(1))+1
         lbnstart=map(2)+65536*LIB$EXTZV(8,6,map(1))
      else if(itype.eq.2) then		! 6-byte medium form
         lbncount=LIB$EXTZV(0,14,map(1))+1
         lbnstart=map(2)+65536*map(3)
      else if(itype.eq.3) then		! 8-byte long form
         lbncount=map(2)+65536*LIB$EXTZV(0,14,map(1))+1
         lbnstart=map(3)+65536*map(4)
      endif
      j=(itype+1)*2
      m=m+j
      if(itype.eq.0) return
      write(6,'(2i6,4(1x,z4.4))') lbncount,lbnstart,(map(i),i=1,itype+1)
      return
      end
      integer function LENBL(string)
c
      character*(*) string
c
c  Returns the length of a character string, ignoring trailing blanks
c
      do 20 l=LEN(string),1,-1
   20   if(string(l:l).ne.' ') go to 40
      l=0
   40 LENBL=l
      return
      end
$ COPY SYS$INPUT CHECKSUM.MAR
	.title	CHECKSUM - Compute checksum: Call CHECKSUM(record)
;
	.psect	CHECKSUM$CODE,nowrt,exe,quad
;
	.ENTRY	CHECKSUM, ^M<R2>
	CLRL	R1			; Accumulate checksum in R1.
	MOVL	4(AP), R2		; Header address into R2.
	MOVZBL	#255, R0		; Loop counter into R0.
;
10$:	ADDW2	(R2)+, R1		; Compute checksum.
	SOBGTR	R0, 10$
;
	MOVW	R1, (R2)		; Store computed checksum.
	RET
	.END
$ MACRO CHECKSUM
$ FORTRAN UNDEL
$ LINK UNDEL, CHECKSUM
--------------------------------------------------------------------------------
Carl J Lydick | INTERnet: CARL@SOL1.GPS.CALTECH.EDU | NSI/HEPnet: SOL1::CARL

Disclaimer:  Hey, I understand VAXen and VMS.  That's what I get paid for.  My
understanding of astronomy is purely at the amateur level (or below).  So
unless what I'm saying is directly related to VAX/VMS, don't hold me or my
organization responsible for it.  If it IS related to VAX/VMS, you can try to
hold me responsible for it, but my organization had nothing to do with it.