#!/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})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: $!" ); } }