#!/usr/local/bin/perl

# trackaddr.pl v2010.11.11.01
# Track changes to a dynamicly-updated hostname (e.g., DynDNS) and do
# something - possibly update a remote website that is using your ip
# address for something (e.g., SIP)
#
# Copyright 2010 Jeremy Kister
# Released under perl's Artistic license


use strict;
use Net::DNS;
use Sys::Syslog;
use Getopt::Std;
use HTTP::Cookies;
use LWP::UserAgent;
use POSIX qw(setsid);
use Sys::SigAction qw(set_sig_handler);

my %opt;
getopts('Dftu:', \%opt);
# D debug
# f foreground
# t testmode
# u username to run as

my %accounts = ( 'example.dyndns.org' => {
                    email  => 'foo@example.com',
                    passwd => 'password',
                    remid  => 23414,
                    update => \&update_myipcomms,
                    stale  => 1,
                 },
          );

my $ERRCHK = 60; # recheck in 1 min after an error
#my $uad = 'trackaddr/2010.11.12.01 (compatible; MSIE 8.0)'; # ua now matters @ 2010.12.09
my $uad = 'Mozilla/5.0 (Windows; U; Windows NT 6.1; en-US; rv:1.9.2.12) Gecko/20101026 Firefox/3.6.12';
openlog( 'trackaddr', 'pid', 'local6' );

unless( $opt{f} ){
    if($opt{u}){
        my ($uid,$gid) = (getpwnam($opt{u}))[2,3];
        debug( "switching to ${uid}/${gid}" );
        $! = 0;
        $( = $) = $gid;
        slowerr( "unable to chgid ${gid}: $!" ) if($!);
        $! = 0;
        $< = $> = $uid;
        slowerr( "unable to chuid ${uid}: $!" ) if($!);
    }

    daemonize(60);
}

verbose( 'starting.' );


$SIG{USR1} = sub {
    if( exists($opt{D}) ){
        delete $opt{D};
    }else{
        $opt{D} = 1;
    }
};

my $recurser = Net::DNS::Resolver->new( debug => 0, recurse => 1 );
my %cache;
while( 1 ){
    my %next;
    my $time = time();
    my $n = 0;
    for my $host (keys %accounts){
        if($opt{D}){
            my $eng;
            my $delta = $cache{$host}{nc} ? ( $cache{$host}{nc} - $time ) : 0;
            if( $delta < 0 ){
                my $ab = abs($delta);
                $eng = "${ab}s behind schedule";
            }elsif($delta){
                my @t = gmtime( $delta );
                my($d,$h,$m,$s) = @t[7,2,1,0];
                $eng .= "${d}d" if $d;
                $eng .= "${h}h" if $h;
                $eng .= "${m}m" if $m;
                $eng .= "${s}s" if $s;
            }else{
                $eng = 'now';
            }
            debug( "checking host ttl: $host (next: $eng)" );
        }

        if( $cache{$host}{nc} <= $time ){
            debug( "resolve underway for $host: cache is $cache{$host}{ipa}" );
        
            my $nchk;
            my $r = resolv( $host );
            if( $r->{ipa} ){
                if( $accounts{$host}{stale} >= 1 || $cache{$host}{ipa} ne $r->{ipa} ){
                    verbose( "stale cache for $host - $cache{$host}{ipa}, new: $r->{ipa} try: $accounts{$host}{stale}" );
                    $accounts{$host}{stale}++;

                    $cache{$host}{ipa} = $r->{ipa};
                    my $r = $accounts{$host}{update}->( $host, $r->{ipa} );
                    if( $r ){
                        verbose( "got bad response from update: $r" );
                        delete $cache{$host}{ipa};
                        $nchk = $ERRCHK;
                    }else{
                        verbose( "got success from update" );
                        $accounts{$host}{stale} = 0;
                    }
                }
        
                unless($nchk){
                    $nchk = ($r->{ttl} + 1);
                }
            }else{
                debug( "lookup error for $host" );
                $nchk = $ERRCHK;
            }
            $time = time();
            $cache{$host}{nc} = ($time + $nchk + $n);
        }
        
        if( ($next{time} > $cache{$host}{nc}) || (! $next{time}) ){
            %next = ( time => $cache{$host}{nc}, host => $host );
        }
        $n += 2;
    }
    my $sleep = ($next{time} - $time);
    if($sleep){
        debug( "$sleep seconds until next lookup (for $next{host}); sleeping..." );
        sleep $sleep;
    }
}

