dyndns/service

   1 #!/usr/bin/perl
   2 # usage: (cat RRs; echo .) | userv dyndns <zone> <subdomain>
   3 # Not all zone file formats are accepted:
   4 #  - All RRs must have owners specified.
   5 #  - All RRs must have TTLs specified.
   6 #  - The owner must be specified as a sub-subdomain, relative
   7 #    to <subdomain>.<zone>, and so must not have a trailing `.';
   8 #    where the owner is to be <subdomain>.<zone>, `@' must be used.
   9
  10 # Copyright (C) 1999-2000,2003 Ian Jackson
  11 #
  12 # This file is part dyndns, part of userv-utils
  13 #
  14 # This is free software; you can redistribute it and/or modify it
  15 # under the terms of the GNU General Public License as published by
  16 # the Free Software Foundation; either version 2 of the License, or
  17 # (at your option) any later version.
  18 #
  19 # This program is distributed in the hope that it will be useful, but
  20 # WITHOUT ANY WARRANTY; without even the implied warranty of
  21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 # General Public License for more details.
  23 #
  24 # You should have received a copy of the GNU General Public License
  25 # along with userv-utils; if not, write to the Free Software
  26 # Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  27 #
  28 # $Id$
  29
  30 use POSIX;
  31
  32 BEGIN {
  33     $vardir= "/var/lib/userv/dyndns";
  34     $defconf= "/etc/userv/dyndns-domains";
  35     $libdir= "/usr/share/userv/dyndns";
  36 }
  37 END {
  38     remove "$vardir/tmp/$$" or $! == ENOENT or
  39         warn "cannot remove tempfile:$!\n";
  40 }
  41
  42 use FileHandle;
  43 use IO::File;
  44 use Socket;
  45 use Socket6;
  46
  47 @ARGV==2 or die "need <zone> and <domain> arguments\n";
  48 ($zone,$subdomain) = @ARGV;
  49 domainsyntax("command line",$zone);
  50 domainsyntax("command line",$subdomain) unless $subdomain eq '@';
  51
  52 @userv_groups= split m/ /, $ENV{'USERV_GROUP'};
  53
  54 @rates= (1,1,1000);
  55 $ttlmin= 0;
  56 $ttlmax= 86400;
  57
  58 sub readconf ($) {
  59     my ($cf,$fh) = @_;
  60     $fh= new FileHandle;
  61     $fh->open("< $cf") or die "$cf: $!\n";
  62     for (;;) {
  63         $!=0; $_= <$fh>;
  64         length or die "$cf:".($? ? "read:$?" : "eof")."\n";
  65         s/^\s+//; chomp; s/\s+$//;
  66         last if m/^eof$/;
  67         next if m/^\#/ or !m/\S/;
  68         if (m/^zone\s+(\S+)$/) {
  69             $thiszone= $1 eq $zone;
  70         } elsif (m/^ratelimit\s+(\d+)\s+(\d+)\s+(\d+)$/) {
  71             @rates= ($1,$2,$3);
  72         } elsif (m/^ttlrange\s+(\d+)\s+(\d+)$/) {
  73             ($ttlmin,$ttlmax) = ($1,$2);
  74         } elsif (m/^rrs\s+([A-Za-z0-9 \t]+)$/) {
  75             $rrt_list= $1;
  76             undef %rrt_allowed;
  77             grep { y/a-z/A-Z/; $rrt_allowed{$_}= 1; } split m/\s+/, $1;
  78         } elsif (m/^include\s+(\S.*)$/) {
  79             return if readconf($1);
  80         } elsif (m/^subdomain\s+(\S+)\s+(\S+)$/) {
  81             next unless $thiszone;
  82             next unless $1 eq $subdomain;
  83             next unless grep { $_ eq $2 } @userv_groups;
  84             return 1;
  85         } else {
  86             die "$cf:$.: config error\n";
  87         }
  88     }
  89     close $fh or die "$cf: close: $!\n";
  90     return 0;
  91 }
  92
  93 readconf "$defconf"
  94     or die "permission denied\n";
  95
  96 chdir "$vardir" or die "chdir dyndns:$!\n";
  97
  98 open T,">tmp/$$" or die "create temp file: $!\n";
  99
 100 for (;;) {
 101     $?=0; $_= <STDIN>;
 102     die "input:$.:".($? ? "$?" : "eof") unless length;
 103     chomp;
 104     last if m/^\.$/;
 105     s/^(\S+)\s+(\d+)\s+([A-Za-z][0-9A-Za-z]*)\s+//
 106         or die "input:$.:bogus line\n";
 107     ($owner,$ttl,$type)= ($1,$2,$3);
 108     if ($owner eq '@') {
 109         $write_owner= $subdomain;
 110     } else {
 111         domainsyntax("input:$.",$owner) unless $owner eq '@';
 112         $write_owner= $subdomain eq '@' ? $owner : "$owner.$subdomain";
 113     }
 114     length "$write_owner.$zone." < 255
 115         or die "input:$.:$owner:resulting domain name too long\n";
 116
 117     $ttl += 0;
 118     if ($ttl < $ttlmin) {
 119         warn "input:$.:$owner:capping ttl $ttl at lower bound $ttlmin\n";
 120         $ttl=$ttlmin;
 121     }
 122     if ($ttl > $ttlmax) {
 123         warn "input:$.:$owner:capping ttl $ttl at upper bound $ttlmax\n";
 124         $ttl=$ttlmax;
 125     }
 126     $type =~ y/a-z/A-Z/;
 127     die "input:$.:$owner:rr type not permitted:$type\n"
 128         unless $rrt_allowed{$type};
 129     if (exists $rrset_ttl{$owner,$type}) {
 130         die "input:$.:$owner:$type:RRset has varying TTLs\n"
 131             unless $rrset_ttl{$owner,$type} == $ttl;
 132     } else {
 133         $rrset_ttl{$owner,$type}= $ttl;
 134     }
 135
 136     die "input:$.:$owner:CNAME and other records, or multiple CNAMEs\n"
 137         if $type eq 'CNAME'
 138             ? exists $owner_types{$owner}
 139             : exists $owner_types{$owner}->{'CNAME'};
 140
 141     if ($type eq 'A') {
 142         defined($addr= inet_aton $_) or
 143             die "input:$.:$owner:invalid IP address\n";
 144         $data= inet_ntoa($addr);
 145     } elsif ($type eq 'AAAA') {
 146         defined($addr= inet_pton(AF_INET6, $_)) or
 147             die "input:$.:$owner:invalid IPv6 address\n";
 148         $data = inet_ntop(AF_INET6, $addr);
 149     } elsif ($type eq 'CNAME') {
 150         $data= domainsyntax_rel("input:$.:$owner:canonical name",$_).".";
 151     } elsif ($type eq 'MX') {
 152         m/^(\d+)\s+(\S+)$/ or die "input:$.:$owner:invalid MX syntax\n";
 153         ($pref,$target) = ($1,$2);
 154         $pref += 0;
 155         die "input:$.:$owner:invalid MX preference\n"
 156             if $pref<0 || $pref>65535;
 157         $target= domainsyntax_rel("input:$.:$owner:mail exchanger",$target);
 158         $data= "$pref $target.";
 159     } else {
 160         die "input:$.:$owner:unsupported RR type:$type\n";
 161     }
 162     $owner_types{$owner}->{$type}= 1;
 163
 164     print T "$write_owner $ttl $type $data\n"
 165         or die "write data to temp file:$!\n";
 166 }
 167
 168 close T or die "close RR data include:$!\n";
 169 open STDIN, "< tmp/$$" or die "reopen RR data include:$!\n";
 170 remove "tmp/$$" or die "close RR data include:$!\n";
 171
 172 chdir "zone,$zone" or die "chdir:$zone:$!\n";
 173
 174 exec "with-lock-ex","-w","Lock",
 175      "$libdir/update", $zone, $subdomain, @rates;
 176 die "execute update program:$!\n";
 177
 178 sub domainsyntax ($$) {
 179     my ($w,$d) = @_;
 180     return if eval {
 181         die "bad char:\`$&'\n" if $d =~ m/[^-.0-9a-z]/;
 182         $d= ".$d.";
 183         die "label starts with hyphen\n" if $d =~ m/\.\-/;
 184         die "label ends with hyphen\n" if $d =~ m/\-\./;
 185         die "empty label or dot at start or end\n" if $d =~ m/\.\./;
 186         die "label too long\n" if $d =~ m/\..{64,}\./;
 187         die "domain name too long\n" if length $d > 255;
 188         1;
 189     };
 190     die "$w:invalid domain name:\`$d':$@";
 191 }
 192
 193 sub domainsyntax_rel ($$) {
 194     my ($w,$d,$r) = @_;
 195     unless ($d =~ s/\.$//) {
 196         $d .= '.' unless $d =~ s/^\@$//;
 197         $d .= ($subdomain eq '@' ? "$zone" : "$subdomain.$zone");
 198     }
 199     domainsyntax($w,$d);
 200     return $d;
 201 }