chiark / gitweb /
ipif: Fix deprecation of udptunnel so it builds
[userv-utils.git] / 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 }