#!/usr/bin/perl -w

##**************************************************************
##
## Copyright (C) 1990-2007, Condor Team, Computer Sciences Department,
## University of Wisconsin-Madison, WI.
## 
## Licensed under the Apache License, Version 2.0 (the "License"); you
## may not use this file except in compliance with the License.  You may
## obtain a copy of the License at
## 
##    http://www.apache.org/licenses/LICENSE-2.0
## 
## Unless required by applicable law or agreed to in writing, software
## distributed under the License is distributed on an "AS IS" BASIS,
## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
## See the License for the specific language governing permissions and
## limitations under the License.
##
##**************************************************************


# $Id: condor_clean_checkpoints,v 1.4 2007-11-07 23:17:43 nleroy Exp $

# make sure to check the sendmail binary a little below in the script.
# make sure to set up the email address correctly
# make sure the $days is correct.
# Written by psilord 11/21/2000

# This script will go through the checkpoint server directory available on 
# the machine and REMOVE all checkpoints that have not been accessed in 
# a configurable number of days. This file should be shoved into either
# condor's(preferrably) crontab on a checkpoint server and set to run once
# a day. It will only send mail when files are actually removed.

# Start of script....

# Pragmae
use strict;

# Standard Perl modules.
use Net::SMTP;		# email interface
use Getopt::Long;   # Command line option parser.
use Cwd;			# current working directory

# Prototypes
sub parse();

# Path to Condor tools
$ENV{PATH} = $ENV{PATH} . ":/unsup/condor/bin";

# Globals, constants
(my $program = $0) =~ s|.*/||; # Name of this program.
my $id = '$Id: condor_clean_checkpoints,v 1.4 2007-11-07 23:17:43 nleroy Exp $';
my $usage = qq{
$program: clean checkpoint server files
usage: $program  [options]
 
    options
    -help           print this help message
    -days           specify checkpoint file no-access days to preserve [def=70]
    -debug          run in debug,noexecute mode
    -version        print version information and exit
    -[no]mail       do [not] send email [default = true]
};
my @invoke = ($0,@ARGV);	# save our invocation
my $debug = 0;
my $days = 70; # ten weeks.
chomp (my $hostname = `hostname`);
my $mailhost = $hostname;
my ($domain) = $hostname =~ /\.(.*)/;
my $mail = 1;	# do send email

parse();	# parse command line

my ($sender,$recipient);
my ($user);
$user = $ENV{USER} || $ENV{LOGNAME};
if ($debug) {
	$recipient = $user . '@' . $domain;		# debug recipient
	$sender = $user . '@' . $domain;		# debug recipient
} else {
	$recipient = "condor-system\@cs.wisc.edu";
	$sender = "condor\@cs.wisc.edu";			# sender
}
my $ckptdir = `condor_config_val CKPT_SERVER_DIR`;
chomp $ckptdir;
$ckptdir or die qq{
condor_config_val CKPT_SERVER_DIR: not defined.
Is this host, $hostname, a checkpoint server?
};
chdir $ckptdir or die "Could not chdir to $ckptdir: $!";

# This chicanery is because people create things that look suspiciously like
# checkpoint files for debugging purposes in the ckpt dir. This is to ensure I
# only blow away the actual checkpoint files.

# grab the checkpoint directories
my @cdirs = grep m/\d+\.\d+\.\d+\.\d+/, `ls $ckptdir`;
chomp @cdirs;

# grab all the checkpoints out the the ip addresses
my @ckpts;
foreach my $cdir (@cdirs)
{
	push @ckpts, `find $cdir -name "cluster*.proc*.subproc*" -atime +$days -type f -print`;
}
chomp @ckpts;
unless (@ckpts) {
	print "no ckpts accessed in more than $days days.  Exiting\n" if $debug;
	exit 0;
}

# make them fully qualified pathnames
map s/^(.*)/$ckptdir\/$1/, @ckpts;

# Add up how much space I'll be removing...
my $space = 0;
my %cfiles;
foreach my $cfile (@ckpts)
{
	my $size = (stat $cfile)[7]; # 7 is size of file.
	$space += $size;	# accumulator
	my $atime = (stat $cfile)[8];
	$cfiles{$cfile}{SIZE} = $size;
	$cfiles{$cfile}{ATIME} = $atime;
}
$space = $space / 1024; # Kilobytes
$space = $space / 1024; # Megabytes
$space = int $space;

# remove the files
foreach my $cfile (@ckpts)
{
	if ($debug) {
		print "$cfile\n";
	} else {
		unlink $cfile;
	}
}
my $df = `/bin/df -h  $ckptdir`;


# send email about what files I removed
exit 0 unless $mail;
my $smtp = Net::SMTP->new($mailhost,Debug  => $debug,) or die;
$smtp->mail($sender) or die;
$smtp->to($recipient) or die;
$smtp->data() or die;
$smtp->datasend("To: $recipient\n") or die;
if ($debug) {
	$smtp->datasend("Subject: TEST: ignore\n");
} else {
	$smtp->datasend("Subject: Cleaned Checkpoints: $hostname\n");
	#$smtp->datasend("Subject: TEST: ignore\n");
}
$smtp->datasend("\n") or die;
#$smtp->datasend("A simple test message\n") or die;
$smtp->datasend(
"This is a mail from the checkpoint cleaning script.\n");
$smtp->datasend("(-debug option is enabled.  RUNNING IN NO-EXECUTE MODE.)\n")
	if $debug;
$smtp->datasend(
"\nHere are the checkpoints I removed that hadn't been accessed\n");
$smtp->datasend("in $days days freeing up about $space Megs...\n\n");
$smtp->datasend("       bytes         last access time file\n");
$smtp->datasend("--------------------------------------------\n");
foreach my $cfile (sort keys %cfiles)
{
	$smtp->datasend(sprintf("%12d %s %s\n",
		$cfiles{$cfile}{SIZE},
		scalar localtime $cfiles{$cfile}{ATIME},
		$cfile));
}

$smtp->datasend("\nfinal partition usage:\n");
$smtp->datasend($df);
$smtp->datasend("\nruntime information:\n-------------------\n");
$smtp->datasend("user: $user\n");
$smtp->datasend("hostname: $hostname\n");
$smtp->datasend("cwd: ", cwd(), "\n");
$smtp->datasend("this script: $id\n");
$smtp->datasend("invocation: ", join(' ', @invoke), "\n");
$smtp->datasend("interactive: ",
	-t STDIN ? "yes" : "no: probably from crontab", "\n");
$smtp->datasend("days of ckpt no-access to preserve: $days\n");
$smtp->datasend("\nEnd of message.\n");
$smtp->dataend() or die;
$smtp->quit or die;

exit 0;
# end of main program ##########################################################

# Parse command line options.
sub parse() {
 
    # Do option parsing via the GetOptions module from the Perl standard
    # library.
    my $parse = new Getopt::Long::Parser;
    $parse->configure();
    $parse->getoptions(
        "help"          => sub  {   print $usage;
                                    exit 0;
                                },
        "days=i"        => \$days,
        "version"       => sub { print $id, "\n"; exit 0; },
        "debug!"		=> \$debug,
        "mail!"			=> \$mail,
    ) or die $usage;
} # sub parse()

