#! /usr/bin/perl -w
    eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
        if 0; #$running_under_some_shell

#
# Notify users of slices that are about to expire
#
# Mark Huang <mlhuang@cs.princeton.edu>
# Copyright (C) 2005 The Trustees of Princeton University
#

use strict;
use Date::Manip;
use Term::ReadKey;
use Frontier::Client;

# Debug
my $verbose = 0;

# API default constants file
my $constants_file = '/etc/planetlab/plc_api';

# API default constants (if file does not exist)
my $server = 'www.planet-lab.org';
my $server_path = '/PLCAPI/';
my $server_port = 80;
my $server_url = "http://$server:$server_port/$server_path";
my $method = 'password';
my $password = '';
my $user = '';
my $role = 'admin';

# E-mail parameters
my $slice_domain = 'slices.planet-lab.org';
my $from_addr = 'noreply@planet-lab.org';
my $update_slice_url = 'https://www.planet-lab.org/db/slices/update_desc.php';
my $renew_slice_url = 'https://www.planet-lab.org/db/slices/renew_slice.php';
my $delete_slice_url = 'https://www.planet-lab.org/db/slices/delete_slice.php';
my $sendmail = "|/usr/sbin/sendmail -t -f$from_addr";

# Other options
my @slices = ();
my $expires = "5 days";
my $dryrun = 0;
my $force = 0;

# Print usage and exit
sub usage() {
    print STDERR "usage: renew_reminder.pl [OPTION]...\n";
    print STDERR "	-h host			API URL (default: $server_url)\n";
    print STDERR "	-c constants		API constants file (default: $constants_file)\n";
    print STDERR "	-m method		API method (default: $method)\n";
    print STDERR "	-p password		API password\n";
    print STDERR "	-u username		API user name\n";
    print STDERR "	-r role			API role (default: $role)\n";
    print STDERR "	-s slice1 -s slice2 ...	Slice(s) to check (default: all accessible slices)\n";
    print STDERR "	-x expires		Warn if slice expires before this time (default: $expires)\n";
    print STDERR "	-n			Dry run, do not actually e-mail users\n";
    print STDERR "	-f			Force, send e-mail even if slice is not close to expiring\n";
    print STDERR "	-v			Be verbose\n";
    exit 1;
}

# Parse API constants file
sub parse_constants_file {
    my $file = shift;

    if ($verbose) {
	print "Parsing API constants file $file...\n";
    }
    
    if (open(CONSTANTS, $file)) {
	while (<CONSTANTS>) {
	    # Skip comments and blank lines
	    next if /^\#/ || /^\s*$/;
	    # Trim whitespace
	    s/^\s+//; s/\s+$//;
	    # Parse assignments
	    my ($name, $value) = split('=');
	    next if (!defined($name) || !defined($value));
	    # Strip quotes from value
	    $value =~ s/\'([^\']*)\'/$1/g;
	    $value =~ s/\"([^\"]*)\"/$1/g;
	    # Set known variables
	    if ($name eq 'PL_API_SERVER') {
		$server = $value;
	    } elsif ($name eq 'PL_API_PATH') {
		$server_path = $value;
	    } elsif ($name eq 'PL_API_PORT') {
		$server_port = $value;
	    } elsif ($name eq "PL_API_CAPABILITY_AUTH_METHOD") {
		$method = $value;
	    } elsif ($name eq 'PL_API_CAPABILITY_PASS') {
 		$password = ($value =~ /CHANGEME/i) ? '' : $value;
	    } elsif ($name eq 'PL_API_CAPABILITY_USERNAME') {
		$user = $value;
	    }
	    # Set derived variables
	    $server_url = "http://$server:$server_port/$server_path";
	}

	return 1;
    }

    return 0;
}

# Autoflush STDOUT
$|++;

# Parse default constants file (if one exists) for new defaults
parse_constants_file($constants_file);

