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