Re: My own dynamic DNS setup

[Theodore]

And here is my own perverted pair of scripts, with IPv6/AAAA support :-)

Client script:

#!/usr/bin/perl

use strict;

if (($ARGV[0] ne "v4") and ($ARGV[0] ne "v6")) {
    print "Usage: $0 v4|v6\n";
    exit 1;
};
# Check for IPV6 requ.
my $ipver = "v4";
if ($ARGV[0] eq "v6") {
  require Net::INET6Glue::INET_is_INET6;
  $ipver = "v6";
};

my $previp = '';

# DNS record types:
my %drts = (
        'v4' =>    'A',
        'v6' =>    'AAAA',
    );

# Checkip url
my $checkurl = 'http://www.example.com.gr/myip';
# Updateip url
my $updateurl = 'http://www.example.com/ddnsset.pl?';
# FQDN to set:
my $fqdn = 'myhost'; 
# History filenames:
my %iphist = (
        'v4' =>    '/tmp/dynipsethistv4.txt',
        'v6' =>    '/tmp/dynipsethistv6.txt',
    );

# Load history:
if (-e $iphist{$ipver}) {
    open (HI, "<", $iphist{$ipver}) or die "Failed to open " . $iphist
+{$ipver} . " for reading: $!.\n";
    $previp = <HI>;
    close HI;
}; 

# Create a user agent object
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
$ua->agent("dynipset/0.1 ");

# Create a request
my $req = HTTP::Request->new(GET => $checkurl);

# 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) {
    my $newip = $res->content;
    #print "DEBUG: My new IP is $newip ($ipver) \n";
    if ($previp eq $newip) {
        # Do nothing.
        #print "DEBUG: IP not changed.\n";
        exit 0;
    } else {
        # Set ip: 
        my $dbrec = "$fqdn|" . $drts{$ipver} . "|$newip";
        my $rc = &setDNS($dbrec);
        if ($rc) {
            print "SET: $fqdn " . $drts{$ipver} . " $newip\n";
        } else {
            print "ERROR: setDNS failed ($fqdn|$newip)!\n";
            exit 1;
        };
        # Save new ip to history:
        open (HI, ">", $iphist{$ipver}) or die "Failed to open " . $ip
+hist{$ipver} . " for writing: $!.\n";
        print HI $newip;
        close HI;
        exit 0;
    };    
} else {
    print "ERROR: checkip request failed: " . $res->status_line, "\n";
    exit 1;
};

exit 0;

sub setDNS {
    my ($dbrec, $rest) = @_; 
    use Crypt::CBC;
    use MIME::Base64 qw(encode_base64url decode_base64url);

    my $cipher = Crypt::CBC->new(     -key    => 'a pass phrase',
                    -cipher => 'Blowfish',
                    -keysize => 56
            );
    my $ciphertext = $cipher->encrypt($dbrec);
     my $encoded = encode_base64url($ciphertext);
    #print "DEBUG: $encoded\n";
    my $url = "$updateurl$encoded";
    my $ua = LWP::UserAgent->new;
    $ua->agent("dynipset/0.1 ");

    # Create a request
    my $req = HTTP::Request->new(GET => $url);

    # Pass request to the user agent and get a response back
    my $res = $ua->request($req);
    if ($res->is_success) {
        return 1;
    } else {
        print "ERROR: updateip request failed: " . $res->status_line, 
+"\n";
        return 0;
    };
};

Server script:

#!/usr/bin/perl

use strict;

use Net::DNS;
use Paranoid::Network::IPv4 qw(:all);
use Paranoid::Network::IPv6 qw(:all);
use Data::Dumper;
use CGI;

my $zone = 'dyn.example.com';        # A zone reserved for this script
+.
my $dnsserver = '127.0.0.1';        # Assuming 'allow-updates {127.0.0
+.1;}' in localhost BIND.
my @validnames = ('myhost', 'myhost2'); # Only these are allowed.
my @validtypes = ('A', 'AAAA');     # Only these are allowed.

my $query = CGI->new;
my @params = $query->url_param('keywords');

my $qref = &qdecode($params[0]);

my ($name, $type, $ip, $rest) = @{ $qref };

if (not grep($name, @validnames)) {
    print STDERR "ERROR: Invalid name: $name\n";
    print $query->header('text/html','500 Internal Server Error');
    print $query->start_html(-title=>'');
    print $query->end_html();
    exit 1;
};

if (not grep($type, @validtypes)) {
    print STDERR "ERROR: Invalid type: $type\n";
    print $query->header('text/html','500 Internal Server Error');
    print $query->start_html(-title=>'');
    print $query->end_html();
    exit 1;
};

if (
    (($type eq 'A') and (not (($ip =~ /^@{[ IPV4REGEX ]}$/)))) or 
    (($type eq 'AAAA') and (not (($ip =~ /^@{[ IPV6REGEX ]}$/)))) 
) {
    print STDERR "ERROR: Invalid IP: $ip\n";
    print $query->header('text/html','500 Internal Server Error');
    print $query->start_html(-title=>'');
    print $query->end_html();
    exit 1;
};

my $fqn = $name . "." . $zone;
my $fqdn = $name . "." . $zone . ".";
my $resolver = new Net::DNS::Resolver;
$resolver->nameservers($dnsserver);

# Delete old record.
my $update = new Net::DNS::Update($zone);
$update->push( prereq => yxrrset("$fqn $type") );
$update->push( update => rr_del("$fqn $type") );
my $reply = $resolver->send($update);
if ($reply) {
        if ( $reply->header->rcode eq 'NOERROR' ) {
                print STDERR "Delete old records succeeded\n";
        } else {
                print STDERR 'Delete old records failed: ', $reply->he
+ader->rcode, "\n";
        }
} else {
        print STDERR 'Delete old records failed: ', $resolver->errorst
+ring, "\n";
    print $query->header('text/html','500 Internal Server Error');
    print $query->start_html(-title=>'');
    print $query->end_html();
    exit 1;
};

undef $reply, $update;
# Add new record.
$update = new Net::DNS::Update($zone);
$update->push( prereq => yxdomain($zone) );
$update->push( update => rr_add("$fqdn 300 $type $ip") );
$reply = $resolver->send($update);
if ($reply) {
        if ( $reply->header->rcode eq 'NOERROR' ) {
                print STDERR "Update succeeded\n";
        print $query->header('text/html','204 No response');
        } else {
                print STDERR 'Update failed: ', $reply->header->rcode,
+ "\n";
        print $query->header('text/html','500 Internal Server Error');
        print $query->start_html(-title=>'');
        print $query->end_html();
        exit 1;
        }
} else {
        print STDERR 'Update failed: ', $resolver->errorstring, "\n";
    print $query->header('text/html','500 Internal Server Error');
    print $query->start_html(-title=>'');
    print $query->end_html();
    exit 1;
}

exit 0;

sub qdecode {
        my ($dbrec, $rest) = @_;
        use Crypt::CBC;
        use MIME::Base64 qw(encode_base64url decode_base64url);
        my $cipher = Crypt::CBC->new(   -key    => 'a pass phrase',
                                        -cipher => 'Blowfish',
                                        -keysize => 56
                        );
    my $decoded = decode_base64url($dbrec);
    my $decrypted = $cipher->decrypt($decoded);
    my @result = split(/\|/, $decrypted, 3);
    return \@result;
};