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 use POSIX;
  11
  12 BEGIN {
  13     $vardir= "/var/lib/userv/dyndns";
  14     $defconf= "/etc/userv/dyndns-domains";
  15     $libdir= "/usr/share/userv/dyndns";
  16 }
  17 END {
  18     remove "$vardir/tmp/$$" or $! == ENOENT or
  19         warn "cannot remove tempfile:$!\n";
  20 }
  21
  22 use FileHandle;
  23 use IO::File;
  24 use Socket;
  25 use Socket6;
  26
  27 @ARGV==2 or die "need <zone> and <domain> arguments\n";
  28 ($zone,$subdomain) = @ARGV;
  29 domainsyntax("command line",$zone);
  30 domainsyntax("command line",$subdomain) unless $subdomain eq '@';
  31
  32 @userv_groups= split m/ /, $ENV{'USERV_GROUP'};
  33
  34 @rates= (1,1,1000);
  35 $ttlmin= 0;
  36 $ttlmax= 86400;
  37
  38 sub readconf ($) {
  39     my ($cf,$fh) = @_;
  40     $fh= new FileHandle;
  41     $fh->open("< $cf") or die "$cf: $!\n";
  42     for (;;) {
  43         $!=0; $_= <$fh>;
  44         length or die "$cf:".($? ? "read:$?" : "eof")."\n";
  45         s/^\s+//; chomp; s/\s+$//;
  46         last if m/^eof$/;
  47         next if m/^\#/ or !m/\S/;
  48         if (m/^zone\s+(\S+)$/) {
  49             $thiszone= $1 eq $zone;
  50         } elsif (m/^ratelimit\s+(\d+)\s+(\d+)\s+(\d+)$/) {
  51             @rates= ($1,$2,$3);
  52         } elsif (m/^ttlrange\s+(\d+)\s+(\d+)$/) {
  53             ($ttlmin,$ttlmax) = ($1,$2);
  54         } elsif (m/^rrs\s+([A-Za-z0-9 \t]+)$/) {
  55             $rrt_list= $1;
  56             undef %rrt_allowed;
  57             grep { y/a-z/A-Z/; $rrt_allowed{$_}= 1; } split m/\s+/, $1;
  58         } elsif (m/^include\s+(\S.*)$/) {
  59             return if readconf($1);
  60         } elsif (m/^subdomain\s+(\S+)\s+(\S+)$/) {
  61             next unless $thiszone;
  62             next unless $1 eq $subdomain;
  63             next unless grep { $_ eq $2 } @userv_groups;
  64             return 1;
  65         } else {
  66             die "$cf:$.: config error\n";
  67         }
  68     }
  69     close $fh or die "$cf: close: $!\n";
  70     return 0;
  71 }
  72
  73 readconf "$defconf"
  74     or die "permission denied\n";
  75
  76 chdir "$vardir" or die "chdir dyndns:$!\n";
  77
  78 open T,">tmp/$$" or die "create temp file: $!\n";
  79
  80 for (;;) {
  81     $?=0; $_= <STDIN>;
  82     die "input:$.:".($? ? "$?" : "eof") unless length;
  83     chomp;
  84     last if m/^\.$/;
  85     s/^(\S+)\s+(\d+)\s+([A-Za-z][0-9A-Za-z]*)\s+//
  86         or die "input:$.:bogus line\n";
  87     ($owner,$ttl,$type)= ($1,$2,$3);
  88     if ($owner eq '@') {
  89         $write_owner= $subdomain;
  90     } else {
  91         domainsyntax("input:$.",$owner) unless $owner eq '@';
  92         $write_owner= $subdomain eq '@' ? $owner : "$owner.$subdomain";
  93     }
  94     length "$write_owner.$zone." < 255
  95         or die "input:$.:$owner:resulting domain name too long\n";
  96
  97     $ttl += 0;
  98     if ($ttl < $ttlmin) {
  99         warn "input:$.:$owner:capping ttl $ttl at lower bound $ttlmin\n";
 100         $ttl=$ttlmin;
 101     }
 102     if ($ttl > $ttlmax) {
 103         warn "input:$.:$owner:capping ttl $ttl at upper bound $ttlmax\n";
 104         $ttl=$ttlmax;
 105     }
 106     $type =~ y/a-z/A-Z/;
 107     die "input:$.:$owner:rr type not permitted:$type\n"
 108         unless $rrt_allowed{$type};
 109     if (exists $rrset_ttl{$owner,$type}) {
 110         die "input:$.:$owner:$type:RRset has varying TTLs\n"
 111             unless $rrset_ttl{$owner,$type} == $ttl;
 112     } else {
 113         $rrset_ttl{$owner,$type}= $ttl;
 114     }
 115
 116     die "input:$.:$owner:CNAME and other records, or multiple CNAMEs\n"
 117         if $type eq 'CNAME'
 118             ? exists $owner_types{$owner}
 119             : exists $owner_types{$owner}->{'CNAME'};
 120
 121     if ($type eq 'A') {
 122         defined($addr= inet_aton $_) or
 123             die "input:$.:$owner:invalid IP address\n";
 124         $data= inet_ntoa($addr);
 125     } elsif ($type eq 'AAAA') {
 126         defined($addr= inet_pton(AF_INET6, $_)) or
 127             die "input:$.:$owner:invalid IPv6 address\n";
 128         $data = inet_ntop(AF_INET6, $addr);
 129     } elsif ($type eq 'CNAME') {
 130         $data= domainsyntax_rel("input:$.:$owner:canonical name",$_).".";
 131     } elsif ($type eq 'MX') {
 132         m/^(\d+)\s+(\S+)$/ or die "input:$.:$owner:invalid MX syntax\n";
 133         ($pref,$target) = ($1,$2);
 134         $pref += 0;
 135         die "input:$.:$owner:invalid MX preference\n"
 136             if $pref<0 || $pref>65535;
 137         $target= domainsyntax_rel("input:$.:$owner:mail exchanger",$target);
 138         $data= "$pref $target.";
 139     } else {
 140         die "input:$.:$owner:unsupported RR type:$type\n";
 141     }
 142     $owner_types{$owner}->{$type}= 1;
 143
 144     print T "$write_owner $ttl $type $data\n"
 145         or die "write data to temp file:$!\n";
 146 }
 147
 148 close T or die "close RR data include:$!\n";
 149 open STDIN, "< tmp/$$" or die "reopen RR data include:$!\n";
 150 remove "tmp/$$" or die "close RR data include:$!\n";
 151
 152 chdir "zone,$zone" or die "chdir:$zone:$!\n";
 153
 154 exec "with-lock-ex","-w","Lock",
 155      "$libdir/update", $zone, $subdomain, @rates;
 156 die "execute update program:$!\n";
 157
 158 sub domainsyntax ($$) {
 159     my ($w,$d) = @_;
 160     return if eval {
 161         die "bad char:\`$&'\n" if $d =~ m/[^-.0-9a-z]/;
 162         $d= ".$d.";
 163         die "label starts with hyphen\n" if $d =~ m/\.\-/;
 164         die "label ends with hyphen\n" if $d =~ m/\-\./;
 165         die "empty label or dot at start or end\n" if $d =~ m/\.\./;
 166         die "label too long\n" if $d =~ m/\..{64,}\./;
 167         die "domain name too long\n" if length $d > 255;
 168         1;
 169     };
 170     die "$w:invalid domain name:\`$d':$@";
 171 }
 172
 173 sub domainsyntax_rel ($$) {
 174     my ($w,$d,$r) = @_;
 175     unless ($d =~ s/\.$//) {
 176         $d .= '.' unless $d =~ s/^\@$//;
 177         $d .= ($subdomain eq '@' ? "$zone" : "$subdomain.$zone");
 178     }
 179     domainsyntax($w,$d);
 180     return $d;
 181 }