From: xcuvellier Date: Tue, 2 Oct 2007 14:42:58 +0000 (+0000) Subject: * Added the renew_reminder.pl from Princeton in our OneLab repository X-Git-Tag: foo~426 X-Git-Url: http://git.onelab.eu/?a=commitdiff_plain;ds=sidebyside;h=2e225eb926d19dc070671a1f56721bd0d8bdd576;p=infrastructure.git * Added the renew_reminder.pl from Princeton in our OneLab repository --- diff --git a/scripts/renew_reminder.pl b/scripts/renew_reminder.pl new file mode 100755 index 0000000..bef7bd1 --- /dev/null +++ b/scripts/renew_reminder.pl @@ -0,0 +1,250 @@ +#! /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 +# 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 () { + # 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 <{'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 <{'name'} +END + } + + # Provide links to renew or delete the slice + print SENDMAIL <{'name'} + +To delete this slice, visit the URL: + + $delete_slice_url?slice_name=$slice->{'name'} +END + + # Send it + close(SENDMAIL); +}