# Get options
use Getopt::Long;
if (!GetOptions('h|host=s' => \$server_url,
		'c|constants=s' => sub { parse_constants_file($_[1]); },
		'm|method=s' => \$method,
		'p|password=s' => \$password,
		'u|username=s' => \$user,
		'r|role=s' => \$role,
		's|slice=s' => \@slices,
		'x|expires=s' => \$expires,
		'n|dryrun' => \$dryrun,
		'f|force' => \$force,
		'v|verbose' => \$verbose,
		'help' => \&usage)) {
    usage();
}

# Print to STDOUT instead of e-mailing
if ($dryrun) {
    $sendmail = ">-";
}

if (!$user) {
    print "Username: ";
    while (not defined ($user = ReadLine(0))) {
	# Wait for input
    };
    # Chop newline
    chop($user);
}

if (!$password) {
    print "Password for $user: ";
    ReadMode 2;
    while (not defined ($password = ReadLine(0))) {
	# Wait for input
    };
    # Chop newline
    print chop($password);
    ReadMode 0;
}

# Set up authentication struct
my $auth = {
    'Username' => $user,
    'AuthMethod' => $method,
    'AuthString' => $password,
    'Role' => $role
};

# Connect to XML-RPC server
my $xmlrpc = Frontier::Client->new('url' => $server_url, 'debug' => $verbose);

# Set up a few constants
my $False = $xmlrpc->boolean(0);
my $True = $xmlrpc->boolean(1);
my $PERL_VERSION = sprintf("%vd", $^V);

$expires = ParseDate($expires);
if ($verbose) {
    print "Checking for slices that expire before " . UnixDate($expires, "%u") . "...\n";
}

my $result = $xmlrpc->call('SliceInfo', $auth, [@slices], $False, $False);

# SliceInfo returns an array of structs
if (ref($result) ne "ARRAY") {
    print STDERR "Unexpected API change: expected an array of structs from SliceInfo\n";
    exit 2;
}

for my $slice (@{$result}) {
    # Sanity checks
    if (ref($slice) ne "HASH") {
	print STDERR "Unexpected API change: expected an array of structs from SliceInfo\n";
	next;
    }
    next if (!defined($slice->{'name'}));
    next if (!defined($slice->{'expires'}));

    # See if slice expires before the specified warning date
    my $slice_expires = ParseDateString("epoch " . int($slice->{'expires'}));
    next if (!$force && (Date_Cmp($slice_expires, $expires) >= 0));

    # Calculate number of whole days left
    my $delta = DateCalc(ParseDate("now"), $slice_expires);
    my $days = Delta_Format($delta, 0, "%dh");
    if ($days == 0) {
	$days = "less than a day";
    } else {
	$days = "$days day" . (($days > 1) ? "s" : "");
    }

    # Print to stdout or send e-mail
    open(SENDMAIL, $sendmail) or die "Cannot open $sendmail: $!";

    # Print header and greeting
    print SENDMAIL <<END;
To: $slice->{'name'}\@$slice_domain
From: $from_addr
Subject: PlanetLab slice $slice->{'name'} expires in $days
X-Mailer: Perl/$PERL_VERSION
Content-type: text/plain

The PlanetLab slice $slice->{'name'} will expire in $days.
END

    # Explain that slices must have descriptions and URLs
    if (($slice->{'description'} =~ /^\s*$/) ||
	($slice->{'url'} =~ /^\s*$/)) {
	print SENDMAIL <<END;

Before you may renew this slice, you must provide a short description
of the slice and a link to a project website. To update this slice,
visit the URL:

	$update_slice_url?slice_name=$slice->{'name'}
END
    }

    # Provide links to renew or delete the slice
    print SENDMAIL <<END;

To renew this slice, visit the URL:

	$renew_slice_url?slice_name=$slice->{'name'}

To delete this slice, visit the URL:

	$delete_slice_url?slice_name=$slice->{'name'}
END

    # Send it
    close(SENDMAIL);
}