Subject: Re: CCL:Deleting files

From: "Serguei Patchkovskii" <[email-masked]>
Date: Wed, 23 Jun 99 9:01:14 MDT

> I need a program for Unix environment that would automatically delete all
> files in certain directories that are older then, i.e. last used longer then
> some time ago (for example 1 month). 

Not really a CCL subject, but...

The easy (and slightly dumb) way:

find /tmp  ! -mount -type f -atime +2 -exec rm -f {} \;

(removes all files in /tmp not accessed within the last 2 days)

Somewhat more intelligent approach (does not remove directory
trees as long as some files there remain in use):

----
#!/freeware/bin/perl
#
# (C) 1998,1999 Serguei Patchkovskii, [email-masked]
#
# This script can be disctributed freely provided that:
#    a) No fee is charged for its distribution beyond the nominal
#       media cost;
#  and
#    b) Proper attribution is made, including leaving this message
#       intact in the body of the script.
#
# Algorithm:
#
#  In the top-level directory (as passed to &CleanDirectory) all
#  files older than $deadTime are removed. For all files older 
#  than $warnTime, an e-mail is sent to the owner warning of an
#  impending removal.
#  
#  Subdirectories are removed recursively if all of the files
#  in the subdirectories have all of atime, mtime and ctime
#  older than $deadTime. Notification e-mail is sent to the 
#  file owner. For directories with files older than $warnTime,
#  a warning e-mail is sent.
#
#  For all directories with oldest ctime older than $ancientTime,
#  a notification e-mail is sent to the user, cc to root.
#
#  Files listed in %MagicFile are ignored.
#
#  For sites which do not use the /usr/remote/system_name/local/scratch
#  convention, it may be necessary to modify &ScratchMountPoint().
#

$verbose     = 0 ;
$skipUnlink  = 0 ;
$deadTime    = 14.0 ;            	# in days
$graceTime   =  3.0 ;			# in days
$warnTime    = $deadTime - $graceTime ;	# in days
$ancientTime = 28.0 ;            	# in days
$configFile  = '/cobalt/systems' ;	# system names, one per line
%MagicFile   = ('.', 1, '..', 1, 'quota.user', 1, 'quota.group', 1, '.tags', 1,
                'macVolume', 1 ) ;

# 
# Variables internal to CleanDirectory
#
$currentDir      = "" ;
$neverUsed       = 1e6 ;         # days
%DeleteMessages  = () ;          # per-user
%WarnMessages    = () ;
%AncientMessages = () ;

sub RecursiveRemove {  # expects $currentDir to be set
	local   ($name) = @_ ;	# may be both a file and directory name, relative to current directory
	local	($savedCurrent) = $currentDir ;
	local	(@files,$file) ;

    print "Want to remove $currentDir/$name\n" if( $verbose ) ;
    lstat($name) || die "Can't lstat($currentDir/$name): $!" ;
    if( -d _ && ! -l _ ){
        $currentDir .= '/' ;
	$currentDir .= $name ;
	chdir( $name ) || die "Can't chdir($currentDir/$name): $!" ;
	opendir(DIR,".") || die "Can't opendir($currentDir/$name): $!" ;
        @files = readdir(DIR) ;
	closedir(DIR) || die "Can't closedir($currentDir/$name): $!" ;
	foreach $file (@files){
	    next if( $file eq '.' || $file eq '..' ) ;
	    &RecursiveRemove($file) ;
	    }
        chdir( '..' ) || die "Can't return from $currentDir/$name: $!" ;
	$currentDir = $savedCurrent ;
	unless( $skipUnlink ){
	    rmdir($name) || warn "Can't rmdir($currentDir/$name) $!" ;
	    }
        }
    else {  # simple rm will do
        unless( $skipUnlink ){
            unlink($name) || warn "Can't unlink($currentDir/$name) $!" ;
	    }
        }
    }

