#!/usr/bin/perl -w

use 5.010;
use LWP;
use Getopt::Long;
use English;
use Carp;
use Storable;

use version; our $VERSION = qv('0.05');

#############CHANGES#####################
#
# 0.01 Initial Release
# 0.02 Added error code handlers and 
#      checking for updates requested too frequently
# 0.03 Added &ausgang 
#      Refactored &time_as_string
# 0.04 Changed error messages
#      Changed last error to log
# 0.05 Added check for notify-send
#      Added check for co-reqs
#      Reorganised the code a bit
#
#########################################

#########################################
#
# record the time of the next update
#
#########################################
sub next_update_in {
    my $min_til_next_update = shift;
    my $next_update_time = time + ($min_til_next_update * 60);
    store \$next_update_time, $next_update_file;
    return;
}

#########################################
#
# Exit and record exit status
#
#########################################
sub ausgang {
    my ($ausgang, $message) = @_;
    open (my $log, '>>', $log_file) or croak "Cannot write last exit status\n";
    print $log '[', time_as_string(time), '] ', $message, "\n";
    close $log or croak "Cannot neatly close log\n";
    exit $ausgang;
}

#########################################
#
# Notify the user of serious errors
#
#########################################
sub error {
    my $got_notify_send = qx(which notify-send);
    if ($got_notify_send) {
        system ("notify-send -u normal -t 10000 -i error 'Error Updating IP' '@_'");
    }
}

