* Added the renew_reminder.pl from Princeton in our OneLab repository

diff --git a/scripts/renew_reminder.pl b/scripts/renew_reminder.pl
new file mode 100755 (executable)
index 0000000..bef7bd1
--- /dev/null
+++ b/scripts/renew_reminder.pl
@@ -0,0 +1,250 @@
+#! /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
+#
+# $Id: renew_reminder.pl,v 1.1 2005/06/28 16:49:12 mlhuang Exp $
+#
+
+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);
+}