scripts/renew_reminder.pl

   1 #! /usr/bin/perl -w
   2     eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
   3         if 0; #$running_under_some_shell
   4
   5 #
   6 # Notify users of slices that are about to expire
   7 #
   8 # Mark Huang <mlhuang@cs.princeton.edu>
   9 # Copyright (C) 2005 The Trustees of Princeton University
  10 #
  11 # $Id$
  12 #
  13
  14 use strict;
  15 use Date::Manip;
  16 use Term::ReadKey;
  17 use Frontier::Client;
  18
  19 # Debug
  20 my $verbose = 0;
  21
  22 # API default constants file
  23 my $constants_file = '/etc/planetlab/plc_api';
  24
  25 # API default constants (if file does not exist)
  26 my $server = 'www.planet-lab.org';
  27 my $server_path = '/PLCAPI/';
  28 my $server_port = 80;
  29 my $server_url = "http://$server:$server_port/$server_path";
  30 my $method = 'password';
  31 my $password = '';
  32 my $user = '';
  33 my $role = 'admin';
  34
  35 # E-mail parameters
  36 my $slice_domain = 'slices.planet-lab.org';
  37 my $from_addr = 'noreply@planet-lab.org';
  38 my $update_slice_url = 'https://www.planet-lab.org/db/slices/update_desc.php';
  39 my $renew_slice_url = 'https://www.planet-lab.org/db/slices/renew_slice.php';
  40 my $delete_slice_url = 'https://www.planet-lab.org/db/slices/delete_slice.php';
  41 my $sendmail = "|/usr/sbin/sendmail -t -f$from_addr";
  42
  43 # Other options
  44 my @slices = ();
  45 my $expires = "5 days";
  46 my $dryrun = 0;
  47 my $force = 0;
  48
  49 # Print usage and exit
  50 sub usage() {
  51     print STDERR "usage: renew_reminder.pl [OPTION]...\n";
  52     print STDERR "      -h host                 API URL (default: $server_url)\n";
  53     print STDERR "      -c constants            API constants file (default: $constants_file)\n";
  54     print STDERR "      -m method               API method (default: $method)\n";
  55     print STDERR "      -p password             API password\n";
  56     print STDERR "      -u username             API user name\n";
  57     print STDERR "      -r role                 API role (default: $role)\n";
  58     print STDERR "      -s slice1 -s slice2 ... Slice(s) to check (default: all accessible slices)\n";
  59     print STDERR "      -x expires              Warn if slice expires before this time (default: $expires)\n";
  60     print STDERR "      -n                      Dry run, do not actually e-mail users\n";
  61     print STDERR "      -f                      Force, send e-mail even if slice is not close to expiring\n";
  62     print STDERR "      -v                      Be verbose\n";
  63     exit 1;
  64 }
  65
  66 # Parse API constants file
  67 sub parse_constants_file {
  68     my $file = shift;
  69
  70     if ($verbose) {
  71         print "Parsing API constants file $file...\n";
  72     }
  73
  74     if (open(CONSTANTS, $file)) {
  75         while (<CONSTANTS>) {
  76             # Skip comments and blank lines
  77             next if /^\#/ || /^\s*$/;
  78             # Trim whitespace
  79             s/^\s+//; s/\s+$//;
  80             # Parse assignments
  81             my ($name, $value) = split('=');
  82             next if (!defined($name) || !defined($value));
  83             # Strip quotes from value
  84             $value =~ s/\'([^\']*)\'/$1/g;
  85             $value =~ s/\"([^\"]*)\"/$1/g;
  86             # Set known variables
  87             if ($name eq 'PL_API_SERVER') {
  88                 $server = $value;
  89             } elsif ($name eq 'PL_API_PATH') {
  90                 $server_path = $value;
  91             } elsif ($name eq 'PL_API_PORT') {
  92                 $server_port = $value;
  93             } elsif ($name eq "PL_API_CAPABILITY_AUTH_METHOD") {
  94                 $method = $value;
  95             } elsif ($name eq 'PL_API_CAPABILITY_PASS') {
  96                 $password = ($value =~ /CHANGEME/i) ? '' : $value;
  97             } elsif ($name eq 'PL_API_CAPABILITY_USERNAME') {
  98                 $user = $value;
  99             }
 100             # Set derived variables
 101             $server_url = "http://$server:$server_port/$server_path";
 102         }
 103
 104         return 1;
 105     }
 106
 107     return 0;
 108 }
 109
 110 # Autoflush STDOUT
 111 $|++;
 112
 113 # Parse default constants file (if one exists) for new defaults
 114 parse_constants_file($constants_file);
 115
 116 # Get options
 117 use Getopt::Long;
 118 if (!GetOptions('h|host=s' => \$server_url,
 119                 'c|constants=s' => sub { parse_constants_file($_[1]); },
 120                 'm|method=s' => \$method,
 121                 'p|password=s' => \$password,
 122                 'u|username=s' => \$user,
 123                 'r|role=s' => \$role,
 124                 's|slice=s' => \@slices,
 125                 'x|expires=s' => \$expires,
 126                 'n|dryrun' => \$dryrun,
 127                 'f|force' => \$force,
 128                 'v|verbose' => \$verbose,
 129                 'help' => \&usage)) {
 130     usage();
 131 }
 132
 133 # Print to STDOUT instead of e-mailing
 134 if ($dryrun) {
 135     $sendmail = ">-";
 136 }
 137
 138 if (!$user) {
 139     print "Username: ";
 140     while (not defined ($user = ReadLine(0))) {
 141         # Wait for input
 142     };
 143     # Chop newline
 144     chop($user);
 145 }
 146
 147 if (!$password) {
 148     print "Password for $user: ";
 149     ReadMode 2;
 150     while (not defined ($password = ReadLine(0))) {
 151         # Wait for input
 152     };
 153     # Chop newline
 154     print chop($password);
 155     ReadMode 0;
 156 }
 157
 158 # Set up authentication struct
 159 my $auth = {
 160     'Username' => $user,
 161     'AuthMethod' => $method,
 162     'AuthString' => $password,
 163     'Role' => $role
 164 };
 165
 166 # Connect to XML-RPC server
 167 my $xmlrpc = Frontier::Client->new('url' => $server_url, 'debug' => $verbose);
 168
 169 # Set up a few constants
 170 my $False = $xmlrpc->boolean(0);
 171 my $True = $xmlrpc->boolean(1);
 172 my $PERL_VERSION = sprintf("%vd", $^V);
 173
 174 $expires = ParseDate($expires);
 175 if ($verbose) {
 176     print "Checking for slices that expire before " . UnixDate($expires, "%u") . "...\n";
 177 }
 178
 179 my $result = $xmlrpc->call('SliceInfo', $auth, [@slices], $False, $False);
 180
 181 # SliceInfo returns an array of structs
 182 if (ref($result) ne "ARRAY") {
 183     print STDERR "Unexpected API change: expected an array of structs from SliceInfo\n";
 184     exit 2;
 185 }
 186
 187 for my $slice (@{$result}) {
 188     # Sanity checks
 189     if (ref($slice) ne "HASH") {
 190         print STDERR "Unexpected API change: expected an array of structs from SliceInfo\n";
 191         next;
 192     }
 193     next if (!defined($slice->{'name'}));
 194     next if (!defined($slice->{'expires'}));
 195
 196     # See if slice expires before the specified warning date
 197     my $slice_expires = ParseDateString("epoch " . int($slice->{'expires'}));
 198     next if (!$force && (Date_Cmp($slice_expires, $expires) >= 0));
 199
 200     # Calculate number of whole days left
 201     my $delta = DateCalc(ParseDate("now"), $slice_expires);
 202     my $days = Delta_Format($delta, 0, "%dh");
 203     if ($days == 0) {
 204         $days = "less than a day";
 205     } else {
 206         $days = "$days day" . (($days > 1) ? "s" : "");
 207     }
 208
 209     # Print to stdout or send e-mail
 210     open(SENDMAIL, $sendmail) or die "Cannot open $sendmail: $!";
 211
 212     # Print header and greeting
 213     print SENDMAIL <<END;
 214 To: $slice->{'name'}\@$slice_domain
 215 From: $from_addr
 216 Subject: PlanetLab slice $slice->{'name'} expires in $days
 217 X-Mailer: Perl/$PERL_VERSION
 218 Content-type: text/plain
 219
 220 The PlanetLab slice $slice->{'name'} will expire in $days.
 221 END
 222
 223     # Explain that slices must have descriptions and URLs
 224     if (($slice->{'description'} =~ /^\s*$/) ||
 225         ($slice->{'url'} =~ /^\s*$/)) {
 226         print SENDMAIL <<END;
 227
 228 Before you may renew this slice, you must provide a short description
 229 of the slice and a link to a project website. To update this slice,
 230 visit the URL:
 231
 232         $update_slice_url?slice_name=$slice->{'name'}
 233 END
 234     }
 235
 236     # Provide links to renew or delete the slice
 237     print SENDMAIL <<END;
 238
 239 To renew this slice, visit the URL:
 240
 241         $renew_slice_url?slice_name=$slice->{'name'}
 242
 243 To delete this slice, visit the URL:
 244
 245         $delete_slice_url?slice_name=$slice->{'name'}
 246 END
 247
 248     # Send it
 249     close(SENDMAIL);
 250 }