2 eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
3 if 0; #$running_under_some_shell
6 # Notify users of slices that are about to expire
8 # Mark Huang <mlhuang@cs.princeton.edu>
9 # Copyright (C) 2005 The Trustees of Princeton University
22 # API default constants file
23 my $constants_file = '/etc/planetlab/plc_api';
25 # API default constants (if file does not exist)
26 my $server = 'www.planet-lab.org';
27 my $server_path = '/PLCAPI/';
29 my $server_url = "http://$server:$server_port/$server_path";
30 my $method = 'password';
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";
45 my $expires = "5 days";
49 # Print usage and exit
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";
66 # Parse API constants file
67 sub parse_constants_file {
71 print "Parsing API constants file $file...\n";
74 if (open(CONSTANTS, $file)) {
76 # Skip comments and blank lines
77 next if /^\#/ || /^\s*$/;
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;
87 if ($name eq 'PL_API_SERVER') {
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") {
95 } elsif ($name eq 'PL_API_CAPABILITY_PASS') {
96 $password = ($value =~ /CHANGEME/i) ? '' : $value;
97 } elsif ($name eq 'PL_API_CAPABILITY_USERNAME') {
100 # Set derived variables
101 $server_url = "http://$server:$server_port/$server_path";
113 # Parse default constants file (if one exists) for new defaults
114 parse_constants_file($constants_file);
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)) {
133 # Print to STDOUT instead of e-mailing
140 while (not defined ($user = ReadLine(0))) {
148 print "Password for $user: ";
150 while (not defined ($password = ReadLine(0))) {
154 print chop($password);
158 # Set up authentication struct
161 'AuthMethod' => $method,
162 'AuthString' => $password,
166 # Connect to XML-RPC server
167 my $xmlrpc = Frontier::Client->new('url' => $server_url, 'debug' => $verbose);
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);
174 $expires = ParseDate($expires);
176 print "Checking for slices that expire before " . UnixDate($expires, "%u") . "...\n";
179 my $result = $xmlrpc->call('SliceInfo', $auth, [@slices], $False, $False);
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";
187 for my $slice (@{$result}) {
189 if (ref($slice) ne "HASH") {
190 print STDERR "Unexpected API change: expected an array of structs from SliceInfo\n";
193 next if (!defined($slice->{'name'}));
194 next if (!defined($slice->{'expires'}));
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));
200 # Calculate number of whole days left
201 my $delta = DateCalc(ParseDate("now"), $slice_expires);
202 my $days = Delta_Format($delta, 0, "%dh");
204 $days = "less than a day";
206 $days = "$days day" . (($days > 1) ? "s" : "");
209 # Print to stdout or send e-mail
210 open(SENDMAIL, $sendmail) or die "Cannot open $sendmail: $!";
212 # Print header and greeting
213 print SENDMAIL <<END;
214 To: $slice->{'name'}\@$slice_domain
216 Subject: PlanetLab slice $slice->{'name'} expires in $days
217 X-Mailer: Perl/$PERL_VERSION
218 Content-type: text/plain
220 The PlanetLab slice $slice->{'name'} will expire in $days.
223 # Explain that slices must have descriptions and URLs
224 if (($slice->{'description'} =~ /^\s*$/) ||
225 ($slice->{'url'} =~ /^\s*$/)) {
226 print SENDMAIL <<END;
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,
232 $update_slice_url?slice_name=$slice->{'name'}
236 # Provide links to renew or delete the slice
237 print SENDMAIL <<END;
239 To renew this slice, visit the URL:
241 $renew_slice_url?slice_name=$slice->{'name'}
243 To delete this slice, visit the URL:
245 $delete_slice_url?slice_name=$slice->{'name'}