You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

366 lines
8.6 KiB
Perl

#!/usr/bin/perl -w
#Author is not held responsible for any damages by this script.
#Feel free to redistribute and modify the script.
#
#
# Author: brian2004[at] hotmail[dot] com
#
# DynDNS Utility v1.0
# Feel free to modify and redistribute under GNU
# Obtain IP address from http://checkip.dyndns.org
$^W++; # Turn on debug warnings
use strict; # Strict Variables!
use IO::Socket; # Sock support
use MIME::Base64; # Base64 encoding support
use Data::Dumper; # Data Dumper
use Tk;
use Tk::Dialog;
use Tk::Entry;
use Tk::Label;
use Tk::Scrollbar;
use Tk::Text;
use Tk::Menu;
use Tk::Frame;
use Tk::DialogBox;
use Tk::Menubutton;
use Tk::Button;
use Tk::Radiobutton;
use Tk::Toplevel;
use Tk::Optionmenu;
my $version = "1.0";
my $lupdate = "April/11/2004";
my $reported_ip = "0.0.0.0";
my $remote_host = "checkip.dyndns.org";
my $remote_port = "80";
my $remote_url = "/";
my @socket_buffer = ();
my $tmpdata = "";
my $username = "";
my $password = "";
my $dyntype = "statdns";
my $g_dyntype = "statdns";
my $dynhost = "yourhost.ath.cx";
my $dynstate = "Idle...";
my $encoded;
my $decoded;
my $h_type = {'Dynamic DNS' => 'dyndns',
'Static DNS' => 'statdns',
'Custom DNS' => 'custom'};
my @host_type = keys %$h_type;
# Create and Display GUI
my $mw = MainWindow->new();
$mw->title ("Tk-DYNDNS IP Manager");
$mw->geometry('+500+300');
$mw->configure(-menu => my $menubar = $mw->Menu);
# File Menu
my $file = $menubar->cascade(-label => '~File',
-tearoff => 0,
);
$file->command(
-label => "Close",
-accelerator => 'Ctrl-w',
-underline => 0,
-command => \&exit,
);
# Help Menu
my $help = $menubar->cascade(-label => '~Help',
-tearoff => 0,
);
$help->command(
-label => "About",
-command => \&mnabout,
);
my $frm1 = $mw->Frame(
-relief => 'groove',
-borderwidth => 2,
-background => 'black',
)
->pack(
-side => 'top',
-fill => 'x'
);
my $lbl1 = $mw->Label(
-text => "Tk-DYNDNS Client. VER: $version",
-font => "-family Elephant -weight normal",
)
->pack(
-side => 'top'
);
my $frm2 = $mw->Frame(
-relief => 'groove',
-borderwidth => 2,
-background => 'gray',
)
->pack(
-side => 'top',
-padx => 120,
-pady => 10,
-fill =>'x'
);
my $lbl2 = $mw->Label(
-text => "Detected IP address:",
)
->pack(
-side => 'top',
-anchor => 'nw'
);
my $txt1 = $mw->Entry(
-textvariable => \$reported_ip,
-background => 'gray',
-foreground => 'black',
)
->pack(
-side => 'top',
-anchor => 'ne'
);
my $lbl3 = $mw->Label(
-text => "Your DNS host type: ",
)
->pack(
-side => 'top',
-anchor => 'nw',
);
my $opt1 = $mw->Optionmenu(
-options => \@host_type,
-variable => \$dyntype,
-background => 'gray',
)
->pack(
-side => 'top',
-anchor => 'ne'
);
my $lbl4 = $mw->Label(
-text => "Your DNS host name: ",
)
->pack(
-side => 'top',
-anchor => 'nw',
);
my $txt2 = $mw->Entry(
-textvariable => \$dynhost,
-background => 'gray',
)
->pack(
-side => 'top',
-anchor => 'ne'
);
my $lbl5 = $mw->Label(
-text => "Your DNS username: ",
)
->pack(
-side => 'top',
-anchor => 'nw',
);
my $txt3 = $mw->Entry(
-textvariable => \$username,
-background => 'gray',
)
->pack(
-side => 'top',
-anchor => 'ne'
);
my $lbl6 = $mw->Label(
-text => "Your DNS password: ",
)
->pack(
-side => 'top',
-anchor => 'nw',
);
my $txt4 = $mw->Entry(
-textvariable => \$password,
-show => "*",
-background => 'gray',
)
->pack(
-side => 'top',
-anchor => 'ne'
);
my $lbl7 = $mw->Label(
-text => "Program status: ",
)
->pack(
-side => 'top',
-anchor => 'nw',
);
my $txt7 = $mw->Entry(
-textvariable => \$dynstate,
-background => 'grey',
)
->pack(
-side => 'top',
-anchor => 'ne',
);
my $frm3 = $mw->Frame(
-relief => 'groove',
-borderwidth => 2,
-background => 'black',
)
->pack(
-side => 'top',
-padx => 120,
-pady => 10,
-fill => 'x'
);
my $btn1 = $mw->Button(
-text => "Update",
-command => sub { &update_ip }
)
->pack(
-side => 'left',
-anchor => 'nw',
);
my $btn2 = $mw->Button(
-text => "Done",
-command => sub { exit }
)
->pack(
-side => 'left',
-anchor => 'ne',
);
# Focus in the username box
$txt3->focus;
my $socket = new IO::Socket::INET (PeerAddr => $remote_host,
PeerPort => $remote_port,
Proto => "tcp",
Type => SOCK_STREAM)
or die "Can't connect to $remote_host:$remote_port : $!\n";
print $socket "GET $remote_url HTTP/1.0\n";
print $socket "Accept: */*\n";
print $socket "User-Agent: Tk-DynIP ($version)\n";
print $socket "Connection: Keep-Alive\n";
print $socket "\r\n\r\n";
@socket_buffer = <$socket>;
foreach (@socket_buffer) {
#print $_."\n";
$reported_ip = $_;
chop ($reported_ip);
if ($reported_ip =~ /[0-9]*\.[0-9]*\.[0-9]*\.[0-9]*/) {
# Debug
# print "\nIP address detected by DynDNS Server: $&\n";
$reported_ip = $&;
}
}
# Initiate Main Loop where the Loop.
MainLoop();
# Subroutine for about operation.
sub mnabout{
my $dw = $mw->Dialog(
-title => 'About IP Manger',
-bitmap => 'info',
-buttons => ["OK",],
-text => "Tk-DYNDNS IP Manager $version\n".
"Brian Ponnampalam\n".
" ".
"Last Updated: $lupdate\n",
);
$dw->Show;
}
# Subroutine for Update operation.
sub update_ip{
# Debug
# print "Update Loop\n";
# print "Selected: ".$dyntype."\=".$h_type->{"$dyntype"}."\n";
# print $dyntype;
$dynstate = "Sending...";
$g_dyntype = $h_type->{"$dyntype"};
$encoded = encode_base64("$username:$password");
#$decoded = decode_base64($encoded);
# Debug
# print "Encoded: ".$encoded."\n";
# print "Decoded: ".$decoded."\n";
$remote_host = "members.dyndns.org";
$remote_url = "/nic/update\?system\=$g_dyntype\&hostname\=$dynhost\&".
"myip\=$reported_ip\&wildcard\=OFF\&mx\=$dynhost\&".
"backmx\=YES&offline\=NO";
# Debug
# print $remote_url."\n";
$socket = new IO::Socket::INET (PeerAddr => $remote_host,
PeerPort => $remote_port,
Proto => "tcp",
Type => SOCK_STREAM)
or die "Can't connect to $remote_host:$remote_port : $!\n";
print $socket "GET $remote_url HTTP/1.0\n";
print $socket "Accept: */*\n";
print $socket "User-Agent: Tk-DynIP ($version)\n";
print $socket "Connection: Keep-Alive\n";
print $socket "Authorization: Basic $encoded\n";
print $socket "\r\n\r\n";
@socket_buffer = <$socket>;
# Debug
foreach(@socket_buffer){
#Debug
#print $_;
if ($_ =~ /badauth/){
$dynstate = "Invalid username/password.";
#Debug
#print $dynstate."\n";
}
elsif ($_ =~ /nochg/){
$dynstate = "No change necessary.";
#Debug
#print $dynstate."\n";
}
elsif($_ =~ /good/){
$dynstate = "Updated sucessfully.";
#Debug
#print $dynstate."\n";
}
elsif($_ =~ /nohost/){
$dynstate = "Host type doesn't match/exist.";
#Debug
#print $dynstate."\n";
}
elsif($_ =~ /abuse/){
$dynstate = "Abuse host is blocked.";
#Debug
#print $dynstate."\n";
}
else{
#Debug
print $_
}
}
}