sub ScanDirectory {
	local	($directory) = @_ ;
	local	($saveCurrent) = $currentDir ;
	local	(@names,$file) ;
	local	($useTime,$createTime,$nfiles,$size) = ($neverUsed,0,0,0) ; # never, now, none and nothing
	local	($dUse,$dCreate,$dFiles,$dSize) ;

    $currentDir .= '/' unless( $currentDir eq '' || $currentDir eq '/' ) ;
    $currentDir .= $directory ;
    print "Scanning $currentDir\n" if( $verbose ) ;
    chdir($directory) || die "Can't cd to $currentDir: $!" ;
    opendir(DIR,".") || die "Can't readdir($currentDir): $!" ;
    @names = readdir(DIR) ;
    closedir(DIR) || die "Can't closedir($currentDir): $!" ;
    stat('.') || die "Can't stat current directory ($currentDir): $!" ;
    $useTime    = -M _ if( -M _ < $useTime ) ;
#   $useTime    = -A _ if( -A _ < $useTime ) ;
    $useTime    = -C _ if( -C _ < $useTime ) ;
    $createTime = -C _ if( -C _ > $createTime ) ;
    foreach $file (@names){
        next if( $file eq '.' || $file eq '..' ) ;
        lstat($file) || die "Can't lstat($currentDir/$file): $!" ;
        $useTime    = -M _ if( -M _ < $useTime ) ;
        $useTime    = -A _ if( -A _ < $useTime && ! -d _ && ! -l _ ) ; # links are "accessed" each time ls -la
                                                                       # is done on them
        $useTime    = -C _ if( -C _ < $useTime ) ;
        $createTime = -C _ if( -C _ > $createTime ) ;
	$size      += -s _ if( -f _ ) ;
	$nfiles++          if( -f _ ) ;
        if( -d _ && ! -l _ ){
	    ($dUse,$dCreate,$dFiles,$dSize) = &ScanDirectory( $file ) ;
	    $nfiles    += $dFiles ;
	    $size      += $dSize ;
	    $useTime    = $dUse    if( $dUse    < $useTime ) ;
	    $createTime = $dCreate if( $dCreate > $createTime ) ;
            }
        }
    chdir("..") || die "Can't return from $directory: $!" ;
    $currentDir = $saveCurrent ;
    ($useTime,$createTime,$nfiles,$size)
    }

sub MessageLine { # This one should be called only from &CleanDirectoryRoot
	local	($sizeh,$sizen,$sizes) ;

    $sizeh = $size ; $sizen = 'bytes' ;
    if( $sizeh > 5000 ){ $sizeh /= 1024.0 ; $sizen = 'kbytes' ; }
    if( $sizeh > 5000 ){ $sizeh /= 1024.0 ; $sizen = 'mbytes' ; }
    if( $sizeh > 5000 ){ $sizeh /= 1024.0 ; $sizen = 'gbytes' ; }
    if( $sizeh > 5000 ){ $sizeh /= 1024.0 ; $sizen = 'tbytes' ; }
    $sizes = sprintf( "%.0f", $sizeh ) if( $suzen eq 'bytes' ) ;
    $sizes = sprintf( "%.2f", $sizeh ) if( $suzen ne 'bytes' ) ;
    "$ftype $longfile ($sizes $sizen)\n"
    }

sub CleanDirectoryRoot {
	local	($directory) = @_ ;
	local	(@names,@statbuf,$file,$longfile) ;
	local	($accessDate,$creationDate,$nfiles,$size,$owner) ;
	local	($ftype) ;

    $currentDir = $directory ;
    print "Processing $currentDir\n" if( $verbose ) ;
    chdir($directory) || die "Can't cd to $currentDir: $!" ;
    opendir(DIR,".") || die "Can't readdir($currentDir): $!" ;
    @names = readdir(DIR) ;
    closedir(DIR) || die "Can't closedir($currentDir): $!" ;
    foreach $file (@names){
        next if( defined( $MagicFile{$file} ) ) ;
	$longfile = "$currentDir/$file" ;
        (@statbuf = lstat($file)) || die "Can't lstat($longfile): $!" ;
	unless( defined( $owner = getpwuid( $statbuf[4] ) ) ){
	    warn "uid = $statbuf[4] is not in passwd file\n" ;
	    $owner = 'root' ;
	    }
        if( -d _ && ! -l _ ){
	    $ftype = 'dir ' ;
            ($accessDate,$creationDate,$nfiles,$size) = &ScanDirectory($file) ;
            }
	else {
	    $ftype = 'file' ;
	    $accessDate   = -A _ ;
	    $accessDate   = -M _ if( -M _ < $accessDate ) ;
	    $accessDate   = -C _ if( -C _ < $accessDate ) ;
	    $creationDate = -C _ ;
	    $nfiles       = 1 ;
	    $size         = -s _ ;
	    }
	print "$currentDir/$file: ow = $owner, ac = $accessDate, " . 
              "cr = $creationDate, nf = $nfiles\n" if( $verbose ) ;
	   if( $accessDate > $deadTime ){   # kill 'em
	    $DeleteMessages{$owner}  .= &MessageLine() ;
	    &RecursiveRemove($file) ;
	    }
        elsif( $accessDate > $warnTime ){   # warn user
	    $WarnMessages{$owner}    .= &MessageLine() ;
	    }
        if( $creationDate > $ancientTime ){ # warn user and root
	    $AncientMessages{$owner} .= &MessageLine() ;
	    }
        }
    }

