c JTDELMAINT c Maintains deleted files in various ways. c c c Uses the sequential deletion record information. c (xformed_filename,devicename,orig_filespec) c (comma-delimited) c (xformed filename is c .sav c ) c The sequential filename is gce$delseq:delrecs.seq, so we expect this c logical gce$delseq to be set appropriately. c c functions: c jtdelmaint file/%UNDELETE c restores file to owner. Filename may be any wildcard string c as the file is replaced in its original place with its original c owner. (This only works if the file is still in nearline storage.) c c jtdelmaint file/%PURGE:NNNN where nnnn is number of seconds old the c file may be. This function is designed to be run every c few minutes to hours and determines the length of time c that files may be undeleted. c c The jtdel$mode logical is used to maintain mode settings that are c global to the process and determines: c 1. What mode was used in moving the file to backup (rename/copy/cmdfile) c 2. Whether a backup facility should be invoked before cleanup deletes c files. (Such a facility would be via command file.) c character*16 cmode integer*4 mode Integer*4 lib$sys_trnlog,lib$get_foreign External lib$sys_trnlog,lib$get_foreign include '($dvidef)' include '($jpidef)' include '($acldef)' include '($acedef)' parameter lib$k_julian_date=20 parameter lib$k_second_of_day=16 integer*4 lib$cvt_from_internal_time,cmdlen external lib$cvt_from_internal_time integer*4 istart,for$rab,sys$flush,lib$spawn,lib$find_file external for$rab,sys$flush,lib$spawn,lib$find_file integer*4 str$match_wild,conv$pass_files,conv$convert external str$match_wild,conv$pass_files,conv$convert integer*4 sys$assign,sys$dassgn,sys$qiow,iosb(2) integer*4 conv$pass_options external conv$pass_options external sys$assign,sys$dassgn,sys$qiow include '($strdef)' include '($iodef)' integer*2 fib(12) integer*4 dfib(2) character*256 dbnam,wrest character*256 delsve integer*4 ldsv character*512 cmdlin,cwrk,cread character*128 resultant integer*4 status,context,iflags integer*4 convopts(19) data convopts/18,1,0,1,0,0,1,2,0,0,0,0,0,0,0,0,0,0,0/ c Pass in the desired ACE as hex mode=0 lcmode=0 c dfib is FIB descriptor dfib(2)=%loc(fib) dfib(1)=24 c First read the mode logical if we can. Call lib$sys_trnlog('JTDEL$MODE',lcmode,cmode) if(lcmode.gt.0)then read(cmode(:lcmode),'(i)')mode endif ii=lib$get_foreign(cmdlin,'DelMaint cmd>',cmdlen,) cmdlin=cmdlin(1:cmdlen) if(cmdlen.lt.3)goto 9800 c test termination. Q or ctrlZ will just exit... if(ichar(cmdlin(1:1)).le.32)goto 9999 if(cmdlin(1:1).eq.'q'.or.cmdlin(1:1).eq.'Q')goto 9999 c find all versions of the sequential file & scan them all context=0 7000 continue iflags=0 iii=lib$find_file('gce$delseq:delrecs.seq;*',resultant, 1 context,,,status,iflags) lres=ivlen(resultant,128) c if the find failed, quit. c if(iand(status,1).eq.0)goto 9800 open(unit=14,file=resultant(1:lres),recl=512, 1 form='formatted',carriagecontrol='list',status='old', 2 shared,err=9800) c mode meanings: c Bit Meaning c 0-1 0 = use .COM file c 1 = use rename mode c 2 = use copy (callable cvt) mode c 3 = copy and add softlink. No database file genn'd c 2 If set don't delete ANYthing immediately c 3 If set don't include only included names c 4 If set, delete file if no room for rename/copy c If clear, leave file alone if copy area is full (return error though) c 5 If set, no timetag on deleted files (use if using softlink...) c 6 If set, call backup cmd file before cleanup; pass it nnnnnnn majmod=mode.and.3 ii=lib$cvt_from_internal_time(lib$k_julian_date,ijul,) ii=lib$cvt_from_internal_time(lib$k_second_of_day,isec,) c get the command now. ii=index(cmdlin,'/') if(ii.le.1)goto 9800 wrest=cmdlin(ii+1:) c is a filename there? cmdlin=cmdlin(1:ii-1) cmdlen=ivlen(cmdlin,256) c Treat the filename as a wild match string if(index(wrest,'%UNDEL').gt.0)then c undelete action. If we can find anything matching this file in the c sequential record, restore it to where it came from for the user. lwrest=ivlen(wrest,256) 150 continue read(14,556,err=9790)cread 556 format(a) lcread=ivlen(cread,512) kkk=str$match_wild(cread(:lcread),cmdlin(1:cmdlen)) if(kkk.eq.str$_match)then c Found a match. Now be sure it belongs to this user and put the file c back. File goes to the original path, so can't be pulled to another c directory. if (majmod.eq.0)then c spawn mode. Use command file to put the file back. cread='$@gcy$cm:filundel ' // cread(:lcread) ll=lcread+18 kkk=lib$spawn(cread(:ll),,,,,,istat) goto 150 endif if(majmod.eq.2)then c copy mode. Use callable convert c Get the filename now and filename (path, really) of original ic1=index(cread,',') if(ic1.lt.0)goto 150 ic2=index(cread(ic1+1:),',') if(ic2.lt.0)goto 150 ic2=ic2+ic1 c copy the file back from device "delsav:" whereverthat is, back c to original location. c Thus this package cannot be used to move files out of where they were, c though we still need to set the copy up somehow to be the original c owner's access. This can be handled perhaps by having the ownership c of the COPY remain the original user. ii=conv$pass_files('delsav:'//cread(:ic1-1),cread(ic1+1:ic2-1) 1 // cread(ic2+1:),,,) if(.not.ii)goto 150 ii=conv$pass_options(convopts) if(.not.ii)goto 150 ii=conv$convert(,) goto 150 endif if(majmod.eq.1)then c rename mode. File ownership automatically is right! ic1=index(cread,',') if(ic1.lt.0)goto 150 ic2=index(cread(ic1+1:),',') if(ic2.lt.0)goto 150 ic2=ic2+ic1 c rename is always on the SAME device. c Second filename already has the device so don't add it twice. c Must also translate the "delsav" and replace it. Call lib$sys_trnlog('DELSAV',ldsv,delsve) lcrd=ivlen(cread,512) call exempt if(ldsv.gt.0)then ii=lib$rename_file(cread(ic1+1:ic2-1)// 1 delsve(1:ldsv)//cread(8:ic1-1), 1 cread(ic2+1:lcrd),,,,,,,,,,) else ii=lib$rename_file(cread(ic1+1:ic2-1)// 1 cread(8:ic1-1), 1 cread(ic2+1:lcrd),,,,,,,,,,) endif call unexempt goto 150 endif endif goto 150 endif if(index(wrest,'%PURG').gt.0)then c Purge old data out action. Find the : and read the count of seconds c and blow away anything older than the selected delta. First however c see if mode bit 6 is set (64 bit) and fire off a command file if so. lwrest=ivlen(wrest,256) iii=index(wrest(:lwrest),':') if(iii.le.0)goto 9800 wrest=wrest(iii+1:) lwrest=ivlen(wrest,256) if(lwrest.lt.1)goto 9800 iv=mode.and.64 if(iv.ne.0)then write(cwrk,1000)wrest(:lwrest) 1000 format('$@gcy$cm:delbak ',a) lcwrk=ivlen(cwrk,512) c This should be very occasional so use spawn...no sense keeping an idle c process constantly around. kkk=lib$spawn(cwrk(:lcwrk),,,,,,istat) endif read(wrest(:lwrest),'(i)')jsecdel c now handle the deletions. 250 continue read(14,556,err=9790)cread lcread=ivlen(cread,512) ic1=index(cread,',') if(ic1.lt.0)goto 150 ic2=index(cread(ic1+1:),',') if(ic2.lt.0)goto 150 ic2=ic2+ic1 c get the julian date read(cread,160)jday,jsec,ifd1,ifd2,ifd3 160 format(7x,i9.9,i5.5,z4.4,z4.4,z4.4) c ijul & isec are "now" ksec=isec if(jday.lt.ijul)ksec=ksec+86400*(ijul-jday) c ksec is now relative to jday where days differ if((jsec+jsecdel).ge.ksec)goto 250 c Use the hex fid we got out of the filename to delete the file c now. c Do so in rename mode only. Other modes delete by name. if(majmod.eq.2)then c fib(3)=ifd1 c fib(4)=ifd2 c fib(5)=ifd3 cc Assign channel every time since several devices may share a delete cc daemon. c kkk=sys$sys$assign(cread(ic1+1:ic2-1),ichn,,,,) c if(.not.kkk)goto 250 cc Use secret delete function that is not inhibited. cc This uses the ACP interface. Note: if directory entries are left cc dangling they need to be removed once no longer present. Leave cc a cleanup dcl proc for this as needed. c kk=sys$qiow(%val(1),%val(ichn),%val(io$_delete+128), c 1 iosb,,,dfid,,,,,) c kkk=sys$dassgn(%val(ichn)) c use delete_file so that if we renamed the file to another directory c we don't delete it. That means undelete is not just for a few c minutes... if(index(cread(:ic1-1),':').le.0)then ii=lib$delete_file(cread(ic1+1:ic2-1) // ':' 1 // cread(:ic1-1),,,,,,,,) else ii=lib$delete_file(cread(:ic1-1),,,,,,,,) endif goto 250 endif if(majmod.ne.2)then c Copy mode or commandfile mode need to delete via a script. c The presumption is that ACROSS devices one uses copy c Accomplish deletion by having the user enter us as an exempt image c if save area is in a controlled place. if(index(cread(:ic1-1),':').le.0)then ii=lib$delete_file('delsav:'//cread(:ic1-1),,,,,,,,) else ii=lib$delete_file(cread(:ic1-1),,,,,,,,) endif goto 250 endif endif 9790 continue close(unit=14) goto 7000 c If command is unknown just leave. 9800 continue 9999 continue call lib$find_file_end(context) close(unit=14) call exit end integer*4 function ivlen(arg,len) integer*4 len character*(*) arg c return length of printable string do 1 n=1,len k=len+1-n c go back in loop looking for a printing char. if(ichar(arg(k:k)).gt.32)goto 2 1 continue ivlen=0 return 2 continue ivlen=k return end