initial commit of bin scripts into git
This commit is contained in:
287
internode-quota-check.pl
Executable file
287
internode-quota-check.pl
Executable file
@@ -0,0 +1,287 @@
|
||||
#!/usr/bin/perl
|
||||
# Copyright (C) 2004,2006,2007 Mark Suter <suter@humbug.org.au>
|
||||
# $Id: internode-quota-check,v 1.27 2008/02/04 10:02:33 suter Exp suter $
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use English qw( -no_match_vars );
|
||||
use Getopt::Long;
|
||||
use IO::File;
|
||||
use Pod::Usage;
|
||||
use Storable;
|
||||
use Time::Local;
|
||||
use WWW::Mechanize;
|
||||
|
||||
## The locations of things not here...
|
||||
my $uri = 'https://accounts.internode.on.net/cgi-bin/padsl-usage';
|
||||
my $cache = "$ENV{HOME}/.internode-quota-check.cache";
|
||||
my $fetchmailrc = "$ENV{HOME}/.fetchmailrc";
|
||||
my $netrc = "$ENV{HOME}/.netrc";
|
||||
|
||||
## Process the command line
|
||||
my %opt = ( man => 0, help => 0, history => 0 );
|
||||
GetOptions( \%opt, "man", "help", "history" ) or pod2usage(0);
|
||||
$opt{man} and pod2usage( -exitval => 0, -verbose => 2 );
|
||||
$opt{help} and pod2usage(0);
|
||||
|
||||
## Get our data, either from cache or directly from the website
|
||||
my $data = undef;
|
||||
if ( -e $cache and -s _ and ( time() - ( stat(_) )[9] ) < 60 * 90 ) {
|
||||
$data = retrieve $cache;
|
||||
}
|
||||
else {
|
||||
|
||||
my ( $user, $pass ) = get_account_details();
|
||||
|
||||
## Ready the browser
|
||||
my $ua = WWW::Mechanize->new( autocheck => 1, keep_alive => 32 );
|
||||
|
||||
## Current Status
|
||||
$ua->post( $uri, { username => $user, password => $pass, iso => 1 } );
|
||||
@{$data}{qw( usage quota rollover excess )} = $ua->content
|
||||
=~ m{ \A ( -? \d+ (?:\.\d+)? ) \s+ (\d+) \s+ (\d{8}) \s+ ( \d+ (?:\.\d+)? ) \Z }x
|
||||
or die "$0: can't parse: ", $ua->content, "\n";
|
||||
|
||||
## Convert rollover to epoch, using midnight Adelaide local time, GMT+0930
|
||||
## Refer FAQ: http://www.internode.on.net/adsl/faq/using-internode-adsl.htm
|
||||
my ( $year, $month, $day )
|
||||
= $data->{rollover} =~ m{ \A (\d{4}) (\d{2}) (\d{2}) \Z }x
|
||||
or die "$0: can't parse rollover date: ", $ua->content, "\n";
|
||||
$data->{rollover} = timegm( 0, 30, 14, $day - 1, $month - 1, $year );
|
||||
|
||||
## Speed value - converting to SI units
|
||||
$ua->post( $uri, { username => $user, password => $pass, speed => 1 } );
|
||||
( $data->{speed} ) = $ua->content =~ / \A (.+) \Z /x
|
||||
or die "$0: can't parse: $ua->content\n";
|
||||
$data->{speed} =~ s{ MBits/sec }{Mb/s}ix;
|
||||
|
||||
## Historical daily totals
|
||||
$ua->post( $uri, { username => $user, password => $pass, history => 1, iso => 1 } );
|
||||
foreach ( split /\n/, $ua->content ) {
|
||||
my ( $year, $month, $day, $traffic )
|
||||
= m{ \A (\d{2,4}) (\d{2}) (\d{2}) \s+ ( -? \d+ (?:\.\d+)? ) \Z }x
|
||||
or die "$0: can't parse: x", $_, "x\n";
|
||||
|
||||
## Do we have a *TWO* digit year?
|
||||
if ( $year < 100 ) {
|
||||
$year = $year < 70 ? "20$year" : "19$year";
|
||||
}
|
||||
|
||||
## Store using ISO8601 format
|
||||
$data->{history}{ "$year-$month-$day" } = $traffic;
|
||||
}
|
||||
|
||||
## Write the cache
|
||||
store $data, $cache;
|
||||
}
|
||||
|
||||
## Optional: Display the historical summary
|
||||
$opt{history} and do {
|
||||
foreach my $day ( sort keys %{ $data->{history} } ) {
|
||||
printf "%s %7.2f\n", $day, $data->{history}{$day};
|
||||
}
|
||||
};
|
||||
|
||||
## Display a simple one-line summary
|
||||
my $days_left = ( $data->{rollover} - time() ) / ( 60 * 60 * 24 );
|
||||
printf "Used %.2f MB of %d MB (%.1f%%) with %.1f days left (%.1f%%) at %s.\n",
|
||||
$data->{usage},
|
||||
$data->{quota},
|
||||
100 * $data->{usage} / $data->{quota},
|
||||
$days_left,
|
||||
100 * $days_left / days_in_billing_month( $data->{rollover} ),
|
||||
$data->{speed};
|
||||
|
||||
## Estimate of number of days in the current billing month
|
||||
sub days_in_billing_month {
|
||||
my ($rollover_time) = @_;
|
||||
|
||||
## Day of the month (1..31) for given epoch time
|
||||
sub mday {
|
||||
return ( gmtime( $_[0] ) )[3];
|
||||
}
|
||||
|
||||
## Find the last day of the month before the rollover month
|
||||
my $time = $rollover_time;
|
||||
while ( mday($time) <= mday($rollover_time) ) {
|
||||
$time -= 86400;
|
||||
}
|
||||
|
||||
return mday($time);
|
||||
}
|
||||
|
||||
## Get the username and password from .fetchmailrc (and .netrc if needed).
|
||||
sub get_account_details {
|
||||
|
||||
my ($user, $pass);
|
||||
|
||||
## Do we have a .fetchmailrc ?
|
||||
if ( -e $fetchmailrc ) {
|
||||
|
||||
## Get our stanza from the .fetchmailrc
|
||||
my ($stanza)
|
||||
= slurp($fetchmailrc)
|
||||
=~ m{ ( poll \s+ \S+ internode \S+ \s+ .+? (?: poll \s+ | \Z ) ) }imsx
|
||||
or die "$0: Didn't find Internode in your .fetchmailrc.\n";
|
||||
|
||||
## Get the username
|
||||
($user) = $stanza =~ m{ user \s+ "? ( .+? ) "? (?: \s | $ ) }imsx;
|
||||
if ( not defined $user ) {
|
||||
exists $ENV{USER} and $user = $ENV{USER};
|
||||
exists $ENV{LOGNAME} and $user = $ENV{LOGNAME};
|
||||
defined $user or die "$0: couldn't find username\n";
|
||||
}
|
||||
|
||||
## Get the password
|
||||
($pass)
|
||||
= $stanza
|
||||
=~ m{ (?<! auth \s ) password \s+ "? ( .+? ) "? (?: \s | $ ) }imsx;
|
||||
|
||||
}
|
||||
else {
|
||||
|
||||
## Get the credentials interactively
|
||||
print "You don't seem to have a .fetchmailrc, so I'll prompt you.\n";
|
||||
print "To avoid extra dependancies, your password will be echoed.\n";
|
||||
print "Username: ";
|
||||
chomp( $user = <STDIN> );
|
||||
print "Password: ";
|
||||
chomp( $pass = <STDIN> );
|
||||
print "Run this command to create a suitable ~/.fetchmailrc file:\n\n\t";
|
||||
printf "echo '# poll mail.internode.on.net user \"%s\" password \"%s\"' >> ~/.fetchmailrc\n",
|
||||
$user, $pass;
|
||||
print "\n";
|
||||
|
||||
}
|
||||
|
||||
## Username needs domain part
|
||||
if ( $user !~ m{ .+? \@ internode \. on \. net }ix ) {
|
||||
$user .= '@internode.on.net';
|
||||
}
|
||||
|
||||
## Do we need .netrc for the password ?
|
||||
if ( not defined $pass ) {
|
||||
my ($stanza)
|
||||
= slurp($netrc)
|
||||
=~ m{ ( machine \s+ \S+ internode \S+ \s+ .+? (?: machine \s+ | \Z ) ) }imsx
|
||||
or die "$0: Didn't find Internode in your .netrc.\n";
|
||||
($pass) = $stanza =~ m{ password \s+ "? ( .+? ) (?: " | \s ) }imsx
|
||||
or die "$0: Didn't find password in your .netrc.\n";
|
||||
}
|
||||
|
||||
return ( $user, $pass );
|
||||
}
|
||||
|
||||
## Slurp without needing an extra module
|
||||
sub slurp {
|
||||
my ($file) = @_;
|
||||
|
||||
my $fh = IO::File->new($file)
|
||||
or die "$0: open of $file failed: $OS_ERROR\n";
|
||||
|
||||
return join q{}, $fh->getlines()
|
||||
or die "$0: open of $file failed: $OS_ERROR\n";
|
||||
}
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
internode-quota-check - Usage information for your Internode account
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
internode-quota-check
|
||||
|
||||
=head1 OPTIONS
|
||||
|
||||
=over 8
|
||||
|
||||
=item B<--history>
|
||||
|
||||
Include a day-by-day historical summary.
|
||||
|
||||
=item B<--man>
|
||||
|
||||
Print the manual page and exit.
|
||||
|
||||
=item B<--help>
|
||||
|
||||
Print a brief help message and exit.
|
||||
|
||||
=back
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
B<This program> retrieves usage information for your Internode PADSL
|
||||
account using a text interface Internode provide, for example,
|
||||
|
||||
$ internode-quota-check
|
||||
Used 3965.47 MB (12.4%) of 32000 MB with 16.1 days left at 1.5 Mbits/sec.
|
||||
|
||||
=head1 FILES
|
||||
|
||||
=over 8
|
||||
|
||||
=item B<$ENV{HOME}/.fetchmailrc> and/or B<$ENV{HOME}/.netrc>
|
||||
|
||||
Where this program gets your username and password. This program
|
||||
does nothing else with these files, nor email or ftp for that matter.
|
||||
|
||||
If you are using fetchmail for your Internode email, it should work.
|
||||
|
||||
This program understands implicit usernames and using your .netrc file
|
||||
if the details aren't all in the .fetchmailrc.
|
||||
|
||||
If you are B<not> using fetchmail for your Internode email, then
|
||||
put a comment into this file, creating it if needed:
|
||||
|
||||
# poll mail.internode.on.net user "example" password "secret"
|
||||
|
||||
=item B<$ENV{HOME}/.internode-quota-check.cache>
|
||||
|
||||
Where this program stores it's cache. If this file is older than
|
||||
90 minutes, or missing, this program fetches fresh data from
|
||||
Internode and updates this file.
|
||||
|
||||
=back
|
||||
|
||||
=head1 EXIT CODES
|
||||
|
||||
If this program exits with a zero exit status and the correct
|
||||
output is on standard output. Nothing else is ever printed to
|
||||
standard output.
|
||||
|
||||
This program will exit with a non-zero exit status if there
|
||||
was a fatal error. Both fatal and non-fatal errors will cause
|
||||
output on standard error.
|
||||
|
||||
=head1 THANKS
|
||||
|
||||
Thanks to Mark Newton at Internode who created the simple interface
|
||||
to the billing system.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<http://www.internode.on.net/tools/usage-meters/>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
internode-quota-check - Usage information for your Internode account
|
||||
Copyright (C) 2007 Mark Suter E<lt>F<suter@humbug.org.au>E<gt>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see L<http://www.gnu.org/licenses/>.
|
||||
|
||||
=cut
|
||||
|
||||
Reference in New Issue
Block a user