--- /dev/null
+#! /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);
+}