#########################################
#
# Print a passed time value as a string
# of the type "12:34 Fri 6 Jul 2008"
#
#########################################
sub time_as_string {
    my $time = shift;
    my @shrt_month = qw(Jan Feb Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
    my @shrt_day   = qw(Sun Mon Tue Wed Thu Fri Sat);
    my (undef,$min,$hour,$mday,$mon,$year,$wday,undef,undef) = localtime($time);
    my $time_as_string 
        = sprintf("%02d:%02d %s %d %s %s", 
                  $hour, $min, $shrt_day[$wday], $mday, $shrt_month[$mon], ($year + 1900));
    return $time_as_string;
}

my $verbose;
my $result = GetOptions('verbose+' => \$verbose);
say "what a frabulous frumpity day to you my good sir!" if $verbose;

#########################################
#
# Initialise global variables
#
#########################################
$0 =~ m&[^/]+$&;
my $name = $&;
my $email = 'alex.kalderimis@gmail.com';
my $ext_ip;
my $resolved_ip;
my $ip_addr = qr/\b(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\b/;
my $config_file = "$ENV{HOME}/.${name}.rc";
our $next_update_file = "$ENV{HOME}/.${name}.nextupdate";
our $log_file         = "$ENV{HOME}/.${name}.log";
if ( (-f $next_update_file) && time < ${retrieve($next_update_file)} ) {
    say 'too soon to update again.' if $verbose;
    my $next_update_localtime = time_as_string(${retrieve($next_update_file)});
    ausgang (8, "Too soon to update: next update at $next_update_localtime");
}


#########################################
#
# set user preferences from a config file
#
#########################################
my %User_Preferences; 
open (my $config, '<', $config_file) or croak 'could not open config file';
while (<$config>) {
    chomp;                  # no newline
    s/#.*//;                # no comments
    s/^\s+//;               # no leading white
    s/\s+$//;               # no trailing white
    next unless length;     # anything left?
    my ($key, $value) = split(/\s*=\s*/, $_, 2);
    $User_Preferences{$key} = $value;
} 
close $config or croak "could not close config file: $ERRNO";

my $net_route = qx(cat /proc/net/route);
if ($net_route =~ m/^(eth|wan|wlan)/m) {
    { 
#########################################
#
# Get the external ip
#
#########################################       
        my $ua = LWP::UserAgent->new
            or croak "$name: Could not make user agent $ERRNO";
        $ua->agent("$name/$VERSION $email");
        # Create a request
        my $req = HTTP::Request->new(GET => 'http://whatismyip.org');
        $req->content_type('text/html');

        # Pass request to the user agent and get a response back
        my $res = $ua->request($req);

        # Check the outcome of the response
        if ($res->is_success) {
         $ext_ip = $res->content if $res->content =~ $ip_addr;         
        } else {
            my $req = HTTP::Request->new(GET => ' http://checkip.dyndns.org');
            my $res = $ua->request($req);

            say $res->content if $verbose;
            if ($res->content =~ $ip_addr) {
                $ext_ip = $&;
            }
        }
        say $ext_ip ? "$ext_ip is the real ip." : "Could not get your real ip." if $verbose;
        croak "Could not find external ip.\n"unless $ext_ip;
    }
#########################################
#
# See what No-Ip thinks the current ip is
#
#########################################       
    {
        $resolved_ip = qx(host $User_Preferences{host});
        $resolved_ip =~ $ip_addr;
        $resolved_ip = $&;
        die unless $resolved_ip;
        say "$resolved_ip is what DNS thinks ${User_Preferences{host}}'s ip is" if $verbose;
    }
    if ($ext_ip eq $resolved_ip) {
        my $message = "Update not necessary - Resolved ip is correct.";
        say $message if $verbose;
        ausgang (0, $message);
#########################################
#
# update the ip address
#
#########################################       
    } else { 
        my $ua = LWP::UserAgent->new
            or croak "$name: Could not make user agent $ERRNO";
        my $can_https;
        $can_https = 1 if ((eval {require Crypt::SSLeay}) || (eval {require IO::Socket::SSL}));
        
        # Create a request
        my $url =
            ($can_https) ? 'https://' : 'http://'
            .$User_Preferences{user}
            .':'
            .$User_Preferences{pass}
            .'@dynupdate.no-ip.com/nic/update?'
            .'hostname='
            .$User_Preferences{host}
            .'&'
            .'myip='
            .$ext_ip;
            
        my $req = HTTP::Request->new(GET => $url);
        
        $req->user_agent("$name/$VERSION $email");
        $req->authorization_basic($User_Preferences{user},
                                  $User_Preferences{pass});

        # Pass request to the user agent and get a response back
        my $res = $ua->request($req);
        
#########################################
#
# Check the outcome of the response
#
#########################################       
        if ($res->is_success && ($res->content =~ $ip_addr) ) {
            if ($& eq $ext_ip) {
                my $message = "Update successful - $User_Preferences{host} now $ext_ip";
                if ($verbose) {
                    say $message;
                    say $res->content;
                }
                next_update_in(5); #no point updating more frequently than that
                ausgang (0, $message);
                
#########################################
#
# Deal with error codes
#
#########################################       
            }
            my $message = 'Updated failed - will try again later';
            next_update_in(5); #no point updating more frequently than that
            say $message if $verbose;
            ausgang (7, $message);
        } else {
            my $failure = 'Updated failed - ';
            given ($res->content) {
                when (/nohost/)   {
                    error('wrong hostname - check credentials');
                    ausgang (2, $failure . $_);
                } 
                when (/badauth/)  {
                    error('wrong username or password - check credentials');
                    ausgang (3, $failure . $_);
                } 
                when (/badagent/) {
                    error('Client is blocked - change user-agent');
                    ausgang (4, $failure . $_);
                } 
                when (/donator/)  {
                    error('Operation not permitted - upgrade account');
                    ausgang (5, $failure . $_);
                } 
                when (/abuse/)    {
                    next_update_in(100_000);
                    error('username is blocked - check account');
                    ausgang (6, $failure . 'username is blocked - check account');
                } 
                when (/911/) {
                    next_update_in(30);
                    ausgang (911, $failure . 'server side database error');
                } 
                default {
                    my $message = $failure . $_ . '- will try again later';
                    say $message if $verbose;
                    ausgang (7, $message);
                }
            } 
        }     
    }
} else {
    my $message = 'Update not sent - not connected to the internet';
    say $message if $verbose;
    ausgang (5, $message);
}

__END__
=head1 NAME

Update_No-ip.pl - Update www.no-ip.com Dynamic IP address

=head1 SYNOPSIS

Update_No-ip.pl [--verbose|-v]

=head1 OPTIONS

=over 1

=item B<--verbose|-v>

Print progress information to stdout. Useful when not being run by cron

=back

=head1 CONFIGURATION

This is designed to be run as a cron job on a regular basis. Rather than
writing your credentials into the crontab, username, passwords and hostnames
are kept in a file named .Update_No-ip.pl.rc

Sample contents of this file:

        host = YOUR_HOSTNAME
        user = YOUR_EMAIL
        pass = YOUR_PASS

order is not significant, and nor is leading of trailing whitespace
At present updates for only one host name are supported, multiple hostnames
and credentials are on the to-do list.

=head1 FILES

see CONFIGURATION

=head1 ERROR CODES

 0     Good update or no change
 1     No internet connection
 2     nohost:   invalid hostname - check credentials
 3     badauth:  invalid username or password - check credentials
 4     badagent: this client has been blocked. Change user agent
 5     !donator: this error should never occur
 6     abuse:    this user has been blocked - fix the issue
 7     unknown:  not sure - retry
 8     too soon to update again.
 911   Database outage - no retry for 30 min
 

=head1 SEE ALSO

LWP
LWP::UserAgent

=head1 PREREQUISITES

only standard core modules.

=head1 COREQUISITES

Crypt::SSLeay
IO::Socket::SSL


=head1 OSNAMES

linux


=head1 SCRIPT CATEORIES

CPAN/Administrative
CPAN/Networking

=head1 VERSION

Update_No-ip.pl, v0.02, 2009/10/09 21:42:37

=head1 AUTHOR

Copyright (C) 2009 Alex Kalderimis. Acknowledgement to Jari Aalto
(jari.aalto@poboxes.com), author of dyndns.pl (perl-webget.sourceforge.net)
from whom the authorisation logic was liberally purloined.

This program is free software; you can redistribute and/or modify program
under the same terms as Perl itself or in terms of Gnu General Public
licence v2 or later.