+#!/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.
+
+use POSIX;
+
+BEGIN {
+ $vardir= "/var/lib/userv/dyndns";
+ $defconf= "/etc/userv/dyndns-domains";
+ $libdir= "/usr/local/lib/userv/dyndns";
+}
+END {
+ remove "$vardir/tmp/$$" or $! == ENOENT or
+ warn "cannot remove tempfile:$!\n";
+}
+
+use FileHandle;
+use IO::File;
+use Socket;
+
+@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 '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;
+}