288 lines
8.6 KiB
Perl
Executable File
288 lines
8.6 KiB
Perl
Executable File
#!/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
|
|
|