3 # Copyright 1999-2005 Project Purple. Written by Jonathan McDowell
4 # See ACKNOWLEDGEMENTS file for full details of contributors.
5 # http://www.earth.li/projectpurple/progs/autodns.html
6 # Released under the GPL.
8 # $Id: autodns.pl,v 1.15 2005/06/15 10:26:25 noodles Exp $
15 use File::Temp qw(tempfile);
19 $ENV{'PATH'} = "/usr/local/bin:/usr/bin:/bin:/usr/sbin";
21 my ($from, $subject, $gpguser, $gpggood, $priv);
22 my ($user, $server, $inprocess, $delcount, $addcount);
23 my ($domain, @MAIL, @GPGERROR, @COMMANDS, %zones, $VERSION);
25 use vars qw($me $ccreply $conffile $domainlistroot @cfgfiles $usersfile
26 $lockfile $reload_command $expiry $zonefiledir);
33 my $file = '/etc/bind/autodns.conf';
34 unless (my $ret = do $file) {
35 warn "Couldn't parse $file\n" if $@;
36 warn "Couldn't do $file\n" unless defined $ret;
37 warn "Couldn't run $file\n" unless $ret;
38 die "Problem reading config file!\n";
42 ### There should be no need to edit anything below (unless you're not
43 ### using BIND). This statement might even be true now - let me know if not.
47 # Try to figure out what zones we currently know about by parsing config
48 # files. Sets the item in %zones to 1 for each zone it finds.
50 # Call with the name of a config file to read:
52 # getzones("/etc/named.conf");
55 my $namedfile = shift;
57 open (NAMEDCONF, "< $namedfile") or
58 fatalerror("Can't open $namedfile");
61 if (/^\s*zone\s*"([^"]+)"/) {
70 # Check that a domain is only made up of valid characters.
72 # These are: a-z, 0-9, - or .
78 if ($domain =~ /^(?:[a-z0-9-]+\.)+[a-z]{2,6}$/) {
80 } elsif ($domain =~ /^(?:[0-9\/-]+\.)+in-addr.arpa$/) {
88 # Deal with a fatal error by printing an error message, closing the pipe to
89 # sendmail and exiting.
91 # fatalerror("I'm melting!");
99 flock(LOCKFILE, LOCK_UN);
107 # Get user details from usersfile based on a PGP ID.
109 # A users entry looks like:
111 # <username>:<keyid>:<privilege level>:<master server ip>
113 # Priviledge level is not currently used.
115 # ($user, $priv, $server) = getuserinfo("5B430367");
119 my ($user, $privilege, $server);
121 open (CONFIGFILE, "< $usersfile") or
122 fatalerror("Couldn't open user configuration file.");
124 foreach (<CONFIGFILE>) {
125 if (/^([^#.]+):$gpguser:(\d+):(.+)$/) {
133 if ($user !~ /^.+$/) {
135 fatalerror("Error in user configuration ".
136 "file: Can't get username.\n");
139 if ($server !~ /^(\d{1,3}\.){3}\d{1,3}$/) {
140 $server =~ s/\d\.]//g;
142 fatalerror("Error in user configuration ".
143 "file: Invalid primary server IP ".
144 "address ($server)\n");
152 fatalerror("User not found.\n");
155 return ($user, $privilege, $server);
159 # Add a new AutoDNS user.
161 # addautodnsuser($username, $keyid, $priv, $masterip);
162 # <username>:<keyid>:<privilege level>:<master server ip>
164 sub addautodnsuser($$$$) {
165 my $username = shift;
168 my $masterip = shift;
170 # Create domains file for the user.
171 open (DOMAINLIST, ">>$domainlistroot$username") or
172 fatalerror("Couldn't create domains file.\n");
175 # Make the directory for the zone files.
176 my @dirs = mkpath("$zonefiledir/$username", 0, 0775);
177 fatalerror("Couldn't create zone file directory.\n")
178 if scalar(@dirs) == 0;
180 # Actually add them to the users file.
181 open(USERFILE, ">> $usersfile") or
182 fatalerror("Couldn't open user configuration file.");
183 print USERFILE "$username:$keyid:$priv:$masterip\n";
187 $delcount = $addcount = $inprocess = 0;
189 # Read in the mail from stdin.
192 $subject = "Reply from AutoDNS";
193 # Now lets try to find out who it's from.
196 if (/^From: (.*)/i) { $from = $1; chomp $from;}
197 if (/^Subject:\s+(re:)?(.*)$/i) { $subject = "Re: ".$2 if ($2);}
200 if ((! defined($from)) || $from =~ /^$/ ) {
201 die "Couldn't find a from address.";
202 } elsif ($from =~ /mailer-daemon@/i) {
203 die "From address is mailer-daemon, ignoring.";
206 if (! defined($subject)) { $subject = "Reply from AutoDNS"; };
208 # We've got a from address. Start a reply.
210 open(REPLY, "|sendmail -t -oem -oi") or die "Couldn't spawn sendmail";
212 print REPLY "From: $me\n";
213 print REPLY "To: $from\n";
215 # Check to see if our CC address is the same as the from address and if so
218 if ($from ne $ccreply) {
219 print REPLY "Cc: $ccreply\n";
225 Copyright 1999-2004 Project Purple. Written by Jonathan McDowell.
226 Released under the GPL.
231 # Throw the mail at MIME::Parser and see if it accepts it.
233 my $parser = new MIME::Parser;
234 $parser->output_to_core(1); # No temporary files
235 my $entity = $parser->parse_data(\@MAIL);
238 # Make sure locale is set to C so we get messages in English as we expect.
240 $ENV{'LC_ALL'} = "C";
242 if ($entity->parts) {
245 my ($got_sig, $got_text) = (0, 0);
246 my ($sig_fh, $sig_name) = tempfile();
247 my ($text_fh, $text_name) = tempfile();
249 foreach my $subent ($entity->parts) {
250 if ($subent->effective_type eq "text/plain") {
251 @COMMANDS = split /\n/,$subent->bodyhandle->as_string;
253 my $str = $subent->as_string;
259 } elsif ($subent->effective_type eq
260 "application/pgp-signature") {
261 print $sig_fh $subent->as_string;
264 } elsif ($subent->effective_type eq "multipart/mixed") {
265 my $str = $subent->as_string;
270 foreach my $mixent ($subent->parts) {
271 if ($mixent->effective_type eq "text/plain") {
272 push @COMMANDS, (split /\n/,
273 $mixent->bodyhandle->as_string);
275 if ($mixent->effective_type eq
276 "application/pgp-keys") {
277 push @COMMANDS, (split /\n/,
278 $mixent->bodyhandle->as_string);
284 if ($got_sig && $got_text) {
285 my $pid = open3(\*GPGIN, \*GPGOUT, \*GPGERR,
286 "gpg --batch --verify ".
287 $sig_name." ".$text_name);
291 @GPGERROR = <GPGERR>;
292 my @GPGOUTPUT = <GPGOUT>;
303 my $pid = open3(\*GPGIN, \*GPGOUT, \*GPGERR, "gpg --batch --verify");
306 print GPGIN $entity->bodyhandle->as_string;
309 # And grab what it has to say.
310 @GPGERROR = <GPGERR>;
311 @COMMANDS = <GPGOUT>;
312 @COMMANDS = split /\n/,$entity->bodyhandle->as_string;
318 # Check who it's from and if the signature was a good one.
321 foreach (@GPGERROR) {
323 if (/Signature made (.*) using.*ID (.*)$/) {
324 $sigtime = str2time($1);
328 print REPLY "Some errors ocurred\n";
329 } elsif (/BAD signature/) {
331 print REPLY "BAD signature!\n";
332 } elsif (/public key not found/) {
334 print REPLY "Public Key not found\n";
338 # If we have an empty user it probably wasn't signed.
340 print REPLY "Message appears not to be GPG signed.\n";
345 # Check the signature we got was ok.
347 print REPLY "Good GPG signature found. ($gpguser)\n";
349 print REPLY "Bad GPG signature!\n";
354 # Check if the signature is outside our acceptable range.
355 if (!defined($sigtime)) {
356 print REPLY "Couldn't parse signature time.\n";
359 } elsif ($sigtime > (time + $expiry)) {
360 print REPLY "Signature too far into the future.\n";
363 } elsif ($sigtime < (time - $expiry)) {
364 print REPLY "Signature too far into the past.\n";
369 # Now let's check if we know this person.
370 ($user, $priv, $server) = getuserinfo($gpguser);
372 if (! defined($user) || ! $user) {
373 print REPLY "Unknown user.\n";
378 print REPLY "Got user '$user'\n";
380 # Right. We know this is a valid user. Get a lock to ensure we have exclusive
381 # access to the configs from here on in.
382 open (LOCKFILE,">$lockfile") ||
383 fatalerror("Couldn't open lock file\n");
384 fatalerror("Couldn't get lock\n") unless(flock(LOCKFILE,LOCK_EX));
386 # Ok, now we should figure out what domains we already know about.
387 foreach my $cfgfile (@cfgfiles) {
391 # Force existance of the $domainlistroot$user file
392 if (! -e $domainlistroot.$user) {
393 open (DOMAINLIST, ">>$domainlistroot$user") or
394 fatalerror("Couldn't create domains file.\n");
398 foreach (@COMMANDS) {
399 # Remove trailing CRs and leading/trailing whitespace
406 print REPLY ">>>$_\n";
411 # Empty line, so ignore it.
415 } elsif (/^BEGIN$/) {
417 } elsif ($inprocess && /^ADD\s+(.*)$/) {
420 # Convert domain to lower case.
421 $domain =~ tr/[A-Z]/[a-z]/;
422 if (! valid_domain($domain)) {
423 $domain =~ s/[-a-z0-9.]//g;
424 print REPLY "Invalid character(s) in domain name:",
426 } elsif (defined($zones{$domain}) && $zones{$domain}) {
427 print REPLY "We already secondary $domain\n";
429 print REPLY "Adding domain $domain\n";
435 open (DOMAINSFILE, ">>$conffile");
437 ### Domain added for '$user'
441 masters { $server; };
442 file \"secondary/$user/$df\";
443 allow-transfer { none; };
444 allow-query { any; };
448 open (DOMAINLIST, ">>$domainlistroot$user") or
449 fatalerror("Couldn't open file.\n");
450 print DOMAINLIST "$domain\n";
454 } elsif ($inprocess && /^DEL\s(.*)$/) {
457 # Convert domain to lower case.
458 $domain =~ tr/[A-Z]/[a-z]/;
459 if (!valid_domain($domain)) {
460 $domain =~ s/[-a-z0-9.]//g;
461 print REPLY "Invalid character(s) in domain name:",
463 } elsif (!defined($zones{$domain}) || !$zones{$domain}) {
464 print REPLY "$domain does not exist!\n";
466 print REPLY "Deleting domain $domain\n";
467 my (@newcfg, $found);
469 open (DOMAINLIST, "<$domainlistroot$user") or
470 fatalerror("Couldn't open file ".
471 $domainlistroot.$user.
472 " for reading: $!.\n");
473 my @cfg = <DOMAINLIST>;
475 @newcfg = grep { ! /^$domain$/ } @cfg;
476 if (scalar @cfg == scalar @newcfg) {
477 print REPLY "Didn't find $domain in ",
478 "$domainlistroot$user!\n";
479 print REPLY "You are only allowed to delete",
480 " your own domains that exist.\n";
484 open (DOMAINLIST, ">$domainlistroot$user") or
485 fatalerror("Couldn't open file ".
486 $domainlistroot.$user.
487 " for writing: $!.\n");
488 print DOMAINLIST @newcfg;
493 open (DOMAINSFILE, "<$conffile") or
494 fatalerror("Couldn't open file $conffile for".
497 local $/ = ''; # eat whole paragraphs
498 while (<DOMAINSFILE>) {
499 unless (/^\s*zone\s+"$domain"/) {
503 if ($newcfg[-1] =~ /^###/) {
504 # remove comment and \n
509 } # end of paragraph eating
512 print REPLY "Didn't find $domain in",
517 open (DOMAINSFILE, ">$conffile") or
518 fatalerror("Couldn't open $conffile for".
520 print DOMAINSFILE @newcfg;
525 } elsif ($inprocess && /^LIST$/) {
526 print REPLY "Listing domains for user $user\n";
527 print REPLY "------\n";
528 if (open (DOMAINLIST, "<$domainlistroot$user")) {
530 while (<DOMAINLIST>) {
535 print REPLY "------\n";
536 print REPLY "Total of $count domains.\n";
538 print REPLY "Couldn't open $domainlistroot$user: $!\n";
540 } elsif ($inprocess && /^MASTER\s(.*)$/) {
541 if (($priv & 1) != 1) {
542 print REPLY "You're not authorised to use the MASTER ",
544 } elsif ($1 =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/) {
546 print REPLY "Set master IP address to $1\n";
548 print REPLY "$1 doesn't look like a valid IPv4 ",
551 } elsif ($inprocess && /^ADDUSER\s(.*)$/) {
552 if (($priv & 2) != 2) {
553 print REPLY "You're not authorised to use the ",
554 "ADDUSER command.\n";
555 } elsif ($1 =~ /^([a-z0-9]+) ([A-Fa-f0-9]{8}) (\d+) (\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/) {
556 addautodnsuser($1, $2, $3, $4);
558 print REPLY "Attempting to import new key:\n";
560 # Feed our command mail to GPG so we can pull the
561 # (hopefully included) new GPG key out from it.
562 my $pid = open3(\*GPGIN, \*GPGOUT, \*GPGERR,
563 "gpg --batch --import");
566 print GPGIN join("\n", @COMMANDS);
569 # And grab what it has to say.
570 @GPGERROR = <GPGERR>;
571 my @GPGOUTPUT = <GPGOUT>;
576 print REPLY @GPGERROR;
578 print REPLY "ADDUSER parameter error.\n";
580 } elsif ($inprocess && /^HELP$/) {
582 In order to use the service, you will need to send GPG signed messages.
583 The format of the text in these messages is important, as they represent
584 commands to autodns. Commands are formatted one per line, and enclosed
585 by "BEGIN" and "END" commands (without the quotes).
587 Current valid commands are:
589 BEGIN - begin processing.
590 END - end processing.
591 HELP - display this message.
592 LIST - show all the zones currently held by you.
593 ADD <domain> - adds the domain <domain> for processing.
594 DEL <domain> - removes the domain <domain> if you own it.
596 if (($priv & 1) == 1) {
597 print REPLY "MASTER <ip address> - set the nameserver".
598 " we should slave off for subsequent ADD\ncommands.\n";
600 if (($priv & 2) == 2) {
601 print REPLY "ADDUSER <username> <keyid> <privilege> ",
602 "<masterip> - add a new user. Imports any key",
603 "\nattached to the message into the keyring.\n";
605 } elsif ($inprocess) {
606 print REPLY "Unknown command!\n";
609 flock(LOCKFILE, LOCK_UN);
613 print REPLY "Added $addcount domains.\n" if $addcount;
614 print REPLY "Removed $delcount domains.\n" if $delcount;
615 if ($addcount || $delcount) {
616 print REPLY "Reloading nameserver config.\n";
617 print REPLY `$reload_command`;