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