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.
13 use File::Temp qw(tempfile);
17 $ENV{'PATH'} = "/usr/local/bin:/usr/bin:/bin:/usr/sbin";
19 my ($from, $subject, $gpguser, $gpggood, $priv);
20 my ($user, $server, $inprocess, $delcount, $addcount);
21 my ($domain, @MAIL, @GPGERROR, @COMMANDS, %zones, $VERSION);
23 use vars qw($me $ccreply $conffile $domainlistroot @cfgfiles $usersfile
24 $lockfile $reload_command $expiry $zonefiledir);
31 my $file = '/etc/bind/autodns.conf';
32 unless (my $ret = do $file) {
33 warn "Couldn't parse $file\n" if $@;
34 warn "Couldn't do $file\n" unless defined $ret;
35 warn "Couldn't run $file\n" unless $ret;
36 die "Problem reading config file!\n";
40 ### There should be no need to edit anything below (unless you're not
41 ### using BIND). This statement might even be true now - let me know if not.
45 # Try to figure out what zones we currently know about by parsing config
46 # files. Sets the item in %zones to 1 for each zone it finds.
48 # Call with the name of a config file to read:
50 # getzones("/etc/named.conf");
53 my $namedfile = shift;
55 open (NAMEDCONF, "< $namedfile") or
56 fatalerror("Can't open $namedfile");
59 if (/^\s*zone\s*"([^"]+)"/) {
68 # Check that a domain is only made up of valid characters.
70 # These are: a-z, 0-9, - or .
76 if ($domain =~ /^(?:[a-z0-9-]+\.)+[a-z]{2,6}$/) {
78 } elsif ($domain =~ /^(?:[0-9\/-]+\.)+in-addr.arpa$/) {
86 # Deal with a fatal error by printing an error message, closing the pipe to
87 # sendmail and exiting.
89 # fatalerror("I'm melting!");
97 flock(LOCKFILE, LOCK_UN);
105 # Get user details from usersfile based on a PGP ID.
107 # A users entry looks like:
109 # <username>:<keyid>:<privilege level>:<master server ip>
111 # Priviledge level is not currently used.
113 # ($user, $priv, $server) = getuserinfo("5B430367");
117 my ($user, $privilege, $server);
119 open (CONFIGFILE, "< $usersfile") or
120 fatalerror("Couldn't open user configuration file.");
122 foreach (<CONFIGFILE>) {
123 if (/^([^#.]+):$gpguser:(\d+):(.+)$/) {
131 if ($user !~ /^.+$/) {
133 fatalerror("Error in user configuration ".
134 "file: Can't get username.\n");
137 if ($server !~ /^(\d{1,3}\.){3}\d{1,3}$/) {
138 $server =~ s/\d\.]//g;
140 fatalerror("Error in user configuration ".
141 "file: Invalid primary server IP ".
142 "address ($server)\n");
150 fatalerror("User not found.\n");
153 return ($user, $privilege, $server);
157 # Add a new AutoDNS user.
159 # addautodnsuser($username, $keyid, $priv, $masterip);
160 # <username>:<keyid>:<privilege level>:<master server ip>
162 sub addautodnsuser($$$$) {
163 my $username = shift;
166 my $masterip = shift;
168 # Create domains file for the user.
169 open (DOMAINLIST, ">>$domainlistroot$username") or
170 fatalerror("Couldn't create domains file.\n");
173 # Make the directory for the zone files.
174 my @dirs = mkpath("$zonefiledir/$username", 0, 0775);
175 fatalerror("Couldn't create zone file directory.\n")
176 if scalar(@dirs) == 0;
178 # Actually add them to the users file.
179 open(USERFILE, ">> $usersfile") or
180 fatalerror("Couldn't open user configuration file.");
181 print USERFILE "$username:$keyid:$priv:$masterip\n";
185 $delcount = $addcount = $inprocess = 0;
187 # Read in the mail from stdin.
190 $subject = "Reply from AutoDNS";
191 # Now lets try to find out who it's from.
194 if (/^From: (.*)/i) { $from = $1; chomp $from;}
195 if (/^Subject:\s+(re:)?(.*)$/i) { $subject = "Re: ".$2 if ($2);}
198 if ((! defined($from)) || $from =~ /^$/ ) {
199 die "Couldn't find a from address.";
200 } elsif ($from =~ /mailer-daemon@/i) {
201 die "From address is mailer-daemon, ignoring.";
204 if (! defined($subject)) { $subject = "Reply from AutoDNS"; };
206 # We've got a from address. Start a reply.
208 open(REPLY, "|sendmail -t -oem -oi") or die "Couldn't spawn sendmail";
210 print REPLY "From: $me\n";
211 print REPLY "To: $from\n";
213 # Check to see if our CC address is the same as the from address and if so
216 if ($from ne $ccreply) {
217 print REPLY "Cc: $ccreply\n";
223 Copyright 1999-2004 Project Purple. Written by Jonathan McDowell.
224 Released under the GPL.
229 # Throw the mail at MIME::Parser and see if it accepts it.
231 my $parser = new MIME::Parser;
232 $parser->output_to_core(1); # No temporary files
233 my $entity = $parser->parse_data(\@MAIL);
236 # Make sure locale is set to C so we get messages in English as we expect.
238 $ENV{'LC_ALL'} = "C";
240 if ($entity->parts) {
243 my ($got_sig, $got_text) = (0, 0);
244 my ($sig_fh, $sig_name) = tempfile();
245 my ($text_fh, $text_name) = tempfile();
247 foreach my $subent ($entity->parts) {
248 if ($subent->effective_type eq "text/plain") {
249 @COMMANDS = split /\n/,$subent->bodyhandle->as_string;
251 my $str = $subent->as_string;
257 } elsif ($subent->effective_type eq
258 "application/pgp-signature") {
259 print $sig_fh $subent->as_string;
262 } elsif ($subent->effective_type eq "multipart/mixed") {
263 my $str = $subent->as_string;
268 foreach my $mixent ($subent->parts) {
269 if ($mixent->effective_type eq "text/plain") {
270 push @COMMANDS, (split /\n/,
271 $mixent->bodyhandle->as_string);
273 if ($mixent->effective_type eq
274 "application/pgp-keys") {
275 push @COMMANDS, (split /\n/,
276 $mixent->bodyhandle->as_string);
282 if ($got_sig && $got_text) {
283 my $pid = open3(\*GPGIN, \*GPGOUT, \*GPGERR,
284 "gpg --batch --verify ".
285 $sig_name." ".$text_name);
289 @GPGERROR = <GPGERR>;
290 my @GPGOUTPUT = <GPGOUT>;
301 my $pid = open3(\*GPGIN, \*GPGOUT, \*GPGERR, "gpg --batch --verify");
304 print GPGIN $entity->bodyhandle->as_string;
307 # And grab what it has to say.
308 @GPGERROR = <GPGERR>;
309 @COMMANDS = <GPGOUT>;
310 @COMMANDS = split /\n/,$entity->bodyhandle->as_string;
316 # Check who it's from and if the signature was a good one.
319 foreach (@GPGERROR) {
321 if (/Signature made (.*) using.*ID (.*)$/) {
322 $sigtime = str2time($1);
326 print REPLY "Some errors ocurred\n";
327 } elsif (/BAD signature/) {
329 print REPLY "BAD signature!\n";
330 } elsif (/public key not found/) {
332 print REPLY "Public Key not found\n";
336 # If we have an empty user it probably wasn't signed.
338 print REPLY "Message appears not to be GPG signed.\n";
343 # Check the signature we got was ok.
345 print REPLY "Good GPG signature found. ($gpguser)\n";
347 print REPLY "Bad GPG signature!\n";
352 # Check if the signature is outside our acceptable range.
353 if (!defined($sigtime)) {
354 print REPLY "Couldn't parse signature time.\n";
357 } elsif ($sigtime > (time + $expiry)) {
358 print REPLY "Signature too far into the future.\n";
361 } elsif ($sigtime < (time - $expiry)) {
362 print REPLY "Signature too far into the past.\n";
367 # Now let's check if we know this person.
368 ($user, $priv, $server) = getuserinfo($gpguser);
370 if (! defined($user) || ! $user) {
371 print REPLY "Unknown user.\n";
376 print REPLY "Got user '$user'\n";
378 # Right. We know this is a valid user. Get a lock to ensure we have exclusive
379 # access to the configs from here on in.
380 open (LOCKFILE,">$lockfile") ||
381 fatalerror("Couldn't open lock file\n");
382 fatalerror("Couldn't get lock\n") unless(flock(LOCKFILE,LOCK_EX));
384 # Ok, now we should figure out what domains we already know about.
385 foreach my $cfgfile (@cfgfiles) {
389 # Force existance of the $domainlistroot$user file
390 if (! -e $domainlistroot.$user) {
391 open (DOMAINLIST, ">>$domainlistroot$user") or
392 fatalerror("Couldn't create domains file.\n");
396 foreach (@COMMANDS) {
397 # Remove trailing CRs and leading/trailing whitespace
404 print REPLY ">>>$_\n";
409 # Empty line, so ignore it.
413 } elsif (/^BEGIN$/) {
415 } elsif ($inprocess && /^ADD\s+(.*)$/) {
418 # Convert domain to lower case.
419 $domain =~ tr/[A-Z]/[a-z]/;
420 if (! valid_domain($domain)) {
421 $domain =~ s/[-a-z0-9.]//g;
422 print REPLY "Invalid character(s) in domain name:",
424 } elsif (defined($zones{$domain}) && $zones{$domain}) {
425 print REPLY "We already secondary $domain\n";
427 print REPLY "Adding domain $domain\n";
433 open (DOMAINSFILE, ">>$conffile");
435 ### Domain added for '$user'
439 masters { $server; };
440 file \"secondary/$user/$df\";
441 allow-transfer { none; };
442 allow-query { any; };
446 open (DOMAINLIST, ">>$domainlistroot$user") or
447 fatalerror("Couldn't open file.\n");
448 print DOMAINLIST "$domain\n";
452 } elsif ($inprocess && /^DEL\s(.*)$/) {
455 # Convert domain to lower case.
456 $domain =~ tr/[A-Z]/[a-z]/;
457 if (!valid_domain($domain)) {
458 $domain =~ s/[-a-z0-9.]//g;
459 print REPLY "Invalid character(s) in domain name:",
461 } elsif (!defined($zones{$domain}) || !$zones{$domain}) {
462 print REPLY "$domain does not exist!\n";
464 print REPLY "Deleting domain $domain\n";
465 my (@newcfg, $found);
467 open (DOMAINLIST, "<$domainlistroot$user") or
468 fatalerror("Couldn't open file ".
469 $domainlistroot.$user.
470 " for reading: $!.\n");
471 my @cfg = <DOMAINLIST>;
473 @newcfg = grep { ! /^$domain$/ } @cfg;
474 if (scalar @cfg == scalar @newcfg) {
475 print REPLY "Didn't find $domain in ",
476 "$domainlistroot$user!\n";
477 print REPLY "You are only allowed to delete",
478 " your own domains that exist.\n";
482 open (DOMAINLIST, ">$domainlistroot$user") or
483 fatalerror("Couldn't open file ".
484 $domainlistroot.$user.
485 " for writing: $!.\n");
486 print DOMAINLIST @newcfg;
491 open (DOMAINSFILE, "<$conffile") or
492 fatalerror("Couldn't open file $conffile for".
495 local $/ = ''; # eat whole paragraphs
496 while (<DOMAINSFILE>) {
497 unless (/^\s*zone\s+"$domain"/) {
501 if ($newcfg[-1] =~ /^###/) {
502 # remove comment and \n
507 } # end of paragraph eating
510 print REPLY "Didn't find $domain in",
515 open (DOMAINSFILE, ">$conffile") or
516 fatalerror("Couldn't open $conffile for".
518 print DOMAINSFILE @newcfg;
523 } elsif ($inprocess && /^LIST$/) {
524 print REPLY "Listing domains for user $user\n";
525 print REPLY "------\n";
526 if (open (DOMAINLIST, "<$domainlistroot$user")) {
528 while (<DOMAINLIST>) {
533 print REPLY "------\n";
534 print REPLY "Total of $count domains.\n";
536 print REPLY "Couldn't open $domainlistroot$user: $!\n";
538 } elsif ($inprocess && /^MASTER\s(.*)$/) {
539 if (($priv & 1) != 1) {
540 print REPLY "You're not authorised to use the MASTER ",
542 } elsif ($1 =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/) {
544 print REPLY "Set master IP address to $1\n";
546 print REPLY "$1 doesn't look like a valid IPv4 ",
549 } elsif ($inprocess && /^ADDUSER\s(.*)$/) {
550 if (($priv & 2) != 2) {
551 print REPLY "You're not authorised to use the ",
552 "ADDUSER command.\n";
553 } elsif ($1 =~ /^([a-z0-9]+) ([A-Fa-f0-9]{8}) (\d+) (\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/) {
554 addautodnsuser($1, $2, $3, $4);
556 print REPLY "Attempting to import new key:\n";
558 # Feed our command mail to GPG so we can pull the
559 # (hopefully included) new GPG key out from it.
560 my $pid = open3(\*GPGIN, \*GPGOUT, \*GPGERR,
561 "gpg --batch --import");
564 print GPGIN join("\n", @COMMANDS);
567 # And grab what it has to say.
568 @GPGERROR = <GPGERR>;
569 my @GPGOUTPUT = <GPGOUT>;
574 print REPLY @GPGERROR;
576 print REPLY "ADDUSER parameter error.\n";
578 } elsif ($inprocess && /^HELP$/) {
580 In order to use the service, you will need to send GPG signed messages.
581 The format of the text in these messages is important, as they represent
582 commands to autodns. Commands are formatted one per line, and enclosed
583 by "BEGIN" and "END" commands (without the quotes).
585 Current valid commands are:
587 BEGIN - begin processing.
588 END - end processing.
589 HELP - display this message.
590 LIST - show all the zones currently held by you.
591 ADD <domain> - adds the domain <domain> for processing.
592 DEL <domain> - removes the domain <domain> if you own it.
594 if (($priv & 1) == 1) {
595 print REPLY "MASTER <ip address> - set the nameserver".
596 " we should slave off for subsequent ADD\ncommands.\n";
598 if (($priv & 2) == 2) {
599 print REPLY "ADDUSER <username> <keyid> <privilege> ",
600 "<masterip> - add a new user. Imports any key",
601 "\nattached to the message into the keyring.\n";
603 } elsif ($inprocess) {
604 print REPLY "Unknown command!\n";
607 flock(LOCKFILE, LOCK_UN);
611 print REPLY "Added $addcount domains.\n" if $addcount;
612 print REPLY "Removed $delcount domains.\n" if $delcount;
613 if ($addcount || $delcount) {
614 print REPLY "Reloading nameserver config.\n";
615 print REPLY `$reload_command`;