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