sub Unique {
	local	(@input) = @_ ;
	local	($key,@output,%seen) ;

    foreach $key (@input){
        push(@output,$key) unless( $seen{$key}++ ) ;
        }
    @output
    }

sub SendEmails {
	local	(@recipients) ;
	local	($user,$text,$valid,$luser) ;

    @recipients = sort( &Unique('root', keys(%DeleteMessages), 
                                keys(%WarnMessages), keys(%AncientMessages)) ) ;
    foreach $user (@recipients){
	$valid = 0 ;
	$text  = "Subject: Scratch space use\n\n" ;
	$text .= "Dear $user,\n\n" ;
	if( defined( $DeleteMessages{$user} ) ){
	    $valid = 1 ;
	    $text .= "The following files and/or directories belonging to you were not accessed\n"
                   . "for more than $deadTime days, and were removed to allow other users of the system\n"
                   . "to access the scratch space:\n\n" ;
	    $text .= $DeleteMessages{$user} ;
	    $text .= "\n\n" ;
	    }
	if( defined( $WarnMessages{$user} ) ){
	    $valid = 1 ;
	    $text .= "The following files and/or directories belonging to you were not accessed\n"
                   . "for more than $warnTime days, and will be removed in $graceTime days to allow other\n"
                   . "users of the system to access the scratch space:\n\n" ;
	    $text .= $WarnMessages{$user} ;
	    $text .= "\n\n" ;
	    }
	if( defined( $AncientMessages{$user} ) ){
	    $valid = 1 ;
	    $text .= "The following files and/or directories belonging to you has been created\n"
                   . "more than $ancientTime days ago. Although these resources appear to be in use, and\n"
                   . "will not be removed, please consider relocating your files to a permanent\n"
                   . "storage location to allow other users to use the scratch space:\n\n" ;
	    $text .= $AncientMessages{$user} ;
	    $text .= "\n\n" ;
	    }
 	if( $user eq 'root' ){ # root gets a copy of all ancient messages
	    foreach $luser (keys(%AncientMessages)){
		next if( $luser eq 'root' ) ;
		$valid = 1 ;
                $text .= "$luser has the following files in long-term storage:\n\n" ;
		$text .= $AncientMessages{$luser} ;
		$text .= "\n\n" ;
		}
	    }
	next unless( $valid ) ;
        # now, try to send e-mail. For the moment, sent it to root.
	open( EMAIL, "|/bin/mail $user" ) || die "Can't start /bin/mail: $!" ;
	print EMAIL $text ;
	close( EMAIL ) || die "Error sending mail: $!" ;
        }
    }

sub ScratchMountPoint {
	local	($system) = @_ ;

    "/usr/remote/$system/local/scratch"
    }

open(CONFIG,"< $configFile") || die "Can't open $configFile: $!" ;
@systems = <CONFIG> ;
close(CONFIG) ;
foreach (@systems){ chop ; }
#
print "Warming up mount points\n" if( $verbose ) ;
foreach $place (@systems){
    stat( &ScratchMountPoint( $place ) ) ;
    }
sleep(30) unless( $#systems > 1 ) ;
#
print "Scanning\n" if( $verbose ) ;
foreach $place (@systems){
    eval { &CleanDirectoryRoot( &ScratchMountPoint( $place ) ) ; } ; 
    print "$place: $@" unless( $@ eq '' ) ;
    }
&SendEmails() ;
---

-- 
home page: http://www.cobalt.chem.ucalgary.ca/ps/

---

From: Konrad Hinsen <[email-masked]>
Date: Wed, 23 Jun 1999 16:50:24 +0200

> some time ago (for example 1 month). 

Unix already provides all you need:

   find directory -atime +30 -exec rm \{\} \;

I didn't test this, but you can easily check the details using "man
find" on your machine. "-atime +30" means "last accessed 30 or more
days ago".
-- 
-------------------------------------------------------------------------------
Konrad Hinsen                            | E-Mail: [email-masked]
Centre de Biophysique Moleculaire (CNRS) | Tel.: +33-2.38.25.55.69
Rue Charles Sadron                       | Fax:  +33-2.38.63.15.17
45071 Orleans Cedex 2                    | Deutsch/Esperanto/English/
France                                   | Nederlands/Francais
-------------------------------------------------------------------------------