[userv-utils] / dyndns / service

#!/usr/bin/perl
# usage: (cat RRs; echo .) | userv dyndns <zone> <subdomain>
# Not all zone file formats are accepted:
#  - All RRs must have owners specified.
#  - All RRs must have TTLs specified.
#  - The owner must be specified as a sub-subdomain, relative
#    to <subdomain>.<zone>, and so must not have a trailing `.';
#    where the owner is to be <subdomain>.<zone>, `@' must be used.

# Copyright (C) 1999-2000,2003 Ian Jackson
#
# This file is part dyndns, part of userv-utils
#
# This is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with userv-utils; if not, write to the Free Software
# Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
# $Id$

use POSIX;

BEGIN {
    $vardir= "/var/lib/userv/dyndns";
    $defconf= "/etc/userv/dyndns-domains";
    $libdir= "/usr/share/userv/dyndns";
}
END {
    remove "$vardir/tmp/$$" or $! == ENOENT or
        warn "cannot remove tempfile:$!\n";
}

use FileHandle;
use IO::File;
use Socket;
use Socket6;

@ARGV==2 or die "need <zone> and <domain> arguments\n";
($zone,$subdomain) = @ARGV;
domainsyntax("command line",$zone);
domainsyntax("command line",$subdomain) unless $subdomain eq '@';

@userv_groups= split m/ /, $ENV{'USERV_GROUP'};

@rates= (1,1,1000);
$ttlmin= 0;
$ttlmax= 86400;

sub readconf ($) {
    my ($cf,$fh) = @_;
    $fh= new FileHandle;
    $fh->open("< $cf") or die "$cf: $!\n";
    for (;;) {
        $!=0; $_= <$fh>;
        length or die "$cf:".($? ? "read:$?" : "eof")."\n";
        s/^\s+//; chomp; s/\s+$//;
        last if m/^eof$/;
        next if m/^\#/ or !m/\S/;
        if (m/^zone\s+(\S+)$/) {
            $thiszone= $1 eq $zone;
        } elsif (m/^ratelimit\s+(\d+)\s+(\d+)\s+(\d+)$/) {
            @rates= ($1,$2,$3);
        } elsif (m/^ttlrange\s+(\d+)\s+(\d+)$/) {
            ($ttlmin,$ttlmax) = ($1,$2);
        } elsif (m/^rrs\s+([A-Za-z0-9 \t]+)$/) {
            $rrt_list= $1;
            undef %rrt_allowed;
            grep { y/a-z/A-Z/; $rrt_allowed{$_}= 1; } split m/\s+/, $1;
        } elsif (m/^include\s+(\S.*)$/) {
            return if readconf($1);
        } elsif (m/^subdomain\s+(\S+)\s+(\S+)$/) {
            next unless $thiszone;
            next unless $1 eq $subdomain;
            next unless grep { $_ eq $2 } @userv_groups;
            return 1;
        } else {
            die "$cf:$.: config error\n";
        }
    }
    close $fh or die "$cf: close: $!\n";
    return 0;
}

readconf "$defconf"
    or die "permission denied\n";

chdir "$vardir" or die "chdir dyndns:$!\n";

open T,">tmp/$$" or die "create temp file: $!\n";

for (;;) {
    $?=0; $_= <STDIN>;
    die "input:$.:".($? ? "$?" : "eof") unless length;
    chomp;
    last if m/^\.$/;
    s/^(\S+)\s+(\d+)\s+([A-Za-z][0-9A-Za-z]*)\s+//
        or die "input:$.:bogus line\n";
    ($owner,$ttl,$type)= ($1,$2,$3);
    if ($owner eq '@') {
        $write_owner= $subdomain;
    } else {
        domainsyntax("input:$.",$owner) unless $owner eq '@';
        $write_owner= $subdomain eq '@' ? $owner : "$owner.$subdomain";
    }
    length "$write_owner.$zone." < 255
        or die "input:$.:$owner:resulting domain name too long\n";

    $ttl += 0;
    if ($ttl < $ttlmin) {
        warn "input:$.:$owner:capping ttl $ttl at lower bound $ttlmin\n";
        $ttl=$ttlmin;
    }
    if ($ttl > $ttlmax) {
        warn "input:$.:$owner:capping ttl $ttl at upper bound $ttlmax\n";
        $ttl=$ttlmax;
    }
    $type =~ y/a-z/A-Z/;
    die "input:$.:$owner:rr type not permitted:$type\n"
        unless $rrt_allowed{$type};
    if (exists $rrset_ttl{$owner,$type}) {
        die "input:$.:$owner:$type:RRset has varying TTLs\n"
            unless $rrset_ttl{$owner,$type} == $ttl;
    } else {
        $rrset_ttl{$owner,$type}= $ttl;
    }

    die "input:$.:$owner:CNAME and other records, or multiple CNAMEs\n"
        if $type eq 'CNAME'
            ? exists $owner_types{$owner}
            : exists $owner_types{$owner}->{'CNAME'};
           
    if ($type eq 'A') {
        defined($addr= inet_aton $_) or
            die "input:$.:$owner:invalid IP address\n";
        $data= inet_ntoa($addr);
    } elsif ($type eq 'AAAA') {
        defined($addr= inet_pton(AF_INET6, $_)) or
            die "input:$.:$owner:invalid IPv6 address\n";
        $data = inet_ntop(AF_INET6, $addr);
    } elsif ($type eq 'CNAME') {
        $data= domainsyntax_rel("input:$.:$owner:canonical name",$_).".";
    } elsif ($type eq 'MX') {
        m/^(\d+)\s+(\S+)$/ or die "input:$.:$owner:invalid MX syntax\n";
        ($pref,$target) = ($1,$2);
        $pref += 0;
        die "input:$.:$owner:invalid MX preference\n"
            if $pref<0 || $pref>65535;
        $target= domainsyntax_rel("input:$.:$owner:mail exchanger",$target);
        $data= "$pref $target.";
    } else {
        die "input:$.:$owner:unsupported RR type:$type\n";
    }
    $owner_types{$owner}->{$type}= 1;

    print T "$write_owner $ttl $type $data\n"
        or die "write data to temp file:$!\n";
}

close T or die "close RR data include:$!\n";
open STDIN, "< tmp/$$" or die "reopen RR data include:$!\n";
remove "tmp/$$" or die "close RR data include:$!\n";

chdir "zone,$zone" or die "chdir:$zone:$!\n";

exec "with-lock-ex","-w","Lock",
     "$libdir/update", $zone, $subdomain, @rates;
die "execute update program:$!\n";

sub domainsyntax ($$) {
    my ($w,$d) = @_;
    return if eval {
        die "bad char:\`$&'\n" if $d =~ m/[^-.0-9a-z]/;
        $d= ".$d.";
        die "label starts with hyphen\n" if $d =~ m/\.\-/;
        die "label ends with hyphen\n" if $d =~ m/\-\./;
        die "empty label or dot at start or end\n" if $d =~ m/\.\./;
        die "label too long\n" if $d =~ m/\..{64,}\./;
        die "domain name too long\n" if length $d > 255;
        1;
    };
    die "$w:invalid domain name:\`$d':$@";
}

sub domainsyntax_rel ($$) {
    my ($w,$d,$r) = @_;
    unless ($d =~ s/\.$//) {
        $d .= '.' unless $d =~ s/^\@$//;
        $d .= ($subdomain eq '@' ? "$zone" : "$subdomain.$zone");
    }
    domainsyntax($w,$d);
    return $d;
}