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
20 # API default constants file
21 my $constants_file = '/etc/planetlab/plc_api';
23 # API default constants (if file does not exist)
24 my $server = 'www.planet-lab.org';
25 my $server_path = '/PLCAPI/';
27 my $server_url = "http://$server:$server_port/$server_path";
28 my $method = 'password';
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";
43 my $expires = "5 days";
47 # Print usage and exit
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";
64 # Parse API constants file
65 sub parse_constants_file {
69 print "Parsing API constants file $file...\n";
72 if (open(CONSTANTS, $file)) {
74 # Skip comments and blank lines
75 next if /^\#/ || /^\s*$/;
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;
85 if ($name eq 'PL_API_SERVER') {
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") {
93 } elsif ($name eq 'PL_API_CAPABILITY_PASS') {
94 $password = ($value =~ /CHANGEME/i) ? '' : $value;
95 } elsif ($name eq 'PL_API_CAPABILITY_USERNAME') {
98 # Set derived variables
99 $server_url = "http://$server:$server_port/$server_path";
111 # Parse default constants file (if one exists) for new defaults
112 parse_constants_file($constants_file);
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)) {
131 # Print to STDOUT instead of e-mailing
138 while (not defined ($user = ReadLine(0))) {
146 print "Password for $user: ";
148 while (not defined ($password = ReadLine(0))) {
152 print chop($password);
156 # Set up authentication struct
159 'AuthMethod' => $method,
160 'AuthString' => $password,
164 # Connect to XML-RPC server
165 my $xmlrpc = Frontier::Client->new('url' => $server_url, 'debug' => $verbose);
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);
172 $expires = ParseDate($expires);
174 print "Checking for slices that expire before " . UnixDate($expires, "%u") . "...\n";
177 my $result = $xmlrpc->call('SliceInfo', $auth, [@slices], $False, $False);
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";
185 for my $slice (@{$result}) {
187 if (ref($slice) ne "HASH") {
188 print STDERR "Unexpected API change: expected an array of structs from SliceInfo\n";
191 next if (!defined($slice->{'name'}));
192 next if (!defined($slice->{'expires'}));
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));
198 # Calculate number of whole days left
199 my $delta = DateCalc(ParseDate("now"), $slice_expires);
200 my $days = Delta_Format($delta, 0, "%dh");
202 $days = "less than a day";
204 $days = "$days day" . (($days > 1) ? "s" : "");
207 # Print to stdout or send e-mail
208 open(SENDMAIL, $sendmail) or die "Cannot open $sendmail: $!";
210 # Print header and greeting
211 print SENDMAIL <<END;
212 To: $slice->{'name'}\@$slice_domain
214 Subject: PlanetLab slice $slice->{'name'} expires in $days
215 X-Mailer: Perl/$PERL_VERSION
216 Content-type: text/plain
218 The PlanetLab slice $slice->{'name'} will expire in $days.
221 # Explain that slices must have descriptions and URLs
222 if (($slice->{'description'} =~ /^\s*$/) ||
223 ($slice->{'url'} =~ /^\s*$/)) {
224 print SENDMAIL <<END;
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,
230 $update_slice_url?slice_name=$slice->{'name'}
234 # Provide links to renew or delete the slice
235 print SENDMAIL <<END;
237 To renew this slice, visit the URL:
239 $renew_slice_url?slice_name=$slice->{'name'}
241 To delete this slice, visit the URL:
243 $delete_slice_url?slice_name=$slice->{'name'}