sub update_myipcomms {
    my $host = shift || slowerr( "no host" );
    my $addr = shift || slowerr( "no addr" );

    debug( "in sub: host: [$host] - addr: [$addr]" );

    my $base = 'https://www.myipcomms.net/IP';
    my $lurl = $base . '/login.aspx',
    my $vrfy = $base . '/techinfo.aspx';
    my $edit = $base . '/editcustomerdestination.aspx?d=' . $accounts{$host}{remid};

    my $ua = LWP::UserAgent->new( timeout    => 15,
                                  agent      => $uad,
                                  cookie_jar => HTTP::Cookies->new(file => "/tmp/sipdns-cookies.$^T.$$"),
                                  keep_alive => 1,
                                  protocols_allowed => [ 'https' ],
                                  requests_redirectable => [ 'GET', 'HEAD', 'POST' ],
                        );

    my $viewstate;
    my $response = $ua->get($lurl);
    if ($response->is_success) {
        for my $line (split /\n/, $response->decoded_content){
            if( $line =~ /__VIEWSTATE.+value="([^"]+)"/ ){
                $viewstate = $1;
                debug( 'viewstate: ', $viewstate );
                last;
            }
        }
    }else{
        verbose( 'get viewstate: ', $response->status_line );
        return 1;
    }

    unless( $viewstate ){
        verbose( 'viewstate missing' );
        return 2;
    }

    my %login = ( 'ctl00$ContentPlaceHolder1$UserEntered' => $accounts{$host}{email},
                  'ctl00$ContentPlaceHolder1$PassEntered' => $accounts{$host}{passwd},
                  'ctl00$ContentPlaceHolder1$Button1'     => 'Log In',
                  '__EVENTTARGET'   => '',
                  '__EVENTARGUMENT' => '',
                  '__VIEWSTATE'     => $viewstate,
            );

    $response = $ua->post($lurl, \%login);
    if($response->is_success){
        filelog( '/tmp/debug-login', "login response: ", $response->decoded_content );
        debug( "login: ", $response->status_line );
    }else{
        verbose( 'bad login: ', $response->status_line );
        return 4;
    }

    my $active;
    $viewstate = undef;
    $response = $ua->get($edit);
    if($response->is_success){
        filelog( '/tmp/debug-get', "get response: ", $response->decoded_content );
        foreach my $line (split /\n/, $response->decoded_content){
            if( $line =~ /__VIEWSTATE.+value="([^"]+)"/ ){
                $viewstate = $1;
                debug( 'viewstate: ', $viewstate );
            }elsif( $line =~ /lblOrigDest">(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/ ){
                $active = $1;
                verbose( 'active: ', $active );
            }
            last if($viewstate && $active);
        }
    }else{
        verbose( 'bad edit get: ', $response->status_line );
        return 8;
    }
 
    unless( $viewstate ){   
        verbose( "viewstate missing" );
        return 9;
    }

    if( $active eq $addr ){
        verbose( "found active address is current address, aborting update" );
        return 0;
    }elsif( $opt{t} ){
        verbose( "test mode: not posting form, but active is: $active - new is: $addr" );
        return  0;
    }

    my %post = ( 'ctl00$ScriptManager1' => 'ctl00$ContentPlaceHolder1$UpdatePanel1|ctl00$ContentPlaceHolder1$btnSubmit',
                 '__EVENTTARGET'        => 'ctl00$ContentPlaceHolder1$btnSubmit',
                 '__EVENTARGUMENT'      => '',
                 '__VIEWSTATE' => $viewstate,
                 'ctl00$ContentPlaceHolder1$txtNewDest' => $addr,
                 'ctl00$ContentPlaceHolder1$CheckBox1'  => 'on',
                 'ctl00$ContentPlaceHolder1$btnSubmit'  => 'Update',
           );


    $ua->default_header('Referer' => $accounts{$host}{edit});
    $ua->default_header('X-MicrosoftAjax' => 'Delta=true');

    $response = $ua->post($edit, \%post);
    if($response->is_success){
        debug( "edit: ", $response->status_line );
        filelog( '/tmp/debug-post', "edit response: ", $response->decoded_content );
    }else{
        verbose( 'bad edit: ', $response->status_line );
        return 5;
    }

    sleep 4;

    $response = $ua->get($vrfy);
    if($response->is_success){
        filelog( '/tmp/debug-vrfy', "vrfy response: ", $response->decoded_content );
        foreach my $line (split /\n/, $response->decoded_content){
            if( $line =~ /ctl03_DestID">(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})</ ){
                my $naddr = $1;
                unless($naddr eq $addr){
                    debug( "naddr: [$naddr] - addr: [$addr]" );
                    return 6;
                }
                last;
            }
        }
    }else{
        verbose( 'bad vrfy: ', $response->status_line );
        return 7;
    }

    return 0; # success
}

sub resolv {
    my $host = shift;
    my $href = eval {
        set_sig_handler( 'ALRM', sub { die "resolv timeout!\n" }, { mask=>[ 'ALRM' ] } );
        alarm(10);
        if( my $query = $recurser->search($host) ){
            foreach my $rr ($query->answer){
                next unless($rr->{type} eq 'A');
                alarm(0);
                return( { ipa => $rr->{address}, ttl => $rr->{ttl} } );
            }
        }else{
            verbose( "query failed: ", $recurser->errorstring );
        }
        alarm(0);
    };
    alarm(0);
    verbose( $@ ) if($@);

    return($href);
}


sub daemonize {
    my $to = shift;

    fork && exit;
    close STDIN;   open( STDIN,  '<', "/dev/null" );
    close STDOUT;  open( STDOUT, '>', "/dev/null" );
    close STDERR;  open( STDERR, '>', "/dev/null" );
    setsid();

    # run as 2 processes
    while( 1 ){ fork ? wait : last; sleep $to; }

}

sub verbose {
    my ($msg) = join('', @_);

    $msg =~ tr/\r//d;

    return unless $msg;
    print STDERR "$msg\n" if $opt{f};
    syslog( 'info', $msg );
}

sub slowerr {
    verbose(@_);
    sleep 10;
    die @_;
}

sub debug {
    verbose( @_ ) if $opt{D};
}

sub filelog {
    my $file = shift;

    return unless $opt{D};

    my $msg = join('', @_);

    if( open(FILELOG, ">$file") ){
        print FILELOG "$msg\n";
        close FILELOG;
    }else{
        verbose( "could not write to $file: $!" );
    }
}